Générateur de labyrinthe (parcours en profondeur)

Programmation avancée de jeux en PureBasic
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Générateur de labyrinthe (parcours en profondeur)

Message par Fig »

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

Code : Tout sélectionner

#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
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Générateur de labyrinthe (parcours en profondeur)

Message par SPH »

J'adore les labyrinthes. Bravo 8O
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Générateur de labyrinthe (parcours en profondeur)

Message par venom »

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







@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Générateur de labyrinthe (parcours en profondeur)

Message par Ar-S »

Impressionnant. :!:
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Générateur de labyrinthe (parcours en profondeur)

Message par falsam »

J'aime beaucoup ce type d'exercice. Merci Fig.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Générateur de labyrinthe (parcours en profondeur)

Message par Micoute »

J'aime bien aussi, bravo et merci pour le partage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Générateur de labyrinthe (parcours en profondeur)

Message par Zorro »

excellent :)
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Générateur de labyrinthe (parcours en profondeur)

Message par djes »

môôm, c'est bôô :P
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Générateur de labyrinthe (parcours en profondeur)

Message par Kwai chang caine »

Moi je trouve ça super mignon, on dirait un lombric de carnaval :D , et un effet parfait 8O
Merci pour le partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Répondre