PureBasic

Forums PureBasic
Nous sommes le Lun 17/Juin/2019 21:53

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 13 messages ] 
Auteur Message
 Sujet du message: Rogue dongeon
MessagePosté: Jeu 30/Mar/2017 14:50 
Hors ligne

Inscription: Jeu 07/Juin/2007 22:54
Messages: 261
Bonjour a vous.

Ça fait quelque temps que j'me demande comment je m'y prendrais si j’étais amené à devoir faire un générateur de niveau pour un jeux de type rogue like... J'ai donc décidé de me lancer la dedans.
Je sais que ce n'est surement pas le meilleur moyen d'approche mais c'est celui qui m'est venu en tête quand j'ai tenté de réfléchir à l'algo.

Loin d'être complet il à au moins l'air fonctionnel...

Code:
EnableExplicit
InitSprite()
Global Dim Mape(50,50)
Enumeration
  #Empty
  #Floor
  #Wall
  #Dore
EndEnumeration
Global *Wall, Room, Time
Declare FullArray(x,y)
Declare FirstRoom(MaxWidth,MinWidht,MaxHeight,MinHeight)
Declare FindDore(MaxWidth,MinWidht,MaxHeight,MinHeight,CouloirMax,CouloirMin)
Declare TestDirection(x,y,sizex,sizey)
Declare AddRoom(x,y,sizex,sizey)
Declare Generate(width,height,RoomMaxWidth,RoomMinWidth,RoomMaxHeight,RoomMinHeight,CouloirMax,CouloirMin,RoomAmontMin)

Procedure Generate(width,height,RoomMaxWidth,RoomMinWidth,RoomMaxHeight,RoomMinHeight,CouloirMax,CouloirMin,RoomAmontMin)
  FullArray(width,height)
  *Wall = FirstRoom(RoomMaxWidth,RoomMinWidth+1,RoomMaxHeight,RoomMinHeight+1) : Room = 1
  Repeat
    If FindDore(RoomMaxWidth,RoomMinWidth+1,RoomMaxHeight,RoomMinHeight+1,CouloirMax,CouloirMin) = #False
      Break
    EndIf
    Room + 1
  ForEver
  If Room >= RoomAmontMin
    Debug Str(Room)+" salles généré en "+Str(ElapsedMilliseconds() - Time) + "ms."
    ProcedureReturn #True
  Else
    Generate(width,height,RoomMaxWidth,RoomMinWidth,RoomMaxHeight,RoomMinHeight,CouloirMax,CouloirMin,RoomAmontMin)
  EndIf
EndProcedure
Procedure FirstRoom(MaxWidth,MinWidht,MaxHeight,MinHeight)
  Protected Loopx, Loopy, ResultX, ResultY,Width,Height, *Return = AllocateMemory(SizeOf(word)*4)
  Width = Random(MaxWidth,MinWidht)
  Height = Random(MaxHeight,MinHeight)
  ResultX = Random(ArraySize(Mape(),1)-Width)
  ResultY = Random(ArraySize(Mape(),2)-Height)
  PokeW(*return,ResultX) : PokeW(*return+SizeOf(word),ResultY):PokeW(*return+SizeOf(word)*2,Width):PokeW(*return+SizeOf(word)*3,Height)
  For Loopx = ResultX To ResultX + Width
    For Loopy = ResultY To ResultY + Height
      If Loopx = ResultX Or Loopx = ResultX + Width Or Loopy = ResultY Or Loopy = ResultY +Height
        Mape(Loopx,Loopy) = #Wall
       Else
         Mape(Loopx,Loopy) = #Floor
       EndIf
    Next Loopy
  Next Loopx
  ProcedureReturn *return
EndProcedure
Procedure FullArray(x,y)
  Global Dim Mape(x,y)
  Protected Loopx, Loopy
  For Loopx = 0 To x
    For Loopy = 0 To y
      Mape(Loopx,Loopy) = #Empty
    Next Loopy
  Next Loopx
EndProcedure
Procedure FindDore(MaxWidth,MinWidht,MaxHeight,MinHeight,CouloirMax,CouloirMin)
  Protected shift, shift2, shifty, shifty2, couloir,sizex,sizey, loopx, loopy
  shift = Random(PeekW(*Wall+SizeOf(word)*3)-1,1)
  shifty = Random(PeekW(*Wall+SizeOf(word)*2)-1,1)
  couloir = Random(CouloirMax,CouloirMin)
  sizex = Random(MaxWidth,MinWidht) : sizey = Random(MaxHeight,MinHeight)
  shift2 = Random(sizey-1,1)
  shifty2 = Random(sizex-1,1)
  If TestDirection(PeekW(*Wall)+PeekW(*Wall+SizeOf(word)*2)+couloir,PeekW(*Wall+SizeOf(word))+shift-shift2,sizex,sizey)
    Mape(PeekW(*Wall)+PeekW(*Wall+SizeOf(word)*2),PeekW(*Wall+SizeOf(word))+shift) = #Dore
    For loopx = PeekW(*Wall)+PeekW(*Wall+SizeOf(word)*2)+1 To PeekW(*Wall)+PeekW(*Wall+SizeOf(word)*2)+couloir-1
      For loopy = PeekW(*Wall+SizeOf(word))+shift-1 To PeekW(*Wall+SizeOf(word))+shift +1
        If loopy = PeekW(*Wall+SizeOf(word))+shift
          Mape(loopx,loopy) = #Floor
        Else
          Mape(loopx,loopy) = #Wall
        EndIf
      Next loopy
    Next loopx
    AddRoom(PeekW(*Wall)+PeekW(*Wall+SizeOf(word)*2)+couloir,PeekW(*Wall+SizeOf(word))+shift-shift2,sizex,sizey)
    Mape(PeekW(*Wall),PeekW(*Wall+SizeOf(word))+shift2) = #Dore
  ElseIf TestDirection(PeekW(*Wall)-couloir-sizex,PeekW(*Wall+SizeOf(word))+shift-shift2,sizex,sizey)
    Mape(PeekW(*Wall),PeekW(*Wall+SizeOf(word))+shift) = #Dore
    For loopx = PeekW(*Wall)-couloir+1 To PeekW(*Wall)-1
      For loopy = PeekW(*Wall+SizeOf(word))+shift-1 To PeekW(*Wall+SizeOf(word))+shift +1
        If loopy = PeekW(*Wall+SizeOf(word))+shift
          Mape(loopx,loopy) = #Floor
        Else
          Mape(loopx,loopy) = #Wall
        EndIf
      Next loopy
    Next loopx
    AddRoom(PeekW(*Wall)-couloir-sizex,PeekW(*Wall+SizeOf(word))+shift-shift2,sizex,sizey)
    Mape(PeekW(*Wall)+PeekW(*Wall+SizeOf(word)*2),PeekW(*Wall+SizeOf(word))+shift2) = #Dore
  ElseIf TestDirection(PeekW(*Wall)+shifty-shifty2,PeekW(*Wall+SizeOf(word))+PeekW(*Wall+SizeOf(word)*3)+couloir,sizex,sizey)
    Mape(PeekW(*Wall)+shifty,PeekW(*Wall+SizeOf(word))+PeekW(*Wall+SizeOf(word)*3)) = #Dore
    For loopx = PeekW(*Wall)+shifty-1 To PeekW(*Wall)+shifty +1
      For loopy = PeekW(*Wall+SizeOf(word))+PeekW(*Wall+SizeOf(word)*3)+1 To PeekW(*Wall+SizeOf(word))+PeekW(*Wall+SizeOf(word)*3) + couloir-1
        If loopx = PeekW(*Wall)+shifty
          Mape(loopx,loopy) = #floor
        Else
          Mape(loopx,loopy) = #Wall
        EndIf
      Next loopy
    Next loopx
    AddRoom(PeekW(*Wall)+shifty-shifty2,PeekW(*Wall+SizeOf(word))+PeekW(*Wall+SizeOf(word)*3)+couloir,sizex,sizey)
    Mape(PeekW(*Wall)+shifty2,PeekW(*Wall+SizeOf(word))) = #Dore
  ElseIf TestDirection(PeekW(*Wall)+shifty-shifty2,PeekW(*Wall+SizeOf(word))-couloir-sizey,sizex,sizey)
    Mape(PeekW(*Wall)+shifty,PeekW(*Wall+SizeOf(word))) = #Dore
    For loopx = PeekW(*Wall)+shifty-1 To PeekW(*Wall)+shifty+1
      For loopy = PeekW(*Wall+SizeOf(word))-couloir To PeekW(*Wall+SizeOf(word))-1
        If loopx = PeekW(*Wall)+shifty
          Mape(loopx,loopy) = #Floor
        Else
          Mape(loopx,loopy) = #Wall
        EndIf
      Next loopy
    Next loopx
    AddRoom(PeekW(*Wall)+shifty-shifty2,PeekW(*Wall+SizeOf(word))-couloir-sizey,sizex,sizey)
    Mape(PeekW(*Wall)+shifty2,PeekW(*Wall+SizeOf(word))+PeekW(*Wall+SizeOf(word)*3)) = #Dore
  Else
    ProcedureReturn #False
  EndIf
  ProcedureReturn  #True
EndProcedure
Procedure TestDirection(x,y,sizex,sizey)
  Protected Loopx, Loopy, result
  For Loopx = x To x+sizex
    For Loopy = y To y+sizey
      If Loopx >= 0 And Loopx <= ArraySize(Mape(),1) And Loopy >= 0 And Loopy <= ArraySize(Mape(),2)
        If Not Mape(Loopx,Loopy) = #Empty
          ProcedureReturn #False
        EndIf
      Else
        ProcedureReturn #False
      EndIf
    Next Loopy
  Next Loopx
  ProcedureReturn #True
EndProcedure
Procedure AddRoom(x,y,sizex,sizey)
  Protected loopx, loopy
  For loopx = x To x+sizex
    For loopy = y To y+sizey
      If Loopx = x Or Loopx = x + sizex Or Loopy = y Or Loopy = y + sizey
       Mape(Loopx,Loopy) = #Wall
     Else
        Mape(Loopx,Loopy) = #Floor
      EndIf 
    Next loopy
  Next loopx
  PokeW(*Wall,x) : PokeW(*Wall+SizeOf(word),y):PokeW(*Wall+SizeOf(word)*2,sizex):PokeW(*Wall+SizeOf(word)*3,sizey)
EndProcedure

;Exemple d'utilisation de l'algo
Declare Init()
Declare Display()
Declare Handler_Generate()

Init()
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Procedure Display()
  ClearScreen($000000)
  Protected Loopx, Loopy
  For Loopx = 0 To ArraySize(Mape(),1)
    For Loopy = 0 To ArraySize(Mape(),2)
      DisplaySprite(Mape(Loopx,Loopy),Loopx*10,Loopy*10)
    Next Loopy
  Next Loopx
  FlipBuffers()
EndProcedure
Procedure Init()
  Protected loop
  OpenWindow(0,0,0,800,600,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  ButtonGadget(0,610,10,80,20,"Generate !")
  TextGadget(#PB_Any,610,40,100,20,"Width")
  TextGadget(#PB_Any,610,70,100,20,"Height")
  TextGadget(#PB_Any,610,100,100,20,"Room min width")
  TextGadget(#PB_Any,610,130,100,20,"Room max width")
  TextGadget(#PB_Any,610,160,100,20,"Room min height")
  TextGadget(#PB_Any,610,190,100,20,"Room max height")
  TextGadget(#PB_Any,610,220,100,20,"Couloir min")
  TextGadget(#PB_Any,610,250,100,20,"Couloir max")
  TextGadget(#PB_Any,610,280,100,20,"Room amont min")
  SpinGadget(1,700,40,90,20,10,100,#PB_Spin_Numeric) : SetGadgetState(1,50)
  SpinGadget(2,700,70,90,20,10,100,#PB_Spin_Numeric) : SetGadgetState(2,50)
  SpinGadget(3,700,100,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(3,2)
  SpinGadget(4,700,130,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(4,20)
  SpinGadget(5,700,160,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(5,2)
  SpinGadget(6,700,190,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(6,20)
  SpinGadget(7,700,220,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(7,2)
  SpinGadget(8,700,250,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(8,5)
  SpinGadget(9,700,280,90,20,1,50,#PB_Spin_Numeric) : SetGadgetState(9,5)
  BindGadgetEvent(0,@Handler_Generate())
  OpenWindowedScreen(WindowID(0),0,0,600,600)
  CreateSprite(#Floor,10,10)
  StartDrawing(SpriteOutput(#floor))
  Box(0,0,10,10,$0000FF)
  StopDrawing()
  CreateSprite(#Empty,10,10)
  StartDrawing(SpriteOutput(#Empty))
  Box(0,0,10,10,$000000)
  StopDrawing()
  CreateSprite(#Wall,10,10)
  StartDrawing(SpriteOutput(#Wall))
  Box(0,0,10,10,$00FF00)
  StopDrawing()
  CreateSprite(#Dore,10,10)
  StartDrawing(SpriteOutput(#Dore))
  Box(0,0,10,10,$CC00CC)
  StopDrawing()
EndProcedure
Procedure Handler_Generate()
  Time = ElapsedMilliseconds()
  Generate(GetGadgetState(1),GetGadgetState(2),GetGadgetState(4),GetGadgetState(3),GetGadgetState(6),GetGadgetState(5),GetGadgetState(8),GetGadgetState(7),GetGadgetState(9))
  Display()
EndProcedure

Edit : Petite modif de dernière minutes... le temps donné pour la génération du niveau n'était évidement pas bon


Dernière édition par boby le Ven 31/Mar/2017 13:59, édité 4 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Jeu 30/Mar/2017 14:54 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8667
Nickel, marche au poil :)

_________________
~~~~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: Rogue dongeon
MessagePosté: Jeu 30/Mar/2017 19:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1122
Très sympa et ça marche bien, mais quelle quantité de peek et de poke ! 8O

_________________
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: Rogue dongeon
MessagePosté: Jeu 30/Mar/2017 20:02 
Hors ligne

Inscription: Jeu 07/Juin/2007 22:54
Messages: 261
@Fig les peek/poke c'est pour ne pas avoir à faire une structure, c'est toujours un peut plus rapide d'accéder directement à une adresse mémoire.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Jeu 30/Mar/2017 20:20 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4210
Localisation: Arras, France
Bim, une erreur sur le redim... vivement que cette fonction soit changée !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Ven 31/Mar/2017 10:55 
Hors ligne

Inscription: Jeu 07/Juin/2007 22:54
Messages: 261
Edit du code pour correction du ReDim, c'est entièrement ma faut le coup du ReDim, j'ai juste pas lu la doc :
Citation:
If ReDim is used with a multi-dimension array, only its last dimension can be changed.


Merci djes de me l'avoir fait remarquer.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Ven 31/Mar/2017 11:30 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4210
Localisation: Arras, France
boby a écrit:
Edit du code pour correction du ReDim, c'est entièrement ma faut le coup du ReDim, j'ai juste pas lu la doc :
Citation:
If ReDim is used with a multi-dimension array, only its last dimension can be changed.


Merci djes de me l'avoir fait remarquer.

Oui, bon, je suis tombé assez souvent sur ce problème, et c'est quand même assez pénible pour ne pas t'en tenir rigueur, surtout vue la qualité du reste du code ;)
Il faudrait vraiment une option pour permettre le redim multi-dimensionnel, même si ça efface le contenu ou que c'est lent...


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Ven 31/Mar/2017 12:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8667
Citation:
Il faudrait vraiment une option pour permettre le redim multi-dimensionnel, même si ça efface le contenu ou que c'est lent...

+1 je l'ai ajouté en wishlist.. Je pense qu'on est nombreux à le vouloir.

_________________
~~~~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: Rogue dongeon
MessagePosté: Ven 31/Mar/2017 13:52 
Hors ligne

Inscription: Jeu 07/Juin/2007 22:54
Messages: 261
C'est vrais qu'on peut se faire avoir assez facilement mais je ne sais pas si c'est parmi les options les plus importantes à demander, effacer le contenu puis refaire le tableau, c'est ce que j'ai fait et ça se fait en 4 lignes, j'ai connu plus chiant comme problème :p

Code:
  ;   ReDim Mape(x,y)
  If ArraySize(Mape())
    FreeArray(Mape())
    Global Dim Mape(x,y)
  EndIf

(Et encore une fois, lire la doc m'aurais économiser 3 lignes de code... Un jour promis j’arrêterais de foncer tête baissée !)
Citation:
If Dim is used on an existing array, it will reset its contents to zero.


Après si on veux conserver les données c'est plutôt simple à condition de connaitre le nombre de dimension du tableau
Code:
Dim array1(10,10)
For loop1 = 0 To 10
  For loop2 = 0 To 10
    array1(loop1,loop2) = loop1+loop2
  Next loop2
Next loop1
;=========REDIM AVEC CONSERVATION DES DATA============
Dim array2(10,10)
CopyArray(array1(),array2())
Dim array1(5,5)
CopyArray(array2(),array1())
FreeArray(array2())
;=========FIN DU REDIM LES DATA SONT BIEN CONSERVÉES !===
For loop1 = 0 To 5
  For loop2 = 0 To 5
    Debug array1(loop1,loop2)
  Next loop2
Next loop1

En revanche un algo qui marche quelque soit le nombre de dimension, persso... Je ne voie pas comment je m'y prendrais :-/


Dernière édition par boby le Ven 31/Mar/2017 17:42, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Ven 31/Mar/2017 15:45 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4210
Localisation: Arras, France
C'est pas faux ;)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Sam 01/Avr/2017 8:22 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1122
boby a écrit:
@Fig les peek/poke c'est pour ne pas avoir à faire une structure, c'est toujours un peut plus rapide d'accéder directement à une adresse mémoire.

Dans mon souvenir, peek et poke sont plus lents qu'utiliser des pointeurs... Mais comme ça fait un moment que je n'utilise plus peek et poke pour ces raisons, j'ai peut être tord :wink:

_________________
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: Rogue dongeon
MessagePosté: Sam 01/Avr/2017 10:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 13/Déc/2015 11:05
Messages: 649
Localisation: Allez, cherche...
Peek, Poke, ect = appel de fonction, et l'appel de fonction est toujours légérement plus lent que le reste des instructions. Par contre un pointeur gére un accés direct à la mémoire, certes c'est pas toujours simple à gérer, mais c'est ce qui offre les meilleures performances. Dans des langages comme le C c'est même incontournable. :)

_________________
"Le bug se situe entre la chaise et le clavier"
Votre expert national en bogage et segfaults.

CPU : AMD A8 Quad core - RAM 8Gb - HDD 2To
  • Windows 10 x64 - PB 5.61 x64
  • Linux Ubuntu 16.04 LTS x64 (dual boot) - PB pas encore réinstallé


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Rogue dongeon
MessagePosté: Sam 01/Avr/2017 11:46 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4210
Localisation: Arras, France
On avait fait le test il y a plusieurs années, c'est perdu dans les limbes du forum...

Edit: ah, si, je crois que c'est ça : viewtopic.php?f=6&t=5593


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

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 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