Quick Terrain

Blitz3D Forums/Blitz3D Programming/Quick Terrain

; Quick Terrain
; ====================================
; Created by Stefan Lulham
;
; Do as you please with the source code, just let me know by E-Mailing me
; at StefanLulham@...
;
; Note: use plus and minus signs to change the height at wich the terrian
; is leveled
;
; Note: Right mouse button allows zooming and rotation
;
; Note: press 'w' to see the wire frame
;
; Note: When saved it will produce a bitmap and a '.qtp" which holds data
; about the pivots
;
; Note: The red area won't be saved!!!

Graphics3D 800, 600, 32, 1
SeedRnd(MilliSecs())
MoveMouse 400, 300

Type CommandButtons
	Field Image
	Field X#, Y#
	Field Index%, Selected%
End Type

Type Pivot
	Field Mesh
	Field X#, Y#, Z#
	Field Name$
End Type

Global Camera = CreateCamera()
MoveEntity Camera, 128 / 2, 0, 0
RotateEntity Camera, 40, 0, 0
MoveEntity Camera, 0, 0, -50

Global Light = CreateLight(Camera)

Global Terrain = CreateTerrain(128)
TerrainDetail Terrain, 8500, True
TerrainShading Terrain, False
EntityPickMode Terrain, 2
ScaleEntity Terrain, 1, 10, 1

Global Colouring = CreateTexture(128, 128)
ScaleTexture Colouring, 128, 128
TextureBlend Colouring, 1
For X = 0 To 128
	For Y = 128 To 0 Step - 1
		SetBuffer(TextureBuffer(Colouring))
			If X > 5 And X < 123 And Y > 5 And Y < 123 Then
				Color 0, 128, 0
			Else
				Color 128, 0, 0
			EndIf
			Plot x, y
		SetBuffer(BackBuffer())
	Next
Next
EntityTexture Terrain, Colouring, 0, 0

Global HeightMap = CreateTexture(128, 128)
ScaleTexture HeightMap, 128, 128
TextureBlend HeightMap, 3
EntityTexture Terrain, HeightMap, 0, 1

Global Height#
Global Level_Hi#
Global Level%
Global Wire%
Global Status$
Global Zoom# = 50

Global CommandButton.CommandButtons
Global Pivot.Pivot

CreateButton(10, 10 + (14 * 0), 1, "New Terrain")
CreateButton(10, 10 + (14 * 1), 2, "Rise Land")
CreateButton(10, 10 + (14 * 2), 3, "Lower Land")
CreateButton(10, 10 + (14 * 3), 4, "Level Land")
CreateButton(10, 10 + (14 * 4), 5, "Create Pivot")
CreateButton(10, 10 + (14 * 5), 6, "Load")
CreateButton(10, 10 + (14 * 6), 7, "Save")
CreateButton(10, 10 + (14 * 7), 8, "Exit")
CreateButton(10 + (124 * 1), 10 + (14 * 0), 9, "Rnd Terrain")

Global M_Image = CreateImage(3, 3)
SetBuffer ImageBuffer(M_Image)
	Cls
	Color 255, 255, 255: Rect 0, 0, 3, 3
SetBuffer BackBuffer()

While Not KeyHit(1)
	
	WireFrame Wire
	
	mxSpeed# = MouseXSpeed()
	mySpeed# = MouseZSpeed()
	
	If Not MouseDown(2) Then
		CameraPick(Camera, MouseX(), MouseY())
		RotateEntity Camera, 0, EntityYaw(Camera), 0
		If MouseX() > 798 Then MoveEntity Camera, 3, 0, 0
		If MouseX() < 2 Then MoveEntity Camera, -3, 0, 0
		If MouseY() > 598 Then MoveEntity Camera, 0, 0, -3
		If MouseY() < 2 Then MoveEntity Camera, 0, 0, 3
		RotateEntity Camera, 40, EntityYaw(Camera), 0
	Else
		MoveMouse 400, 300
		PositionEntity Camera, PickedX(), PickedY(), PickedZ()
		RotateEntity Camera, 0, EntityYaw(Camera), 0
		If mxSpeed > 0 Then
			TurnEntity Camera, 0, 8, 0
		ElseIf mxSpeed < 0 Then 
			TurnEntity Camera, 0, -8, 0
		ElseIf mySpeed > 0 Then 
			Zoom = Zoom - 6
		ElseIf mySpeed < 0 Then 
			Zoom = Zoom + 6
		EndIf
		RotateEntity Camera, 40, EntityYaw(Camera), 0
		MoveEntity Camera, 0, 0, -Zoom
	EndIf
	
	If MouseHit(1) Then
		NotCollided = False
		Select GetSelected()
			Case 0:	NotCollided = True
			Case 1: 
				FreeEntity Terrain
				Terrain = CreateTerrain(128)
				TerrainDetail Terrain, 8500, True
				TerrainShading Terrain, False
				EntityPickMode Terrain, 2
				ScaleEntity Terrain, 1, 10, 1
				EntityTexture Terrain, Colouring, 0, 0
				EntityTexture Terrain, HeightMap, 0, 1
				
				For Pivot = Each Pivot
					FreeEntity Pivot\Mesh
					Delete Pivot
				Next
			Case 2: Status = "Raising Land"
			Case 3: Status = "Lowering Land"
			Case 4: Status = "Leveling Land"
			Case 5: Status = "Creating Pivot"
			Case 6:
				Color 255, 255, 255: Locate 10, 10 + (14 * 8): name$ = Input("Load: ")
				FreeEntity Terrain
				Terrain = LoadTerrain(name + ".bmp")
				TerrainDetail Terrain, 8500, True
				TerrainShading Terrain, False
				EntityPickMode Terrain, 2
				ScaleEntity Terrain, 1, 10, 1
				EntityTexture Terrain, Colouring, 0, 0
				EntityTexture Terrain, HeightMap, 0, 1
				File = ReadFile(Name + ".qtp")
					PivotCount = ReadInt(File)
					For PC = 0 To PivotCount - 1
						Name$ = ReadString(File)
						Xx# = ReadInt(File)
						Yy# = ReadInt(File)
						Zz# = ReadInt(File)
						CreatePiv(Xx, Yy, Zz, Name)
					Next
				CloseFile File
			Case 7: 
				Color 255, 255, 255: Locate 10, 10 + (14 * 8): name$ = Input("Call it: ")
				SaveBuffer(TextureBuffer(HeightMap), name + ".bmp")
				For Pivot = Each Pivot
					PivotCount = PivotCount + 1
				Next
				File = WriteFile(Name + ".qtp")
					WriteInt File, PivotCount
					For Pivot = Each Pivot
						WriteString(File, Pivot\Name)
						WriteInt(File, Pivot\X)
						WriteInt(File, Pivot\Y)
						WriteInt(File, Pivot\Z)
					Next
				CloseFile File
					
			Case 8: End
			
			Case 9:
				Color 255, 255, 255: Locate 10, 10 + (14 * 8): Power# = Input("Power#: ")
				For X = 0 To 128
					For Y = 0 To 128
						ModifyTerrain Terrain, x, y, Rnd(0, Power)
					Next
				Next
		End Select
	ElseIf MouseDown(1) Then
		If NotCollided = True Then
			TFormPoint(PickedX(), PickedY(), PickedZ(), 0, Terrain)
			x = TFormedX()
			z = TFormedZ()
			Height# = TerrainHeight(Terrain, x, z)
			Select Status
				Case "Raising Land":
					If Height# < .9 Then
						Height# = Height# + .01
						For Xx = x - 2 To x + 2
							For Zz = z - 2 To z + 2
								ModifyTerrain Terrain, Xx, Zz, Height#, False
							Next
						Next
					EndIf
				Case "Lowering Land":
					If Height# > .001 Then
						Height# = Height# - .01
						For Xx = x - 2 To x + 2
							For Zz = z - 2 To z + 2
								ModifyTerrain Terrain, Xx, Zz, Height#, False
							Next
						Next
					EndIf
				Case "Leveling Land":
					For Xx = x - 2 To x + 2
						For Zz = z - 2 To z + 2
							ModifyTerrain Terrain, Xx, Zz, Level_Hi, False
						Next
					Next
				Case "Creating Pivot":
					Color 255, 255, 255: Locate 10, 10 + (14 * 8): name$ = Input("Call it: ")
					CreatePiv(PickedX(), PickedY(), PickedZ(), Name)
			End Select
		EndIf
	EndIf
	
	If KeyHit(157) Then
		Select Level
			Case 0: Level = 1
			Case 1: Level = 0
		End Select
	EndIf
	
	If KeyHit(17) Then
		Select Wire
			Case 0: Wire = 1
			Case 1: Wire = 0
		End Select
	EndIf
	
	If KeyDown(12) Then 
		If Level_Hi > .001 Then Level_Hi = Level_Hi - .01
	ElseIf KeyDown(13) Then
		If Level_Hi < .9 Then Level_Hi = Level_Hi + .01
	EndIf
	
	UpdateWorld: RenderWorld
	
	Color 255, 255, 255: Rect 0, 600 - 20, 800, 20
	Color 0, 0, 0: Text 400, 590, "Level land height: " + Level_Hi + " : Leveling = " + Level, True, True
	For CommandButton = Each CommandButtons
		DrawImage CommandButton\Image, CommandButton\X, CommandButton\Y, CommandButton\Selected
	Next
	
	DrawImage M_Image, MouseX(), MouseY()
	Color 255, 255, 255: Text MouseX(), MouseY() + 3, Status, False, False
	
	For CommandButton = Each CommandButtons
		CommandButton\Selected = False
	Next
	
	For CommandButton = Each CommandButtons
		If ImagesCollide(M_Image, MouseX(), MouseY(), 0, CommandButton\Image, CommandButton\X, CommandButton\Y, 0) Then
			CommandButton\Selected = True
			Exit
		EndIf
	Next
	
	If KeyHit(31) Then
		SaveBuffer(TextureBuffer(HeightMap), "HeightMap.bmp")
	EndIf
	
	SetBuffer(TextureBuffer(HeightMap))
		Cls
		For X = 0 To 128
			YY = 0
			For Y = 128 To 0 Step - 1
				YY = YY + 1
				White# = 0 + (TerrainHeight(Terrain, x, y) * 255)
				If X > 5 And X < 123 And Y > 5 And Y < 123 Then 
					Color White, White, White
				Else
					Color 0, 0, 0
				EndIf
				Plot x, YY
			Next
		Next
	SetBuffer(BackBuffer())
		
	Flip: Cls
Wend: End

Function CreateButton(X#, Y#, Index%, Caption$)
	a = CreateImage(120, 12, 2)
	SetBuffer ImageBuffer(a, 0)
		Cls
		Color 255, 255, 255: Rect 0, 0, 120, 12
		Color 1, 0, 0: Text ImageWidth(a) / 2, ImageHeight(a) / 2, Caption, True, True
	SetBuffer ImageBuffer(a, 1)
		Cls
		Color 155, 155, 155: Rect 0, 0, 120, 12
		Color 1, 0, 0: Text ImageWidth(a) / 2, ImageHeight(a) / 2, Caption, True, True
	SetBuffer BackBuffer()
	
	CommandButton = New CommandButtons
	CommandButton\Image = CopyImage(a)
	CommandButton\X = X
	CommandButton\Y = Y
	CommandButton\Selected = False
	CommandButton\Index = Index
End Function

Function GetSelected()
	For CommandButton = Each CommandButtons
		If CommandButton\Selected = True Then Return CommandButton\Index
	Next
End Function

Function CreatePiv(X#, Y#, Z#, Name$)
	Pivot = New Pivot
	Pivot\Name = Name
	Pivot\X = X
	Pivot\Y = Y
	Pivot\Z = Z
	Pivot\Mesh = CreateSphere()
	PositionEntity Pivot\Mesh, X, Y, Z
	EntityColor Pivot\Mesh, 255, 0, 0
	EntityOrder Pivot\Mesh, -10
	EntityPickMode Pivot\Mesh, 2, True
End Function


Above is some source code that i have been working on for a terrain editor. it saves the terrain as a height map to be loaded in later.

it also creates a sperate file that holds pivot information that you can use to place objects around i.e. start positions.

i'm currently working on a texture editor for it, any ideas would be welcomed!

nice :)

; Quick Terrain
; ====================================
; Created by Stefan Lulham
;
; Do as you please with the source code, just let me know by E-Mailing me
; at StefanLulham@...
;
; Note: use plus and minus signs to change the height at wich the terrian
; is leveled
;
; Note: Right mouse button allows zooming and rotation
;
; Note: press 'w' to see the wire frame
;
; Note: When saved it will produce a bitmap and a '.qtp" which holds data
; about the pivots
;
; Note: The red area won't be saved!!!

Graphics3D 800, 600, 32, 1
SeedRnd(MilliSecs())
MoveMouse 400, 300

Type CommandButtons
	Field Image
	Field X#, Y#
	Field Index%, Selected%
End Type

Type Pivot
	Field Mesh
	Field X#, Y#, Z#
	Field Name$
End Type

Global Camera = CreateCamera()
MoveEntity Camera, 128 / 2, 0, 0
RotateEntity Camera, 40, 0, 0
MoveEntity Camera, 0, 0, -50

Global Light = CreateLight(Camera)

Global Terrain = CreateTerrain(128)
TerrainDetail Terrain, 8500, True
TerrainShading Terrain, True
EntityPickMode Terrain, 2, False
ScaleEntity Terrain, 1, 10, 1

Global Colouring = CreateTexture(128, 128)
ScaleTexture Colouring, 128, 128
TextureBlend Colouring, 1
For X = 0 To 128
	For Y = 128 To 0 Step - 1
		SetBuffer(TextureBuffer(Colouring))
			If X > 5 And X < 123 And Y > 5 And Y < 123 Then
				Color 0, 128, 0
			Else
				Color 128, 0, 0
			EndIf
			Plot x, y
		SetBuffer(BackBuffer())
	Next
Next
EntityTexture Terrain, Colouring, 0, 0

Global HeightMap = CreateTexture(128, 128)
ScaleTexture HeightMap, 128, 128
TextureBlend HeightMap, 3
EntityTexture Terrain, HeightMap, 0, 1

Global Height#
Global Level_Hi#
Global Level%
Global Wire%
Global Status$
Global Zoom# = 50

Global CommandButton.CommandButtons
Global Pivot.Pivot

CreateButton(10, 10 + (14 * 0), 1, "New Terrain")
CreateButton(10, 10 + (14 * 1), 2, "Rise Land")
CreateButton(10, 10 + (14 * 2), 3, "Lower Land")
CreateButton(10, 10 + (14 * 3), 4, "Level Land")
CreateButton(10, 10 + (14 * 4), 5, "Create Pivot")
CreateButton(10, 10 + (14 * 5), 6, "Load")
CreateButton(10, 10 + (14 * 6), 7, "Save")
CreateButton(10, 10 + (14 * 7), 8, "Exit")
CreateButton(10 + (124 * 1), 10 + (14 * 0), 9, "Rnd Terrain")

Global M_Image = CreateImage(3, 3)
SetBuffer ImageBuffer(M_Image)
	Cls
	Color 255, 255, 255: Rect 0, 0, 3, 3
SetBuffer BackBuffer()

While Not KeyHit(1)
	
	WireFrame Wire
	
	mxSpeed# = MouseXSpeed()
	mySpeed# = MouseZSpeed()
	
	If Not MouseDown(2) Then
		CameraPick(Camera, MouseX(), MouseY())
		If PickedEntity() > 0 Then
			SelectedEntity = PickedEntity()
			tmpName$ = EntityName(SelectedEntity)
			globalName$ = ""
			If tmpName <> "" Then
				globalName$ = tmpName
				TurnEntity SelectedEntity, 0, 1, 0
				If KeyHit(14) Then
					For Pivot = Each Pivot
						If tmpName = Pivot\Name Then
							FreeEntity SelectedEntity
							SelectedEntity = 0
							;FreeEntity Pivot\Mesh
							;Pivot\Mesh = 0
							Delete Pivot
						EndIf
					Next
				EndIf
			EndIf
		EndIf
		RotateEntity Camera, 0, EntityYaw(Camera), 0
		If MouseX() > 798 Then MoveEntity Camera, 3, 0, 0
		If MouseX() < 2 Then MoveEntity Camera, -3, 0, 0
		If MouseY() > 598 Then MoveEntity Camera, 0, 0, -3
		If MouseY() < 2 Then MoveEntity Camera, 0, 0, 3
		RotateEntity Camera, 40, EntityYaw(Camera), 0
	Else
		MoveMouse 400, 300
		PositionEntity Camera, PickedX(), PickedY(), PickedZ()
		RotateEntity Camera, 0, EntityYaw(Camera), 0
		If mxSpeed > 0 Then
			TurnEntity Camera, 0, 8, 0
		ElseIf mxSpeed < 0 Then 
			TurnEntity Camera, 0, -8, 0
		ElseIf mySpeed > 0 Then 
			Zoom = Zoom - 6
		ElseIf mySpeed < 0 Then 
			Zoom = Zoom + 6
		EndIf
		RotateEntity Camera, 40, EntityYaw(Camera), 0
		MoveEntity Camera, 0, 0, -Zoom
	EndIf
	
	If MouseHit(1) Then
		NotCollided = False
		Select GetSelected()
			Case 0:	NotCollided = True
			Case 1: 
				FreeEntity Terrain
				Terrain = CreateTerrain(128)
				TerrainDetail Terrain, 8500, True
				TerrainShading Terrain, False
				EntityPickMode Terrain, 2, False
				ScaleEntity Terrain, 1, 10, 1
				EntityTexture Terrain, Colouring, 0, 0
				EntityTexture Terrain, HeightMap, 0, 1
				
				For Pivot = Each Pivot
					FreeEntity Pivot\Mesh
					Delete Pivot
				Next
			Case 2: Status = "Raising Land"
			Case 3: Status = "Lowering Land"
			Case 4: Status = "Leveling Land"
			Case 5: Status = "Creating Pivot"
			Case 6:
				FlushKeys()
				Color 255, 255, 255: Locate 10, 10 + (14 * 8): name$ = Input("Load: ")
				FreeEntity Terrain
				Terrain = LoadTerrain(name + ".bmp")
				TerrainDetail Terrain, 8500, True
				TerrainShading Terrain, False
				EntityPickMode Terrain, 2, False
				ScaleEntity Terrain, 1, 10, 1
				EntityTexture Terrain, Colouring, 0, 0
				EntityTexture Terrain, HeightMap, 0, 1
				File = ReadFile(Name + ".qtp")
					PivotCount = ReadInt(File)
					For PC = 0 To PivotCount - 1
						Name$ = ReadString(File)
						Xx# = ReadFloat(File)
						Yy# = ReadFloat(File)
						Zz# = ReadFloat(File)
						CreatePiv(Xx, Yy, Zz, Name)
					Next
				CloseFile File
				FlushKeys()
				
			Case 7: 
				FlushKeys()
				Color 255, 255, 255: Locate 10, 10 + (14 * 8): name$ = Input("Call it: ")
				SaveBuffer(TextureBuffer(HeightMap), name + ".bmp")
				For Pivot = Each Pivot
					PivotCount = PivotCount + 1
				Next
				File = WriteFile(Name + ".qtp")
					WriteInt File, PivotCount
					For Pivot = Each Pivot
						WriteString(File, Pivot\Name)
						WriteFloat(File, Pivot\X)
						WriteFloat(File, Pivot\Y)
						WriteFloat(File, Pivot\Z)
					Next
				CloseFile File
				FlushKeys()
					
			Case 8: End
			
			Case 9:
				Color 255, 255, 255: Locate 10, 10 + (14 * 8): Power# = Input("Power#: ")
				For X = 0 To 128
					For Y = 0 To 128
						ModifyTerrain Terrain, x, y, Rnd(0, Power)
					Next
				Next
		End Select
	ElseIf MouseDown(1) Then
		If NotCollided = True Then
			TFormPoint(PickedX(), PickedY(), PickedZ(), 0, Terrain)
			x = TFormedX()
			z = TFormedZ()
			Height# = TerrainHeight(Terrain, x, z)
			Select Status
				Case "Raising Land":
					If Height# < .9 Then
						Height# = Height# + .01
						For Xx = x - 2 To x + 2
							For Zz = z - 2 To z + 2
								ModifyTerrain Terrain, Xx, Zz, Height#, False
							Next
						Next
					EndIf
				Case "Lowering Land":
					If Height# > .001 Then
						Height# = Height# - .01
						For Xx = x - 2 To x + 2
							For Zz = z - 2 To z + 2
								ModifyTerrain Terrain, Xx, Zz, Height#, False
							Next
						Next
					EndIf
				Case "Leveling Land":
					For Xx = x - 2 To x + 2
						For Zz = z - 2 To z + 2
							ModifyTerrain Terrain, Xx, Zz, Level_Hi, False
						Next
					Next
				Case "Creating Pivot":
					Color 255, 255, 255: Locate 10, 10 + (14 * 8): name$ = Input("Call it: ")
					CreatePiv(PickedX(), PickedY(), PickedZ(), Name)
			End Select
		EndIf
	EndIf
	
	If KeyHit(157) Then
		Select Level
			Case 0: Level = 1
			Case 1: Level = 0
		End Select
	EndIf
	
	If KeyHit(17) Then
		Select Wire
			Case 0: Wire = 1
			Case 1: Wire = 0
		End Select
	EndIf
	
	If KeyDown(12) Then 
		If Level_Hi > .001 Then Level_Hi = Level_Hi - .01
	ElseIf KeyDown(13) Then
		If Level_Hi < .9 Then Level_Hi = Level_Hi + .01
	EndIf
	
	UpdateWorld: RenderWorld
	
	Color 255, 255, 255: Rect 0, 600 - 20, 800, 20
	Color 0, 0, 0: Text 400, 590, "Level land height: " + Level_Hi + " : Leveling = " + Level + " : Selected Pivot " + globalName, True, True
	For CommandButton = Each CommandButtons
		DrawImage CommandButton\Image, CommandButton\X, CommandButton\Y, CommandButton\Selected
	Next
	
	DrawImage M_Image, MouseX(), MouseY()
	Color 255, 255, 255: Text MouseX(), MouseY() + 3, Status, False, False
	
	For CommandButton = Each CommandButtons
		CommandButton\Selected = False
	Next
	
	For CommandButton = Each CommandButtons
		If ImagesCollide(M_Image, MouseX(), MouseY(), 0, CommandButton\Image, CommandButton\X, CommandButton\Y, 0) Then
			CommandButton\Selected = True
			Exit
		EndIf
	Next
	
	If KeyHit(31) Then
		SaveBuffer(TextureBuffer(HeightMap), "HeightMap.bmp")
	EndIf
	
	SetBuffer(TextureBuffer(HeightMap))
		Cls
		For X = 0 To 128
			YY = 0
			For Y = 128 To 0 Step - 1
				YY = YY + 1
				White# = 0 + (TerrainHeight(Terrain, x, y) * 255)
				If X > 5 And X < 123 And Y > 5 And Y < 123 Then 
					Color White, White, White
				Else
					Color 0, 0, 0
				EndIf
				Plot x, YY
			Next
		Next
	SetBuffer(BackBuffer())
		
	Flip: Cls
Wend: End

Function CreateButton(X#, Y#, Index%, Caption$)
	a = CreateImage(120, 12, 2)
	SetBuffer ImageBuffer(a, 0)
		Cls
		Color 255, 255, 255: Rect 0, 0, 120, 12
		Color 1, 0, 0: Text ImageWidth(a) / 2, ImageHeight(a) / 2, Caption, True, True
	SetBuffer ImageBuffer(a, 1)
		Cls
		Color 155, 155, 155: Rect 0, 0, 120, 12
		Color 1, 0, 0: Text ImageWidth(a) / 2, ImageHeight(a) / 2, Caption, True, True
	SetBuffer BackBuffer()
	
	CommandButton = New CommandButtons
	CommandButton\Image = CopyImage(a)
	CommandButton\X = X
	CommandButton\Y = Y
	CommandButton\Selected = False
	CommandButton\Index = Index
End Function

Function GetSelected()
	For CommandButton = Each CommandButtons
		If CommandButton\Selected = True Then Return CommandButton\Index
	Next
End Function

Function CreatePiv(X#, Y#, Z#, Name$)
	Pivot = New Pivot
	Pivot\Name = Name
	Pivot\X = X
	Pivot\Y = Y
	Pivot\Z = Z
	Pivot\Mesh = CreateSphere()
	NameEntity Pivot\Mesh, Name
	PositionEntity Pivot\Mesh, X, Y, Z
	EntityColor Pivot\Mesh, 255, 0, 0
	EntityOrder Pivot\Mesh, -10
	EntityPickMode Pivot\Mesh, 2, True
End Function


The updated version:
allows deletion of pivots at lets u see what u called them on mouse over.

<.qtp File structure>
NumberOfPivots
...PivotName
...X
...Y
...Z
....