Sliding Blocks Puzzle

I thought it would be fun to create a sliding-block puzzle on-screen. However I lost the code when I accidentally copied an 8G card image over the firtst 8G of my hard drive! This is therefore a re-creation, and bits are yet to add ( see the remarks in the code). I think an AI autosolver is beyond me however!

Code at present requires a 400x400 bitmap image called 'cellist.bmp', but fileselector will be added soon.

To be continued.....

    '   ********************************************************************
    '   **                                                                **
    '   **    SlidingBlocks6a1.bas  tenochtitlanuk   17 Jan 2020          **
    '   **                                                                **
    '   ********************************************************************

    '   To-dos
    '       make the move conditional on whether adjacent block chosen and blank    DONE
    '       get the graphics to work correctly- array seems to work & update        DONE

    '       add initial shuffle                                                     DONE

    '       add option to choose image, including one showing numbers
    '       test if all are in 'correct' places and announce number of attempted moves entered

    '       add routine to display moves attempted
    '       add routine to detect completion.
    '       add routine to save moves so can reverse/rewind to start.....



       nomainwin

    global blankX, blankY, clicks

    WindowWidth  = 412
    WindowHeight = 440
    UpperLeftX   = 800
    UpperLeftY   =  20

    open "Sliding blocks puzzle" for graphics_nsb as #wg

    #wg "trapclose quit"

    #wg "when leftButtonUp moveIfPossible"

    loadbmp "scr", "cellist.bmp"
    #wg "drawbmp scr 1 1 ; flush"

    dim puzzle$( 5, 5)

    i =1

    for y =1 to 4   '   save tile00 to tile15
        for x =1 to 4
            #wg "getbmp tile" +right$( "00" +str$( i), 2); " "; ( x -1) *100; " "; ( y -1) *100; " 100 100"
            'bmpsave "tile", "tile_" +right$( "00" +str$( i), 2)
            puzzle$( x, y) ="tile" +right$( "00" +str$( x +( y -1) *4), 2)
            i =i +1
        next x
    next y

    #wg "cls"   '   and now tile16, all white blank one
    #wg "getbmp tile16 300 300 100 100"
    #wg "cls"

    blankX =4
    blankY =4
    clicks =0

    '   fill the puzzle area systematically
    'for i =1 to 15  '   tile16 is the white one...
    '    #wg "drawbmp tile" +right$( "00" +str$( i), 2); " "; 100 *( ( i -1) mod 4); " "; 100 *( int( ( i -1) /4))
    'next i
    '        . .  . . . OR fill at random
    posn$       =" 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16"
    scrambled$  =""
    do
        R           =int( len( posn$) /3 *rnd( 1))              '   ie 0 ... 15
        scrambled$  =scrambled$ +mid$( posn$, 1 +3 *R, 3)       '   3 chars   starting at 1, 4, 7, ..
        lPart$      =left$( posn$, 3 *R)                        '   all chars up to & inc 0, 3, 6, ....
        rPart$      =mid$(  posn$, 3 *R +4)                     '   all chars after & inc 4, 7,10, ....
        posn$       =lPart$ +rPart$
        print scrambled$

        scan
    loop until len( posn$) =0

    for i =0 to 15
        x                       =( i mod 4)
        y                       =int( i /4)
        puzzle$( x +1, y +1)    ="tile" +mid$( scrambled$, 3 *i +2, 2)
        XX                      =val( mid$( puzzle$( x +1, y +1), 5, 1))
        YY                      =val( mid$( puzzle$( x +1, y +1), 6, 1))
        print "x+1, y+1 "; x+1; " "; y+1, "XX, YY "; XX; " "; YY; " tile = "; puzzle$( x +1, y +1)
        #wg "drawbmp "; puzzle$( x+1, y+1); " "; 100 *x; " "; 100 *y
        if str$( XX) ="1" and str$( YY) ="6" then blankX =x +1: blankY =y +1: print "Blank tile @ "; blankX; "; "; blankY
    next i

    print ""
    for y =1 to 4
        for x =1 to 4
            print puzzle$( x, y),
        next x
        print ""
    next y

    wait

    sub quit h$
        close #wg
        end
    end sub

    sub moveIfPossible h$, x, y
        'scan
        if clicks =0 then
            for y =1 to 4
                for x =1 to 4
                    print puzzle$( x, y),
                next x
                print ""
            next y
        end if

        print ""


        clicks                      =clicks +1

        tileX                       =int( MouseX /100) +1   '   1 to 4 in x and y
        tileY                       =int( MouseY /100) +1


        if ( tileX =4) and ( tileY =4) and abs( tileX -blankX) =1 and ( tileY -blankY) =1 then notice "Home!!": goto [kk]
        if ( tileX =blankX) and ( tileY =blankY)             then notice "You clicked space!": goto [skip]
        if abs( tileX -blankX) >1 or abs( tileY -blankY) >1  then notice "Too far away!":      goto [skip]
        if abs( tileX -blankX) =1 and abs( tileY -blankY) =1 then notice "Diagonal!":          goto [skip]
      [kk]
        print " Swap "; tileX; " ";  tileY; " "; puzzle$(  tileX,  tileY); " with ";_
                       blankX; " "; blankY; " "; puzzle$( blankX, blankY)

        ch                          =(  tileX) +4 *(  tileY -1)
        bl                          =( blankX) +4 *( blankY -1)

        #wg   "drawbmp "; puzzle$( blankX, blankY); " "; (  tileX -1) *100; " "; (  tileY -1) *100
        #wg   "drawbmp "; puzzle$(  tileX,  tileY); " "; ( blankX -1) *100; " "; ( blankY -1) *100

        temp$                       =puzzle$( blankX, blankY)
        puzzle$( blankX, blankY)    =puzzle$(  tileX,  tileY)
        puzzle$(  tileX,  tileY)    =temp$

        blankX                      =tileX
        blankY                      =tileY

        for y =1 to 4
            for x =1 to 4
                print puzzle$( x, y),
            next x
            print ""
        next y

        print " Blank at "; blankX; ", "; blankY
        print ""

        #wg "getbmp all 0 0 399 399"
        bmpsave "all", "all/all_" +right$( "000" +str$( clicks), 3) +".bmp"

      [skip]
    end sub

    end