Inseln auf ein Image malen

[xZise]

Ich möchte immer zufällige Karten erstellen, die mit schönen runden küsten sind...

Gibt es eine Möglichkeit sowas zu programmieren?

Ich benötige 2 Endergbnisse:

1. Image
2. array of array of Byte (in dem steht ob Wasser/Land)

[sirius]

Da gabs für Windows 3.11 mal so ein kleines Tool, was das gemacht hat. :mrgreen:

Mir fallen auf Anhieb zwei Möglichkeiten ein:
1. du fängst in einer Ecke deiner Karte an und versuchst wie ein sich verzweigender Baum immer abhängig von dem verherigen Punkt einen neuen HöhenPunkt zu berechnen. Du machst als quasi Raster. Und alles was negative Höhe hat, wird wohl Wasser sein.

2. Fraktale. Damit kann man auch Landschaften erzeugen. Da hab ich schonmal Bilder gesehen. Aber bis auf, dass ich die gängigsten Fraktale zeichnen lassen könnte, wüsste ich bei einer Landschaft erstmal keinen Ansatz.

[Nikolas]

Hier mal meine spontane Idee:

Stelle dir jede Insel als kreisähnliche Figur vor. Diese ist dann Darstellbar als r(phi) (stetig und auf (0 bis 2pi) definiert. Du hast also für jeden Winkel einen anderen Abstand zum Mittelpunkt. r(0)=r(2pi) sollte auch gelten, damit deine Insel einen stetigen Rand hat. Im Anhang habe ich mal für zwei r(phi)-Funktionen die passende Insel gezeichnet. (als Bonus könntest du noch forden, dass die einseitigen Ableitungen an den Intervallgrenzen übereinstimmen, dann hat deine Insel auch keinen Knick)

Für r(phi)=1 hast du einen normalen Kreis, sonst ist eigentlich alles Möglich. Du musst jetzt nur noch passende Funktionen bauen. Am einfachsten wäre der polynome Ansatz bei dem du die Koeffizienten fast alle per Random wählst und einen (z.B. den vor der höchsten Potenz) so, dass deine Funktionswerte übereinstimmen.

Damit solltest du schöne Inseln haben. Indem du die Integrale unter den Polynomen vergleichst, solltest du auch die Größe der Inseln vergleichen können. (Glaube ich, sonst kanst du im Matheboard.de nachfragen).

Fahrplan:

Zufälliges Polynom auf (0,2pi) mit r(0)=r(2pi) erzeugen.
Mittelpunkt (x,y) auf deiner Karte auswählen.
Dann etwa:

Delphi-Quellcode:

 moveto(x+cos(0)*r(0),y)
 winkel:=0;
 while winkel<=2*pi
 begin
 newx:= cos(winkel)*r(winkel);
 newy:= sin(winkel)*r(winkel);
 lineto(x+newx,y+newy);
 winkel:= winkel+0.01;
 end;

Die Inseln kannst du dir dann mal anschauen (sollten eigentlich recht schön sein). Wenn nicht, könntest du an den Parametern schrauben und schauen, wie sich Einschränkungen an den Parameterbereich jedes Koeffizienten auf die Inselform auswirken.

Damit hast du dann einen Umriss, den du per floodfill füllen kannst. Das Array könntest du dann füllen, in dem du für jedes Pixel die Farbe ausliest. Ist zwar nicht besonders schön, funktioniert aber.

/////////////////////////

Nachtrag:

Delphi-Quellcode:

Function TForm1.r(phi: real): real;
begin
result:= (cos(phi)+1)*50+20;
// result:= (phi-pi)*(phi-pi)*20;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
x,y,newx,newy: real;
phi: real;
begin

x:=100;
y:=100;
phi:=0;

with image1.Canvas do
 begin
 moveto(round(x+r(0)),round(y));
  while phi<=2*pi do
   begin
   newx:= cos(phi)*r(phi);
   newy:= sin(phi)*r(phi);
   lineto(round(x+newx),round(y+newy));
   phi:= phi+0.01;
   end;

 end;

end;

Das Problem an dieser Methode ist eine passende r-Funktion zu finden. Diese sollte positiv sein, da es sonst zu Überschneidungen der Inselkanten kommen kann. Auch ist die Übereinstimmende Ableitung an den Intervallenden wichtig, da die Insel sonst die oben erwähnte Ecke hat. Auch sollte sie nicht unbedingt symetrisch sein.
Eine weitere spontane Idee:
Definiere dir kurze Inselstücke (r(phi)Funtionen in eingeschränkten Intervallen wie (0,pi/4) deren Ableitung an den Enden 0 beträgt und deren Funktionswert dort für alle Stücke gleich ist)
Wenn du eine neue Insel bauen willst, suche dir zufällig vier solcher Stücke aus. Entscheide dich für einen Durchmesser und multipliziere alle Funktionen mit dieser Konstanten (damit kannst du dir größe der Insel einstellen. ) Dann klebe sie dir zu einer einzigen phiFunktion zusammen, die auf (0,2pi) lebt.
Damit ist deine Insel skalierbar, hat keinen Knick und ist nicht einfach symetrisch. Wenn du mehr Arbeit haben willst, nimmst du immer unterschiedliche Intervalllängen für deine Inselstücke und suchst dir diese so zusammen, dass deine zusammengesetzte Funktion den richtigen Definitionsbereich hat.
Damit sollte der Spiele nichts mehr von deiner Arbeitstechnik mitbekommen.

[grizzly]

Was heißt "schön rund"?

Ich habe vor Jahren mal von einen ganz simplen Ansatz gelesen, solche Karten zu erstellen:

1. Du beginnst mit einer leeren Karte (Alles 0)
2. Du erzeugst Dir eine zufällige Trennlinie durch Deine Karte
3. Alle Punkte auf der einen Seite der Karte erhöhst Du um eins, die anderen verminderst Du um eins.

Die Schritte 2 und 3 ein paar hundert mal wiederholen...

Weil ich das schon seit Jahren mal ausprobieren wollte, hier mal schnell eine Quick and Dirty Umsetzung:

Der Source benötigt eine Form mit einem TBitBtn, einem TImage und einem TLabel.
Den Button öfters mal betätigen. Manchmal kommt nur Wasser oder nur Land raus...

Delphi-Quellcode:

procedure TForm1.TBitBtn1Click(Sender: TObject);
const
  cWidth = 400;
  cHeight= 400;
  MaxLoop= 500;
var
  i    : integer;
  Grid : ARRAY[1..cWidth, 1..cHeight] OF integer;
  Step : ARRAY[1..cWidth] OF integer;
  x, y : integer;
  a, b : double;
  Ma   : integer;
  UpDown: Boolean;
begin
  Randomize;

  Image1.Width  := cWidth;
  Image1.Height := cHeight;
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image1.Picture.Bitmap.Width := cWidth;
  Image1.Picture.Bitmap.Height := cHeight;

  // Grundstruktur
  FillChar(Grid, SizeOf(Grid), #0);
  FOR i := 1 TO MaxLoop DO
    BEGIN
      // Gleichung für Schnittgerade durch Landschaft
      a := random * cHeight*3 - cHeight;
      b := random * 4 -2 ;
      // Für Schnittgerade die x/y Punktepaare berechnen
      FOR x := 1 TO cWidth DO
        Step[x] := round(a + b*x);
      // Landschaft erhöhen/erniedrigen je nachdem, ob Punkt über unter unter Schnittgerade ist
      UpDown := random < 0.5;  // Entscheidung Erhöhen/Erniedrigen pro Durchlauf variieren
      FOR y := cHeight DOWNTO 1 DO
        FOR x := cWidth downto 1 DO
          IF UpDown then
            begin
              IF Step[x] < y
                then Inc(Grid[x, y])
                else Dec(Grid[x, y]);
            end
            else begin
              IF Step[x] >= y
                then Inc(Grid[x, y])
                else Dec(Grid[x, y]);
            end;
      Label1.Caption := IntToStr(Trunc(i/MaxLoop*100)) +'%';
      Application.ProcessMessages;
    END;

  // Landschaft glätten
  // Filtern "vor Ort" (ohne zweites Grid) ist nicht ganz optimal, aber auf die Schnelle...
  FOR i := 1 TO 4 do
    begin
      FOR y := cHeight-1 DOWNTO 2 DO
        FOR x := cWidth-1 downto 2 DO
          Grid[x, y] := (Grid[x, y] * 4+
                         (Grid[x+1, y]+Grid[x-1, y]+Grid[x, y+1]+Grid[x, y-1]) * 2+
                          Grid[x+1, y+1]+Grid[x-1, y+1]+Grid[x+1, y-1]+Grid[x-1, y-1] ) div 16;
    end;

  // Maximum bestimmen
  Ma := 0;
  FOR y := cHeight DOWNTO 1 DO
    FOR x := cWidth downto 1 DO
      IF Ma < Grid[x, y] THEN
        Ma := Grid[x, y];

  // Bitmap einfärben
  WITH Image1.Picture.Bitmap.Canvas DO
    FOR y := cHeight DOWNTO 1 DO
      FOR x := cWidth downto 1 DO
        IF Grid[x, y] <= 0
          then Pixels[x, y] := clBlue
          else begin
            i := Trunc(Grid[x, y] * 160 / Ma);
            Pixels[x, y] := $0020F020 + $00010001 * (i div 4) - $00000100 * i;
          end;
end;

Zugegeben, rund ist das nicht. ;)

Gruß
Michael

[xZise]

Zitat:

Zitat von sirius

1. du fängst in einer Ecke deiner Karte an und versuchst wie ein sich verzweigender Baum immer abhängig von dem verherigen Punkt einen neuen HöhenPunkt zu berechnen. Du machst als quasi Raster. Und alles was negative Höhe hat, wird wohl Wasser sein.

Wäre interessant (vorteil: Man kann gleich das array füllen)

Zitat:

Zitat von sirius

2. Fraktale. Damit kann man auch Landschaften erzeugen. Da hab ich schonmal Bilder gesehen. Aber bis auf, dass ich die gängigsten Fraktale zeichnen lassen könnte, wüsste ich bei einer Landschaft erstmal keinen Ansatz.

:mrgreen: Damit kenn ich mich noch net aus ^^

Zitat:

Zitat von Nikolas

Stelle dir jede Insel als kreisähnliche Figur vor. Diese ist dann Darstellbar als r(phi) (stetig und auf (0 bis 2pi) definiert. Du hast also für jeden Winkel einen anderen Abstand zum Mittelpunkt. r(0)=r(2pi) sollte auch gelten, damit deine Insel einen stetigen Rand hat. Im Anhang habe ich mal für zwei r(phi)-Funktionen die passende Insel gezeichnet. (als Bonus könntest du noch forden, dass die einseitigen Ableitungen an den Intervallgrenzen übereinstimmen, dann hat deine Insel auch keinen Knick)

Für r(phi)=1 hast du einen normalen Kreis, sonst ist eigentlich alles Möglich. Du musst jetzt nur noch passende Funktionen bauen. Am einfachsten wäre der polynome Ansatz bei dem du die Koeffizienten fast alle per Random wählst und einen (z.B. den vor der höchsten Potenz) so, dass deine Funktionswerte übereinstimmen.

Damit solltest du schöne Inseln haben. Indem du die Integrale unter den Polynomen vergleichst, solltest du auch die Größe der Inseln vergleichen können. (Glaube ich, sonst kanst du im Matheboard.de nachfragen).

Zitat:

Zitat von grizzly

Was heißt "schön rund"?

Klingt interessant und logisch... Aber ich denke ich habe mich oben falsch ausgedrückt ^^ Und zwar hatte ich bei meinen Polygon ziemlich seltsame gebilde manchmal... Deshalb meinte ich rund ;)

Obwohl ich damit eigentlich eben eine "Typische" Insel ;)

Zitat:

Zitat von grizzly

Ich habe vor Jahren mal von einen ganz simplen Ansatz gelesen, solche Karten zu erstellen:

1. Du beginnst mit einer leeren Karte (Alles 0)
2. Du erzeugst Dir eine zufällige Trennlinie durch Deine Karte
3. Alle Punkte auf der einen Seite der Karte erhöhst Du um eins, die anderen verminderst Du um eins.

Die Schritte 2 und 3 ein paar hundert mal wiederholen...

Diese Idee klingt ziemlich geil ehrlich gesagt... und das Ergebnis auch ... Nur wäre mehr Wasseranteil besser ;) aber ich denke, es lässt sich damit verbessern, dass ich die Punkte weniger erhöhe als erniedrige ...

[edit]Juhu ^^ Der Code von qrizzly ist Perfekt!!! Danke!![/edit]

[Zerolith]

Hallo,

Ich hab mir mal Grizzlys Code angesehen, und einfach mal versucht das ganze mit z.B. cWidth und cHeight auf 800 zu setzen.
Beim Start der Procedure bekomm ich eine EStackOverFlow Meldung (Der Debugger steht auf dem Begin).

An Integer kanns ja niciht liegen da lt. meiner REchnung mit 640000 der Wertebereich von Integer noch nicht überschritten ist. Habs zwar trotzdem mal mit longword versucht, ging ebenfalls in die Hose.

Kann mir mal jemand erklären wie ich dieses Stack problem behandel? Mir ist klar wie der Stack funktioniert, mir ist auch klar dass das Zeug im Stack abgelegt wird. Normalerweiße werden ja alle Variablen im Stack abgelegt ( oder gilt das nur für Lokale? )

Aber wie ich ich das anders lösen kann, weiß ich nicht.

Danke,
Daniel

Zitat:

Zitat von grizzly

Delphi-Quellcode:

procedure TForm1.TBitBtn1Click(Sender: TObject);
const
[b]  cWidth = 400;
  cHeight= 400;[/b]
  MaxLoop= 500;
var
  i    : integer;
  Grid : ARRAY[1..cWidth, 1..cHeight] OF integer;
  Step : ARRAY[1..cWidth] OF integer;
  x, y : integer;
  a, b : double;
  Ma   : integer;
  UpDown: Boolean;
begin

[sirius]

Das Anlegen der Arrays könnte schon zum Stackoverflow führen. Du hast standardmäßig 1MB Stack (zumindest bei mir unter Delphi 7). Mach doch mal die Zahl ein wenig größer dann siehst du es. Ansonsten landen nur lokale Variable auf dem Stack. Es dürfte schon reichen aus den statischen arrays dynamische arrays zu machen. Denn dann kommt nur ein pointer auf den Stack und die Werte liegen woanders (mich wudnert es, dass der Compiler bei so großen arrays nicht reagiert :gruebel: und sie auf den "Heap" legt)

[shmia]

Hier werden verschiedene Terrain-Algorithmen behandelt:
http://www2.informatik.uni-erlangen....df?language=de

[Zerolith]

Erstmal danke Sirius,

aber, was meinst du damit?

Zitat:

Zitat von sirius

Mach doch mal die Zahl ein wenig größer dann siehst du es.

Die Zahl?

Zitat:

Zitat von sirius

Ansonsten landen nur lokale Variable auf dem Stack.

ah gut :-) *merk*

Zitat:

Zitat von sirius

Es dürfte schon reichen aus den statischen arrays dynamische arrays zu machen. Denn dann kommt nur ein pointer auf den Stack und die Werte liegen woanders

dafür sollte ich mich eigentlich auspeitschen... dass ich nicht selber drauf gekommen bin. Danke nochmal

Zitat:

Zitat von sirius

(mich wudnert es, dass der Compiler bei so großen arrays nicht reagiert :gruebel: und sie auf den "Heap" legt)

Delphi 6.... :-)

[grizzly]

Für mein Beispiel oben wollte ich kein komplettes Programm posten. Deshalb habe ich alles in die Prozedur selbst reingeworfen. Natürlich sollte man so eine Struktur nicht auf dem Stack allokieren. Aber um den Algorithmus zu illustrieren schien mir das vertretbar. Tut mir leid, wenn deswegen jemand seinen Stack eingerannt hat - hoffentlich erholt er sich wieder... ;)

Hier die Stack-sichere Variante. Wollte ja eigentlich den obigen Beitrag editieren, aber das geht scheinbar nur innerhalb 24 Stunden. Wußte ich bisher auch noch nicht (entschuldigt also bitte diesen zweiten Riesen-Eintrag)...

Delphi-Quellcode:

procedure TForm1.BitBtn1Click(Sender: TObject);
const
  cWidth = 400;
  cHeight= 400;
  MaxLoop= 500;
type
  TGrid= ARRAY[1..cWidth, 1..cHeight] OF integer;  // Wenn man eh nur 500 Zyklen macht, reicht hier auch ein smallint
var
  i    : integer;
  PGrid: ^TGrid;
  Step : ARRAY[1..cWidth] OF integer;
  x, y : integer;
  a, b : double;
  Ma   : integer;
  UpDown: Boolean;
begin
  Randomize;

  try
    New(PGrid);
  except
    exit;  // Not enough memory
  end;

  Image1.Width  := cWidth;
  Image1.Height := cHeight;
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image1.Picture.Bitmap.Width := cWidth;
  Image1.Picture.Bitmap.Height := cHeight;

  // Grundstruktur
  FillChar(PGrid^, SizeOf(TGrid), #0);
  FOR i := 1 TO MaxLoop DO
    BEGIN
      // Gleichung für Schnittgerade durch Landschaft
      a := random * cHeight*3 - cHeight;
      b := random * 4 -2 ;
      // Für Schnittgerade die x/y Punktepaare berechnen
      FOR x := 1 TO cWidth DO
        Step[x] := round(a + b*x);
      // Landschaft erhöhen/erniedrigen je nachdem, ob Punkt über unter unter Schnittgerade ist
      UpDown := random < 0.5;  // Entscheidung Erhöhen/Erniedrigen pro Durchlauf variieren
      FOR y := cHeight DOWNTO 1 DO
        FOR x := cWidth downto 1 DO
          IF UpDown then
            begin
              IF Step[x] < y
                then Inc(PGrid^[x, y])
                else Dec(PGrid^[x, y]);
            end
            else begin
              IF Step[x] >= y
                then Inc(PGrid^[x, y])
                else Dec(PGrid^[x, y]);
            end;
      Label1.Caption := IntToStr(Trunc(i/MaxLoop*100)) +'%';
      Application.ProcessMessages;
    END;

  // Landschaft glätten
  // Filtern "vor Ort" (ohne zweites Grid) ist nicht ganz optimal, aber auf die Schnelle...
  FOR i := 1 TO 4 do
    begin
      FOR y := cHeight-1 DOWNTO 2 DO
        FOR x := cWidth-1 downto 2 DO
          PGrid^[x, y] := (PGrid^[x, y] * 4+
                         (PGrid^[x+1, y]+PGrid^[x-1, y]+PGrid^[x, y+1]+PGrid^[x, y-1]) * 2+
                          PGrid^[x+1, y+1]+PGrid^[x-1, y+1]+PGrid^[x+1, y-1]+PGrid^[x-1, y-1] ) div 16;
    end;

  // Maximum bestimmen
  Ma := 0;
  FOR y := cHeight DOWNTO 1 DO
    FOR x := cWidth downto 1 DO
      IF Ma < PGrid^[x, y] THEN
        Ma := PGrid^[x, y];

  // Bitmap einfärben
  WITH Image1.Picture.Bitmap.Canvas DO
    FOR y := cHeight DOWNTO 1 DO
      FOR x := cWidth downto 1 DO
        IF PGrid^[x, y] <= 0
          then Pixels[x, y] := clBlue
          else begin
            i := Trunc(PGrid^[x, y] * 160 / Ma);
            Pixels[x, y] := $0020F020 + $00010001 * (i div 4) - $00000100 * i;
          end;

  Dispose(PGrid);
end;

Gruß
Michael

[sirius]

Zitat:

Zitat von Zerolith

Die Zahl?

Projekt -> Optionen -> Linker ==> Maximale Stackgröße

[xZise]

So... Ich bins wieder ;) Und zwar bekomme ich jetzt ein Problem mit dem Zeiger-Code... (AV):

Delphi-Quellcode:

procedure TForm1.DrawMap(const AWidth, AHeight : Word);
const
  MaxLoop = 500;
type
  TGrid = array of array of SmallInt;
var
  progress : Byte;
  i    : integer;
  PGrid : ^TGrid;
  Step : array of integer;
  x, y : integer;
  a, b : double;
  Ma   : integer;
  UpDown: Boolean;
begin
  try
    New(PGrid);
  except
    MessageBox(Handle, PChar('Not enough memory' + #13#10 + 'Error: 1'), PChar('Error - 1'), MB_OK or MB_ICONERROR);
    exit;
  end;

   SetLength(PGrid^, AWidth, AHeight);
  SetLength(Step, AWidth);

  // Grundstruktur
  FillChar(PGrid^, SizeOf(TGrid), #0);
  FOR i := 1 TO MaxLoop DO
    BEGIN
      // Gleichung für Schnittgerade durch Landschaft
      a := Random * AHeight * 3 - AHeight;
      b := Random * 4 -2 ;
      // Für Schnittgerade die x/y Punktepaare berechnen
      FOR x := 1 TO AWidth DO
        Step[x - 1] := round(a + b*x);
      // Landschaft erhöhen/erniedrigen je nachdem, ob Punkt über unter unter Schnittgerade ist
      UpDown := random < 0.5;  // Entscheidung Erhöhen/Erniedrigen pro Durchlauf variieren
      FOR y := AHeight DOWNTO 1 DO
        FOR x := AWidth downto 1 DO
          IF UpDown then
            begin
              IF Step[x - 1] < y
                then Inc(PGrid^[x - 1, y - 1])
                else Dec(PGrid^[x - 1, y - 1]);
            end
            else begin
              IF Step[x - 1] >= y
                then Inc(PGrid^[x - 1, y - 1])
                else Dec(PGrid^[x - 1, y - 1]);
            end;
      progress := Trunc(i/MaxLoop*100);
      lProgress.Caption := 'Progress: ' + IntToStr(progress) +'%';
      pbProgress.Position := progress;
      lProgress.Repaint;
      pbProgress.Repaint;
    END;

  // Landschaft glätten
  // Filtern "vor Ort" (ohne zweites PGrid^) ist nicht ganz optimal, aber auf die Schnelle...
  FOR i := 1 TO 4 do
    begin
      FOR y := AHeight - 2 DOWNTO 12 DO
        FOR x := AWidth - 2 downto 1 DO
          PGrid^[x, y] := (PGrid^[x, y] * 4+
                         (PGrid^[x+1, y]+PGrid^[x-1, y]+PGrid^[x, y+1]+PGrid^[x, y-1]) * 2+
                          PGrid^[x+1, y+1]+PGrid^[x-1, y+1]+PGrid^[x+1, y-1]+PGrid^[x-1, y-1] ) div 16;
    end;

  // Maximum bestimmen
  Ma := 0;
  FOR y := AHeight - 1 DOWNTO 0 DO
    FOR x := AWidth - 1 downto 0 DO
      IF Ma < PGrid^[x, y] THEN
        Ma := PGrid^[x, y];

  // Bitmap einfärben
  WITH iMap.Picture.Bitmap.Canvas DO
    FOR y := AHeight DOWNTO 1 DO
      FOR x := AWidth downto 1 DO
        IF PGrid^[x, y] <= 0
          then Pixels[x, y] := clBlue
          else begin
            i := Trunc(PGrid^[x - 1, y - 1] * 160 / Ma);
            Pixels[x, y] := $0020F020 + $00010001 * (i div 4) - $00000100 * i;
          end;


  Dispose(PGrid);
end;

Der Fehler tritt je nach Zufall in den Zeilen 43, 44, 48 oder 49 auf.

[Hawkeye219]

Hallo Fabian,

ein mehrdimensionales, dynamisches Array belegt keinen zusammenhängenden Speicherbereich. Das Löschen solltest du also besser so durchführen:

Delphi-Quellcode:

for y := 0 to High(PGrid^) do
  for x := 0 to High(PGrid^[y]) do
    PGrid^[x, y] := 0;

In der letzten Ebene (x) könntest du prinzipiell auch mit FillChar arbeiten.

In Zeile 63 ist wahrscheinlich der Endwert der y-Schleife falsch:

Delphi-Quellcode:

FOR y := AHeight - 2 DOWNTO 12 DO  // 1 statt 12?

Bei der Schleife zum Einfärben der Bitmap solltest du die Schleifenparameter prüfen. Der Zugriff auf PGrid^[AWidth, AHeight] dürfte ebenfalls zu einem Fehler führen. Eine einfache Verschiebung beider Laufvariablen um 1 führt allerdings zu Problemen im ELSE-Zweig.

Gruß Hawkeye

[xZise]

Hallo Hawkeye !
Danke erstmal für den Report!

Zitat:

Zitat von Hawkeye219

ein mehrdimensionales, dynamisches Array belegt keinen zusammenhängenden Speicherbereich. Das Löschen solltest du also besser so durchführen:

Delphi-Quellcode:

for y := 0 to High(PGrid^) do
  for x := 0 to High(PGrid^[y]) do
    PGrid^[x, y] := 0;

In der letzten Ebene (x) könntest du prinzipiell auch mit FillChar arbeiten.

Danke.... Wusste ich nicht! Aber daran wirds doch wohl kaum liegen oder :) :?:

Zitat:

Zitat von Hawkeye219

In Zeile 63 ist wahrscheinlich der Endwert der y-Schleife falsch:

Delphi-Quellcode:

FOR y := AHeight - 2 DOWNTO 12 DO  // 1 statt 12?

OOPs... ja da hast du recht ;)

Zitat:

Zitat von Hawkeye219

Bei der Schleife zum Einfärben der Bitmap solltest du die Schleifenparameter prüfen. Der Zugriff auf PGrid^[AWidth, AHeight] dürfte ebenfalls zu einem Fehler führen. Eine einfache Verschiebung beider Laufvariablen um 1 führt allerdings zu Problemen im ELSE-Zweig.

Jo ^^ Da muss ich den Zugriff modifizieren (habe es da wohl vergessen).

Danke :) Aber ich glaube kaum, dass es daran liegt...

MfG, xZise

[Hawkeye219]

Zitat:

Zitat von xZise

Aber daran wirds doch wohl kaum liegen oder?

Da bin ich anderer Meinung.

Delphi-Quellcode:

type
  TGrid = array of array of SmallInt;
var
  Grid : TGrid;
begin
  SetLength (Grid, 10, 20);
end;

Im obigen Beispiel ist Grid ein Zeiger auf ein Array mit 10 Zeigern auf jeweils ein Array mit 20 SmallInt-Elementen. In Wirklichkeit sind noch einige Verwaltungsdaten dabei, das tut aber nichts zur Sache. SizeOf(TGrid) wird immer den Wert 4 liefern - die Größe eines Zeigers.

Mit dem FillChar-Befehl in deinem Code löschst du nicht den Inhalt des Arrays, sondern einen Teil der Zeigerstruktur bzw. der Verwaltungsinformationen. Dies muß früher oder später zum Absturz führen.

Gruß Hawkeye

[xZise]

Jo :) Is mir auch aufgefallen! Funktioniert jetzt wunderbar! Danke!

[jmit]

Hallo,

Zitat:

Zitat von grizzly

Was heißt "schön rund"?

Ich habe vor Jahren mal von einen ganz simplen Ansatz gelesen, solche Karten zu erstellen:

1. Du beginnst mit einer leeren Karte (Alles 0)
2. Du erzeugst Dir eine zufällige Trennlinie durch Deine Karte
3. Alle Punkte auf der einen Seite der Karte erhöhst Du um eins, die anderen verminderst Du um eins.

Die Schritte 2 und 3 ein paar hundert mal wiederholen...

Weil ich das schon seit Jahren mal ausprobieren wollte, hier mal schnell eine Quick and Dirty Umsetzung:

Der Source benötigt eine Form mit einem TBitBtn, einem TImage und einem TLabel.
Den Button öfters mal betätigen. Manchmal kommt nur Wasser oder nur Land raus...

Delphi-Quellcode:

procedure TForm1.TBitBtn1Click(Sender: TObject);
const
  cWidth = 400;
  cHeight= 400;
  MaxLoop= 500;
var
  i    : integer;
  Grid : ARRAY[1..cWidth, 1..cHeight] OF integer;
  Step : ARRAY[1..cWidth] OF integer;
  x, y : integer;
  a, b : double;
  Ma   : integer;
  UpDown: Boolean;
begin
  Randomize;

  Image1.Width  := cWidth;
  Image1.Height := cHeight;
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image1.Picture.Bitmap.Width := cWidth;
  Image1.Picture.Bitmap.Height := cHeight;

  // Grundstruktur
  FillChar(Grid, SizeOf(Grid), #0);
  FOR i := 1 TO MaxLoop DO
    BEGIN
      // Gleichung für Schnittgerade durch Landschaft
      a := random * cHeight*3 - cHeight;
      b := random * 4 -2 ;
      // Für Schnittgerade die x/y Punktepaare berechnen
      FOR x := 1 TO cWidth DO
        Step[x] := round(a + b*x);
      // Landschaft erhöhen/erniedrigen je nachdem, ob Punkt über unter unter Schnittgerade ist
      UpDown := random < 0.5;  // Entscheidung Erhöhen/Erniedrigen pro Durchlauf variieren
      FOR y := cHeight DOWNTO 1 DO
        FOR x := cWidth downto 1 DO
          IF UpDown then
            begin
              IF Step[x] < y
                then Inc(Grid[x, y])
                else Dec(Grid[x, y]);
            end
            else begin
              IF Step[x] >= y
                then Inc(Grid[x, y])
                else Dec(Grid[x, y]);
            end;
      Label1.Caption := IntToStr(Trunc(i/MaxLoop*100)) +'%';
      Application.ProcessMessages;
    END;

  // Landschaft glätten
  // Filtern "vor Ort" (ohne zweites Grid) ist nicht ganz optimal, aber auf die Schnelle...
  FOR i := 1 TO 4 do
    begin
      FOR y := cHeight-1 DOWNTO 2 DO
        FOR x := cWidth-1 downto 2 DO
          Grid[x, y] := (Grid[x, y] * 4+
                         (Grid[x+1, y]+Grid[x-1, y]+Grid[x, y+1]+Grid[x, y-1]) * 2+
                          Grid[x+1, y+1]+Grid[x-1, y+1]+Grid[x+1, y-1]+Grid[x-1, y-1] ) div 16;
    end;

  // Maximum bestimmen
  Ma := 0;
  FOR y := cHeight DOWNTO 1 DO
    FOR x := cWidth downto 1 DO
      IF Ma < Grid[x, y] THEN
        Ma := Grid[x, y];

  // Bitmap einfärben
  WITH Image1.Picture.Bitmap.Canvas DO
    FOR y := cHeight DOWNTO 1 DO
      FOR x := cWidth downto 1 DO
        IF Grid[x, y] <= 0
          then Pixels[x, y] := clBlue
          else begin
            i := Trunc(Grid[x, y] * 160 / Ma);
            Pixels[x, y] := $0020F020 + $00010001 * (i div 4) - $00000100 * i;
          end;
end;

Zugegeben, rund ist das nicht. ;)

Gruß
Michael

Egal ob rund oder nicht rund, die Idee gefällt mir sehr gut.

Gruß Jörg

[grizzly]

Mittlerweile weiß ich wenigstens wieder, wo ich von diesem Verfahren gelesen hatte:
Benoît B. Mandelbrot, Die fraktale Geometrie der Natur, Birkhäuser Verlag, 1987.

Irgendwo in der Mitte des Buches gibt es ein Kapitel "Die Erzeugung eines Brown-Reliefs", in dem der Algorithmus beschrieben wird (allerdings ein klein wenig anders, als ich ihn in Erinnerung hatte: Der Höhenunterschied zwischen den durch einen Schnitt entstehenden Seiten kann zufällig gewählt werden, außerdem wird noch eine Normierung bzgl. der Anzahl der Durchläufe angewandt (Multiplikation mit der Wurzel aus der Anzahl der Durchläufe)).

Dieses Kapitel wiederum bezieht sich auf eine andere Veröffentlichung Mandelbrots: Fonctions aléatoires pluritemporelles: approximation poissonien ne du cas brownien et généralisations. Comptes Rendus (Paris), 280 A, 1075-1078, was mir nix nutzt, weil ich kein Französisch kann ;)

Gruß
Michael

[xZise]

Übrigens hatte ich einmal eine verbesserte Variante mit Kreisen ;) Dann stand nicht von anfang an fest, wo viel Land sein wird. (Weil bei der obigen ist das meißte Land dort, wo als erstes Land erzeugt wurde). Leider ist der Code regelrecht "verbruzelt"... Und ich hatte leider keine Sicherungskopie auf'm Rechner :(

Aber als Tipp (welche das ummodifizieren wollen):
Statt zu überprüfen, ob der Punkt im oder außerhalb des Kreises ist:

Delphi-Quellcode:

if Sqrt(Power(x, 2) + Power(y, 2)) >{=} r then
  // außerhalb

kann man das besser mit "a² + b² = c²" lösen:

Delphi-Quellcode:

if Power(x, 2) + Power(y, 2) >{=} Power(r, 2) then
  //außerhalb

wobei ich nicht weiß, ob "IntPower(x, 2)", "Power(x, 2)" oder "x * x" schneller ist.
Aber die obige Verbesserung mach den Algo um ein vielfaches Schneller (Mensch hatte ich da gestaunt xD)

[grizzly]

Falls doch mal jemand schnell mit dem Algorithmus von Herrn Mandelbrot ein wenig herumspielen will: Im Anhang ist der Source-Code zu meinem Testprogramm. (Testprogramm! d.h. keine Kommentare! ;))

Achtung: Wenn man Randseed nicht ändert, dann erhält man immer dieselbe Landkarte.

Ein AVI mit der Erschaffung einer Insel gibt es hier (2MB).

Gruß
Michael