PureBasic

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

Bonjour case Merci pour ce partage

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 !!!

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

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"

Bonjour Tonio, il te suffit donc de mettre le chemin qui fonctionne chez toi.

Micoute a écrit :Bonjour Tonio, il te suffit donc de mettre le chemin qui fonctionne chez toi.

merci

Jolie Case

PureBasic

[cadeau] un generateur de carte de donjon

[cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon

Re: [cadeau] un generateur de carte de donjon