Labyrinth-Generator (Prims Algorithmus)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Labyrinth-Generator (Prims Algorithmus)

Beitrag von diceman »

Hallöchen,
Ich teile mal meinen Labyrinth-Generator, vielleicht kann jemand was damit anfangen. :-)

Das Prinzip ist eigentlich recht simpel ... Man hat eine Spielfeld, welches in Zellen unterteilt ist. Am Anfang ist jede Zelle leer --> dim board(xMax, yMax). Dann sucht man sich eine zufällige Zelle als Startfeld heraus, und fügt sie zu einer offenen Liste hinzu (Structure field()). Jetzt sucht man in allen angrenzenden Richtungen nach gültigen Feldern (umschlossen von Mauern), und setzt diese auf eine temporäre saveList(). Von dieser saveList() pickt man sich ein zufälliges Feld heraus, setzt den entsprechenden Array-Bereich auf 1 und fügt das Feld zur offenen Liste hinzu. Wenn die saveList() ein "empty" zurückgibt, wird das entsprechende Feld von der offenen Liste gelöscht. Zurück zum Anfang, zufälliges Feld aus der offenen Liste suchen, etc. Diesen Prozess wiederholt man so lange, bis auch die offene Liste ein "empty" zurückgibt.

Beim zufälligen Heraussuchen eines neuen Feldes von der offenen Liste empfiehlt es sich, dem jeweils zuletzt hinzugefügten Listenelement eine mindestens 50% Chance einzuräumen, direkt neu gewählt zu werden, da man so schönere gewundene Pfade erhält. Ansonsten gibt es einen etwas unschönen "zackigen" Look mit vielen kurzen Dead Ends.

Wie manchen vielleicht auffällt, frage ich nur für das tatächlich zu verwendende Feld ab, ob das Board-Array = 0 ist, während umliegende Felder mit < 1 auf Gültigkeit überprüft werden; das hat den Grund, daß man so z.B. zu Beginn des Prozesses einige zufällige Flächen mit -1 "blocken" kann, und so interessantere Layouts erzeugt, da der Algorithmus automatisch Wege um die geblockten Felder herum findet.

Ein Start- und Zielfeld müßt ihr euch selbst suchen. :doh:

Bild

Code: Alles auswählen

EnableExplicit

;{ DECLARATIONS AND STRUCTURES
Declare loop()
Declare drawMap()
Declare createMap()
Declare createWindow(x,y,exeName.s)

Structure FIELD
	x.i
	y.i
EndStructure
Global NewList field.FIELD()

;}


#xRes = 800
#yRes = 600
#xMax = 39
#yMax = 29
#tileSize = 20

Global Dim board(#xMax,#yMax)

Global screen = createWindow(#xRes,#yRes,"Maze-Generator (Press ESC to quit)")

createMap()
loop()
End




Procedure loop()
	Protected quit
	
	Repeat
		drawMap()
		FlipBuffers()

		ExamineKeyboard()
		quit = KeyboardPushed(#PB_Key_Escape)
		WaitWindowEvent(1)
	Until quit
EndProcedure


Procedure drawMap()
	Protected x, y
	
	If StartDrawing(ScreenOutput())
		DrawingMode(#PB_2DDrawing_Default)
		For x = 0 To #xMax
			For y = 0 To #yMax
				If board(x,y) = 1
					Box(x*#tileSize,y*#tileSize,#tileSize,#tileSize)
				EndIf
			Next
		Next	
		StopDrawing()
	EndIf
EndProcedure


Procedure createMap()
	;{ INITIALIZE LOCALS
	Protected x, y
	Protected *lastElement
	
	Structure SAVE_FIELD
		x.i
		y.i
	EndStructure
	NewList saveField.SAVE_FIELD()
	;}
	
	Dim board(#xMax, #yMax)
	*lastElement = #Null
	

	;StartFeld
	Repeat
		x = Random(#xMax-1, 1)
		y = Random(#yMax-1, 1)
	Until board(x,y) = 0
	board(x,y) = 1
	AddElement(field())
	field()\x = x
	field()\y = y
	
	
	While ListSize(field()) <> #Null
		If Random(2) > 0 And *lastElement		;letztes gefundenes Element bevorzugen (gibt schönere gewundene Wege)
			ChangeCurrentElement(field(),*lastElement)
		Else
			SelectElement(field(), Random(ListSize(field())-1))
		EndIf
		
		;Überprüfen ob Feld gültige angrenzende Felder hat und Auswahl speichern
		ClearList(saveField())
		
		If field()\y-2 > -1	;Oben
			If board(field()\x,field()\y-2) < 1
				If board(field()\x-1,field()\y-1) < 1 And board(field()\x+1,field()\y-1) < 1
					If board(field()\x-1,field()\y-2) < 1 And board(field()\x+1,field()\y-2) < 1
						If board(field()\x,field()\y-1) = 0
							AddElement(saveField())
							saveField()\x = field()\x
							saveField()\y = field()\y-1
						EndIf
					EndIf
				EndIf		
			EndIf
		EndIf
		If field()\x-2 > -1 ;Links
			If board(field()\x-2,field()\y) < 1
				If board(field()\x-1,field()\y-1) < 1 And board(field()\x-1,field()\y+1) < 1
					If board(field()\x-2,field()\y-1) < 1 And board(field()\x-2,field()\y+1) < 1
						If board(field()\x-1,field()\y) = 0
							AddElement(saveField())
							saveField()\x = field()\x-1
							saveField()\y = field()\y
						EndIf
					EndIf
				EndIf
			EndIf
		EndIf
		If field()\x+2 < #xMax+1 ;Rechts
			If board(field()\x+2,field()\y) < 1
				If board(field()\x+1,field()\y-1) < 1 And board(field()\x+1,field()\y+1) < 1
					If board(field()\x+2,field()\y-1) < 1 And board(field()\x+2,field()\y+1) < 1
						If board(field()\x+1,field()\y) = 0
							AddElement(saveField())
							saveField()\x = field()\x+1
							saveField()\y = field()\y
						EndIf
					EndIf
				EndIf
			EndIf
		EndIf
		If field()\y+2 < #yMax+1 ;Unten
			If board(field()\x,field()\y+2) < 1
				If board(field()\x-1,field()\y+1) < 1 And board(field()\x+1,field()\y+1) < 1
					If board(field()\x-1,field()\y+2) < 1 And board(field()\x+1,field()\y+2) < 1
						If board(field()\x,field()\y+1) = 0
							AddElement(saveField())
							saveField()\x = field()\x
							saveField()\y = field()\y+1
						EndIf
					EndIf
				EndIf
			EndIf
		EndIf
		
		If ListSize(saveField()) <> #Null
			SelectElement(saveField(), Random(ListSize(saveField())-1)) ;Zufälliges Element aus Auswahl wählen und zu offener Liste hinzufügen
			AddElement(field())
			field()\x = saveField()\x
			field()\y = saveField()\y
			*lastElement = @field() ;letztes hinzugefügtes Element merken, wegen bevorzugtem Pick
			board(field()\x,field()\y) = 1
		Else
			DeleteElement(field()) ;Falls keine Auswahl, aktuelles Feld aus offener Liste entfernen
			*lastElement = #Null
		EndIf
	Wend
EndProcedure


Procedure createWindow(x,y,exeName.s)
	Protected window

   If Not InitSprite() : Debug "InitSprite() failed" : End : EndIf
   
    window = OpenWindow(#PB_Any,0,0,x,y,exeName,#PB_Window_ScreenCentered)
    If Not window : Debug "Window-Creation failed" : End : EndIf
    If Not OpenWindowedScreen(WindowID(window),0,0,x,y) : Debug "Screen-Creation failed" : End : EndIf
    
    If Not InitKeyboard() : Debug "InitKeyboard() failed" : End : EndIf
     
    ProcedureReturn window
EndProcedure
Zuletzt geändert von diceman am 04.03.2018 12:46, insgesamt 2-mal geändert.
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Labyrinth-Generator (Prim's Algorithmus)

Beitrag von RSBasic »

Ich habe mich gestern noch gefragt, ob du überhaupt noch im Forum aktiv bist oder ob du keine Lust mehr hattest, weil du das letzte Mal am 17.02. was geschrieben hast.
Aber anscheinend bist du noch da.

Bezüglich deines Labyrinth-Generators: :allright: :allright: :allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: Labyrinth-Generator (Prim's Algorithmus)

Beitrag von diceman »

Doch doch, bin voll dabei! :D
Mittlerweile liebe ich PureBasic, Blitzbasic vermisse ich gar nicht mehr. Habe mich halt privat ausgetobt, alle möglichen Übungs-Snippets programmiert, weiter mein Verständnis vertieft, was *Pointer und Verwaltung von Listenelementen angeht, Minesweeper und einen Snake-Klon gebastelt, meine A*-Pfadsuche optimiert, und mit diversen Algorithmen und Sprites herumgespielt.
Wenn ich mein Roguelike-Projekt angehe, muß ich die Werkzeuge kennen, mit denen ich arbeiten will. :)

@Labyrinth-Generator
Den Kniff mit der Bevorzugung des zuletzt gefundenen Listenelementes, beim zufälligen Pick aus der offenen Liste, habe ich übrigens aus einem GDC-Vortrag vom Designer des Indie-Spiels "Eldritch" aufgeschnappt. <)
Habe außerdem gemerkt, daß man mit dem Blockieren von Feldern sehr leicht sehr schöne Effekte basteln kann ... z.b. einfach mal folgende paar Zeilen direkt vor Festlegung des initialen Feldes einfügen, und der Algorithmus zeichnet kreisförmige Labyrinthe (alle Zellen, welche außerhalb vom Radius der y-Achse liegen - Überprüfung erfolgt mittels Satz des Pythagoras - , werden geblockt):

Code: Alles auswählen

	midX = #xMax/2
	midY = #yMax/2
	For x = 1 To #xMax-1
		For y = 1 To #yMax -1
			If Sqr(Pow(x-midX,2)+Pow(y-midY,2)) > #yMax/2
				board(x,y) = -1
			EndIf
		Next
	Next
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
ccode_new
Beiträge: 1214
Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge

Re: Labyrinth-Generator (Prims Algorithmus)

Beitrag von ccode_new »

Hallo diceman,

ich dachte auch erst wie RSBasic, aber schön das du noch aktiv bist.

Dein Code ist nicht schlecht, aber vergiss bitte bei Screen-Anwendungen nie FlipBuffers()

Unter Windows funktioniert es zwar so, aber unter Linux würde dein Code dann auch so funktionieren:

Code: Alles auswählen

loop()
End

Procedure loop()
  Protected quit
  createMap()
  Repeat
    
    drawMap()
    FlipBuffers()

    ExamineKeyboard()
    quit = KeyboardPushed(#PB_Key_Escape)
    WaitWindowEvent(1)
  Until quit
EndProcedure
Bleib dran und ich bin mir sicher du wirst bald ein neues schönes Spiel (made with PureBasic) veröffentlichen.

Du hast das Zeug dazu.
Betriebssysteme: div. Windows, Linux, Unix - Systeme

no Keyboard, press any key
no mouse, you need a cat
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Re: Labyrinth-Generator (Prims Algorithmus)

Beitrag von diceman »

Huch, danke! :oops:
Den FlipBuffer()-Befehl habe ich, ehrlich gesagt, ganz vergessen; bzw muß beim Outsourcen der drawMap()-Routinen verlorengegangen sein.
Wundert mich jetzt im Nachhinein, daß das trotzdem funktioniert.

//EDIT:
Hab's weiter oben reineditiert.
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Antworten