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