Labyrinthes

' Generateur de labyrinthe
' D'apres un programme en QuickBasic
' https://rosettacode.org/wiki/Maze_generation#BASIC

const W = 50, H = 50  ' Dimensions (doivent etre paires)

randomize timer
 
' make array and fill
dim maze$(W, H), x%, y%

for x% = 0 to W
    for y% = 0 to H
        maze$(x%, y%) = chr$(143)
    next y%
next x%
 
' initial start location

dim currentx%, currenty%

currentx% = int(rnd * (W - 1))
currenty% = int(rnd * (H - 1))

' value must be odd
if currentx% mod 2 = 0 then currentx% = currentx% + 1
if currenty% mod 2 = 0 then currenty% = currenty% + 1

maze$(currentx%, currenty%) = " "
 
' generate maze

dim done%, i%, oldx%, oldy%

done% = 0
while done% = 0
    for i% = 0 to 99
        oldx% = currentx%
        oldy% = currenty%
 
        ' move in random direction
        select int(rnd * 4)
            case 0
                if currentx% + 2 < W then currentx% = currentx% + 2
            case 1
                if currenty% + 2 < H then currenty% = currenty% + 2
            case 2
                if currentx% - 2 > 0 then currentx% = currentx% - 2
            case 3
                if currenty% - 2 > 0 then currenty% = currenty% - 2
        end_select
 
        ' if cell is unvisited then connect it
        if maze$(currentx%, currenty%) = chr$(143) then
            maze$(currentx%, currenty%) = " "
            maze$((currentx% + oldx%) \ 2, (currenty% + oldy%) \ 2) = " "
        end if
    next i
 
    ' check if all cells are visited
    done% = 1
    for x% = 1 to W - 1 step 2
        for y% = 1 to H - 1 step 2
            if maze$(x%, y%) = chr$(143) then done% = 0
        next y%
    next x%
Wend
 
' draw maze

mode 3, "Labyrinthe", 16 * (W + 1), 16 * (H + 1)

for y% = 0 to H
    for x% = 0 to W
        locate x% + 1, y% + 1
        print maze$(x%, y%)
    next x%
next y%

while inkey$() = "" : wend

rem ===============================================================================
rem                         GENERATEUR DE LABYRINTHES
rem                                maze.bas
rem            D`APRES UN CODE EN BASIC-256 DE j.m.reneau 03-05-2010
rem                 ADAPTATION EN FBCROCO PAR PAPYDALL 15-03-2020
rem ===============================================================================
rem use a recursive backtracking algorithm to create a maze from the top left to
rem the bottom right of the graphics output area.
rem ===============================================================================

dim d,w,h  
d = 40       : '  < ============================================== Essayez 25 ou 50
w = int(500 / d)  : ' cell width in pixels
h = int(500 / d)  : ' cell height in pixels

dim cells(d,d)
dim visited(d,d)
dim notvisited(4)
dim stack(d*d,2)
dim walls(4)
dim nstack
dim x,y,x0,y0,c
dim nnotvisited, tnotvisited

nstack = 0 : x0 = 50 : y0 = 550

' constants for the walls array index and the value for notvisited
const goup    = 0
const goright = 1
const godown  = 2
const goleft  = 3

mode 3,"GENERATEUR DE LABYRINTES AVEC ENTREE / SORTIE",600,600
origin x0,y0

initcells
x = 0 : y = 0
pushstack
randomize timer
while nstack > 0
   visited(x, y) = true
   not_visited
   if nnotvisited > 0 then
      ' get a random direction to go
      tnotvisited = int(rnd * nnotvisited)
      ' remove the cell wall from  cell
      c = cells(x, y)
      cellwalls
      walls(notvisited(tnotvisited)) = 0
       wallscell
      cells(x, y) = c
      ' change current cell
      if notvisited(tnotvisited) = goup    then y = y - 1
      if notvisited(tnotvisited) = goright then x = x + 1
      if notvisited(tnotvisited) = godown  then y = y + 1
      if notvisited(tnotvisited) = goleft  then x = x - 1
      ' add to stack
      pushstack
      ' remove wall to previous cell
      c = cells(x, y)
      cellwalls
      if notvisited(tnotvisited) = goup    then walls(godown)  = 0
      if notvisited(tnotvisited) = godown  then walls(goup)    = 0
      if notvisited(tnotvisited) = goleft  then walls(goright) = 0
      if notvisited(tnotvisited) = goright then walls(goleft)  = 0
      wallscell
      cells(x, y) = c
   else
      popstack
   end_if
   drawmaze
end_while
locate 4,2   : ? chr$(241) + " Entree"
locate 26,36 : ? " Sortie " + chr$(240)


while inkey$ = "" : wend
rem ===============================================================================
SUB drawmaze()
    dim drawx,drawy
    cls
    for drawx = 0 to d-1
       for drawy = 0 to d-1
           c = cells(drawx, drawy)
           cellwalls
          if walls(goup)    then plot drawx * w, -drawy * h                 : draw drawx * w + w - 1 ,-drawy * h
          if walls(goright) then plot drawx * w + w - 1, -(drawy * h)         : draw drawx * w + w - 1 ,-(drawy * h + h - 1)
          if walls(godown)  then plot drawx * w + w - 1, -(drawy * h + h - 1) : draw drawx * w, -(drawy * h + h - 1)
          if walls(goleft)  then plot drawx * w, -drawy * h                 : draw drawx * w, -(drawy * h + h - 1)
      next drawy
    next drawx
END_SUB
rem ===============================================================================
SUB not_visited()
    nnotvisited = 0
    if x > 0 then
       if not visited(x-1, y)  then
          notvisited(nnotvisited) = goleft
          nnotvisited = nnotvisited + 1
       end_if
    end_if
    if x < d-1 then
       if not visited(x+1, y) then
          notvisited(nnotvisited) = goright
          nnotvisited = nnotvisited + 1
       end_if
    end_if
    if y > 0 then
       if not visited(x, y-1) then
          notvisited(nnotvisited) = goup
          nnotvisited = nnotvisited + 1
       end_if
    end_if
    if y < d-1 then
       if not visited(x, y+1) then
          notvisited(nnotvisited) = godown
          nnotvisited = nnotvisited + 1
       end_if
    end_if
END_SUB
rem ===============================================================================
SUB initcells()
    for x = 0 to d-1
        for y = 0 to d-1
            cells(x, y) = 15
            visited(x, y) = 0
        next y
    next x
    cells(0,0) = 14
    cells(d-1,d-1) = 11
END_SUB
rem ===============================================================================
SUB cellwalls()  : '  pass c with cells value
    ' get back walls()
    ' 0 = up 1 = right 2 = down 3 = left
    walls(goup)    = c mod 2
    walls(goright) = (c\2) mod 2
    walls(godown)  = (c\4) mod 2
    walls(goleft)  = (c\8) mod 2
END_SUB
rem ================================================================================
SUB wallscell()  : ' pass walls and get back c
    c = walls(goup) + walls(goright) * 2 + walls(godown) * 4 + walls(goleft) * 8
END_SUB
rem ================================================================================
SUB popstack()
    x = stack(nstack-1,0)
    y = stack(nstack-1,1)
    nstack = nstack - 1
END_SUB
rem ================================================================================
SUB pushstack()
    stack(nstack,0) = x
    stack(nstack,1) = y
    nstack = nstack + 1
END_SUB
rem ================================================================================

if visited(x-1, y) = false then

if not visited(x-1, y) then

' *******************************************************
' Exploration d'un labyrinthe
' *******************************************************

dim W% = 40, H% = 30  ' Dimensions (doivent etre paires)

dim bloc$, perso$, sortie$, touche$

bloc   = chr(207)
perso  = chr(248)
sortie = chr(238)

dim maze$(W, H)

mode 3, "Labyrinthe", 16 * (W + 1), 16 * (H + 5)

Boucle:

GenMaze maze(), bloc
DrawMaze maze(), bloc, perso, sortie
ExploreMaze maze(), bloc, perso

repeat
  touche = inkey()
until touche <> ""

if touche <> "ESCAPE" then goto Boucle

' *******************************************************

sub GenMaze(maze$(), bloc$)
' ---------------------------------------------------
' Generateur de labyrinthe
' D'apres un programme en QuickBasic
' https://rosettacode.org/wiki/Maze_generation#BASIC
' ---------------------------------------------------
' maze$() : Labyrinthe (0..W, 0..H)
'           W et H doivent etre pairs
' bloc$   : Caractere pour dessiner les murs
' ---------------------------------------------------

  dim W%, H%, x%, y%
  dim currentx%, currenty%, oldx%, oldy%
  dim done%, i%

  W = ubound(maze, 1)
  H = ubound(maze, 2)

  for x = 0 to W
    for y = 0 to H
      maze(x, y) = bloc
    next y
  next x
 
  randomize timer
 
 ' initial start location

  currentx = int(rnd * (W - 1))
  currenty = int(rnd * (H - 1))

  ' value must be odd
  if currentx mod 2 = 0 then currentx = currentx + 1
  if currenty mod 2 = 0 then currenty = currenty + 1

  maze(currentx, currenty) = " "
 
  ' generate maze

  done = 0
  while done = 0
    for i = 0 to 99
      oldx = currentx
      oldy = currenty
 
      ' move in random direction
      select int(rnd * 4)
        case 0
          if currentx + 2 < W then currentx = currentx + 2
        case 1
          if currenty + 2 < H then currenty = currenty + 2
        case 2
          if currentx - 2 > 0 then currentx = currentx - 2
        case 3
          if currenty - 2 > 0 then currenty = currenty - 2
      end_select
 
      ' if cell is unvisited then connect it
      if maze(currentx, currenty) = bloc then
        maze(currentx, currenty) = " "
        maze((currentx + oldx) \ 2, (currenty + oldy) \ 2) = " "
      end if
    next i
 
    ' check if all cells are visited
    done = 1
    for x = 1 to W - 1 step 2
      for y = 1 to H - 1 step 2
        if maze(x, y) = bloc then done = 0
      next y
    next x
  wend
end_sub

sub DrawMaze(maze$(), bloc$, perso$, sortie$)
' ---------------------------------------------------
' Dessine le labyrinthe et affiche la legende
' ---------------------------------------------------
' maze$() : Labyrinthe (0..W, 0..H)
'           W et H doivent etre pairs
' bloc$   : Caractere pour dessiner les murs
' perso$  : Caractere figurant le personnage
' sortie$ : Caractere figurant la sortie
' ---------------------------------------------------

  dim W%, H%, x%, y%

  W = ubound(maze, 1)
  H = ubound(maze, 2)

  pen CL_TURQUOISE
  for y = 0 to H
    for x = 0 to W
      locate x + 1, y + 1
      print maze(x, y)
    next x
  next y

  pen CL_VERT_VIF
  locate 2, H + 3 : print "Guidez le personnage   vers la sortie"
  locate 6, H + 4 : print "a l'aide des fleches du clavier"

  pen CL_ROUGE_VIF
  locate W, H : print sortie
  locate 40, H + 3 : print sortie

  pen CL_JAUNE_VIF
  locate 2, 2 : print perso
  locate 23, H + 3 : print perso
end_sub

sub ExploreMaze(maze$(), bloc$, perso$)
' ---------------------------------------------------
' Exploration du labyrinthe
' ---------------------------------------------------

  dim W%, H%, x%, y%, x1%, y1%, a$

  W = ubound(maze, 1)
  H = ubound(maze, 2)

  x = 2 : y = 2 : x1 = x : y1 = y
  
  repeat
    a = inkey()
    
    if a = "RIGHT" and x < W then x1 = x + 1
    if a = "LEFT"  and x > 2 then x1 = x - 1
    if a = "DOWN"  and y < H then y1 = y + 1
    if a = "UP"    and y > 2 then y1 = y - 1

    if x1 <> x or y1 <> y then
      if maze(x1 - 1, y1 - 1) <> bloc then
        locate x, y : print " "
        locate x1, y1 : print perso
        x = x1 : y = y1
      else
        x1 = x : y1 = y
      end_if
    end_if
  until (x = W and y = H)

  locate 1, H + 3 : print space(40)
  locate 1, H + 4 : print space(40)

  pen CL_TURQUOISE_VIF

  locate 11, H + 3 : print "Tapez ESC pour quitter,"
  locate  7, H + 4 : print "une autre touche pour rejouer"
end_sub

' *******************************************************
' Exploration d'un labyrinthe
' *******************************************************

dim W% = 40, H% = 30  ' Dimensions (doivent etre paires)

dim bloc$, perso$, sortie$, touche$

bloc   = chr(207)
perso  = chr(248)
sortie = chr(238)

dim maze$(W, H)

mode 3, "Labyrinthe", 16 * (W + 1), 16 * (H + 5)

print chr$(22, 4)  ' Active le mode transparent

Boucle:

cls
GenMaze maze(), bloc
DrawMaze maze(), bloc, perso, 2, 2
PrintLegend perso, sortie
ExploreMaze maze(), bloc, perso

repeat
  touche = inkey()
until touche <> ""

if touche <> "ESCAPE" then goto Boucle

' *******************************************************

sub GenMaze(maze$(), bloc$)
' ---------------------------------------------------
' Generateur de labyrinthe
' D'apres un programme en QuickBasic
' https://rosettacode.org/wiki/Maze_generation#BASIC
' ---------------------------------------------------
' maze$() : Labyrinthe (0..W, 0..H)
'           W et H doivent etre pairs
' bloc$   : Caractere pour dessiner les murs
' ---------------------------------------------------

  dim W%, H%, x%, y%
  dim currentx%, currenty%, oldx%, oldy%
  dim done%, i%

  W = ubound(maze, 1)
  H = ubound(maze, 2)

  for x = 0 to W
    for y = 0 to H
      maze(x, y) = bloc
    next y
  next x
 
  randomize timer
 
  ' initial start location
  currentx = int(rnd * (W - 1))
  currenty = int(rnd * (H - 1))

  ' value must be odd
  if currentx mod 2 = 0 then currentx = currentx + 1
  if currenty mod 2 = 0 then currenty = currenty + 1

  maze(currentx, currenty) = " "
 
  ' generate maze

  done = 0
  while done = 0
    for i = 0 to 99
      oldx = currentx
      oldy = currenty
 
      ' move in random direction
      select int(rnd * 4)
        case 0
          if currentx + 2 < W then currentx = currentx + 2
        case 1
          if currenty + 2 < H then currenty = currenty + 2
        case 2
          if currentx - 2 > 0 then currentx = currentx - 2
        case 3
          if currenty - 2 > 0 then currenty = currenty - 2
      end_select
 
      ' if cell is unvisited then connect it
      if maze(currentx, currenty) = bloc then
        maze(currentx, currenty) = " "
        maze((currentx + oldx) \ 2, (currenty + oldy) \ 2) = " "
      end if
    next i
 
    ' check if all cells are visited
    done = 1
    for x = 1 to W - 1 step 2
      for y = 1 to H - 1 step 2
        if maze(x, y) = bloc then done = 0
      next y
    next x
  wend
end_sub

sub PrintLegend (perso$, sortie$)
' ---------------------------------------------------
' Ecrit la legende
' ---------------------------------------------------
' perso$  : Caractere figurant le personnage
' sortie$ : Caractere figurant la sortie
' ---------------------------------------------------
  
  pen CL_BLANC : plot 0, 58 : drawr 16 * (W + 1), 0

  pen CL_VERT_VIF
  locate 2, H + 3 : print "Guidez le personnage   vers la sortie"
  locate 6, H + 4 : print "a l'aide des fleches du clavier"

  pen CL_ROUGE_VIF : locate 40, H + 3 : print sortie
  pen CL_JAUNE_VIF : locate 23, H + 3 : print perso
end_sub

sub DrawMaze(maze$(), bloc$, perso$, xp%, yp%)
' ---------------------------------------------------
' Dessine le labyrinthe
' ---------------------------------------------------
' xp%, yp% : Position du personnage
' ---------------------------------------------------

  dim W%, H%, x%, y%, x1%, y1%, dx%, dy%, dist%, op%

  W = ubound(maze, 1)
  H = ubound(maze, 2)

  for y = 0 to H
    for x = 0 to W
      x1 = x + 1
      y1 = y + 1
      dx = x1 - xp
      dy = y1 - yp
      dist = sqr(dx * dx + dy * dy)
      if dist < 5 then op = 250 - 50 * dist else op = 0
      pen RGBA(0, 128, 128, op)  
      locate x1, y1
      print maze(x, y)
    next x
  next y

  pen CL_ROUGE_VIF : locate W, H : print sortie
  pen CL_JAUNE_VIF : locate xp, yp : print perso
end_sub

sub ExploreMaze(maze$(), bloc$, perso$)
' ---------------------------------------------------
' Exploration du labyrinthe
' ---------------------------------------------------

  dim W%, H%, x%, y%, x1%, y1%, a$

  W = ubound(maze, 1)
  H = ubound(maze, 2)

  x = 2 : y = 2 : x1 = x : y1 = y
  
  repeat
    a = inkey()
    
    select a
      case "RIGHT" : if x < W then x1 = x + 1
      case "LEFT"  : if x > 2 then x1 = x - 1
      case "DOWN"  : if y < H then y1 = y + 1
      case "UP"    : if y > 2 then y1 = y - 1
    end_select

    if (x1 <> x or y1 <> y) and (maze(x1 - 1, y1 - 1) <> bloc) then
      DrawMaze maze(), bloc, perso, x1, y1
      locate x, y : print " "
      locate x1, y1 : print perso
      x = x1 : y = y1
    else
      x1 = x : y1 = y
    end_if
  until (x = W and y = H)

  locate 1, H + 3 : print space(40)
  locate 1, H + 4 : print space(40)

  pen CL_TURQUOISE_VIF

  locate 11, H + 3 : print "Tapez ESC pour quitter,"
  locate  7, H + 4 : print "une autre touche pour rejouer"
end_sub