'15 Puzzle (4x4) and variants
option base 1
Dim cputype%=0, f4%=4, cmm2%=0, ls$, ipsFlag%=0, pixRatio!, x%,y%
dim ORNGE%
If MM.Device$<>"Colour Maximite 2" Then
 cputype%=f4% ' ARMmite F407 (non-CMM2)
 pixRatio=min(mm.hres/1024,mm.vres/768) ' CMM2 mode 9 is 1024/768
 ORNGE%=rgb(brown)
 else: ORNGE%=rgb(orange):pixRatio=1
endif
dim string  a$
dim integer ex, ey, i, j, r, rx, ry, st, stx, sty, size
dim integer placed(99) 'values are 0 for not placed and 1 for placed
dim integer grid(10, 10) 'values are 0 (empty) and 1 - 15
dim integer pixels(10) 'width and height number of pixels for tiles for each size
dim integer smaller(10) 'number of tiles starting with zero per row and column for each size
dim integer larger(10) 'number of tiles starting with one per row and column for each size
dim integer tiles(10) 'number of numbered tiles for each size
dim integer sdnho(10) 'single digit number pixels offset (number 1-9 displayed on tile) for each size
dim integer tdnho(10) 'two digit number pixels offset (number 10-99 displayed on tile) for each size
dim integer vo(10) 'vertical pixels offset for each size
dim integer font_size(10) 'for number displayed on tile for each size
dim integer font_scale(10) 'font size multiplier for number displayed on tile for each size
if cputype%=cmm2% then mode 9, 16
font 2
color rgb(white)
main()

sub main
 local menu$(8)
 local size = 5  ' default choice
 local menux = MM.HRES/2

 menu$(1) = " 3.  3x3  ( 8 Puzzle)"
 menu$(2) = " 4.  4x4  (15 Puzzle)"
 menu$(3) = " 5.  5x5  (24 Puzzle)"
 menu$(4) = " 6.  6x6  (35 Puzzle)"
 menu$(5) = " 7.  7x7  (48 Puzzle)"
 menu$(6) = " 8.  8x8  (63 Puzzle)"
 menu$(7) = " 9.  9x9  (80 Puzzle)"
 menu$(8) = "10. 10x10 (99 Puzzle)"

 cls
 text menux,10, "15 Puzzle",CT, 2, 1, rgb(red)
 text menux, 230, "Select size with arrows, then press Enter",CT, 2, 1, rgb(green)
 do
   for i = 1 to 8
     text menux,30+i*20,menu$(i),CT,2,1, rgb(green),(size=i+2)*rgb(gray)
   next i

   do
     kp = asc(inkey$):
     if kp=27 then: a$=inkey$: a$=ucase$(inkey$)
       select case a$
         case "A": kp=128 ' UP ARROW
         case "B": kp=129 ' DOWN ARROW
         case "C": kp=131 ' RIGHT ARROW
         case "D": kp=130 ' LEFT ARROW
         case else: kp=0
       end select
     endif
   loop until kp <> 0
   select case kp
     case 13     ' [ENTER]
       if size >=3 and size <= 10 then exit do  ' range test just in case - not really needed
     case 128    ' [UP ARROW]
       size = size - (size > 3)
     case 129    ' [DOWN ARROW]
       size = size + (size <10)
   end select
 loop

 'Initialize arrays for new game
 for i = 1 to 99
   placed(i) = 0
 next i
 for i = 1 to 10
   for j = 1 to 10
     grid(i, j) = 0
   next j
 next i

 pixels(3)  = 240 : smaller(3)  = 2 : larger(3)  =  3 : tiles(3)  =  8
 pixels(4)  = 180 : smaller(4)  = 3 : larger(4)  =  4 : tiles(4)  = 15
 pixels(5)  = 144 : smaller(5)  = 4 : larger(5)  =  5 : tiles(5)  = 24
 pixels(6)  = 120 : smaller(6)  = 5 : larger(6)  =  6 : tiles(6)  = 35
 pixels(7)  = 103 : smaller(7)  = 6 : larger(7)  =  7 : tiles(7)  = 48
 pixels(8)  =  90 : smaller(8)  = 7 : larger(8)  =  8 : tiles(8)  = 63
 pixels(9)  =  80 : smaller(9)  = 8 : larger(9)  =  9 : tiles(9)  = 80
 pixels(10) =  72 : smaller(10) = 9 : larger(10) = 10 : tiles(10) = 99

 sdnho(3)  = 239 : tdnho(3)  = 239 : vo(3)  = 91 : font_size(3)  = 6 : font_scale(3)  = 2
 sdnho(4)  = 212 : tdnho(4)  = 174 : vo(4)  = 60 : font_size(4)  = 6 : font_scale(4)  = 2
 sdnho(5)  = 208 : tdnho(5)  = 191 : vo(5)  = 67 : font_size(5)  = 6 : font_scale(5)  = 1
 sdnho(6)  = 195 : tdnho(6)  = 179 : vo(6)  = 55 : font_size(6)  = 6 : font_scale(6)  = 1
 sdnho(7)  = 187 : tdnho(7)  = 170 : vo(7)  = 46 : font_size(7)  = 6 : font_scale(7)  = 1
 sdnho(8)  = 183 : tdnho(8)  = 171 : vo(8)  = 51 : font_size(8)  = 5 : font_scale(8)  = 1
 sdnho(9)  = 179 : tdnho(9)  = 166 : vo(9)  = 46 : font_size(9)  = 5 : font_scale(9)  = 1
 sdnho(10) = 175 : tdnho(10) = 163 : vo(10) = 41 : font_size(10) = 5 : font_scale(10) = 1
 if cputype%<>cmm2% then
   for i=3 to 10
     pixels(i)=pixels(i)*pixRatio
     font_size(i)=font_size(i)*pixRatio
   next i
 endif

 cls
 line 134*pixRatio,   4*pixRatio, 871*pixRatio,   4*pixRatio, 15*pixRatio, rgb(white)
 line 134*pixRatio, 741*pixRatio, 871*pixRatio, 741*pixRatio, 15*pixRatio, rgb(white)
 line 134*pixRatio,   4*pixRatio, 134*pixRatio, 755*pixRatio, 15*pixRatio, rgb(white)
 line 871*pixRatio,   4*pixRatio, 871*pixRatio, 755*pixRatio, 15*pixRatio, rgb(white)
 'Place the "blank" tiles on the grid
 for i = 0 to smaller(size)
   for j = 0 to smaller(size)
     x%=i * pixels(size) + 150*pixRatio
     y%=j * pixels(size) + 20*pixRatio
     box x%, y%, pixels(size), pixels(size), 1, rgb(black), rgb(red)
   next j
 next i
 'Randomly place the "empty tile" on the grid
 rx = int(rnd * larger(size))
 ry = int(rnd * larger(size))
 ex = rx
 ey = ry
 grid(rx + 1, ry + 1) = 0
 x%=rx * pixels(size) + 150*pixRatio
 y%=ry * pixels(size) + 20*pixRatio
 box x%, y%, pixels(size), pixels(size), 1, rgb(black), rgb(black)
 'Randomly place the tiles on the grid
 for i = 0 to smaller(size)
   for j = 0 to smaller(size)
     if rx <> i or ry <> j then 'Do not display a number for the "empty tile"
       do
         r = int(rnd * tiles(size) + 1)
         if placed(r) = 1 then continue do
         exit do
       loop
       grid(i + 1, j + 1) = r
       if r < 10 then
         x%=i * pixels(size) + sdnho(size)*pixRatio
         y%=j * pixels(size) + vo(size)*pixRatio
         text x%, y%, str$(r),, font_size(size), font_scale(size), rgb(yellow), rgb(red)
       else 'r > 9
         x%=i * pixels(size) + tdnho(size)*pixRatio
         y%=j * pixels(size) + vo(size)*pixRatio
         text x%, y%, str$(r),, font_size(size), font_scale(size), rgb(yellow), rgb(red)
       endif
       placed(r) = 1
     endif
   next j
 next i

 a$=str$(size)+".bmp"
'  save image a$
'  text 894*pixRatio, 20, "Slide Tile",, 2, 1, rgb(green)
 text 894*pixRatio, 20, "Use",, 2, 1, rgb(green)
 text 894*pixRatio, 60, "Arrow Keys",, 2, 1, rgb(green)
 text 894*pixRatio, 100, "to",, 2, 1, rgb(green)
 text 894*pixRatio, 140, "Slide Tile",, 2, 1, rgb(green)
 do
'    text 894, 44, "        ",, 2, 1, rgb(green)
'    text 894, 44, "",, 2, 1, rgb(green)
'    input st
'    if st < 1 or st > tiles(size) then continue do

   'Determine coordinates for tile that was slided
   do
     kp = asc(inkey$):
     if kp=27 then: a$=inkey$: a$=ucase$(inkey$)
       select case a$
         case "A": kp=128 ' UP ARROW
         case "B": kp=129 ' DOWN ARROW
         case "C": kp=131 ' RIGHT ARROW
         case "D": kp=130 ' LEFT ARROW
         case else: kp=0
       end select
     endif
   loop until kp <> 0
   select case kp
     case 128    ' [UP ARROW]
       stx = ex : sty = ey + (ey < size - 1)
     case 129    ' [DOWN ARROW]
       stx = ex : sty = ey - (ey > 0)
     case 130    ' [LEFT ARROW]
       stx = ex + (ex < size - 1) : sty = ey
     case 131    ' [RIGHT ARROW]
       stx = ex - (ex > 0) : sty = ey
   end select

   st = grid(stx + 1, sty + 1)

'    for i = 0 to smaller(size)
'      for j = 0 to smaller(size)
'        if grid(i + 1, j + 1) = st then
'          stx = i : sty = j
'        endif
'      next j
'    next i

   'Only allow a tile that is adjacent to the "empty tile" to be slided
   if stx - 1 = ex and sty = ey then
     pause 0
   elseif stx + 1 = ex and sty = ey then
     pause 0
   elseif stx = ex and sty - 1 = ey then
     pause 0
   elseif stx = ex and sty + 1 = ey then
     pause 0

   else
     continue do
   endif
   'Move the selected tile to the empty location
   x%=ex * pixels(size) + 150*pixRatio
   y%=ey * pixels(size) + 20*pixRatio
   box x%, y%, pixels(size), pixels(size), 1, rgb(black), rgb(red)
   if st < 10 then
     x%=ex * pixels(size) + sdnho(size)*pixRatio
     y%=ey * pixels(size) + vo(size)*pixRatio
     text x%,y%, str$(st),, font_size(size), font_scale(size), rgb(yellow), rgb(red)
   else 'st > 9
     x%=ex * pixels(size) + tdnho(size)*pixRatio
     y%=ey * pixels(size) + vo(size)*pixRatio
     text x%,y%, str$(st),, font_size(size), font_scale(size), rgb(yellow), rgb(red)
   endif
   'Draw the new "empty tile"
   x%=stx * pixels(size) + 150*pixRatio
   y%=sty * pixels(size) + 20*pixRatio
   box x%, y%, pixels(size), pixels(size), 1, rgb(black), rgb(black)
   'Update the grid and the empty square coordinates
   grid(ex + 1, ey + 1) = st
   grid(stx + 1, sty + 1) = 0
   ex = stx : ey = sty

   'Determine if the puzzle has been solved
   do
     for j = 1 to larger(size)
       for i = 1 to larger(size)
         if i = larger(size) and j = larger(size) then
           if grid(larger(size), larger(size)) <> 0 then
             exit do
           endif
         else
           if grid(j, i) <> (i - 1) * larger(size) + j then
             exit do
           endif
         endif
       next i
     next j
     ending()
     exit do
   loop
 loop
end sub

sub ending
 text 894*pixRatio, 182, "Solved!",, 2, 1, ORNGE%
 text 894*pixRatio, 226, "Play again (y)",, 2, 1, ORNGE%
 text 894*pixRatio, 260, "",, 2, 1, ORNGE%
 input a$
 if left$(lcase$(a$), 1) = "y" then
   main()
 else
   end
 endif
end sub

do : loop