PureBasic

Forums PureBasic
Nous sommes le Ven 19/Juil/2019 11:17

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 9 messages ] 
Auteur Message
 Sujet du message: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Sam 03/Mar/2018 19:34 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1121
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

_________________
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 : 5.45LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Sam 03/Mar/2018 20:28 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3980
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Sam 03/Mar/2018 21:39 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2772
Localisation: Klyntar
8O En effet, joli rendu en ci peut de ligne. Bravo Fig







@++

_________________
Windows 10 x64, PureBasic 5.71 Beta 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Sam 03/Mar/2018 22:42 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8703
Impressionnant. :!:

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Sam 03/Mar/2018 22:45 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6846
Localisation: IDF (Yvelines)
J'aime beaucoup ce type d'exercice. Merci Fig.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Dim 04/Mar/2018 11:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2153
Localisation: 50200 Coutances
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 GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Dim 04/Mar/2018 16:00 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2034
excellent :)

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Lun 05/Mar/2018 12:36 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4216
Localisation: Arras, France
môôm, c'est bôô :P


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Générateur de labyrinthe (parcours en profondeur)
MessagePosté: Mar 06/Mar/2018 9:40 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6637
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 9 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 3 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye