vb6: Zufällige Landkarte
lima-city → Forum → Programmiersprachen → Basic
bergen
bild
bilden
byte
chance
ergebnis
flag
frage
gebirge
gebirgskette
http
idee
meer
paar
papierkorb
see
stelle
url
wasser
zufall
-
Jeder kennt die frage: Das Schachbrett-Problem: Wenn auf einem Schachbrett an der obersten und linken Linie je 3 Reisköner je Feld liegen, auf jedem angrenzenden Feld eine zufällige anzahl gelegt werden soll, welche alleridings nicht 4 übersteigen darf und welche ausserdem maximal um eines höher oder niedriger sein darf, als ein angrenzendes.
Anders gefragt: Ich will eine zufällige "Landschaftskarte" (auf einer Picturebox) erstellen. Diese erstreckt sich über 5 "höhen", also beispielsweise tiefes wasser, niedriges wasser. strand, flachland und berge. Nun soll da nicht ein pixel wasser und der danebn liegende plötzlich ein gebirge sein.
Nun, ich habe mich daran gesetzt und war auch relativ erfolgreich. Allerdings bin ich mit dem Ergebnis nicht so ganz zufrieden. Erstens ergeben sich fast "muster", trotz jeder menge Mühe, genau dies zu umgehen. Nun frage ich: Hat jemand eine Idee, wie man das besser machen könnte?
Hier nun erstmal mein bisheriger Code
Const MapHeight = 400 Const MapWidth = 400 Dim Colors(0 To 4) As Long Dim HeightMap() As Byte Private Sub Command1_Click() render End Sub Private Sub Form_Load() Dim flag(0 To 4) As Boolean ReDim HeightMap(0 To MapHeight, 0 To MapWidth) As Byte Dim chance(0 To 4) As Byte Colors(0) = RGB(0, 0, 255) Colors(1) = RGB(255, 255, 0) Colors(2) = RGB(0, 255, 0) Colors(3) = RGB(0, 128, 0) Colors(4) = RGB(128, 128, 0) For x = 0 To MapWidth For y = 0 To MapHeight HeightMap(x, y) = 200 Next y Next x For x = 0 To MapWidth For y = 0 To MapHeight If x = 0 Or y = 0 Then HeightMap(x, y) = 3 ElseIf x = MapWidth Or y = MapHeight Then HeightMap(x, y) = 1 Else flag(0) = True flag(1) = True flag(2) = True flag(3) = True flag(4) = True If HeightMap(x, y - 1) = 0 Then flag(4) = False: flag(3) = False: flag(2) = False If HeightMap(x, y + 1) = 0 Then flag(4) = False: flag(3) = False: flag(2) = False If HeightMap(x - 1, y) = 0 Then flag(4) = False: flag(3) = False: flag(2) = False If HeightMap(x + 1, y) = 0 Then flag(4) = False: flag(3) = False: flag(2) = False If HeightMap(x, y - 1) = 1 Then flag(4) = False: flag(3) = False If HeightMap(x, y + 1) = 1 Then flag(4) = False: flag(3) = False If HeightMap(x - 1, y) = 1 Then flag(4) = False: flag(3) = False If HeightMap(x + 1, y) = 1 Then flag(4) = False: flag(3) = False If HeightMap(x, y - 1) = 2 Then flag(4) = False: flag(0) = False If HeightMap(x, y + 1) = 2 Then flag(4) = False: flag(0) = False If HeightMap(x - 1, y) = 2 Then flag(4) = False: flag(0) = False If HeightMap(x + 1, y) = 2 Then flag(4) = False: flag(0) = False If HeightMap(x, y - 1) = 3 Then flag(0) = False: flag(1) = False If HeightMap(x, y + 1) = 3 Then flag(0) = False: flag(1) = False If HeightMap(x - 1, y) = 3 Then flag(0) = False: flag(1) = False If HeightMap(x + 1, y) = 3 Then flag(0) = False: flag(1) = False If HeightMap(x, y - 1) = 4 Then flag(0) = False: flag(1) = False: flag(2) = False If HeightMap(x, y + 1) = 4 Then flag(0) = False: flag(1) = False: flag(2) = False If HeightMap(x - 1, y) = 4 Then flag(0) = False: flag(1) = False: flag(2) = False If HeightMap(x + 1, y) = 4 Then flag(0) = False: flag(1) = False: flag(2) = False flagcnt = 0 For i = 0 To 4 If flag(i) Then flagcnt = flagcnt + 1 Next i For i = 0 To 4 If flag(i) Then chance(i) = 100 / flagcnt Next i Randomize Timer zufall = Round(Rnd * 98) + 1 chance(1) = chance(1) + chance(0) chance(2) = chance(2) + chance(1) chance(3) = chance(3) + chance(2) chance(4) = chance(4) + chance(3) ' zufall = zufall + 50 If zufall <= chance(0) Then HeightMap(x, y) = 0 ElseIf zufall > chance(0) And zufall <= chance(1) Then HeightMap(x, y) = 1 ElseIf zufall > chance(1) And zufall <= chance(2) Then HeightMap(x, y) = 2 ElseIf zufall > chance(2) And zufall <= chance(3) Then HeightMap(x, y) = 3 ElseIf zufall > chance(3) And zufall <= chance(4) Then HeightMap(x, y) = 4 ElseIf zufall > chance(4) Then If chance(4) < 100 Then HeightMap(x, y) = 4 Else HeightMap(x, y) = 4 End If End If chance(0) = 0 chance(1) = 0 chance(2) = 0 chance(3) = 0 chance(4) = 0 If HeightMap(x, y) = 200 Then HeightMap(x, y) = 0 End If Next y Next x End Sub Private Sub render() For x = 0 To MapWidth For y = 0 To MapHeight Picture1.Line (x * 2, y * 2)-(x * 2 + 2, y * 2 + 2), Colors(HeightMap(x, y)), BF Next y Next x End Sub
Das ernüchternde Ergebnis war: Bild
Nun, eigentlich kann ich mich kaum beklagen. Er macht ziemlich exakt das, was er soll. Allerdings würde ich mir wünschen, dass das ganze am Ende etwas "eleganter" aussieht. Also praktisch sowas wie "Inseln" oder vielleicht eine große Landmasse mit Flüssen, Seen oder ähnliches.
Ich wäre über jegliche Ideen Dankbar :) -
Diskutiere mit und stelle Fragen: Jetzt kostenlos anmelden!
lima-city: Gratis werbefreier Webspace für deine eigene Homepage
-
nerdinator schrieb:
(..)
Ich wäre über jegliche Ideen Dankbar :)
Ich stelle mir als Laie mal ganz vereinfacht "Landschaftsbildung" so vor:
Durch die Bewegung der Kontinentalplatten entstehen Falten, die man gerne auch mal als Berge bezeichnen kann (siehe Alpen).
An diesen Bergen bilden sich dann die meisten Süßwasserquellen, die sich wiederum zu immer größeren Flüssen vereinen um schließlich im Meer zu enden.
Also würde ich in folgenden schritten vorgehen:
1. ein paar zufällige "Äderchen" als Gebirgszüge bilden
Bild 1
2. Am weitesten entfernt von den Äderchen das Meer bilden
Bild 2
3.Die Ränder der Äderchen ausweiten und noch zufällig "zerklüften"
Bild 3
4. Ausgehend von den höchsten Bergen Flüsse bilden die immer möglichst flache Flächen entlang laufen um schließlich im Meer oder einem See zu enden.
Bild 4
Ich denke mal der 4te teil dürfte am schwersten zu programmieren sein...
Und zum Schluß kann man sicher noch ein paar kleine Inseln in das Meer setzen , wenn man will.
Beitrag zuletzt geändert: 29.1.2010 23:48:18 von simuliertes -
Setze standardmäßig erstmal alles als Wasser....
Schritt zwei sind flache Landmassen.
Schritt drei wären kleine Hügel.
Darauf folgt der schwerste Teil:
Dann setzt du zufällig eine zufällige Zahl - in einem gewissen Rahmen - an Gebirgen. Unzwar den höchsten Punkt. Von da lässt du zufällig - ich würde an dieser Stelle Rekursion empfehlen - in einer Art "Kreisform" das Gebiet wieder flacher werden.
So könnte es was werden.
Du müsstest eben noch Grenzen einrichten, die etwas darüber aussagen, wie nah sich Hügel und Gebirge sein dürfen usw.
Wenn ich mal die Zeit finde, schreibe ich dir ein Beispiel. ^^ -
Danke für eure Vorschläge.
Also ich versuche das jetzt praktisch als kombination von beiden bisher vorgeschlagenen Ideen.
- 1.) fülle das Feld mit Wasser.
- 2.) Zeichne im Wasser eine Gebirgskette. (Wobei die "Gebirgskette" eine dynamische höhe haben kann)
- 3.) Umrahme diese Gebirgskette mit einer Landstufe "Tiefer".
Schritt zwei und drei dann jeweils dynamisch häufig. Dadurch ergibt sich dann hoffentlich ein nach außen hin immer flacher werdendes Land, welches dann irgendwann im Wasser endet.
Mal schauen ob das ordentlich funktioniert.
Für weitere Forschläge bin ich immer dankbar :)
PS: Sieht doch schonmal gar nicht so übel aus für den Anfang.
Beitrag zuletzt geändert: 4.2.2010 14:39:45 von nerdinator -
Diskutiere mit und stelle Fragen: Jetzt kostenlos anmelden!
lima-city: Gratis werbefreier Webspace für deine eigene Homepage