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.

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

Damit kenn ich mich noch net aus ^^

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 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 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 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 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 von sirius:

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

Die Zahl?

Zitat von sirius:

Ansonsten landen nur lokale Variable auf dem Stack.

ah gut *merk*

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 von sirius:

(mich wudnert es, dass der Compiler bei so großen arrays nicht reagiert 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