![]() |
Inseln auf ein Image malen
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:
|
Re: Inseln auf ein Image malen
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. |
Re: Inseln auf ein Image malen
Liste der Anhänge anzeigen (Anzahl: 1)
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:
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.
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; 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:
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.
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; 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. |
Re: Inseln auf ein Image malen
Liste der Anhänge anzeigen (Anzahl: 1)
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:
Zugegeben, rund ist das nicht. ;)
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; Gruß Michael |
Re: Inseln auf ein Image malen
Zitat:
Zitat:
Zitat:
Zitat:
Obwohl ich damit eigentlich eben eine "Typische" Insel ;) Zitat:
[edit]Juhu ^^ Der Code von qrizzly ist Perfekt!!! Danke!![/edit] |
Re: Inseln auf ein Image malen
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:
|
Re: Inseln auf ein Image malen
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)
|
Re: Inseln auf ein Image malen
Hier werden verschiedene Terrain-Algorithmen behandelt:
![]() |
Re: Inseln auf ein Image malen
Erstmal danke Sirius,
aber, was meinst du damit? Zitat:
Zitat:
Zitat:
Zitat:
|
Re: Inseln auf ein Image malen
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 |
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:09 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz