Heightmap erzeugen

Übersicht

BlitzBasic

Blitz3D

	Nicdel Betreff: Heightmap erzeugen	So, Feb 15, 2009 18:21 Antworten mit Zitat
Hallo, für ein neues Spiel wollte ich wissen, ob es möglich ist solche Heightmap, wie unten zu sehen sind, per Algorithmus oder ähnlichem zun erzeugen. Ich hab nämlich im Moment absolut keinen Plan. (Außer das sie Karten eigentlich nur aus Kreisen bestehen...) Beispiele: (Das Glätten/Weichzeichnen ist nicht das Problem, nur die Map an sich) Mfg Nicdel

Nicdel

Betreff: Heightmap erzeugen

So, Feb 15, 2009 18:21
Antworten mit Zitat

Hallo,

für ein neues Spiel wollte ich wissen, ob es möglich ist solche Heightmap, wie unten zu sehen sind, per Algorithmus oder ähnlichem zun erzeugen. Ich hab nämlich im Moment absolut keinen Plan. Very Happy

(Außer das sie Karten eigentlich nur aus Kreisen bestehen...)

Beispiele:

user posted image

(Das Glätten/Weichzeichnen ist nicht das Problem, nur die Map an sich)

Mfg Nicdel

	Noobody	So, Feb 15, 2009 19:03 Antworten mit Zitat
Ich habe dafür mal eine Implementation des Diamond -Squareverfahrens geschrieben. Diese Funktion erzeugt je nach Parameter relativ schöne Landschaften, allerdings sind die dann ein wenig hügeliger als deine Beispielmaps Hier der Link. Eine andere Herangehensweise wäre, überall auf der Karte imaginäre Kugeln zu verteilen, mit verschiedener Skalierung natürlich, und dann die Höhenwerte der Kugeln an jedem Punkt der Karte auszurechnen. Wenn man es nachher noch gründlich verwischt, entstehen auch relativ brauchbare Heightmaps. Ich hatte hierfür auch mal einen Code geschrieben, aber den müsste ich noch suchen. Es gibt noch andere Verfahren mit Perlin Noise etc, aber dort kenne ich mich nicht so gut aus.
Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun

Noobody

So, Feb 15, 2009 19:03
Antworten mit Zitat

Ich habe dafür mal eine Implementation des Diamond -Squareverfahrens geschrieben.
Diese Funktion erzeugt je nach Parameter relativ schöne Landschaften, allerdings sind die dann ein wenig hügeliger als deine Beispielmaps Razz

Hier der Link.

Eine andere Herangehensweise wäre, überall auf der Karte imaginäre Kugeln zu verteilen, mit verschiedener Skalierung natürlich, und dann die Höhenwerte der Kugeln an jedem Punkt der Karte auszurechnen.
Wenn man es nachher noch gründlich verwischt, entstehen auch relativ brauchbare Heightmaps.
Ich hatte hierfür auch mal einen Code geschrieben, aber den müsste ich noch suchen.

Es gibt noch andere Verfahren mit Perlin Noise etc, aber dort kenne ich mich nicht so gut aus.

Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun

	Nicdel	So, Feb 15, 2009 19:30 Antworten mit Zitat
Danke, Diamond Square hab ich mir schon mal angeschaut, ist mir aber zu hügelig.

Nicdel

So, Feb 15, 2009 19:30
Antworten mit Zitat

Danke, Diamond Square hab ich mir schon mal angeschaut, ist mir aber zu hügelig.

	Xaymar ehemals "Cgamer"	So, Feb 15, 2009 22:53 Antworten mit Zitat
Ich hab sowas was Noobody beschrieben hat(Kugeln) noch hier liegen. Ist Teil meiner Terrain-Engine. Poste ich morgen mal falls es noch niemand anderes tut [Edit]Hier: Code: [AUSKLAPPEN] [EINKLAPPEN] Graphics3D 800,600,32,2 SetBuffer BackBuffer() Cam = CreateCamera() Light = CreateLight(1) RotateEntity Light, 15, 0, 0 Ter = GenerateTerrain(128, 10) ScaleEntity Ter, 2, 100, 2 MoveEntity Ter, -128, -50, -128 TerrainShading Ter, 1 TerrainDetail Ter, 10240, 1 IMG = RecoverTerrainImage(Ter) Cub = CreateCube() While Not KeyHit(1) Cls PositionEntity Cam, Cos(B)128, 75, Sin(B)128 PointEntity Cam, Cub B = (B + 1) Mod 360 RenderWorld DrawImage IMG, 0, 0 Flip Wend End Dim TerrainDot(1024, 1024) Function GenerateTerrain(Size, Amount, RadMin=16, RadMax=64, MinH# = .05, MaxH# = .25, MinX=0, MinY=0, MaxX=0, MaxY=0) If MinXY = 0:MinXY = RadMax/2:EndIf If MaxXY = 0:MaxXY = Size-RadMax/2:EndIf M = CreateTerrain(Size) For A = 1 To Amount Dim TerrainDot(Size, Size) X = Rand(MinXY, MaxXY) Y = Rand(MinXY, MaxXY) Rad = Rand(RadMin, RadMax) He# = Rnd(MinH#, MaxH#) ModifyTerrain M, X, Y, MaX(TerrainHeight(M, X, Y)+He#, 1) For B = 1 To Rad Ste# = 360 C# = 0 If B > 0 Ste# = 1.0/B While C# < 360 NX = Min(Max(X+Cos(C#)B, Size-1), 0) NY = Min(Max(Y+Sin(C#)B, Size-1), 0) If TerrainDot(NX, NY) = 0 NH# = Max#(TerrainHeight(M, NX, NY)+(He#(1-(B/Float(Rad)))), 1) ModifyTerrain M, NX, NY, NH# TerrainDot(NX, NY) = 1 EndIf C# = C# + Ste# Wend Next Next Return M End Function Function RecoverTerrainImage(Ter) Size = TerrainSize(Ter) Scale = 1 If Size > 256 Scale = Size/256 IMG = CreateImage(Size, Size) IMGB = ImageBuffer(IMG) LockBuffer IMGB While X < Size - 1 While Y < Size - 1 H = Int(TerrainHeight#(Ter, X, Y) 255) RGB = (H Shr 16) Or (H Shr 8) Or (H) WritePixelFast X/Scale, Y/Scale, RGB, IMGB Y = Y + Scale Wend X = X + Scale Wend UnlockBuffer IMGB Return IMG End Function Function Max#(A#,B#) If A#>B# Return B# Return A# End Function Function Min#(A#,B#) If A#<B# Return B# Return A# End Function
Warbseite

Xaymar

ehemals "Cgamer"

So, Feb 15, 2009 22:53
Antworten mit Zitat

Ich hab sowas was Noobody beschrieben hat(Kugeln) noch hier liegen. Ist Teil meiner Terrain-Engine.
Poste ich morgen mal falls es noch niemand anderes tut

[Edit]Hier:

Code: [AUSKLAPPEN]

Graphics3D 800,600,32,2
SetBuffer BackBuffer()

Cam = CreateCamera()

Light = CreateLight(1)
RotateEntity Light, 15, 0, 0

Ter = GenerateTerrain(128, 10)
ScaleEntity Ter, 2, 100, 2
MoveEntity Ter, -128, -50, -128
TerrainShading Ter, 1
TerrainDetail Ter, 10240, 1

IMG = RecoverTerrainImage(Ter)

Cub = CreateCube()
While Not KeyHit(1)
Cls
PositionEntity Cam, Cos(B)*128, 75, Sin(B)*128
PointEntity Cam, Cub
B = (B + 1) Mod 360
RenderWorld
DrawImage IMG, 0, 0
Flip
Wend
End

Dim TerrainDot(1024, 1024)

Function GenerateTerrain(Size, Amount, RadMin=16, RadMax=64, MinH# = .05, MaxH# = .25, MinX=0, MinY=0, MaxX=0, MaxY=0)
If MinXY = 0:MinXY = RadMax/2:EndIf
If MaxXY = 0:MaxXY = Size-RadMax/2:EndIf
M = CreateTerrain(Size)
For A = 1 To Amount
   Dim TerrainDot(Size, Size)
   X = Rand(MinXY, MaxXY)
   Y = Rand(MinXY, MaxXY)
   Rad = Rand(RadMin, RadMax)
   He# = Rnd(MinH#, MaxH#)
   ModifyTerrain M, X, Y, MaX(TerrainHeight(M, X, Y)+He#, 1)
   For B = 1 To Rad
      Ste# = 360
      C# = 0
      If B > 0 Ste# = 1.0/B
      While C# < 360
         NX = Min(Max(X+Cos(C#)*B, Size-1), 0)
         NY = Min(Max(Y+Sin(C#)*B, Size-1), 0)
         If TerrainDot(NX, NY) = 0
            NH# = Max#(TerrainHeight(M, NX, NY)+(He#*(1-(B/Float(Rad)))), 1)
            ModifyTerrain M, NX, NY, NH#
            TerrainDot(NX, NY) = 1
         EndIf
         C# = C# + Ste#
      Wend
   Next
Next
Return M
End Function

Function RecoverTerrainImage(Ter)
Size = TerrainSize(Ter)
Scale = 1
If Size > 256 Scale = Size/256

IMG = CreateImage(Size, Size)
IMGB = ImageBuffer(IMG)
LockBuffer IMGB
While X < Size - 1
   While Y < Size - 1
      H = Int(TerrainHeight#(Ter, X, Y) * 255)
      RGB = (H Shr 16) Or (H Shr 8) Or (H)
      WritePixelFast X/Scale, Y/Scale, RGB, IMGB
      Y = Y + Scale
   Wend
   X = X + Scale
Wend
UnlockBuffer IMGB
Return IMG
End Function

Function Max#(A#,B#)
If A#>B# Return B#
Return A#
End Function
Function Min#(A#,B#)
If A#<B# Return B#
Return A#
End Function

Warbseite

	Nicdel	Mo, Feb 16, 2009 17:47 Antworten mit Zitat
Vielen Dank dafür. Leider funktioniert deine Speicherfunktion fürs Bild nicht (Das Bild ist nur schwarz), aber ich schaus mir mal näher an.
Desktop: Intel Pentium 4 2650 Mhz, 2 GB RAM, ATI Radeon HD 3850 512 MB, Windows XP Notebook: Intel Core i7 720 QM 1.6 Ghz, 4 GB DDR3 RAM, nVidia 230M GT, Windows 7

Nicdel

Mo, Feb 16, 2009 17:47
Antworten mit Zitat

Vielen Dank dafür. Leider funktioniert deine Speicherfunktion fürs Bild nicht (Das Bild ist nur schwarz), aber ich schaus mir mal näher an.

Desktop: Intel Pentium 4 2650 Mhz, 2 GB RAM, ATI Radeon HD 3850 512 MB, Windows XP
Notebook: Intel Core i7 720 QM 1.6 Ghz, 4 GB DDR3 RAM, nVidia 230M GT, Windows 7

	Xaymar ehemals "Cgamer"	Mo, Feb 16, 2009 20:25 Antworten mit Zitat
ich hab da einfach nur shr und shl vertauscht. fehler meinerseits [EDit] doch nicht [Edit2] Hier verbesserte Version Code: [AUSKLAPPEN] [EINKLAPPEN] Graphics3D 800,600,32,2 SetBuffer BackBuffer() Cam = CreateCamera() Light = CreateLight(1) RotateEntity Light, 15, 0, 0 Ter = GenerateTerrain(128, 10) ScaleEntity Ter, 2, 100, 2 MoveEntity Ter, -128, -50, -128 TerrainShading Ter, 1 TerrainDetail Ter, 10240, 1 IMG = RecoverTerrainImage(Ter) Cub = CreateCube() While Not KeyHit(1) Cls PositionEntity Cam, Cos(B)128, 75, Sin(B)128 PointEntity Cam, Cub B = (B + 1) Mod 360 RenderWorld DrawImage IMG, 0, 0 Flip Wend End Dim TerrainDot(1024, 1024) Function GenerateTerrain(Size, Amount, RadMin=16, RadMax=64, MinH# = .05, MaxH# = .25, MinX=0, MinY=0, MaxX=0, MaxY=0) If MinXY = 0:MinXY = RadMax/2:EndIf If MaxXY = 0:MaxXY = Size-RadMax/2:EndIf M = CreateTerrain(Size) For A = 1 To Amount Dim TerrainDot(Size, Size) X = Rand(MinXY, MaxXY) Y = Rand(MinXY, MaxXY) Rad = Rand(RadMin, RadMax) He# = Rnd(MinH#, MaxH#) ModifyTerrain M, X, Y, MaX(TerrainHeight(M, X, Y)+He#, 1) For B = 1 To Rad Ste# = 360 C# = 0 If B > 0 Ste# = 1.0/B While C# < 360 NX = Min(Max(X+Cos(C#)B, Size-1), 0) NY = Min(Max(Y+Sin(C#)B, Size-1), 0) If TerrainDot(NX, NY) = 0 NH# = Max#(TerrainHeight(M, NX, NY)+(He#(1-(B/Float(Rad)))), 1) ModifyTerrain M, NX, NY, NH# TerrainDot(NX, NY) = 1 EndIf C# = C# + Ste# Wend Next Next Return M End Function Function RecoverTerrainImage(Ter) Size = TerrainSize(Ter) DebugLog Size IMG = CreateImage(Size, Size) IMGB = ImageBuffer(IMG) LockBuffer IMGB While X < Size-1 Y = 0 While Y < Size-1 H = TerrainHeight(Ter, X, Y) 255 WritePixelFast X, Y, (H Shl 16) Or (H Shl 8) Or H, IMGB Y = Y + 1 Wend X = X + 1 Wend UnlockBuffer IMGB Return IMG End Function Function Max#(A#,B#) If A#>B# Return B# Return A# End Function Function Min#(A#,B#) If A#<B# Return B# Return A# End Function [Edit2]Noch besserer Code: Code: [AUSKLAPPEN] [EINKLAPPEN] Graphics3D 800,600,32,2 SetBuffer BackBuffer() Cam = CreateCamera() Light = CreateLight(1) RotateEntity Light, 15, 0, 0 Ter = GenerateTerrain(256, 50, 8, 64, 0, .25) ScaleEntity Ter, 4, 200, 4 MoveEntity Ter, -512, -100, -512 TerrainShading Ter, 1 TerrainDetail Ter, 10240, 1 IMG = RecoverTerrainImage(Ter) Cub = CreateCube() While Not KeyHit(1) Cls PositionEntity Cam, Cos(B)128, 75, Sin(B)128 PointEntity Cam, Cub B = (B + 1) Mod 360 RenderWorld DrawImage IMG, 0, 0 Flip Wend End Dim TerrainDot(1024, 1024) Function GenerateTerrain(Size, Amount, RadMin=24, RadMax=32, MinH# = 0, MaxH# = .5, MinXY=-1, MaxXY=-1) If MinXY = -1:MinXY = RadMax:EndIf If MaxXY = -1:MaxXY = Size-RadMax:EndIf M = CreateTerrain(Size) For A = 1 To Amount Dim TerrainDot(Size, Size) X = Rand(MinXY, MaxXY) Y = Rand(MinXY, MaxXY) Rad = Rand(RadMin, RadMax) He# = Rnd(MinH#, MaxH#) ModifyTerrain M, X, Y, MaX(TerrainHeight(M, X, Y)+He#, 1) For B = 1 To Rad Ste# = 360 C# = 0 If B > 0:Ste# = 1.0/(Rad-B):EndIf While C# < 360 NX = Min(Max(X+Cos(C#)B, Size-1), 0) NY = Min(Max(Y+Sin(C#)B, Size-1), 0) If TerrainDot(NX, NY) = 0 NH# = Max#(TerrainHeight(M, NX, NY)+((He#(1-(B/Float(Rad)))))Cos((Float(B)/Rad)90), 1) ModifyTerrain M, NX, NY, NH# TerrainDot(NX, NY) = 1 EndIf C# = C# + Ste# Wend Next Next SmoothTerrain(M) Return M End Function Function SmoothTerrain(Ter) WH=TerrainSize(Ter) For X = 0 To WH:For Y = 0 To WH HL#=0:HR#=0:HU#=0:Hd#=0 If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y) If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y) If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1) If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1) HM#=TerrainHeight#(Ter,X,Y) NewH# = (HL#+HR#+HU#+HD#+HM#)/5 ModifyTerrain Ter,X,Y,NewH# Next:Next End Function Function RecoverTerrainImage(Ter) Size = TerrainSize(Ter) DebugLog Size IMG = CreateImage(Size, Size) IMGB = ImageBuffer(IMG) LockBuffer IMGB While X < Size-1 Y = 0 While Y < Size-1 H = TerrainHeight(Ter, X, Y) 255 WritePixelFast X, Y, (H Shl 16) Or (H Shl 8) Or H, IMGB Y = Y + 1 Wend X = X + 1 Wend UnlockBuffer IMGB Return IMG End Function Function Max#(A#,B#) If A#>B# Return B# Return A# End Function Function Min#(A#,B#) If A#<B# Return B# Return A# End Function
Warbseite

Xaymar

ehemals "Cgamer"

Mo, Feb 16, 2009 20:25
Antworten mit Zitat

ich hab da einfach nur shr und shl vertauscht. fehler meinerseits

[EDit] doch nicht

[Edit2] Hier verbesserte Version
Code: [AUSKLAPPEN]

Graphics3D 800,600,32,2
SetBuffer BackBuffer()

Cam = CreateCamera()

Light = CreateLight(1)
RotateEntity Light, 15, 0, 0

Ter = GenerateTerrain(128, 10)
ScaleEntity Ter, 2, 100, 2
MoveEntity Ter, -128, -50, -128
TerrainShading Ter, 1
TerrainDetail Ter, 10240, 1

IMG = RecoverTerrainImage(Ter)

Cub = CreateCube()
While Not KeyHit(1)
Cls
PositionEntity Cam, Cos(B)*128, 75, Sin(B)*128
PointEntity Cam, Cub
B = (B + 1) Mod 360
RenderWorld
DrawImage IMG, 0, 0
Flip
Wend
End

Dim TerrainDot(1024, 1024)

Function GenerateTerrain(Size, Amount, RadMin=16, RadMax=64, MinH# = .05, MaxH# = .25, MinX=0, MinY=0, MaxX=0, MaxY=0)
If MinXY = 0:MinXY = RadMax/2:EndIf
If MaxXY = 0:MaxXY = Size-RadMax/2:EndIf
M = CreateTerrain(Size)
For A = 1 To Amount
   Dim TerrainDot(Size, Size)
   X = Rand(MinXY, MaxXY)
   Y = Rand(MinXY, MaxXY)
   Rad = Rand(RadMin, RadMax)
   He# = Rnd(MinH#, MaxH#)
   ModifyTerrain M, X, Y, MaX(TerrainHeight(M, X, Y)+He#, 1)
   For B = 1 To Rad
      Ste# = 360
      C# = 0
      If B > 0 Ste# = 1.0/B
      While C# < 360
         NX = Min(Max(X+Cos(C#)*B, Size-1), 0)
         NY = Min(Max(Y+Sin(C#)*B, Size-1), 0)
         If TerrainDot(NX, NY) = 0
            NH# = Max#(TerrainHeight(M, NX, NY)+(He#*(1-(B/Float(Rad)))), 1)
            ModifyTerrain M, NX, NY, NH#
            TerrainDot(NX, NY) = 1
         EndIf
         C# = C# + Ste#
      Wend
   Next
Next
Return M
End Function

Function RecoverTerrainImage(Ter)
Size = TerrainSize(Ter)
DebugLog Size
IMG = CreateImage(Size, Size)
IMGB = ImageBuffer(IMG)
LockBuffer IMGB
While X < Size-1
   Y = 0
   While Y < Size-1
      H = TerrainHeight(Ter, X, Y) * 255
      WritePixelFast X, Y, (H Shl 16) Or (H Shl 8) Or H, IMGB
      Y = Y + 1
   Wend
   X = X + 1
Wend
UnlockBuffer IMGB
Return IMG
End Function

Function Max#(A#,B#)
If A#>B# Return B#
Return A#
End Function
Function Min#(A#,B#)
If A#<B# Return B#
Return A#
End Function

[Edit2]Noch besserer Code:
Code: [AUSKLAPPEN]

Graphics3D 800,600,32,2
SetBuffer BackBuffer()

Cam = CreateCamera()

Light = CreateLight(1)
RotateEntity Light, 15, 0, 0

Ter = GenerateTerrain(256, 50, 8, 64, 0, .25)
ScaleEntity Ter, 4, 200, 4
MoveEntity Ter, -512, -100, -512
TerrainShading Ter, 1
TerrainDetail Ter, 10240, 1

IMG = RecoverTerrainImage(Ter)

Cub = CreateCube()
While Not KeyHit(1)
Cls
PositionEntity Cam, Cos(B)*128, 75, Sin(B)*128
PointEntity Cam, Cub
B = (B + 1) Mod 360
RenderWorld
DrawImage IMG, 0, 0
Flip
Wend
End

Dim TerrainDot(1024, 1024)

Function GenerateTerrain(Size, Amount, RadMin=24, RadMax=32, MinH# = 0, MaxH# = .5, MinXY=-1, MaxXY=-1)
If MinXY = -1:MinXY = RadMax:EndIf
If MaxXY = -1:MaxXY = Size-RadMax:EndIf
M = CreateTerrain(Size)
For A = 1 To Amount
   Dim TerrainDot(Size, Size)
   X = Rand(MinXY, MaxXY)
   Y = Rand(MinXY, MaxXY)
   Rad = Rand(RadMin, RadMax)
   He# = Rnd(MinH#, MaxH#)
   ModifyTerrain M, X, Y, MaX(TerrainHeight(M, X, Y)+He#, 1)
   For B = 1 To Rad
      Ste# = 360
      C# = 0
      If B > 0:Ste# = 1.0/(Rad-B):EndIf
      While C# < 360
         NX = Min(Max(X+Cos(C#)*B, Size-1), 0)
         NY = Min(Max(Y+Sin(C#)*B, Size-1), 0)
         If TerrainDot(NX, NY) = 0
            NH# = Max#(TerrainHeight(M, NX, NY)+((He#*(1-(B/Float(Rad)))))*Cos((Float(B)/Rad)*90), 1)
            ModifyTerrain M, NX, NY, NH#
            TerrainDot(NX, NY) = 1
         EndIf
         C# = C# + Ste#
      Wend
   Next
Next
SmoothTerrain(M)
Return M
End Function

Function SmoothTerrain(Ter)
WH=TerrainSize(Ter)
For X = 0 To WH:For Y = 0 To WH
   HL#=0:HR#=0:HU#=0:Hd#=0
   If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y)
   If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y)
   If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1)
   If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1)
   HM#=TerrainHeight#(Ter,X,Y)
   NewH# = (HL#+HR#+HU#+HD#+HM#)/5
   ModifyTerrain Ter,X,Y,NewH#
Next:Next
End Function

Function RecoverTerrainImage(Ter)
Size = TerrainSize(Ter)
DebugLog Size
IMG = CreateImage(Size, Size)
IMGB = ImageBuffer(IMG)
LockBuffer IMGB
While X < Size-1
   Y = 0
   While Y < Size-1
      H = TerrainHeight(Ter, X, Y) * 255
      WritePixelFast X, Y, (H Shl 16) Or (H Shl 8) Or H, IMGB
      Y = Y + 1
   Wend
   X = X + 1
Wend
UnlockBuffer IMGB
Return IMG
End Function

Function Max#(A#,B#)
If A#>B# Return B#
Return A#
End Function
Function Min#(A#,B#)
If A#<B# Return B#
Return A#
End Function

Warbseite

Übersicht

BlitzBasic

Blitz3D

Nach Oben

BlitzBasic Portal

Heightmap erzeugen

Nicdel

Betreff: Heightmap erzeugen

Noobody

Nicdel

Xaymar

Nicdel

Xaymar