PureBasic
https://www.purebasic.fr/french/

Générateur de labyrinthe (parcours en profondeur)
https://www.purebasic.fr/french/viewtopic.php?f=2&t=17176
Page 1 sur 1

Auteur:  Fig [ Sam 03/Mar/2018 19:34 ]
Sujet du message:  Générateur de labyrinthe (parcours en profondeur)

Changez la constante #delay pour que le tracé se fasse plus ou moins vite.

Code:
#delay=70 ;milliseconds: reduce this value to make it faster
#mapsize=60
#size=10
;colors
#Black0=$000000
#White0=$FFFFFF
#Red0=$0000FF
#Blue0=$FF0000
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, #mapsize*#size, #mapsize*#size, "Maze generator", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,#mapsize*#size,#mapsize*#size,0,0,0,#PB_Screen_NoSynchronization)=0
   MessageRequester("Error", "Can't open the sprite system", 0)
   End
EndIf
Structure stack
   x.i
   y.i
EndStructure
Dim carte.b(#mapsize,#mapsize)
NewList stack.stack()
Dim dir.stack(3)
Dim dir2.b(3,1)
CreateSprite(0,#mapsize*#size,#mapsize*#size)
StartDrawing(SpriteOutput(0))
FillArea(10,10,#White)
StopDrawing()
CreateSprite(1,#size-2,#size-2)
StartDrawing(SpriteOutput(1))
Box(0,0,#size-2,#size-2,#Red)
StopDrawing()
dir(0)\x=0:dir(0)\y=-1:dir(1)\x=1:dir(1)\y=0
dir(2)\x=0:dir(2)\y=1:dir(3)\x=-1:dir(3)\y=0
dir2(0,0)=%0111:dir2(1,0)=%1011:dir2(2,0)=%1101:dir2(3,0)=%1110
dir2(0,1)=%1101:dir2(1,1)=%1110:dir2(2,1)=%0111:dir2(3,1)=%1011
For j.i=0 To #mapsize-1
   For i.i=0 To #mapsize-1
      xx.i=i*#size:yy.i=j*#size
      carte(i,j)=%1111
      If i=0 Or j=0 Or i=#mapsize-1 Or j=#mapsize-1:carte(i,j)=0:EndIf
   Next i
Next j
x.i=1:y.i=1:color.i=#Red0
Repeat
   Repeat:Until WindowEvent()=0
   Delay(#delay)
   FlipBuffers()
   ClearScreen(#Black0)
   ExamineKeyboard():If KeyboardPushed(#PB_Key_Escape):End:EndIf
   ;draw maze
   StartDrawing(SpriteOutput(0))
   xx=x*#size:yy=y*#size
   If carte(x,y) & %1000
      LineXY(xx,yy,xx+#size,yy,#Black0)
   Else
      LineXY(xx+1,yy,xx+#size-1,yy,#White0)
   EndIf   
   If carte(x,y) & %0100
      LineXY(xx+#size,yy,xx+#size,yy+#size,#Black0)
   Else
      LineXY(xx+#size,yy+1,xx+#size,yy+#size-1,#White0)
   EndIf   
   If carte(x,y) & %0010
      LineXY(xx+#size,yy+#size,xx,yy+#size,#Black0)
   Else
      LineXY(xx+#size-1,yy+#size,xx+1,yy+#size,#White0)
   EndIf   
   If carte(x,y) & %0001
      LineXY(xx,yy+#size,xx,yy,#Black0)
   Else
      LineXY(xx,yy+#size-1,xx,yy+1,#White0)
   EndIf
   StopDrawing()   
   DisplaySprite(0,0,0)
   DisplayTransparentSprite(1,x*#size+1,y*#size+1,255,color)
   color=#Red0
   ;test 4 directions
   If carte(x,y-1)<%1111 And carte(x+1,y)<%1111 And carte(x,y+1)<%1111 And carte(x-1,y)<%1111
      ;regression in stack
      x=stack()\x:y=stack()\y
      DeleteElement(stack())
      ;save picture when maze is completed
      If ListSize(stack())=0:SaveSprite(0,"maze.bmp"):End:EndIf
      color=#Blue0
      Continue
   EndIf
   ;choose a direction
   Repeat
      direction.i=Random(3)
   Until x+dir(direction)\x>0 And x+dir(direction)\x<#mapsize-1 And y+dir(direction)\y>0 And y+dir(direction)\y<#mapsize-1 And carte(x+dir(direction)\x,y+dir(direction)\y)=%1111
   ;delete previous wall
   carte(x,y)=carte(x,y) & dir2(direction,0)
   ;add to the stack
   AddElement(stack())
   stack()\x=x:stack()\y=y
   x=x+dir(direction)\x:y=y+dir(direction)\y
   ;delete wall
   carte(x,y)=carte(x,y) & dir2(direction,1)
ForEver

Auteur:  SPH [ Sam 03/Mar/2018 20:28 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

J'adore les labyrinthes. Bravo 8O

Auteur:  venom [ Sam 03/Mar/2018 21:39 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

8O En effet, joli rendu en ci peut de ligne. Bravo Fig







@++

Auteur:  Ar-S [ Sam 03/Mar/2018 22:42 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

Impressionnant. :!:

Auteur:  falsam [ Sam 03/Mar/2018 22:45 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

J'aime beaucoup ce type d'exercice. Merci Fig.

Auteur:  Micoute [ Dim 04/Mar/2018 11:07 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

J'aime bien aussi, bravo et merci pour le partage.

Auteur:  Zorro [ Dim 04/Mar/2018 16:00 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

excellent :)

Auteur:  djes [ Lun 05/Mar/2018 12:36 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

môôm, c'est bôô :P

Auteur:  Kwai chang caine [ Mar 06/Mar/2018 9:40 ]
Sujet du message:  Re: Générateur de labyrinthe (parcours en profondeur)

Moi je trouve ça super mignon, on dirait un lombric de carnaval :D , et un effet parfait 8O
Merci pour le partage 8)

Page 1 sur 1 Heures au format UTC + 1 heure
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/