! PathFinder & Maze generator
! by Cassiope34

Fn.def gRVB(color$)
  gr.color 255, val(word$(color$,1)), val(word$(color$,2)), val(word$(color$,3)), 1
Fn.end

GR.OPEN 255,114,188,112,1,0   % pale green
GR.SCREEN real_w, real_h

! CONSTANTS !
!type = 2  % 1=eff   2=mur   3=pion vert   4=pion rouge
show = 0
dia  = 0  % diagonal not autorized = 0, autorized = 4
Dim cell[1,1]
DIM cas[1,1]
DIM casPtr[1,1]
DIM casBmp[6]
DIM colr$[6]
ARRAY.LOAD dirX[],0,1,0,-1,-1,1,-1,1  % 1 North  2 East  3 South  4 West  rest=diagonals
ARRAY.LOAD dirY[],-1,0,1,0,-1,-1,1,1
colr$[1] = "252 241 211"  % Ivory
colr$[2] = "000 060 255"  % Blue
colr$[3] = "012 200 038"  % Green
colr$[4] = "222 010 030"  % Red
colr$[5] = "156 156 156"  % Gray
colr$[6] = "255 150 000"  % Orange
oy = 36   % satusBar Height

nc = 41   % toujours impair, nombre de cases sur 1 cotГ©  (c'est un carrГ© !)

Restart:
c  = floor((real_h-oy)/nc)  % dimension d'un cotГ© de case en pixels
STARTX = floor(nc/2)+1   % coord. pion vert = point de dГ©part
STARTY = nc-1
TARGX = floor(nc/2)+1    % coord. pion rouge = point d'arrivГ©e
TARGY = 2

!  Create 6 bitmaps  !
for b=1 to 6
  if casBmp[b] then gr.bitmap.delete casBmp[b]
  gr.bitmap.create casBmp[b], c, c
  gr.bitmap.drawinto.start casBmp[b]
  call gRVB(colr$[1])   % cell ivory background
  if b=2
    call gRVB(colr$[2])    % wall
  endif
  gr.rect nul, 0,0,c-1,c-1
  if b>2
    call gRVB(colr$[b])
    if b<6
      gr.circle nul,c/2,c/2,c/2.2  % pawns
    else
      gr.circle nul,c/2,c/2,c/2.5  % little circle to show path
    endif
  endif
  gr.bitmap.drawinto.end
next

! start board nc x nc   with edges = 1 and update of cas[x,y]
 gr.CLS
 undim cas[]
 undim casPtr[]
 DIM cas[nc,nc]
 DIM casPtr[nc,nc]
 x=0
 y=1
 for i = 1 to nc*nc
    x++
    if x = 1 | x = nc then cas[x,y] = 1  % les bords = 1
    if y = 1 | y = nc then cas[x,y] = 1
    gr.bitmap.draw casPtr[x,y], casBmp[cas[x,y]+1], (x-1)*c, oy+(y-1)*c
    if x>nc-1
       x=0
       y++
    endif
 next
 gr.modify casPtr[STARTX, STARTY], "bitmap", casBmp[3]
 gr.modify casPtr[TARGX, TARGY], "bitmap", casBmp[4]
 
 ! MENU !
ct= (real_h-oy)/12
xt= real_h+1.6*ct
gr.text.align 1
gr.color 255,0,0,0,1
gr.text.size ct/1.6
gr.bitmap.draw nul, casBmp[1], xt, oy+1*ct-ct/5
gr.text.draw nul, xt+2*ct, oy+1*ct+10, "del"
gr.bitmap.draw nul, casBmp[2], xt, oy+2*ct-ct/5
gr.text.draw nul, xt+2*ct, oy+2*ct+10, "wall"
gr.bitmap.draw nul, casBmp[3], xt, oy+3*ct-ct/5
gr.text.draw nul, xt+2*ct, oy+3*ct+10, "green pawn"
gr.bitmap.draw nul, casBmp[4], xt, oy+4*ct-ct/5
gr.text.draw nul, xt+2*ct, oy+4*ct+10, "red pawn"
gr.color 255,0,0,0,0
gr.circle nul, xt+ct/4, oy+5*ct, ct/3
gr.text.draw nul, xt+2*ct, oy+5*ct+10, "diagonal"
gr.circle nul, xt+ct/4, oy+6*ct, ct/3
gr.text.draw nul, xt+2*ct, oy+6*ct+10, "show work"
gr.color 255,0,0,0,1
gr.circle diaPtr, xt+ct/4, oy+5*ct, ct/5
gr.circle showPt, xt+ct/4, oy+6*ct, ct/5
gr.text.align 2
gr.text.draw nul, xt+3*ct, oy+8*ct+10, "PathFinder"
gr.text.draw nul, xt+3*ct, oy+9*ct+10, "Maze Generator"
gr.text.draw resPtr, xt+3*ct, oy+10*ct+10, "Reset   ("+right$(format$("%%",nc),2)+"x"+ right$(format$("%%",nc),2)+")"
gr.text.size ct
gr.set.stroke 5
gr.text.draw nul, xt-ct,   oy+10*ct+14, "-"
!gr.text.draw nul, xt+7*ct, oy+10*ct+14, "+"
gr.text.draw nul, real_w-ct, oy+10*ct+14, "+"
gr.text.size ct/1.8
gr.set.stroke 0
gr.color 255,255,100,0,1
gr.text.draw mesg, xt+3*ct, oy+11.5*ct, ""
if dia  then gr.show diaPtr else gr.hide diaPtr
if show then gr.show showPt else gr.hide showPt       
curs = 2
gr.color 65,255,100,0,1
gr.rect cursPtr, xt-ct/3, oy+(curs-1)*ct+ct/2, xt+6*ct+ct/5, oy+(curs)*ct+ct/2

DO
  if !background() then gr.render
  DO
    GR.TOUCH touched,tx,ty
  UNTIL touched
  DO
    GR.TOUCH touched,tx,ty
    xSel= FLOOR(tx/c)+1
    ySel= FLOOR((ty-oy)/c)+1
    if xSel>1 & xSel<nc & ySel>1 & ySel<nc
      if curs<3
        cas[xSel,ySel] = curs-1
        gr.modify casPtr[xSel,ySel], "bitmap", casBmp[curs]
      elseif curs=3
        if xSel<>STARTX & xSel<>TARGX & ySel<>STARTY & ySel<>TARGY
          gr.modify casPtr[STARTX,STARTY], "bitmap", casBmp[1]
          gr.modify casPtr[xSel,ySel], "bitmap", casBmp[3]
          STARTX= xSel
          STARTY= ySel
        endif
      elseif curs=4
        if xSel<>TARGX & xSel<>STARTX & ySel<>STARTY & ySel<>TARGY
          gr.modify casPtr[TARGX,TARGY], "bitmap", casBmp[1]
          gr.modify casPtr[xSel,ySel], "bitmap", casBmp[4]
          TARGX= xSel
          TARGY= ySel
        endif
      endif
      gr.render
    endif
  UNTIL !touched
  
  if xSel > nc+1   % Menu
    curs = FLOOR((ty-oy-ct/2)/ct)+1
    if curs>0 & curs<11 & curs<>7
      chx:
      gr.modify cursPtr, "top", oy+(curs-1)*ct+ct/2
      gr.modify cursPtr, "bottom", oy+(curs)*ct+ct/2
      gr.render
      if curs=5
        if dia=0 then dia=4 else dia=0
        if dia then gr.show diaPtr else gr.hide diaPtr
        
      elseif curs=6
        if show=0 then show=1 else show=0
        if show then gr.show showPt else gr.hide showPt
        
      elseif curs=10
        xcurs= FLOOR((tx-nc*c)/ct)+1
        if xcurs<3
          if nc>20 then nc-=6
        elseif xcurs>8
          if nc<40 then nc+=6
        endif
        gr.modify resPtr, "text", "Reset   ("+right$(format$("%%",nc),2)+"x"+ right$(format$("%%",nc),2)+")"
        gr.render
        goto restart
        
      elseif curs=9
        gosub MazeGenerate
        curs=2
        goto chx
        
      elseif curs=8
        gosub pathfindOK
        curs=2
        goto chx
        
      endif
    endif
  endif
  
UNTIL 0

ONBACKKEY:
 POPUP "Goodbye",0,0,0
 PAUSE 500
 OnError:
 GR.CLOSE
END "Bye !"

!'''''''''''''''''  Labyrinthe !

MazeGenerate:
 gr.modify mesg, "text", "Maze Generate..."
 gr.render
 td = clock()
 nRows = 0
 nColumns = 0
 totalCells = 0
 visitedCells = 0
 currentCell = 0
 cellNext = 0
 lastCell$ = ""
 path$ = ""

 for y = 2 to nc-1
   for x = 2 to nc-1
     cas[x,y] = 1
     if mod(x,2) = 0 & mod(y,2) = 0 & x < nc & y < nc then cas[x,y] = 0
     gr.modify casPtr[x,y], "bitmap", casBmp[cas[x,y]+1]
   next
 next

 nRows = floor(nc/2)
 nColumns = floor(nc/2)
 undim cell[]
 DIM cell[nRows+1, nColumns+1]
 For row = 1 to nRows
   For column = 1 to nColumns
     cell[row,column] = (100*row + column) * -1
   Next
 Next
 cell[nRows,1] = Abs(cell[nRows,1])
 currentCell = cell[nRows,1]
 totalCells = nRows*nColumns
 visitedCells = 1
 cellNext = 1

 While visitedCells < totalCells
   gosub cellNextS
   IF cellNext > 0
     visitedCells++
     currentCell = cellNext
     gosub currentCellS
     path$ = path$+"-"+currentCell$
   ELSEIF cellNext = 0
     path$ = Left$(path$,Len(path$)-7)
     lastCell$ = Right$(path$,6)
     currentCell = Val(Left$(lastCell$,3))*100 + Val(Right$(lastCell$,3))
   EndIF
 Repeat

 cas[STARTX,STARTY] = 0
 cas[TARGX,TARGY] = 0
 gr.modify casPtr[STARTX, STARTY], "bitmap", casBmp[3]
 gr.modify casPtr[TARGX, TARGY], "bitmap", casBmp[4]
 gr.modify mesg, "text", "time :"+format$("## ###",clock()-td)+" ms."

RETURN

cellNextS: 
! depend of currentCell
 nCm = 0
 nC$= ""
 rC = Abs(floor(currentCell/100))
 cC = Abs(rC*100 - currentCell)
 if rC-1>0
  If cell[rC-1,cC] < 0
   nCm = nCm + 1
   nC$= nC$+format$("%%%%%",Abs(cell[rC-1,cC]))
  endif 
 EndIf
 If cell[rC,cC+1] < 0
   nCm = nCm + 1
   nC$= nC$+format$("%%%%%",Abs(cell[rC,cC+1]))
 EndIf
 If cell[rC+1,cC] < 0
   nCm = nCm + 1
   nC$= nC$+ format$("%%%%%",Abs(cell[rC+1,cC]))
 EndIf
 if cC-1>0
  If cell[rC,cC-1] < 0
   nCm = nCm + 1
   nC$= nC$+ format$("%%%%%",Abs(cell[rC,cC-1]))
  endif 
 EndIf
 If nCm = 0
   cellNext$ = ""
 Else
   rndPath = floor(Rnd()*nCm)+1
   cellNext$ = Word$(nC$, rndPath)
 EndIf
 if len(cellNext$) then cellNext = Val(cellNext$) else cellNext = 0
 If cellNext = 0
   path = 0
 Else
   rN = floor(cellNext/100)
   cN = cellNext - rN*100
   If rC - rN = 1 Then path = 1
   If cN - cC = 1 Then path = 2
   If rN - rC = 1 Then path = 3
   If cC - cN = 1 Then path = 4
 EndIf
 cell[rN,cN] = Abs(cell[rN,cN])
 IF path      % North East South West
   if cas[cC*2+dirX[path],rC*2+dirY[path]]<>0
     cas[cC*2+dirX[path],rC*2+dirY[path]]=0
     gr.modify casPtr[cC*2+dirX[path], rC*2+dirY[path]], "bitmap", casBmp[1]
     !gr.render  % to see generator work
   endif
 ENDIF
RETURN

currentCellS:
! depend of currentCell
 r = floor(currentCell/100)
 r$ = right$(format$("%%%",r),3)
 cc = currentCell - r*100
 c$ = right$(format$("%%%",cc),3)
 currentCell$ = r$+c$
RETURN

! ''''''''''''''''''''''' FIN GГ©nГ©rateur de Labyrinthe ''''''''''''''''''

razPath:
 x=0
 y=1
 for i = 1 to nc*nc
   x++
   if cas[x,y] = 0 then gr.modify casPtr[x,y], "bitmap", casBmp[1]
   if x>nc-1 then
     x=0
     y++
   endif
 next
 gr.modify casPtr[STARTX, STARTY], "bitmap", casBmp[3]
 gr.modify casPtr[TARGX, TARGY], "bitmap", casBmp[4]
 gr.render
RETURN

!********************* DEBUT de la RECHERCHE du PLUS COURT CHEMIN **********************

pathfindOK:
 gr.modify mesg, "text", "Pathfinder...."
 gr.render
 gosub razPath
 success = 0
 xc = STARTX  % case courante
 yc = STARTY
 ppp = 0   % distance pour arriver lГ  du parent... ici 0 puisque c'est la case de dГ©part !
 iterations = 0
 
! format des listes = "_XXYYxxyypppCCC_XXYYxxyypppCCC" etc...  une case = 15 caractГЁres.
     ! XXYY = coord. de la case
     ! xxyy = coord. de son parent (la case d'ou elle vient)
     ! ppp = cout de ce parent pour venir jusqu'ici dans le chemin.  (cpv)
     ! CCC = cout de la case = ppp + 1 + distance de la case Г  l'arrivГ©e Г  vol d'oiseau...

!         la case       son parent         ppp         son cout (sur 3 chiffres)
 lf$ = "_"+right$(format$("%%",STARTX),2)+right$(format$("%%",STARTY),2)~
          +right$(format$("%%",STARTX),2)+right$(format$("%%",STARTY),2)  % liste fermГ©e
 lo$ = ""    % liste ouverte
 td = clock()
 DO
   ! check all 4 (or 8) available directions
   FOR i = 1 TO 4 + dia      % ou 8 si les diagonales sont admises...
     Xnext = xc + dirX[i]    % coordonnГ©e de la case voisine dans la direction i
     Ynext = yc + dirY[i]
     if cas[Xnext, Ynext] = 0   % if not a wall
       ccc = ppp + abs(TARGY-Ynext) + abs(TARGX-Xnext)  % Calcul du Cout de cette case voisine.
       ct$ = "_"+ right$(format$("%%",Xnext),2)+ right$(format$("%%",Ynext),2)  % case Г  rechercher...
       if Ynext = TARGY & Xnext = TARGX   % arrivГ©e...
          lf$ = lf$ + ct$ +right$(format$("%%",xc),2)+right$(format$("%%",yc),2)  % liste fermГ©e
          success = 1
          F_n.break
       else
          if Is_In(ct$, lf$) = 0   % si la case n'est PAS dans la liste fermГ©e ...
            slo = Is_In(ct$, lo$)  % on la cherche dans la Liste Ouverte lo$
            if slo = 0     % si la case n'est pas dans la liste ouverte : on l'y met et c'est tout...
              lo$= lo$ +ct$ + right$(format$("%%",xc),2)+ right$(format$("%%",yc),2)~
                   + right$(format$("%%%",ppp),3)+ right$(format$("%%%",ccc),3)   % liste ouverte
              if show 
                gr.modify casPtr[Xnext,Ynext], "bitmap", casBmp[5]
                gr.render
              endif

            else
               ! si elle y est : comparer les 2 couts
              cclo = val(mid$(lo$, slo + 12, 3))   % cout de cette case dГ©jГ  prГ©sente dans lo$
              if ccc < cclo   % si le cout actuel est infГ©rieur Г  celui de cette case trouvГ©e dans lo$ :
       ! mise Г  jour des donnГ©es de cette case dans la liste ouverte : " parent ppp et cout"
                lt$ = left$(lo$,slo+4)   % partie gauche de lo$ y compris les XXYY de la case Г  mettre Г  jour
                lt$ = lt$ + right$(format$("%%",xc),2) + right$(format$("%%",yc),2)~
                          + right$(format$("%%%",ppp),3) + right$(format$("%%%",ccc),3) % mise Г  jour du parent + cout
                lo$ = lt$ + right$(lo$,len(lo$)-len(lt$))     % reconstruction de lo$
              endif
            endif
          endif
        endif
      endif
    NEXT
    if success then D_u.break
    nclo = len(lo$)/15  % nbre total de cases dans lo$ (liste ouverte)  (rappel: 1 case = 15 caractГЁres)

    if nclo = 0           % si liste ouverte vide = pas de solution... on arrГЄte.
       D_u.break

    elseif nclo = 1       % s'il n'y a qu'une case dans lo$ alors c'est celle lГ  qui est sГ©lectionnГ©e bien sur...!
       ncppc = 1

    else
      ! localise dans lo$ le nВ° de la case qui a le plus petit cout... = ncppc
       mc = val(right$(lo$,3))  % cout rГ©fГ©rence = celui de la DERNIERE case enregistrГ©e dans lo$
       ncppc = nclo
       for n = nclo to 1 step -1   % puis on remonte case par case dans lo$ en partant de la fin...
         mc2 = val(mid$(lo$, n*15-2, 3))  % cout de la case prГ©cГ©dente dans lo$
         if mc2 < mc    % cout infГ©rieur trouvГ©...
            mc = mc2
            ncppc = n   % ncppc = localisation (base 15) dans lo$ de la case qui a le plus petit cout.
         endif
       next
    endif

  ! maintenant retirer de lo$ la case qui a le plus petit cout (dГ©terminГ©e ci-dessus)
  ! la mettre dans la liste fermГ©e.
  ! en faire la case courante.

   lt$ = mid$(lo$,(ncppc-1)*15+1,15)  % la case choisie dans lo$ est mise dans une chaine temporaire.
   xc = val(mid$(lt$,2,2))  % devient la nouvelle case courante, (et donc le nouveau parent...)
   yc  = val(mid$(lt$,4,2))
   ppp = val(mid$(lt$,10,3)) + 1  % nouveau cout pour venir jusqu'ici (dans le chemin)

   lf$ = lf$ + left$(lt$,9)       % ajoutГ©e Г  la liste fermГ©e  (constitution du chemin)

    !retrait de cette case de lo$ (liste ouverte) :
   lt$ = left$(lo$,(ncppc-1)*15)  % partie gauche de lo$ avant la case choisie
   rst = nclo - (len(lt$)/15+1)
   lo$ = lt$ + right$(lo$,rst*15)  % reconstitution de la Liste Ouverte

    iterations++

 UNTIL success>0

 ! FIN de la RECHERCHE du PLUS COURT CHEMIN

 t = clock() - td
 
 !pathLenght = (len(lf$)/9)-2  % dernier cout de la derniГЁre case enregistrГ©e dans la liste fermГ©e lf$
 if success
    gr.modify mesg, "text", "Time :"+format$("## ###",t)+ " ms."
    pl=0
    i = Is_In("_"+right$(format$("%%",Xnext),2)+right$(format$("%%",Ynext),2), lf$)
    while i > 1
       x = val(mid$(lf$,i+5,2))
       y = val(mid$(lf$,i+7,2))
       gr.modify casPtr[x,y], "bitmap", casBmp[6]
       gr.render
       i = Is_In("_"+right$(format$("%%",x),2)+right$(format$("%%",y),2), lf$)
       pl++
    Repeat
    gr.modify casPtr[STARTX, STARTY], "bitmap", casBmp[3]
    gr.modify mesg, "text", "Time :"+format$("## ###",t)+ " ms.  lenght = "+format$("####",pl-1)
 else
    gr.modify mesg, "text", "impossible."
 endif
RETURN