Zufalls Labyrinth (dynamisch) erstellen

[Christian18]

Hallo,

ich will ein kleines Game proggen. Das Labyrinth soll dynamisch erstellt werden. Hat jemand vieleicht eine Idee wie ich das machen kann???

Mit freundlichen Grüßen

Christian18

[freak4fun]

Hm..
ich würde sagen du machst einfach ein Random um die Felder zu erstellen, aber dadurch ist nicht sichergestellt, dass es auch einen finalen weg gibt. Also wäre es sinnvoll erst den weg zu erstellen und dann den Rest hinzuzufügen. Du könntest auch das ganze erst erstellen und dann per - wie heisst das - backtracking einen weg erstellen lassen.

Ich hoffe ich konnte die weiterhelfen.

mfg
freak

[The Wishmaster]

So würde ich das machen:

procedure TfrmWege.SpielfeldInitialisieren;
// Den ausgewählten Labyrinth-Grundriss erst mal auf Bildschirm ausgeben
var
i, j: Integer;
begin
for i := 0 to MaxZeile - 1 do for j := 0 to MaxSpalte - 1 do
Ausgabefeld.Cells [i,j] := Plan [j,i];
{ Die Umstellung von i,j nach j,i beachten ! }
end{SpielfeldInitialisieren};

Erster Schritt ist also das Initialisieren eines Grundrisses für das Labirinth.
Zweiter Schritt:

procedure TfrmWege.SpielplanEinlesen (Name: String);
var
i,j: Integer;
begin
{ Das auszuwählende Array einlesen }
for i := 0 to MaxZeile-1 do for j := 0 to MaxSpalte-1 do
begin
if Name = 'Laby0' then Plan[i,j] := Laby0[i,j]
else if Name = 'Laby1' then Plan[i,j] := Laby1[i,j]
else if Name = 'Laby2' then Plan[i,j] := Laby2[i,j];
end{for};
end{SpielplanEinlesen};

Dann kreierst Du eine Einlesung des Spielplans um das Ganze dem Compiler klar zu machen:

procedure TfrmWege.Wegsuche (zl, sp: Integer);
// Der eigentliche "Motor" des Programms
// Beachte den rekursiven Aufruf!
begin
if IsStein (zl,sp,leer) OR IsStein (zl,sp,tor) then
begin
if IsStein (zl,sp,tor) then Ausgang
else
if IsStein (zl,sp,leer) then
begin
SetStein (zl,sp,marke);
Pause (Pausenzeit);
(* ================================================ *)
{} Wegsuche (zl,sp+1); {nach rechts} {}
{} Wegsuche (zl+1,sp); {nach unten } {}
{} Wegsuche (zl,sp-1); {nach links } {}
{} Wegsuche (zl-1,sp); {nach oben } {}
(* ================================================ *)
ResetStein (zl,sp);
Pause (Pausenzeit);
end{if IsStein(leer)};
end{if IsStein};
end{Wegsuche};

Dann sucht die KI den Weg.

procedure TfrmWege.Ausgang;
// Zeigt Torausgang im Programm an
begin
panMeldung.Caption := 'Ausgang gefunden !! Weiter mit <TASTE> ...';
WAVDateienAbspielen ('go.wav', false);
panTor.Visible := true;
repeat
Application.ProcessMessages;
until Abbruch;
abbruch := false;
end{Ausgang};

Mit den integrierten Objekten kannst Du dann den Ausgang markieren und finden lassen. Sollte an sich nichts Problematisches dabei sein. Einen Ausweg muss es geben, da die Initialisierung des Spielfeldes darauf abgestimmt ist. Sonst gibt es keine Lösung!

MfG
The Wishmaster


:wiejetzt:

[Christian18]

Hallo The Wishmaster,

kannst du das programm mal anhängen, da ich bei deinen variablen nicht so richtig durch sehe. z.b.

MaxZeile, MaxSpalte, ...

MFG

Christian18

[Phantom1]

Ich habe schonmal ein dynamisches Labyrinth programmiert, du brauchst dazu ein TImage, ein TButton und eine TCheckbox.

hier der Code von mir:

Delphi-Quellcode:

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

Type
  TCellType = Set Of (cStart, cFinal, cSolution, cFree);

  TForm1 = Class(TForm)
    Button1: TButton;
    Image1: TImage;
    CheckBox1: TCheckBox; // zum anzeigen des Lösungsweges
    Procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  Private
    Cells: Array[0..49, 0..49] Of Record S, O: Boolean; CellType: TCellType End;
    Procedure GenerateMaze(StartX, StartY: Integer);
    Procedure DrawMaze(ShowSolution: Boolean); 
  End;

Var
  Form1: TForm1;

Implementation

{$R *.DFM}

Procedure TForm1.Button1Click(Sender: TObject);
Begin
  Randomize;
  //RandSeed:=0;
  Caption:=IntToStr(RandSeed);
  // Labyrinth erstellen mit zufälliger Startposition
  GenerateMaze(Random(High(Cells)),0);
  // Labyrinth anzeigen
  DrawMaze(CheckBox1.Checked);
End;

procedure TForm1.DrawMaze(ShowSolution: Boolean);
Var x, y: Integer;
begin
  Image1.Picture.Bitmap:=Nil;
  Image1.Width:=501;
  Image1.Height:=501;
  With Image1.Canvas Do Begin
    Brush.Color:=clBlack;
    FrameRect(ClipRect);
    Pen.Width:=1;
    Pen.Color:=clBlack;
    For x:=0 to High(Cells) Do
      For y:=0 to High(Cells[0]) Do Begin
        If Cells[x,y].O Then Begin
          MoveTo((x+1)*10, y*10);
          LineTo((x+1)*10, (y+1)*10+1)
        End;
        If Cells[x,y].S Then Begin
          MoveTo(x*10, (y+1)*10);
          LineTo((x+1)*10+1, (y+1)* 10)
        End;
        If cStart In Cells[x,y].CellType Then
          Ellipse(x*10+2, y*10+2, x*10+8, y*10+8);
        If cFinal In Cells[x,y].CellType Then
          Ellipse(x*10+2, y*10+2, x*10+8, y*10+8);
        If ShowSolution And (cSolution In Cells[x,y].CellType) Then
          Ellipse(x*10+4, y*10+4, x*10+6, y*10+6);
      End;
  End;
end;

Procedure TForm1.GenerateMaze(StartX, StartY: Integer);
CONST N=0; S=1; W=2; O=3;

  Function ValidCell(x, y: Integer): Boolean;
  Begin
    Result:=(x>=0) And (y>=0) And (x<=High(Cells)) And (y<=High(Cells[0]));
  End;

  Function ValidWay(x, y: Integer): Boolean;
  Begin
    If ValidCell(x,y) Then Result:=cFree In Cells[x,y].CellType
    Else Result:=False;
  End;

  Function NewWay(x, y, r: Integer): Boolean;
  Var WegNr: Array[0..3] Of Boolean; Solution: Boolean; Nr: Byte;
  Begin
    // die aktuelle Zelle als belegt markieren
    Cells[x,y].CellType:=Cells[x,y].CellType-[cFree];
    // die Wand entfernen, aus der Richtung der wir gekommen sind
    Case r Of
      S: If ValidCell(x,y-1) Then Cells[x,y-1].S:=False;
      N: Cells[x,y].S:=False;
      O: If ValidCell(x-1,y) Then Cells[x-1,y].O:=False;
      W: Cells[x,y].O:=False;
    End;
    // Zufällige Reihenfolge der Richtungen berechnen
    For Nr:=0 To 3 Do WegNr[Nr]:=False;
    Solution:=False;
    Repeat
      Nr:=Random(4);
      Case Nr Of
        N: If ValidWay(x,y-1) Then Solution:=NewWay(x,y-1,N);
        S: If ValidWay(x,y+1) Then Solution:=NewWay(x,y+1,S);
        W: If ValidWay(x-1,y) Then Solution:=NewWay(x-1,y,W);
        O: If ValidWay(x+1,y) Then Solution:=NewWay(x+1,y,O);
      End;
      WegNr[Nr]:=True;
      If Solution Then With Cells[x,y] Do CellType:=CellType+[cSolution];
    Until WegNr[0] And WegNr[1] And WegNr[2] And WegNr[3];

    Result:=(cSolution In Cells[x,y].CellType) Or (cStart In Cells[x,y].CellType);
  End;

Var x, y: Integer;
Begin
  For x:=0 To High(Cells) Do
    For y:=0 To High(Cells[0]) Do Begin
      Cells[x,y].S:=True;
      Cells[x,y].O:=True;
      Cells[x,y].CellType:=[cFree];
    End;
  With Cells[StartX,StartY] Do CellType:=CellType+[cStart];
  // ein zufälliges Ziel
  x:=Random(High(Cells)+1); y:=High(Cells[0]);
  With Cells[x,y] Do CellType:=CellType+[cFinal];
  // Anfangszelle setzten
  NewWay(x,y,-1);
End;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  DrawMaze(CheckBox1.Checked);
end;

End.

Die procedure NewWay habe ich rekursiv geschrieben :wink:

mfg

[Alexander]

Ist auch recht sinnvoll ;)

Zumindest habe ich keine Idee, wie das iterativ funktionieren soll :gruebel:

[trifid]

einige Info's über Labyrinthe (maze) ...
http://www.efg2.com/Lab/Mathematics/MazeMaker.htm