Prozedural erstellte Landschaften mit Diamond-Square

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Noobody

Betreff: Prozedural erstellte Landschaften mit Diamond-Square

 BeitragMi, Okt 29, 2008 20:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Wie der Titel so sagt, habe ich eine kleine Implementation des Diamond-Square Algorithmus' in BB vollbracht.
Dieser Algorithmus ist dafür geeignet, um während der Laufzeit einigermassen realistische Heightmaps zu erstellen, die unter anderem auch für Terrains o.ä. gebraucht werden können.
Die Geschwindigkeit ist im Moment akzeptabel, aber ich bin mir nicht sicher, ob es dafür reicht, während dem Programm im Hintergrund neue Kartenteile zu erstellen, wenn sich die Kamera an die Grenzen des bisherigen Teils bewegt.
Hier der Link zum Wikipediaartikel.

Zur Erklärung: Die Funktion DiamondSquare leistet hier die ganze Hauptarbeit. Sie erwartet zum einen die Grösse der Karte (MUSS eine 2er - Potenz sein) und die vier Startwerte, die jeweils in die Ecken der Karte gesetzt werden.
Das Array HeightMap# enthält schliesslich die Höhe jedes Punkts auf der Karte.

In der ersten Testumgebung wird einfach die Heightmap selbst erstellt und angezeigt.

BlitzBasic: [AUSKLAPPEN] 
Const TEXSIZE = 512

Graphics TEXSIZE + 1, TEXSIZE + 1, 0, 2
SetBuffer BackBuffer()

Dim HeightMap#( 0, 0 )

SeedRnd MilliSecs()
DiamondSquare( TEXSIZE, 2, 2, 8, 4 )
Render( TEXSIZE )
Flip 0
WaitKey()
End

Function DiamondSquare( Size, S1#, S2#, S3#, S4# )
	Dim HeightMap#( Size, Size )
	
	HeightMap#( 0, 0 ) = S1#
	HeightMap#( Size, 0 ) = S2#
	HeightMap#( Size, Size ) = S3#
	HeightMap#( 0, Size ) = S4#
	
	Local StepSize = Size
	While StepSize > 1
		For X = 0 To Size - StepSize
			For Y = 0 To Size - StepSize
				HeightMap#( X + StepSize/2, Y ) = ( HeightMap#( X, Y ) + HeightMap#( X + StepSize, Y ) )/2
				HeightMap#( X, Y + StepSize/2 ) = ( HeightMap#( X, Y ) + HeightMap#( X, Y + StepSize ) )/2
				HeightMap#( X + StepSize/2, Y + StepSize ) = ( HeightMap#( X, Y + StepSize ) + HeightMap#( X + StepSize, Y + StepSize ) )/2
				HeightMap#( X + StepSize, Y + StepSize/2 ) = ( HeightMap#( X + StepSize, Y ) + HeightMap#( X + StepSize, Y + StepSize ) )/2
				
				HeightMap#( X + StepSize/2, Y + StepSize/2 ) = ( HeightMap#( X, Y ) + HeightMap#( X + StepSize, Y ) + HeightMap#( X, Y + StepSize ) + HeightMap#( X + StepSize, Y + StepSize ) )/4
				HeightMap#( X + StepSize/2, Y + StepSize/2 ) = HeightMap#( X + StepSize/2, Y + StepSize/2 ) + Rnd( -1, 1 )*StepSize/Float( Size )*5
				
				Y = Y + StepSize - 1
			Next
			
			X = X + StepSize - 1
		Next
		
		StepSize = StepSize/2
	Wend
End Function

Function Render( Size )
	Local Max#, Min# = 10000
	For X = 0 To Size - 1
		For Y = 0 To Size - 1
			If HeightMap#( X, Y ) > Max# Then Max# = HeightMap#( X, Y )
			If HeightMap#( X, Y ) < Min# Then Min# = HeightMap#( X, Y )
		Next
	Next
	
	LockBuffer BackBuffer()
	For X = 0 To Size - 1
		For Y = 0 To Size - 1
			Ratio = Floor( ( HeightMap#( X, Y ) - Min# )/( Max# - Min# )*255 )
			WritePixelFast X, Y, $FF000000 + Ratio*$010101
		Next
	Next
	UnlockBuffer BackBuffer()
End Function


In der zweiten Testumgebung wird die generierte Höhenkarte auf ein Mesh angewandt und so in 3D dargestellt. Linke Maustaste für Wireframe, WASD/Maus zum bewegen und Enter, um eine neue Karte zu generieren.

BlitzBasic: [AUSKLAPPEN] 
Graphics3D 800, 600, 0, 2
SetBuffer BackBuffer()

Dim HeightMap#( 0, 0 )

Cam = CreateCamera()
PositionEntity Cam, 10, 40, -30
TurnEntity Cam, 45, 90, 0

Light = CreateLight( 1 )
LightRange Light, 10
PositionEntity Light, 0, 10, 0

Mesh = CreateMeshPlane( 64, 64 )
PositionEntity Mesh, -32, 0, -32
UpdateNormals Mesh
Surf = GetSurface( Mesh, 1 )
Tex = CreateTexture( 64, 64 )
EntityTexture Mesh, Tex

Timer = CreateTimer( 60 )

MouseXSpeed()
MouseYSpeed()
SeedRnd MilliSecs()

Local Generate = True

While Not KeyHit( 1 )
	RenderWorld
	
	WireFrame MouseDown( 1 )
	TurnEntity Cam, MouseYSpeed(), -MouseXSpeed(), 0
	MoveMouse 400, 300
	MoveEntity Cam, ( KeyDown( 32 ) - KeyDown( 30 ) )*0.5, KeyDown( 57 )*0.1, ( KeyDown( 17 ) - KeyDown( 31 ) )*0.5
	
	If Generate Then
		DiamondSquare( 64, Rnd( -2, 2 ), Rnd( -2, 2 ), Rnd( -2, 2 ), Rnd( -2, 2 ) )
		
		Render( 64 )
		CopyRect 0, 0, 64, 64, 0, 0, BackBuffer(), TextureBuffer( Tex )
		
		For X = 0 To 63
			For Z = 0 To 63
				VertexCoords Surf, X*64 + Z, VertexX( Surf, X*64 + Z ), HeightMap#( X, Z )*5, VertexZ( Surf, X*64 + Z )
			Next
		Next
		UpdateNormals Mesh
		EntityTexture Mesh, Tex
	EndIf
	
	Generate = KeyHit( 28 )
	
	Text 0, 0, "Enter, um eine neue Karte zu generieren"
	
	Flip 0
	WaitTimer Timer
Wend
End

Function DiamondSquare( Size, S1#, S2#, S3#, S4# )
	Dim HeightMap#( Size, Size )
	
	HeightMap#( 0, 0 ) = S1#
	HeightMap#( Size, 0 ) = S2#
	HeightMap#( Size, Size ) = S3#
	HeightMap#( 0, Size ) = S4#
	
	Local StepSize = Size
	While StepSize > 1
		For X = 0 To Size - StepSize
			For Y = 0 To Size - StepSize
				HeightMap#( X + StepSize/2, Y ) = ( HeightMap#( X, Y ) + HeightMap#( X + StepSize, Y ) )/2
				HeightMap#( X, Y + StepSize/2 ) = ( HeightMap#( X, Y ) + HeightMap#( X, Y + StepSize ) )/2
				HeightMap#( X + StepSize/2, Y + StepSize ) = ( HeightMap#( X, Y + StepSize ) + HeightMap#( X + StepSize, Y + StepSize ) )/2
				HeightMap#( X + StepSize, Y + StepSize/2 ) = ( HeightMap#( X + StepSize, Y ) + HeightMap#( X + StepSize, Y + StepSize ) )/2
				
				HeightMap#( X + StepSize/2, Y + StepSize/2 ) = ( HeightMap#( X, Y ) + HeightMap#( X + StepSize, Y ) + HeightMap#( X, Y + StepSize ) + HeightMap#( X + StepSize, Y + StepSize ) )/4
				HeightMap#( X + StepSize/2, Y + StepSize/2 ) = HeightMap#( X + StepSize/2, Y + StepSize/2 ) + Rnd( -1, 1 )*StepSize/Float( Size )*5
				
				Y = Y + StepSize - 1
			Next
			
			X = X + StepSize - 1
		Next
		
		StepSize = StepSize/2
	Wend
End Function

Function Render( Size )
	Local Max#, Min# = 10000
	For X = 0 To Size - 1
		For Y = 0 To Size - 1
			If HeightMap#( X, Y ) > Max# Then Max# = HeightMap#( X, Y )
			If HeightMap#( X, Y ) < Min# Then Min# = HeightMap#( X, Y )
		Next
	Next
	
	LockBuffer BackBuffer()
	For X = 0 To Size - 1
		For Y = 0 To Size - 1
			Ratio = Floor( ( HeightMap#( X, Y ) - Min# )/( Max# - Min# )*255 )
			WritePixelFast X, Y, $FF000000 + Ratio*$010101
		Next
	Next
	UnlockBuffer BackBuffer()
End Function

Function CreateMeshPlane( XSize, ZSize )
	Local Mesh = CreateMesh()
	Local Surf = CreateSurface( Mesh )
	
	For X# = -XSize/2. + 0.5 To XSize/2. - 0.5
		For Z# = -ZSize/2. + 0.5 To ZSize/2. - 0.5
			AddVertex Surf, X#, 0, Z#, ( X# + XSize/2. )/XSize, ( Z# + ZSize/2. )/ZSize
		Next
	Next
	
	For X = 0 To XSize - 2
		For Z = 0 To ZSize - 2
			V1 = X*ZSize + Z + 1
			V2 = ( X + 1 )*ZSize + Z + 1
			V3 = ( X + 1 )*ZSize + Z
			V4 = X*ZSize + Z
			
			AddTriangle Surf, V1, V2, V3
			AddTriangle Surf, V1, V3, V4
		Next
	Next
	
	Return Mesh
End Function


Screenshot:
user posted image
  • Zuletzt bearbeitet von Noobody am So, Nov 14, 2010 15:46, insgesamt 2-mal bearbeitet

peacemaker

 BeitragDo, Okt 30, 2008 11:48
Antworten mit Zitat
Benutzer-Profile anzeigen
Interessanter Code, danke. Werde sicherlich noch Verwendung dafür finden.


mfG
~Tehadon~
www.tehadon.de
http://www.blitzforum.de/worklogs/14/

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group