! ColorSquare  11/2014 by @Cassiope34

Fn.def clr( cl$ )
  gr.color val(word$(cl$,1)), val(word$(cl$,2)), val(word$(cl$,3)), ~
           val(word$(cl$,4)), val(word$(cl$,5))
Fn.end

FN.DEF roundCornerRect (b, h, r)
 half_pi = 3.14159 / 2
 dphi    = half_pi / 8
 LIST.CREATE N, S1
 mx      = -b/2+r
 my      = -h/2+r
 FOR phi= 0 TO half_pi STEP dphi
  LIST.ADD s1, mx-COS(phi)*r, my-sin (phi)*r
 NEXT
 mx      = b/2-r
 my      = -h/2+r
 FOR phi= 0 TO half_pi STEP dphi
  LIST.ADD s1, mx+SIN(phi)*r, my- cos (phi)*r
 NEXT
 mx      = b/2-r
 my      = h/2-r
 FOR phi= 0 TO half_pi STEP dphi
  LIST.ADD s1, mx+COS(phi)*r, my+sin (phi)*r
 NEXT
 mx      = -b/2+r
 my      =  h/2-r
 FOR phi= 0 TO half_pi STEP dphi
  LIST.ADD s1, mx-SIN(phi)*r, my+cos (phi)*r
 NEXT
 FN.RTN s1
FN.END

File.Root tmp$
IstandAlone =Is_In("rfo-basic",tmp$)    % to know if it's an APK for the way to exit.

gr.open 255,163,163,163,0,0
gr.screen scrx,scry
svx =2560
svy =1600
sx  =scrx/svx
sy  =scry/svy
gr.scale sx,sy
ARRAY.LOAD diX[], 0, 1, 0,-1  % 1 North  2 East  3 South  4 West
ARRAY.LOAD diY[],-1, 0, 1, 0

DIM c$[6], bt[4], bptr[10,10], gb$[4], gc$[4], moves[4], best[4], tmv[4], tbe[4]
c$[1] ="255 24 255 0 1"   % vert
c$[2] ="255 0 54 255 1"   % bleu
c$[3] ="255 255 0 0 1"    % rouge
c$[4] ="255 255 192 0 1"  % orange
c$[5] ="255 0 240 255 1"  % bleu clair
c$[6] ="255 228 255 0 1"  % jaune
filesave$ ="ColorSquare.sav"
gb$[1] ="1122112233443344"
gb$[2] ="111222111222111222333444333444333444"
gb$[3] ="1111222211112222111122221111222233334444333344443333444433334444"
gb$[4] ="11111222221111122222111112222211111222221111122222"+~
        "33333444443333344444333334444433333444443333344444"
array.copy gb$[], gc$[]

nc    =4   % 4, 6, 8 or 10  grid size : 4x4, 6x6, 8x8 or 10x10
nmix$ ="16 36 64 80"   %  nb of mix at start...
File.exists fe, fileSave$

gr.bitmap.create bcurs, 250, 250    % button cursor
gr.bitmap.drawinto.start bcurs
  gr.color 50,0,0,0,1
  poly = roundCornerRect (250-10, 250-10, 25)
  gr.poly nul, poly, 250/2, 250/2
gr.bitmap.drawinto.end

New:        % --------  new game  -----------
gr.cls

unDim cell[]
Dim cell[10,10]

if fe then gosub loadgame
fe =0
sc   =(svy-140)/nc    % cell size

sbx  =svx-140         % grid background
sby  =sbx

! bitmaps creation
for b=1 to 4
  if bt[b] then gr.bitmap.delete bt[b]
  gr.bitmap.create bt[b], sc+1, sc+1    % colors bitmaps
  gr.bitmap.drawinto.start bt[b]
    gr.color 255,0,0,0,1
    gr.rect nul, 0, 0, sc+1, sc+1
    call clr( c$[b] )
    poly = roundCornerRect (sc-16, sc-16, 25)
    gr.poly nul, poly, sc/2, sc/2
  gr.bitmap.drawinto.end
next

gosub buttons     % reference + buttons
gr.text.size 60
gr.text.draw nul, sbx+400, 240, "<- NEW"

poly = roundCornerRect (nc*sc+20, nc*sc+20, 25)    % grid background
gr.color 255,0,0,0,1
gr.poly nul, poly, 70+(nc*sc)/2, 70+(nc*sc)/2

for y=1 to nc          % install bitmaps
  for x=1 to nc
    px =70+(x-1)*sc
    py =70+(y-1)*sc
    gr.bitmap.draw bptr[x,y], bt[1], px, py
  next
next

call clr( c$[6] )
gr.text.size 70
gr.text.draw mess, 280+nc*sc, 240, ""

ng    =val(mid$("...1.2.3.4",nc,1))
grid$ =gc$[ng]
start =1
if btn=1
 start =0
 grid$ =gb$[ng]   % new game
endif
gosub loadgrid
gr.modify curs, "y", sby+ng*iny+(iny-lgb)/2    % button cursor pos.

new =0
nnc =0
fin =0
if gc$[ng]=gb$[ng] then start =0

DO
  do
    gr.touch touched, x, y
    if !background() then gr.render
  until touched | quit
  if quit then D_U.break
  x/=sx
  y/=sy
  
  do
    gr.touch touched, tx, ty
  until !touched
  tx/=sx
  ty/=sy
  
  if tx>70 & tx<70+nc*sc & ty>70 & ty<70+nc*sc & !fin     % into the grid
    if start
      gosub dirset
      if fin then gr.modify mess, "text", "WIN !"
    else
      gosub mix
      start =1
    endif
    
  else
    btn =0
    if x>sbx & x<sbx+lgb then btn =int((y-70)/iny)+1    % buttons select
    btn =min(btn,5)
    if btn
      new =1
      nnc =val(word$("0 4 6 8 10",btn))
      if btn>1 & nnc<>nc
        gosub savegrid
        gc$[ng] =grid$
        nc =nnc
        gr.modify curs, "y", sby+btn*iny+(iny-lgb)/2
      endif
    endif
    
  endif
  
UNTIL quit | new

if new then goto New
gosub savegame
if IstandAlone
  END "Bye...!"
else
  EXIT
endif      %  ---------------  exit  ---------------

onbackkey:
if help
  gr.hide helpb
  help =0
  Back.resume
endif
lastime =clock()
if lastime-thistime <1000
  quit =1
else
  quit =0
  thistime =lastime
  popup " Press a second time to quit. ",0,0,0
endif
Back.resume

buttons:   % make & show the reference + buttons
lgb =250
sbx = (svx-140+nc*sc)/2
sby = 70
iny = (svy-140)/5
gr.bitmap.draw curs, bcurs, sbx, sby+iny+(iny-lgb)/2
gr.text.align 2
gr.set.stroke 6
for bn =0 to 4
  gr.color 255,0,0,255,0
  poly = roundCornerRect (lgb, lgb, 25)
  gr.poly nul, poly, sbx+lgb/2, sby+bn*iny+(iny-lgb)/2+lgb/2
  if bn
    gr.color 255,0,0,255,2
    gr.text.size 86
    gr.text.draw nul, sbx+lgb/2-2, sby+bn*iny+(iny-lgb)/2+iny/2+6, word$("4x4 6x6 8x8 10x10",bn)
    call clr( c$[6] )
    gr.text.size 66
    gr.text.draw tmv[bn], sbx+430, sby+bn*iny+(iny-lgb)/2+iny/2+6, word$(nmix$,bn)+" / "+int$(moves[bn])
    gr.text.draw tbe[bn], sbx-200, sby+bn*iny+(iny-lgb)/2+iny/2+6, int$(best[bn])
  endif
next
rfx = sbx+25
rfy = sby+45
call clr(c$[1])
gr.rect nul, rfx, rfy, rfx+100, rfy+100
call clr(c$[2])
gr.rect nul, rfx+100, rfy, rfx+200, rfy+100
call clr(c$[3])
gr.rect nul, rfx, rfy+100, rfx+100, rfy+200
call clr(c$[4])
gr.rect nul, rfx+100, rfy+100, rfx+200, rfy+200
return

dirset:    % direction detection + maj
dx =x-tx
dy =y-ty
d  =0
if abs(dx)>5 | abs(dy)>5   % pixels minimum for action.
 if abs(dx)>abs(dy)
  d =4
  if dx<0 then d =2
 else
  d =1
  if dy<0 then d =3
 endif
endif
if d
  cx =int((tx-70)/sc)+1
  cy =int((ty-70)/sc)+1
  if d=1       % haut
    cy =1
  elseif d=3   % bas
    cy =nc
  elseif d=2   % droite
    cx =nc
  elseif d=4   % gauche
    cx =1
  endif
  gosub slide
  moves[ng]++
  gr.modify tmv[ng], "text", word$(nmix$,ng)+" / "+int$(moves[ng])
  gosub savegrid
  gc$[ng] =grid$
  if grid$=gb$[ng]     % win control
    fin =1
    if moves[ng]<best[ng] | !best[ng]     % best score ?
      best[ng] =moves[ng]
      gr.modify tbe[ng], "text", int$(best[ng])
    endif
  endif
endif
return

slide:   % to d direction from cx,cy side pos.
d =val(mid$("3412",d,1))
for n =1 to nc-1
  swap cell[cx,cy], cell[cx+diX[d],cy+diY[d]]
  gr.modify bptr[cx,cy], "bitmap", bt[cell[cx,cy]]
  cx +=diX[d]
  cy +=diY[d]
next
gr.modify bptr[cx,cy], "bitmap", bt[cell[cx,cy]]
return

mix:
nmix =val(word$(nmix$,ng))
moves[ng] =0
for m=1 to nmix       % nombre de mélange
  d =int(rnd()*4)+1
  if d=1 | d=3
    cx =int(rnd()*nc)+1
    cy =nc
    if d=1 then cy=1
  else
    cy =int(rnd()*nc)+1
    cx =nc
    if d=4 then cx=1
  endif
  gosub slide
  gr.modify tmv[ng], "text", int$(m)+" / "+int$(moves[ng])
  gr.render
next
gosub savegrid
gc$[ng] =grid$
return

savegrid:
grid$ =""
for y=1 to nc
  for x=1 to nc
    grid$ =grid$+int$(cell[x,y])
  next
next
return

loadgrid:
c=0
for y=1 to nc
  for x=1 to nc
    c++
    cell[x,y] =val(mid$(grid$,c,1))
    gr.modify bptr[x,y], "bitmap", bt[ cell[x,y] ]
  next
next
return

savegame:
gosub savegrid
gc$[ng] =grid$
cls
print nc, moves[1] ,moves[2] ,moves[3] ,moves[4], best[1] ,best[2] ,best[3] ,best[4]
for n=1 to 4
  print gc$[n]
next
console.save filesave$
cls
return

loadgame:
grabfile ldgame$, filesave$
split ln$[], ldgame$, "\n"
nc       =val(word$(ln$[1],1,","))
for n=1 to 4
  moves[n] =val(word$(ln$[1],n+1,","))
  best[n]  =val(word$(ln$[1],n+5,","))
next
gc$[1] =ln$[2]
gc$[2] =ln$[3]
gc$[3] =ln$[4]
gc$[4] =ln$[5]
array.delete ln$[]
!file.delete fe, filesave$
return