[cadeau] un generateur de carte de donjon

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Répondre
Avatar de l’utilisateur
case
Messages : 1545
Inscription : lun. 10/sept./2007 11:13

[cadeau] un generateur de carte de donjon

Message par case »

un generateur de carte de style donjon des couloirs, des portes des salles :p
ca peux interesser quelqu'un
la salle de départ du générateur est affichée en blanc sur la carte

le principe c'est que je crée une sale puis des portes ensuite je reli des couloirs a chaque porte puis au bout de chaque couloir une pièce puis je répété l’opération pour chaque piece
bien sur je teste pour voir si la pièce n'est pas a la mème position qu'autre chose. de meme pour les couloirs et si c'est le cas je suprime l'objet jusqu'a la porte correspondante.

ça peut sans doute être optimisé . mais bon ;)

Code : Tout sélectionner

;+------------------------------+
;! map generator                !
;! licence : CC-BY              !
;! 2017 case @ purebasic forums !
;+------------------------------+
;
InitSprite()
Structure door
  x.i
  y.i
  lock.i        ; 0 door is not real.1 open,2locked
  orientation.s ; nesw 
  linked.i
  unlock.i      ; code to unlock
EndStructure
Structure room
  type.i  ; 0=room ; 1 = hall from south, 2 hall from east, 3 hall from north,4 hall from w
  x.i
  y.i
  l.i
  h.i
  nodoor.s      ; "nesw" la chaine est updatée en fonction des portes generees
  color.i
  List doors.door()
  ddd.i
  count.i
  parentd.i
  parentr.i
EndStructure
Global zoom
Global main=OpenWindow(#PB_Any,0,0,1024,768,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
Global scr=OpenWindowedScreen(WindowID(main),0,0,768,768)
Global nbr
Global maxdoors
Global NewList rooms.room()
Global x_maxroomsize
Global y_maxroomsize
Global x_minroomsize
Global y_minroomsize
Global zoom
Procedure overlap(x,y,l,h)
  curent=ListIndex(rooms())
  ForEach rooms()    
    hoverlap = Bool(Bool((x<rooms()\x+rooms()\l)) & Bool((rooms()\x<x+l)))
    voverlap = Bool(Bool((y<rooms()\y+rooms()\h)) & Bool((rooms()\y<y+h)))
    inside = Bool(hoverlap & voverlap)
    If inside=1
      SelectElement(rooms(),curent)
      ProcedureReturn 0      
    EndIf
  Next
  SelectElement(rooms(),curent)
  ProcedureReturn 1  
EndProcedure
Procedure createroom(t=0,x=-1,y=-1,l=-1,h=-1,color=$ffffff)    
  ;Repeat
  If l=-1
    l=Random(x_maxroomsize,x_minroomsize) ; largeur
  EndIf
  If h=-1
    h=Random(y_maxroomsize,y_maxroomsize) ; hauteur
  EndIf
  If x=-1
    x=Random(30)+5 ; ul
  EndIf
  If y=-1
    y=Random(30)+5 
  EndIf
  AddElement(rooms())
  rooms()\type=t
  rooms()\x=x
  rooms()\y=y
  rooms()\l=l
  rooms()\h=h
  rooms()\nodoor="nswe"
  rooms()\color=color
  rooms()\ddd=0
  If t=0
    nbr -1
  EndIf
EndProcedure
Procedure createdoors(maxdoors)
  ; ADDING DOORS TO ACTUAL ROOM
  If maxdoors>=4
    dr=Random(4,1)
    If Len(rooms()\nodoor)<4 
      dr=Len(rooms()\nodoor)
    EndIf
    ;   maxdoors-dr
  ElseIf maxdoors>0
    dr=Random(maxdoors % 4,1)
    ;   maxdoors-dr
  Else 
    dr=0
  EndIf     
  ; adding doors to  actual room
  For adoor=1 To dr    
    If Len(rooms()\nodoor)>0
      For retru=1 To 10        
        di.s=Mid(rooms()\nodoor,Random(Len(rooms()\nodoor),1),1)
      Next
      rooms()\nodoor=RemoveString(rooms()\nodoor,di)
      AddElement(rooms()\doors())
      rooms()\doors()\orientation=di      
      Select di
        Case "n"; add a door on the top of the room 'north' 
          rooms()\doors()\x=rooms()\x+Random(rooms()\l-2,2)
          rooms()\doors()\y=rooms()\y              
        Case "s"
          rooms()\doors()\x=rooms()\x+Random(rooms()\l-2,2)
          rooms()\doors()\y=rooms()\y+rooms()\h-1
        Case "e"
          rooms()\doors()\x=rooms()\x+rooms()\l-1
          rooms()\doors()\y=rooms()\y+Random(rooms()\h-2,2)
        Case "w"
          rooms()\doors()\x=rooms()\x
          rooms()\doors()\y=rooms()\y+Random(rooms()\h-2,2)             
      EndSelect
    EndIf
  Next
  ProcedureReturn maxdoors  
EndProcedure
Procedure  createhall()                                        
  curentroom=ListIndex(rooms())
  ForEach rooms()\doors()
    If maxdoors>0
      curentdoor=ListIndex(rooms()\doors())
      rl=Random(x_maxroomsize,x_minroomsize)
      rh=Random(y_maxroomsize,y_minroomsize)
      x=rooms()\doors()\x
      y=rooms()\doors()\y
      o.s=rooms()\doors()\orientation.s
      l=Random(5,3) ; longueur du couloir
      Select o
        Case"w"
          If overlap(x-l,y-1,l,3)
            rooms()\doors()\linked=1
            LastElement(rooms())
            createroom(2,x-l,y-1,l,3,$888888)
            AddElement(rooms()\doors())
            rooms()\doors()\linked=1           
            rooms()\doors()\y=y
            rooms()\doors()\x=x-1
            b=ListIndex(rooms())
            LastElement(rooms())                   
            xr=x-l-rl
            wallsize=rh-3 ; 
            doorx=-(Random(wallsize)-wallsize/2)  
            yr=(y-1)-((wallsize/2))+doorx         
            If overlap(xr,yr,rl,rh)
              AddElement(rooms()\doors())
              rooms()\doors()\linked=1
              rooms()\doors()\y=y
              rooms()\doors()\x=x-l     
              createroom(0,xr,yr,rl,rh,$888888)
              rooms()\nodoor=RemoveString(rooms()\nodoor,"e")
              AddElement (rooms()\doors())
              rooms()\doors()\linked=1
              rooms()\doors()\x=x-l-1
              rooms()\doors()\y=y
              rooms()\count=maxdoors
              maxdoors -1
            Else
              DeleteElement(rooms())
              SelectElement(rooms(),curentroom)
              SelectElement(rooms()\doors(),curentdoor)
              DeleteElement(rooms()\doors())                  
            EndIf  
            SelectElement(rooms(),curentroom)
            SelectElement(rooms()\doors(),curentdoor)         
          Else
            SelectElement(rooms(),curentroom)                   
            SelectElement(rooms()\doors(),curentdoor)          
          EndIf
          SelectElement(rooms(),b)
        Case"n"
          If overlap(x-1,y-l,3,l)            
            rooms()\doors()\linked=1
            LastElement(rooms())
            createroom(1,x-1,y-l,3,l,$888888)
            AddElement(rooms()\doors())
            rooms()\parentd=curentdoor
            rooms()\parentr=curentroom
            rooms()\doors()\linked=1            
            rooms()\doors()\x=x
            rooms()\doors()\y=y-1                     
            b=ListIndex(rooms())
            wallsize=rl-3 ; 
            doorx=-(Random(wallsize)-wallsize/2)  
            xr=(x-1)-((wallsize/2))+doorx
            yr=y-l-rh
            If overlap(xr,yr,rl,rh)
              SelectElement(rooms(),b)
              AddElement(rooms()\doors())
              rooms()\doors()\linked=1            
              rooms()\doors()\x=x
              rooms()\doors()\y=y-l
              LastElement(rooms())    
              createroom(0,xr,yr,rl,rh,$888888)
              rooms()\nodoor=RemoveString(rooms()\nodoor,"s")              
              AddElement (rooms()\doors())
              rooms()\doors()\lock=Random(2)
              rooms()\doors()\linked=1
              rooms()\doors()\x=x
              rooms()\doors()\y=y-l-1
              rooms()\count=maxdoors              
              maxdoors -1              
            Else
              DeleteElement(rooms())
              SelectElement(rooms(),curentroom)
              SelectElement(rooms()\doors(),curentdoor)
              DeleteElement(rooms()\doors())              
            EndIf
            SelectElement(rooms(),curentroom)
            SelectElement(rooms()\doors(),curentdoor)         
          Else         
            SelectElement(rooms(),curentroom)                   
            SelectElement(rooms()\doors(),curentdoor)                          
          EndIf
          SelectElement(rooms(),b)
        Case"s"
          If overlap(x-1,y+1,3,l)
            rooms()\doors()\linked=1
            LastElement(rooms())
            createroom(3,x-1,y+1,3,l,$888888)
            AddElement(rooms()\doors())
            rooms()\doors()\linked=1            
            rooms()\doors()\x=x
            rooms()\doors()\y=y+1                  
            b=ListIndex(rooms())
            LastElement(rooms())                   
            wallsize=rl-3 ; 
            doorx=-(Random(wallsize)-wallsize/2)  
            xr=(x-1)-((wallsize/2))+doorx
            yr=y+l +1            
            If overlap(xr,yr,rl,rh)
              AddElement(rooms()\doors())
              rooms()\doors()\linked=1
              rooms()\doors()\x=x
              rooms()\doors()\y=y+l         
              createroom(0,xr,yr,rl,rh,$888888)
              AddElement (rooms()\doors())
              rooms()\doors()\linked=1
              rooms()\doors()\x=x
              rooms()\doors()\y=y+l+1
              rooms()\nodoor=RemoveString(rooms()\nodoor,"n")
              rooms()\count=maxdoors
              maxdoors -1            
            Else
              DeleteElement(rooms())
              SelectElement(rooms(),curentroom)
              SelectElement(rooms()\doors(),curentdoor)
              DeleteElement(rooms()\doors())
            EndIf
            SelectElement(rooms(),curentroom)
            SelectElement(rooms()\doors(),curentdoor)         
          Else
            SelectElement(rooms(),curentroom)                   
            SelectElement(rooms()\doors(),curentdoor)
          EndIf
          SelectElement(rooms(),b)
        Case"e"
          If overlap(x+1,y-1,l,3)
            rooms()\doors()\linked=1
            LastElement(rooms())
            createroom(4,x+1,y-1,l,3,$888888)
            AddElement(rooms()\doors())
            rooms()\doors()\linked=1            
            rooms()\doors()\y=y
            rooms()\doors()\x=x+1
            b=ListIndex(rooms())
            LastElement(rooms())                   
            xr=x+l+1
            wallsize=rh-3 ; 
            doorx=-(Random(wallsize)-wallsize/2)  
            yr=(y-1)-((wallsize/2))+doorx                   
            If overlap(xr,yr,rl,rh)
              AddElement(rooms()\doors())
              rooms()\doors()\linked=1
              rooms()\doors()\y=y
              rooms()\doors()\x=x+l            
              createroom(0,xr,yr,rl,rh,$888888)
              rooms()\nodoor=RemoveString(rooms()\nodoor,"w")
              AddElement (rooms()\doors())
              rooms()\doors()\linked=1
              rooms()\doors()\x=x+l+1
              rooms()\doors()\y=y
              rooms()\count=maxdoors
              maxdoors -1
            Else
              DeleteElement(rooms())
              SelectElement(rooms(),curentroom)
              SelectElement(rooms()\doors(),curentdoor)
              DeleteElement(rooms()\doors())
            EndIf
            SelectElement(rooms(),curentroom)
            SelectElement(rooms()\doors(),curentdoor)         
          Else
            SelectElement(rooms(),curentroom)                   
            SelectElement(rooms()\doors(),curentdoor)          
          EndIf
          SelectElement(rooms(),b)
      EndSelect          
      SelectElement(rooms(),curentroom)                   
      SelectElement(rooms()\doors(),curentdoor) 
    Else
      If rooms()\doors()\linked=0
        DeleteElement(rooms()\doors())
      EndIf
      Break
    EndIf
  Next
EndProcedure
Procedure generatedungeon(nbr=1)  
  centerx=(768/2)/zoom
  centery=(768/2)/zoom
  maxdoors=nbr
  createroom(0,centerx-8,centery-8,16,16,$ffffff) ; create the first room 
  If nbr>1                                        ; more rooms to come       
    maxdoors=nbr-1                                ; nombre de portes max = nombre de pieces 
    Repeat
      ForEach rooms()
        curentroom=ListIndex(rooms())        
        If rooms()\type=0 And rooms()\ddd=0
          maxdoors=createdoors(maxdoors)
          createhall()                                        
        EndIf
        SelectElement(rooms(),curentroom)        
      Next      
    Until maxdoors=0   
  EndIf            
EndProcedure
;seed$="PureBasicRulez"
If seed$<>""
  For a=1 To Len(seed$)
    seed.q +Asc(Mid(seed$,a,1))
  Next
  RandomSeed(seed)
EndIf
;;
x_maxroomsize=32
y_maxroomsize=32
x_minroomsize=8
y_minroomsize=8
zoom=1
generatedungeon(200) ; restons coherents :) 
miny=$ffff 
maxy=-0
minx=$ffff
maxx=-0
ForEach rooms()
  If rooms()\x< minx
    minx=rooms()\x
  EndIf
  If rooms()\x+rooms()\l>maxx
    maxx=rooms()\x+rooms()\l
  EndIf
  If rooms()\y< miny
    miny=rooms()\y
  EndIf
  If rooms()\y+rooms()\h> maxy
    maxy=rooms()\y+rooms()\h
  EndIf  
Next
MapSizex =(Abs(maxx)-Abs(minx))
MapSizey =(Abs(maxy)-Abs(miny))
centerx=Int(768/2)
centery=Int(768/2)
offsetx=  minx
offsety=  miny
mappic=CreateImage(#PB_Any,MapSizex,MapSizey)
StartDrawing(ImageOutput(mappic))    
DrawingMode(#PB_2DDrawing_Default) 
ForEach rooms()   
  Box((rooms()\x-offsetx)*zoom,(rooms()\y-offsety)*zoom,rooms()\l*zoom,rooms()\h*zoom,rooms()\color)
  Box((rooms()\x-offsetx)*zoom+zoom,(rooms()\y-offsety)*zoom+zoom,rooms()\l*zoom-zoom*2,rooms()\h*zoom-zoom*2,$333333)
  ForEach rooms()\doors()
    If rooms()\type=0
      If rooms()\doors()\linked=1
        Select rooms()\doors()\lock
          Case 0 
            Box((rooms()\doors()\x-offsetx)*zoom,(rooms()\doors()\y-offsety)*zoom,zoom,zoom,$333333)      
          Case 1
            Box((rooms()\doors()\x-offsetx)*zoom,(rooms()\doors()\y-offsety)*zoom,zoom,zoom,$00ff00)      
          Case 2
            Box((rooms()\doors()\x-offsetx)*zoom,(rooms()\doors()\y-offsety)*zoom,zoom,zoom,$0000ff)      
        EndSelect
      Else    
        DeleteElement(rooms()\doors())
      EndIf
    Else
      Box((rooms()\doors()\x-offsetx)*zoom,(rooms()\doors()\y-offsety)*zoom,zoom,zoom,$333333)          
      Box((rooms()\doors()\x-offsetx)*zoom,(rooms()\doors()\y-offsety)*zoom,zoom,zoom,$333333)      
    EndIf      
  Next    
Next
StopDrawing()                   
;- mainloop
playerx=0
playery=0
StartDrawing(ScreenOutput())   
DrawImage(ImageID(mappic),centerx-ImageWidth(mappic)/2,centery-ImageHeight(mappic)/2)
StopDrawing()
FlipBuffers()
Repeat
  ev=WaitWindowEvent(1)       
Until ev=#PB_Event_CloseWindow
ImageImage
Haut
Tonio
Messages : 95
Inscription : ven. 07/avr./2017 14:49
Localisation : Sud Est

Re: [cadeau] un generateur de carte de donjon

Message par Tonio »

Bonjour case Merci pour ce partage
Haut
Avatar de l’utilisateur
Zorro
Messages : 2186
Inscription : mar. 31/mai/2016 9:06

Re: [cadeau] un generateur de carte de donjon

Message par Zorro »

plus qu'a adapter pour le faire en 3D :)

il "suffit" en principe de faire une procedure "Box3d()" qui soit en fait une construction cubique d'une salle
c'est quasi pareil que la fonction Box() en 2D , tu attribues une hauteur par defaut
mais pour le reste c'est pareil je pense :)

donc une procedure Box3D qui soit capable de faire une salle (4 murs ,un plafon ou pas)
et tu remplaceq tout tes "box" dans ton code, par cette nouvelle procedure
et te voila avec un generateur de donjon !!! :)
Haut
Avatar de l’utilisateur
Zorro
Messages : 2186
Inscription : mar. 31/mai/2016 9:06

Re: [cadeau] un generateur de carte de donjon

Message par Zorro »

voici une base ....


ici je genere un monde 3D
un sol , puis ma procedure Box3d () genere une premiere salle !!

je met la camera a l'interieur , il te suffit d'utiliser les touches flechées pour traverser le mur et voir le monde a l'exterieur

tu verra ainsi le cube généré
je pense que ça peut faire une bonne base a ton code ....

par contre faudra demander au specialiste de la 3D (Falsam , Comtois ) de voir comme creer des trous dans le box3D() pour les portes .....

ici ma procedure Box3d () se comporte un peu comme le Box() en 2D
box3d(x,y,taille_x,taille_y,taille_h) ;
x/y = position de la box dans le monde 3D
taille_x /taille_y/taille_h = ça parle de soit meme :)

je suis allé au plus simple (en utilisant un cube )
mais peut etre faudrai t'il fabriquer la salle en utilisant plusieurs mesh (4 murs,plafond ,et donc "trou" pour la porte )



Code : Tout sélectionner

;test 3d  Base
; By zorro
Enumeration
		#Camera 
		#Entity
		#mesh
		#material
		#texture
		;
		#sol
		#Entity_sol
		#material_sol
EndEnumeration
#CameraSpeed = 1
Global path_3D.s=#PB_Compiler_Home+"Examples\3D\"


IncludeFile "D:\Dobro\Purebasic_5_60\86\Examples\3D\"+"Screen3DRequester.pb"
Define.f KeyX, KeyY, MouseX, MouseY
Declare box3d(x,y,taille_x,taille_y,taille_h)
Enumeration  ;3d
		#Mesh_tour
		#entity_tour
		#material_tour
		#texture_tour
EndEnumeration

If InitEngine3D()
		Add3DArchive(path_3D.s+"Data/Textures", #PB_3DArchive_FileSystem)
		Add3DArchive(path_3D.s+"Data/Models", #PB_3DArchive_FileSystem)
		InitSprite()
		InitKeyboard()
		InitMouse()
		If Screen3DRequester()
				AmbientColor(RGB(255, 255, 255)) 
				; ; ************ le robot ********************************************
				; CreateMaterial(#material, LoadTexture(#texture, "r2skin.jpg"))
				; CreateEntity(#Entity, LoadMesh(#mesh, "robot.mesh"), MaterialID(#material))
				; StartEntityAnimation(#entity, "Walk")
				; ; *******************************************************************
				; ******* le Sol **************************************
				CreateMaterial(#material_sol, LoadTexture(#texture, path_3D.s+"Data/Textures/"+"MRAMOR6X6.jpg"))
				CreatePlane(#sol, 2000,2000,100, 100,10, 10)
				CreateEntity(#Entity_sol, Meshid(#sol), MaterialID(#material_sol))
				MoveEntity(#Entity_sol,0,0,0)
				; *****************************************************
				;
				; *********** la camera **********************************
				CreateCamera(#Camera , 0, 0, 100, 100)  ; Front camera
				CameraBackColor(#Camera , RGB(120, 120, 255))
				MoveCamera(#Camera , -800, 100, -800, #PB_Absolute) ; ici je me suis mis dans le cube  , utilise les touches flechée pour traverser le mur et voir le cube de l'exterieur
				RotateCamera(#Camera, #pb_ignore,15,  0,#PB_Absolute)                     
				; *********************************************************
				; ********************** creation du box3d ****************************
				Taille_x=100
				Taille_y=100
				Taille_h=400
				x=-800
				y=-800
				box3d(x,y,taille_x,taille_y,taille_h)
				; *******************************************************************
				Repeat
						Screen3DEvents()
						If ExamineMouse()
								MouseX = -MouseDeltaX() * #CameraSpeed * 0.05
								MouseY = -MouseDeltaY() * #CameraSpeed * 0.05
						EndIf
						If ExamineKeyboard()
								If KeyboardPushed(#PB_Key_Left)
										KeyX = -#CameraSpeed 
								ElseIf KeyboardPushed(#PB_Key_Right)
										KeyX = #CameraSpeed 
								Else
										KeyX = 0
								EndIf
								If KeyboardPushed(#PB_Key_Up)
										KeyY = -#CameraSpeed 
								ElseIf KeyboardPushed(#PB_Key_Down)
										KeyY = #CameraSpeed 
								Else
										KeyY = 0
								EndIf
						EndIf
						; RotateEntity(#entity, 0, 0.1, 0, #PB_Relative)
						RotateCamera(#camera, MouseY, MouseX, 0, #PB_Relative)
						MoveCamera  (#camera, KeyX, 0, KeyY)
						RenderWorld()
						Screen3DStats()
						FlipBuffers()
				Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
		EndIf
Else
		MessageRequester("Error", "The 3D Engine can't be initialized",0)
EndIf
; 

Procedure box3d(x,y,taille_x,taille_y,taille_h)
		; *************** matiere des batiments ********************************²
		;-creation batiments
		CreateMaterial(#material_tour, LoadTexture(#texture_tour, path_3D.s+"Data/Textures/"+"soil_wall.jpg"))
		MaterialCullingMode(#material_tour, #PB_Material_NoCulling)
		; **************************************************************
		; *************** les batiments *************************************
		type=Random(3,1)	
		id=CreateCube(#PB_Any, taille_h)
		entity=CreateEntity(#PB_Any,MeshID(id), MaterialID(#material_tour))
		MoveEntity(entity,x,taille_h/2,y)
		RotateEntity(Entity, 0,  Random(359,0)/4, 0 )	
		CreateEntityBody(entity, #PB_Entity_StaticBody,1,1,1)
		; *************************************************************
EndProcedure


ps : je n'aime vraiment pas coder Ogre en Purebasic !!
c'est a mourir d'ennuis
Haut
Tonio
Messages : 95
Inscription : ven. 07/avr./2017 14:49
Localisation : Sud Est

Re: [cadeau] un generateur de carte de donjon

Message par Tonio »

Bonjour Zorro ton code marche pas
à cause de cette ligne :

Code : Tout sélectionner

IncludeFile "D:\Dobro\Purebasic_5_60\86\Examples\3D\"+"Screen3DRequester.pb"
Haut
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: [cadeau] un generateur de carte de donjon

Message par Micoute »

Bonjour Tonio, il te suffit donc de mettre le chemin qui fonctionne chez toi.
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 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Haut
Tonio
Messages : 95
Inscription : ven. 07/avr./2017 14:49
Localisation : Sud Est

Re: [cadeau] un generateur de carte de donjon

Message par Tonio »

Micoute a écrit :Bonjour Tonio, il te suffit donc de mettre le chemin qui fonctionne chez toi.
merci
Haut
Shadow
Messages : 1413
Inscription : mer. 04/nov./2015 17:39

Re: [cadeau] un generateur de carte de donjon

Message par Shadow »

Jolie Case :D
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Haut
Répondre

Revenir à « Débutants »