Aktuelle Zeit: 27.05.2018 19:35

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 5 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Labyrinth-Generator (Prims Algorithmus)
BeitragVerfasst: 04.03.2018 09:28 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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:
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

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Zuletzt geändert von diceman am 04.03.2018 12:46, insgesamt 2-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Labyrinth-Generator (Prim's Algorithmus)
BeitragVerfasst: 04.03.2018 11:23 
Offline
Moderator
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Rupture Farms
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:

_________________
BildBildBildBild
Bild | EnableExplicit ist kostenlos und vermeidet Fehler | Gib Goto keine Chance | Schneller als die Telekom erlaubt | Avira? Nein Danke
WinAPI forever | Bei Problemen bitte Beispielcode posten | Mit Adblock werbefrei, schneller und sicherer surfen | brain.exe ist der beste Schutz | Userlibrary ohne Source = NoGo


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Labyrinth-Generator (Prim's Algorithmus)
BeitragVerfasst: 04.03.2018 11:51 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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:
   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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Labyrinth-Generator (Prims Algorithmus)
BeitragVerfasst: 04.03.2018 12:37 
Offline

Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge
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:
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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Labyrinth-Generator (Prims Algorithmus)
BeitragVerfasst: 04.03.2018 12:39 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
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.


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 5 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye