Code archives/3D Graphics - Misc/LoadMeshTerrain( file$, [parent] )

This code has been declared by its author to be Public Domain code.

Download source code

LoadMeshTerrain( file$, [parent] ) by Neo Genesis102003
Creates a mesh terrain (minus Level of Detail [LOD]) by loading in a bitmap image. This gets around the vertex limitation by using several meshes. To texture the terrain, you should color / texture each of the returned mesh's children. Also included, and required by the function, is my MeshPlane function.
Dim vertex( 512, 512 )
Global IMdivider# = 10

Function MeshPlane(width, height, dist#=1, parent=0)
	width = width - 1
	height = height - 1

	If width > 127 Then width = 127
	If height > 127 Then height = 127

	mesh = CreateMesh()
	surface = CreateSurface(mesh)

	For x = 0 To width + 1
		For z = 0 To height + 1
			IMx# = Float#(x * dist#)
			IMz# = Float#(z * dist#)
			vertex(x,z) = AddVertex(surface,IMx#,0,IMz#, x, z)
		Next
	Next

	For x = 0 To width
		For z = 0 To height		
			AddTriangle(surface, vertex(x,z), vertex(x,z+1), vertex(x+1,z+1) )
			AddTriangle(surface, vertex(x+1,z+1), vertex(x+1,z), vertex(x,z) )
		Next
	Next
	
	EntityParent mesh, parent
	Return mesh
	
End Function

Function LoadMeshTerrain( filename$, parent=0 )

	img = LoadImage(filename$)
	If img = 0 RuntimeError "Mesh does not exist: " + filename$
	
	size = ImageWidth( img )
	If ImageHeight( img ) <> wth Then ResizeImage img, size, size
	
	Local returner
	
	buff = GraphicsBuffer()
	SetBuffer ImageBuffer( img )
	
	Lr = ColorRed()
	Lg = ColorGreen()
	Lb = ColorBlue()
	
	Local Ix, Iy
	
	If size >= 128
		For I = 1 To size Step 128
			For J = 1 To size Step 128
				mesh = MeshPlane( 128, 128 )

				If I = 1 And J = 1
					returner = mesh
					EntityParent mesh, parent
				Else
					EntityParent mesh, returner
				EndIf
				
				Origin I-1, J-1
				
				For x = 0 To 128
					For y = 0 To 128
					
						GetColor x, y
						r = ColorRed()
					
						surface = GetSurface( mesh, 1 )
						Vx# = VertexX#( surface, vertex(x,y) )
						Ny# = Float(r / IMdivider#)
						Vz# = VertexZ#( surface, vertex(x,y) )
										
						VertexCoords surface, vertex(x,y), Vx#, Ny#, Vz#
					Next
				Next
								
				PositionEntity mesh, I , 0, J, True
			Next
		Next
	Else
		mesh = MeshPlane( size, size )
		returner = mesh
		
		For x = 0 To (size - 1)
			For y = 0 To (size - 1)
			
				GetColor x, y
				r = ColorRed()
			
				surface = GetSurface( mesh, 1 )
				Vx# = VertexX#( surface, vertex(x,y) )
				Ny# = Float(r / IMdivider#)
				Vz# = VertexZ#( surface, vertex(x,y) )
								
				VertexCoords surface, vertex(x,y), Vx#, Ny#, Vz#
			Next
		Next
	EndIf
	
	; Behave yourself nicely :)
	Color r, g, b
	Origin 0, 0
	SetBuffer buff
	EntityParent returner, parent
	Return returner
	
End Function

Comments

None.

Code Archives Forum