Dynamic LOD (Level Of Detail)

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

Dynamic LOD (Level Of Detail) by MusicianKool

2010

well, this comes in 3 parts: A stripped down perlin tiled geodesic sphere lib, the main example, and the LOD Mesh divide/reduce codes(but all crammed together in one code). You will notice that mesh edges of unlike Levels of detail don't line up, I'm not sure how to fix this ( and help doing so would be great).

Download Improved 3d Perlin noise UserLib here : http://www.mediafire.com/?wzg2ymntxmg

Update!
- lod now dynamically adds higher resolution Textures.

Bugs!
- tiles of higher detail don't line up with tiles of lower detail
- Textures of higher lod have dark lines

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

Dim Tile_LOD(1,1)    
Const ColorDepth = 256
Global TotalTiles = 0
Global TotalTriangles = 0 
Global ClosestTile# = 0
Global Planet_Texture
Global Detail
Global Range = 5

Global MAX_LOD_LVLS = 4			;Maximum levels of detail to use.
Dim LOD_LVL_D(MAX_LOD_LVLS)		;Storage for the LOD distances.
Dim LOD_TEXTURES(MAX_LOD_LVLS)	;Storage for the Images to replace low level ones they are generated with the lod

Restore Planet
Global DEPTH = ColorDepth
Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0)
CreateGradient(10,DEPTH)

Local Tiles,Segments,ImageSize,Planet,Camera,PlanetSize,Scale#,Multiplier#,Offset#,Seed
Local wire       

Gosub initfunctions 

AmbientLight 255,255,255

Tiles		=			16
Segments	=			1
ImageSize	=			64
PlanetSize	=			1000
Scale		=			(((((Tiles*Tiles*6)*(Segments*Segments))/Tiles ))/(Float Segments))
Multiplier	=			.2
Offset		=			-.2
Seed		=			100 

InitPerlinNoise( Seed )

SetupLOD(PlanetSize*2*3,ImageSize)		;Set the LOD Distances

cpiv = CreatePivot()
Camera = CreateCamera(cpiv):CameraRange(Camera,1,10000)
PositionEntity Camera,0,0,(-planetsize)*4

PlanetHeightMap = CreateImage(ImageSize,ImageSize)

Planet = CreatePivot()

CreateSegCube(Tiles,Segments,Planet)

ConvertToPerlinSphere(PlanetHeightMap,PlanetSize,Scale#,Multiplier#,Offset#,Planet)

SaveImage PlanetHeightMap,"PHM.bmp"
LOD_TEXTURES(0) = LoadTexture("PHM.bmp",16+32) 
CubeTextureMapFix(LOD_TEXTURES(0))  

Detail = 0;CreateDetail(ImageSize*2)
ApplyTexture(Planet,Tiles,LOD_TEXTURES(0),Detail) 

wire = 0
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
PointEntity Camera,Planet
While Not KeyHit(1) 
	Locate 0,0 
	
	If KeyHit ( 57 ) Then wire=1-wire:WireFrame wire
	
	;This is were all the LOD is handled
	LOD_Tiles(Camera,Planet,PlanetSize+1000,ImageSize,PlanetSize,Scale#,Multiplier#,Offset#)
	
	;Controls
	If KeyDown ( 30 ) Then TurnEntity Cpiv,0,-1,0 ;a
	If KeyDown ( 32 ) Then TurnEntity Cpiv,0,1,0;d
	If KeyDown ( 17 ) Then MoveEntity Camera,0,0,1;w
	If KeyDown ( 31 ) Then MoveEntity Camera,0,0,-1 ;s 
	If KeyDown ( 16 ) Then TurnEntity Camera,0,0,2;q
	If KeyDown ( 18 ) Then TurnEntity Camera,0,0,-2;e
	If KeyDown ( 36 ) Then MoveEntity Camera,0,0,20
	If KeyDown ( 50 ) Then MoveEntity Camera,0,0,-20 
	TurnEntity Camera,MouseYSpeed(),-MouseXSpeed(),0  
	MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
	
	RenderWorld  
	
	Print "Triangles Rendered: "+TrisRendered()
	Print "Distance to Planet Core: " + EntityDistance(Camera,Planet)
	Print "Closest Tile: " + ClosestTile  
	
	Flip 
	
Wend       

End 



.initfunctions
;#Region ;ARGB to A,R,G,B and vis versa
Function GetRGB(r,g,b,a=255)
	Return b Or (g Shl 8) Or (r Shl 16) Or (a Shl 24)
End Function

Function GetA(RGB)
	Return RGB Shr 24 And %11111111
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function
;#End Region  

;#Region    ;Spherical Vector
Global SphericalBank = CreateBank(4*5)
Function Spherical(x#,y#,z#,Vector#)
	RD# = Vector#
	zen# = ATan2(Sqr(x#*x#+y#*y#),z#)
	azi# = ATan2(y#,x#)
	PokeFloat (SphericalBank,0,Sin(Zen#))
	PokeFloat (SphericalBank,4,Cos(Zen#))
	PokeFloat (SphericalBank,8,Sin(Azi#))
	PokeFloat (SphericalBank,12,Cos(Azi#))
	PokeFloat (SphericalBank,16,RD#)
End Function
Function Spherical_X#(Vector#=0)
	If Not Vector# Then
		Return (PeekFloat(SphericalBank,16)*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,12))
	Else
		Return (Vector#*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,12))
	EndIf
End Function
Function Spherical_Y#(Vector#=0)
	If Not Vector# Then
		Return (PeekFloat(SphericalBank,16)*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,8))
	Else
		Return (Vector#*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,8))
	EndIf
End Function
Function Spherical_Z#(Vector#=0)
	If Not Vector# Then
		Return (PeekFloat(SphericalBank,16)*PeekFloat(SphericalBank,4))
	Else
		Return (Vector#*PeekFloat(SphericalBank,4))
	EndIf
End Function
Function VertexYaw#(X1#,Y1#,Z1#,X2# = 0,Y2# = 0,Z2# = 0)
	y# = ATan2( (x2-x1) , (Z2 - Z1))
	If y# = NaN Then Return 0
	Return -y#
End Function
Function VertexPitch#(X1#,Y1#,Z1#,X2# = 0,Y2# = 0,Z2# = 0)
	p# = ATan2( (z2-z1) , (Y2 - Y1))
	If p# = NaN Then Return 0
	Return p#
End Function
Function VertexRoll#(X1#,Y1#,Z1#,X2# = 0,Y2# = 0,Z2# = 0)
	Return ATan( (y2-y1) / (X2 - X1))
End Function
;#End Region  

;#Region ;LOD Mesh Manipulation code  
;
;LOD_PerlinDivide - Is specifically written for the perlinGeosphere.   
;
;LOD_Divide -Is a blank mesh divider. ie. if you divide a low poly sphere you will notice
;			no changes to the shape of the sphere, only with 'wireframe true' will you see
;			the added vertecies. 
;			Increases the number of trianges (Number of tiangles * 4). 
;
;LOD_Reduce -reduces the number of triangels a mesh has by (number of triangles / 4).
;			DO NOT TRY to reduce the original mesh!  LOD_Reduce was not made to reduce the 
;			triangles of just any mesh, just meshes that have had LOD_Divide applied to them!
	

Function LOD_PerlinDivide(Mesh,ImageSize,PlanetSize,Scale#,Multiplier#,Offset#,LOD_LEVEL)
	
	Local DestMesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	Local X4#,Y4#,Z4#,U4#,V4#
	Local X5#,Y5#,Z5#,U5#,V5#
	Local X6#,Y6#,Z6#,U6#,V6#
	Local Vert1,Vert2,Vert3,Vert4,Vert5,Vert6
	Local PN#,Height#
	DestMesh = CreateMesh()
	Surf = CreateSurface(DestMesh)
	RefSurf = GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt = CountTriangles(RefSurf)         
	
	LockBuffer TextureBuffer (LOD_TEXTURES(LOD_LEVEL)) 
	IW = TextureWidth(LOD_TEXTURES(LOD_LEVEL))-1
	IH = TextureHeight(LOD_TEXTURES(LOD_LEVEL))-1
	
	For A = 0 To Cnt-1
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A,0))
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A,1))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A,1))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,1))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A,1))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A,1))
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A,2))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A,2))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,2))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A,2))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A,2))
		
		X4#=(X1+X2)/2.0
		Y4#=(Y1+Y2)/2.0
		Z4#=(Z1+Z2)/2.0
		U4#=(U1+U2)/2.0
		V4#=(V1+V2)/2.0
		
		X5#=(X2+X3)/2.0
		Y5#=(Y2+Y3)/2.0
		Z5#=(Z2+Z3)/2.0
		U5#=(U2+U3)/2.0
		V5#=(V2+V3)/2.0
		
		X6#=(X3+X1)/2.0
		Y6#=(Y3+Y1)/2.0
		Z6#=(Z3+Z1)/2.0
		U6#=(U3+U1)/2.0
		V6#=(V3+V1)/2.0
		
		Spherical(X1,Y1,Z1,Scale#)
		PN# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),ImageSize,0,999))
		Height# = ((1.0) + (PN#*Multiplier#))*PlanetSize
		X1 = Spherical_X( Height )   
		Y1 = Spherical_Y( Height )
		Z1 = Spherical_Z( Height )
		col = ((PN#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > ColorDEPTH Then col = ColorDEPTH ;limit color
		argb = GetRGB(GradientR(col),GradientG(col),GradientB(col));Convert color to ARGB
		u = U1 * iw
		v = V1 * iw
		WritePixelFast U,V,argb,TextureBuffer (LOD_TEXTURES(LOD_LEVEL))	;Write pixel to Texture
		Vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original 
		
		Spherical(X2,Y2,Z2,Scale#)
		PN# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),ImageSize,0,999))
		Height# = ((1.0) + (PN#*Multiplier#))*PlanetSize
		X2 = Spherical_X( Height )   
		Y2 = Spherical_Y( Height )
		Z2 = Spherical_Z( Height )
		col = ((PN#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > ColorDEPTH Then col = ColorDEPTH ;limit color
		argb = GetRGB(GradientR(col),GradientG(col),GradientB(col))
		u = U2 * iw
		v = V2 * iw
		WritePixelFast U,V,argb,TextureBuffer (LOD_TEXTURES(LOD_LEVEL))	;Write pixel to Texture
		Vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		 
		Spherical(X3,Y3,Z3,Scale#)
		PN# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),ImageSize,0,999))
		Height# = ((1.0) + (PN#*Multiplier#))*PlanetSize
		X3 = Spherical_X( Height )   
		Y3 = Spherical_Y( Height )
		Z3 = Spherical_Z( Height )
		col = ((PN#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > ColorDEPTH Then col = ColorDEPTH ;limit color
		argb = GetRGB(GradientR(col),GradientG(col),GradientB(col))
		u = U3 * iw
		v = V3 * iw
		WritePixelFast U,V,argb,TextureBuffer (LOD_TEXTURES(LOD_LEVEL))	;Write pixel to Texture
		Vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		
		Spherical(X4,Y4,Z4,Scale#)
		PN# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),ImageSize,0,999))
		Height# = ((1.0) + (PN#*Multiplier#))*PlanetSize
		X4 = Spherical_X( Height )   
		Y4 = Spherical_Y( Height )
		Z4 = Spherical_Z( Height )
		col = ((PN#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > ColorDEPTH Then col = ColorDEPTH ;limit color
		argb = GetRGB(GradientR(col),GradientG(col),GradientB(col))
		u = U4 * iw
		v = V4 * iw
		WritePixelFast U,V,argb,TextureBuffer (LOD_TEXTURES(LOD_LEVEL))	;Write pixel to Texture
		Vert4 = AddVertex (Surf,X4,Y4,Z4,U4,V4) ;New
		
		Spherical(X5,Y5,Z5,Scale#)
		PN# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),ImageSize,0,999))
		Height# = ((1.0) + (PN#*Multiplier#))*PlanetSize
		X5 = Spherical_X( Height )   
		Y5 = Spherical_Y( Height )
		Z5 = Spherical_Z( Height )
		col = ((PN#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > ColorDEPTH Then col = ColorDEPTH ;limit color
		argb = GetRGB(GradientR(col),GradientG(col),GradientB(col))
		u = U5 * iw
		v = V5 * iw
		WritePixelFast U,V,argb,TextureBuffer (LOD_TEXTURES(LOD_LEVEL))	;Write pixel to Texture
		Vert5 = AddVertex (Surf,X5,Y5,Z5,U5,V5) ;New
		
		Spherical(X6,Y6,Z6,Scale#)
		PN# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),ImageSize,0,999))
		Height# = ((1.0) + (PN#*Multiplier#))*PlanetSize
		X6 = Spherical_X( Height )   
		Y6 = Spherical_Y( Height )
		Z6 = Spherical_Z( Height )   
		col = ((PN#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > ColorDEPTH Then col = ColorDEPTH ;limit color
		argb = GetRGB(GradientR(col),GradientG(col),GradientB(col))
		u = U6 * iw
		v = V6 * iw
		WritePixelFast U,V,argb,TextureBuffer (LOD_TEXTURES(LOD_LEVEL))	;Write pixel to Texture
		Vert6 = AddVertex (Surf,X6,Y6,Z6,U6,V6) ;New
		
		AddTriangle Surf,Vert1,Vert4,Vert6
		AddTriangle Surf,Vert2,Vert5,Vert4
		AddTriangle Surf,Vert3,Vert6,Vert5
		AddTriangle Surf,Vert4,Vert5,Vert6
		
	Next
	UnlockBuffer TextureBuffer (LOD_TEXTURES(LOD_LEVEL))  
	CubeTextureMapFix(LOD_TEXTURES(LOD_LEVEL))
	UpdateNormals DestMesh
	FreeEntity Mesh
	Return DestMesh
End Function    

Function LOD_Divide(Mesh)
	
	Local DestMesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	Local X4#,Y4#,Z4#,U4#,V4#
	Local X5#,Y5#,Z5#,U5#,V5#
	Local X6#,Y6#,Z6#,U6#,V6#
	Local Vert1,Vert2,Vert3,Vert4,Vert5,Vert6
	
	DestMesh = CreateMesh()
	Surf = CreateSurface(DestMesh)
	RefSurf = GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt = CountTriangles(RefSurf)
	
	For A = 0 To Cnt-1
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A,0))
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A,1))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A,1))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,1))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A,1))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A,1))
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A,2))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A,2))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,2))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A,2))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A,2))
		
		X4#=(X1+X2)/2.0
		Y4#=(Y1+Y2)/2.0
		Z4#=(Z1+Z2)/2.0
		U4#=(U1+U2)/2.0
		V4#=(V1+V2)/2.0
		
		X5#=(X2+X3)/2.0
		Y5#=(Y2+Y3)/2.0
		Z5#=(Z2+Z3)/2.0
		U5#=(U2+U3)/2.0
		V5#=(V2+V3)/2.0
		
		X6#=(X3+X1)/2.0
		Y6#=(Y3+Y1)/2.0
		Z6#=(Z3+Z1)/2.0
		U6#=(U3+U1)/2.0
		V6#=(V3+V1)/2.0
		
		
		Vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original
		Vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		Vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		
		Vert4 = AddVertex (Surf,X4,Y4,Z4,U4,V4)
		Vert5 = AddVertex (Surf,X5,Y5,Z5,U5,V5) 
		Vert6 = AddVertex (Surf,X6,Y6,Z6,U6,V6)
		
		AddTriangle Surf,Vert1,Vert4,Vert6
		AddTriangle Surf,Vert2,Vert5,Vert4
		AddTriangle Surf,Vert3,Vert6,Vert5
		AddTriangle Surf,Vert4,Vert5,Vert6
		
	Next 
	UpdateNormals DestMesh
	FreeEntity Mesh
	Return DestMesh
End Function

Function LOD_Reduce(Mesh)
	
	Local Destmesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	
	Destmesh=CreateMesh()
	Surf=CreateSurface(Destmesh)
	RefSurf=GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt=CountTriangles(RefSurf)
	For A=0 To Cnt-1 Step 4
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A+0,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A+0,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+0,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A+0,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A+0,0))
		
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A+1,0))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A+1,0))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+1,0))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A+1,0))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A+1,0))
		
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A+2,0))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A+2,0))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+2,0))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A+2,0))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A+2,0))
		
		vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original
		vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		AddTriangle Surf,vert1,vert2,vert3
	Next
	UpdateNormals Destmesh
	FreeEntity Mesh
	Return Destmesh
	
End Function  

;#End Region

;#Region   Geosphere and other functions
;#Region GeoSphere & segmented cube

; transform a cube to sphere Using Heightmap Data
Function ConvertToPerlinSphere(SphereHeightMap,PlanetSize,Scale#,Multiplier#,Offset#,Parent=0)
	IW = ImageWidth(SphereHeightMap)
	IH = ImageHeight(SphereHeightMap)
	Local s%,surf%,vc%
	Local vx#,vy#,vz#,v#,u#
	LockBuffer (ImageBuffer (SphereHeightMap))
	For q = 1 To CountChildren(Parent)
		child = GetChild(Parent,q)
		For s=1 To CountSurfaces(child)
			surf=GetSurface(child,s)
			For vc=0 To CountVertices(surf)-1	
				vx#= VertexX#(surf,vc)
				vy#= VertexY#(surf,vc)
				vz#= VertexZ#(surf,vc)
				u# = (VertexU(surf,vc)*(IW-1))
				v# = (VertexV(surf,vc)*(IH-1))

				Spherical(vx#,vy#,vz#,Scale#)
				pn# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),IW,0,999))

				col = ((pn#+Offset#)*(ColorDepth/2))+(ColorDepth/2)+Rand(-range,Range)	;Convert Perlin noise to colorGradient
				If col < 0 Then col = 0		;limit color
				If col > ColorDEPTH Then col = ColorDEPTH ;limit color
			
				If col > 255 And col > 511 Then
					r = 255:g = 255:b = col-512
				ElseIf col > 255 Then
					r = 255:g = col - 256:b = 0
				ElseIf col < 256 Then
					r = col:g = 0:b = 0		
				EndIf
				argb = GetRGB(GradientR(col),GradientG(col),GradientB(col));Convert color to ARGB;Convert color to ARGB
				WritePixelFast u,v,argb,ImageBuffer (SphereHeightMap)	;Write pixel to Texture
				h# = ((1.0) + (pn#*Multiplier#))*PlanetSize
				sx# = Spherical_X#(h)
				sy# = Spherical_Y#(h)
				sz# = Spherical_Z#(h)
				VertexCoords surf,vc,sx#,sy#,sz#
			Next			
		Next
		CalcSphereNormals(child)
	Next
	UnlockBuffer (ImageBuffer (SphereHeightMap))
	;CubeHeightMapFix(SphereHeightMap)
	Return ParentPiv
End Function

Function LoadGeodesicHeightmapedSphere(SphereHeightMap,PlanetSize,Scale#,Multiplier#,Offset#,seed,Parent=0)
	IW = ImageWidth(SphereHeightMap)
	IH = ImageHeight(SphereHeightMap)
	Local s%,surf%,vc%
	Local vx#,vy#,vz#,v#,u#,tv#,tu#
	LockBuffer (ImageBuffer (SphereHeightMap))
	For q = 1 To CountChildren(Parent)
		child = GetChild(Parent,q)
		For s=1 To CountSurfaces(child)
			surf=GetSurface(child,s)
			For vc=0 To CountVertices(surf)-1	
				vx#= VertexX#(surf,vc)
				vy#= VertexY#(surf,vc)
				vz#= VertexZ#(surf,vc)
				u# = Floor (VertexU(surf,vc)*(IW-1))
				v# = Floor (VertexV(surf,vc)*(IH-1))
				col = ReadPixelFast(u,v,ImageBuffer(SphereHeightMap))
				If ColorDEPTH = 256 Then 
					pn# = 1/ColorDEPTH * (GetR(col))
				Else If ColorDEPTH = 512 Then
					pn# = 1/ColorDEPTH * (GetR(col)+GetG(col))
				Else If ColorDEPTH = 768 Then
					pn# = 1/ColorDEPTH * (GetR(col)+GetG(col)+GetB(col))
				EndIf
				Height#=((1.0+Offset#) + (pn#*Multiplier#))*PlanetSize
				Spherical(vx#,vy#,vz#,Height#)
				
				sx# = Spherical_X#()
				sy# = Spherical_Y#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize)
				sz# = Spherical_Z#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize)
				VertexCoords surf,vc,sx#,sy#,sz#
			Next			
		Next
	Next
	UnlockBuffer (ImageBuffer (SphereHeightMap))
	Return ParentPiv
End Function

; creates a segmented cube
Function CreateSegCube(Tiles = 1,segs=1,parent=0)
	Local side%,surf%
	Local a%,v#,b%,u#
	Local v0%,v1%,v2%,v3%
	Dim Tile_LOD((Tiles*Tiles)*6,MAX_LOD_LVLS)
	; sides
	For side=0 To 3
		For t = 0 To tiles-1
			For q = 0 To tiles-1
				mesh%=CreateMesh( parent )
				surf=CreateSurface( mesh )
				Tile_LOD(TotalTiles,0) = mesh
				TotalTiles = TotalTiles+1
				For a=0 To segs
					v#=((a+(t*segs))/Float(segs))/Tiles;y axis
					tv#=(Float 0.25)+(v#)*(Float 0.25);y axis
					For b=0 To segs
						u#=((b+(q*segs))/Float(segs))/Tiles ;x axis
						Select True
							Case side = 0
								tu#=(Float 0.0)+(u#)*(Float .25) ;x axis
							Case side = 1
								tu#=(Float .25)+(u#)*(Float .25) ;x axis
							Case side = 2
								tu#=(Float 0.5)+(u#)*(Float .25) ;x axis
							Case side = 3
								tu#=(Float .75)+(u#)*(Float .25) ;x axis
						End Select
						AddVertex(surf,u-.5,v-.5,0.5,tu#,tv#)
					Next		
				Next
				For a=0 To segs-1
					For b=0 To segs-1	
						v0=a*(segs+1)+b:v1=v0+1
						v2=(a+1)*(segs+1)+b+1:v3=v2-1
						AddTriangle( surf,v0,v1,v2 )
						AddTriangle( surf,v0,v2,v3 )
						TotalTriangles = TotalTriangles + 2
					Next
				Next
				Select True
					Case side = 0 
						RotateMesh mesh,0,-90,0
					Case side = 1
						RotateMesh mesh,0,180,0
					Case side = 2
						RotateMesh mesh,0,90,0
					Case side = 3
						RotateMesh mesh,0,0,0
				End Select
			Next
		Next
	Next
	;top bottom
	For side=0 To 1
		For t = 0 To tiles-1
			For q = 0 To tiles-1
				mesh%=CreateMesh( parent )
				surf=CreateSurface( mesh )
				Tile_LOD(TotalTiles,0) = mesh
				TotalTiles = TotalTiles+1	
				For a=0 To segs
					v#=(Float (a+(t*segs))/Float(segs))/Tiles;y axis
					If side = 0 Then
						tv#=(Float 0.0)+(v#)*(Float 0.25);y axis
					Else
						tv#=(Float 0.50)+(v#)*(Float 0.25);y axis
					EndIf
					For b=0 To segs
						u#=(Float (b+(q*segs))/Float(segs))/Tiles;x axis
						tu#=(Float .25)+(u#)*(Float .25) ;x axis
						AddVertex(surf,u-.5,v-.5,0.5,tu#,tv#)
					Next
				Next
				
				For a=0 To segs-1
					For b=0 To segs-1
						v0=a*(segs+1)+b:v1=v0+1
						v2=(a+1)*(segs+1)+b+1:v3=v2-1
						AddTriangle( surf,v0,v1,v2 )
						AddTriangle( surf,v0,v2,v3 )
						TotalTriangles = TotalTriangles + 2
					Next
				Next
				Select True
					Case side = 0
						RotateMesh mesh,90,-90,-90
					Case side = 1
						RotateMesh mesh,-90,-90,90
				End Select
			Next
		Next
	Next
End Function

Function ApplyTexture(Planet,Tiles,PlanetTexture=0,Detail = 0)
	Planet_Texture = PlanetTexture
	For i = 0 To 6-1
		For j = 1 To tiles*tiles
			ent = GetChild(Planet,j+i*(tiles*tiles))
			EntityTexture ent ,PlanetTexture
			If Detail <> 0 Then 
				EntityTexture ent,Detail,0,2
				ScaleTexture Detail,.1,.1 
				TextureBlend Detail,2
			EndIf
		Next
	Next
End Function

Function CalcSphereNormals(Mesh)
	surf=GetSurface(Mesh,1)
	
	For v=0 To CountVertices(surf)-1
		
		VX#=VertexX(surf,v)
		VY#=VertexY(surf,v)
		VZ#=VertexZ(surf,v)
		
		TFormNormal VX#, VY#, VZ#, 0, 0
		VertexNormal surf,v, TFormedX(), TFormedY(), TFormedZ()
	Next
End Function

Function CubeTextureMapFix(TextureMap) 
	Local HMB,IW,X,TX,Y
	HMB = TextureBuffer(TextureMap)
	IW = TextureWidth(TextureMap)
	LockBuffer HMB
	For x = 0 To IW/4
		TX = X
		Y = (IW/4)
		WritePixelFast X,Y -1,ReadPixelFast(X,Y,HMB),HMB
		WritePixelFast X+(IW/4)*2,Y -1,ReadPixelFast(X+(IW/4)*2,Y,HMB),HMB
		WritePixelFast X+(IW/4)*3,Y -1,ReadPixelFast(X+(IW/4)*3,Y,HMB),HMB
		WritePixelFast x,y*2,ReadPixelFast(x,y*2-1,HMB),HMB
		WritePixelFast X+(IW/4)*2,Y*2,ReadPixelFast(X+(IW/4)*2,Y*2 -1,HMB),HMB
		WritePixelFast X+(IW/4)*3,Y*2,ReadPixelFast(X+(IW/4)*3,Y*2 -1,HMB),HMB
		WritePixelFast X+(IW/4),Y*3,ReadPixelFast(X+(IW/4),Y*3-1,HMB),HMB
		y = x
		x = (IW/4)
		WritePixelFast X -1,Y,ReadPixelFast(X,Y,HMB),HMB
		WritePixelFast X -1,Y+(IW/4)*2,ReadPixelFast(X,Y+(IW/4)*2,HMB),HMB
		WritePixelFast X*2,Y,ReadPixelFast(X*2 -1,Y,HMB),HMB
		WritePixelFast X*2,Y+(IW/4)*2,ReadPixelFast(X*2 -1,Y+(IW/4)*2,HMB),HMB
		x = tx
	Next
	UnlockBuffer HMB
End Function
;#End Region 

Function LOD_Tiles(Source,Parent,Distance#,ImageSize,PlanetSize,Scale#,Multiplier#,Offset#)
	ClosestTile# = 99999
	For i = 0 To TotalTiles-1
		surf = GetSurface(Tile_LOD(i,0),1)
		cv = CountVertices(surf)/2
		ex# = VertexX(surf,cv):ey# = VertexY(surf,cv):ez# = VertexZ(surf,cv)
		sX# = EntityX#(Source,1):sY# = EntityY#(Source,1):sZ# = EntityZ#(Source,1) 
		DeltaX# = (eX#-sX#)
		DeltaY# = (eY#-sY#)
		DeltaZ# = (eZ#-sZ#)
		Dist# = Sqr(DeltaX*DeltaX + DeltaY*DeltaY + DeltaZ*DeltaZ)
		If  dist# < ClosestTile#*ClosestTile# Then ClosestTile# = Sqr( dist# ) 
		
		TilesRendered = TilesRendered + 1	;Count the total tiles being rendered 
		
		;Apply  LOD to meshes if the distance to the mesh is lessthen the LOD levels distance
		For lvl = 1 To MAX_LOD_LVLS    
		    If Dist# < LOD_LVL_D(lvl) And Tile_LOD(i,lvl)=0 Then

			    Tile_LOD(i,lvl)= 1  ;store that this tile has had this lod lvl applied to it
			    
			    ;replace mesh with a new higher poly one
			    Tile_LOD(i,0)= LOD_PerlinDivide(Tile_LOD(i,0),ImageSize,PlanetSize,Scale#,Multiplier#,Offset#,LVL)
				
				;Re apply parenting and textures to mesh
			    EntityParent Tile_LOD(i,0),Parent
			    EntityTexture Tile_LOD(i,0),LOD_TEXTURES(lvl)
			    If Detail <> 0 Then 
					EntityTexture Tile_LOD(i,0),Detail,0,2
					ScaleTexture Detail,.1,.1 
					TextureBlend Detail,2
				EndIf
			EndIf
			If Dist# > LOD_LVL_D(lvl) And Tile_LOD(i,lvl)=1 Then
			    
			    Tile_LOD(i,lvl)= 0	;Store that this Lod is no longer being applied to this tile
			    
			    ;Replace Mesh with a new lower poly one
			    Tile_LOD(i,0)= LOD_Reduce(Tile_LOD(i,0))
			    
			    ;Re apply parenting and textures to mesh
			    EntityParent Tile_LOD(i,0),Parent
			    EntityTexture Tile_LOD(i,0),LOD_TEXTURES(lvl-1)
			    If Detail <> 0 Then 
					EntityTexture Tile_LOD(i,0),Detail,0,2
					ScaleTexture Detail,.1,.1 
					TextureBlend Detail,2
				EndIf
			EndIf 
		Next	
	Next
End Function

Function DeletePlanet(Parent)
	For i = 1 To CountChildren(Parent)
		FreeEntity GetChild(Parent,i)
	Next
End Function

Function SetupLOD(InitalDistance = 1000,Image_Size = 64)     
	LOD_LVL_D(0) = InitalDistance
	LOD_TEXTURES(0) = CreateTexture(Image_Size,Image_Size)
	For i = 1 To MAX_LOD_LVLS
		LOD_LVL_D(i) = LOD_LVL_D(i-1)/2  
		Image_Size = Image_Size * 2
		LOD_TEXTURES(i) = CreateTexture(Image_Size,Image_Size)
	Next
End Function

Function CreateDetail(Texture_Size)
	Detail = CreateTexture(Texture_Size,Texture_Size)
	LockBuffer TextureBuffer(Detail)
	For x = 0 To Texture_Size-1
		For y = 0 To Texture_Size-1 
			r = Rand(255);Rand(-10,10)
			If r < 0 Then r = 0
			If r > 255 Then r = 255 
			col = GetRGB(R,R,R)
		    WritePixelFast x,y,col,TextureBuffer(detail)
		Next
	Next
	UnlockBuffer TextureBuffer(detail)
	Return detail
End Function
;#End Region

.Planet
Data   0.0,  2, 43, 68   ; very dark blue: deep water 
Data  10.0,  9, 62, 92   ; dark blue: water
Data  20.0, 17, 82,112   ; blue: shallow water
Data  30.0, 69,108,118   ; light blue: shore
Data  50.0,255,246,143   ; gold:Beach
Data  60.0, 42,102, 41   ; green: grass
Data  85.0,115,128, 77   ; light green: veld
Data  90.0,153,143, 92   ; brown: tundra
Data  95.0,179,179,179   ; grey: rocks
Data 100.0,255,255,255   ; white: snow

;Color Gradient
Function CreateGradient(colors%,steps%)
	
	Dim GradientR(steps),GradientG(steps),GradientB(steps),Percent(colors),Red(colors),Green(colors),Blue(colors)
	
	Local i%,pos1%,pos2%,pdiff%
	Local rdiff%,gdiff%,bdiff%
	Local rstep#,gstep#,bstep#
	Local counter%=1
	
    ; read color codes
	For i=1 To colors : Read Percent(i),Red(i),Green(i),Blue(i) : Next
	
    ; calculate gradient
	While counter<colors
		
        ; transform percent value into step position
		pos1%=Percent(counter)*steps/100
		pos2%=Percent(counter+1)*steps/100
		
        ; calculate position difference
		pdiff%=pos2-pos1
		
        ; calculate color difference
		rdiff%=Red(counter)-Red(counter+1)
		gdiff%=Green(counter)-Green(counter+1)
		bdiff%=Blue(counter)-Blue(counter+1)
		
        ; calculate color steps
		rstep#=rdiff*1.0/pdiff
		gstep#=gdiff*1.0/pdiff
		bstep#=bdiff*1.0/pdiff
		
        ; calculate "in-between" color codes
		For i=0 To pdiff
			
			GradientR(pos1+i)=Int(Red(counter)-(rstep*i))
			GradientG(pos1+i)=Int(Green(counter)-(gstep*i))
			GradientB(pos1+i)=Int(Blue(counter)-(bstep*i))
			
		Next
		
        ; increment counter
		counter=counter+1
		
	Wend
	
End Function

Return

...Controls...
W = forward
S = Backward
A = Strafe camera left
D = Strafe camera right
Q = roll camera Left
E = Roll Camera Right

J = Move Forward Fast
M = Move Backward Fast
spacebar = Wire Frame on/off
Mouse = look

Comments

MusicianKool

2010

Here Is a simpler LOD,

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

camera = CreateCamera()
PositionEntity camera,0,0,-3

WireFrame 1
sph = CreateSphere()

Texture = CreateRandomTexture(128) 

EntityTexture sph,texture  

While Not KeyHit(1)
	If KeyHit(17) Then wire = 1-wire:WireFrame wire
	
	If KeyHit(200) And LOD < 3 Then sph = LOD_Divide(sph):EntityTexture sph,texture:LOD = LOD + 1
	If KeyHit(208) And LOD > 0 Then sph = LOD_Reduce(sph):EntityTexture sph,texture:LOD = LOD - 1
	RenderWorld
	Locate 0,0 : Color 255,255,255
	Print "Triangle Count: " + TrisRendered()
	Print "Press Up Arrow to Increase LOD"
	Print "Press Down Arrow to Decrease LOD"
	Print "Press W for Wire Frame"
	Flip
Wend



Function LOD_Divide(Mesh)
	
	Local DestMesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	Local X4#,Y4#,Z4#,U4#,V4#
	Local X5#,Y5#,Z5#,U5#,V5#
	Local X6#,Y6#,Z6#,U6#,V6#
	Local Vert1,Vert2,Vert3,Vert4,Vert5,Vert6
	
	DestMesh = CreateMesh()
	Surf = CreateSurface(DestMesh)
	RefSurf = GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt = CountTriangles(RefSurf)
	
	For A = 0 To Cnt-1
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A,0))
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A,1))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A,1))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,1))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A,1))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A,1))
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A,2))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A,2))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,2))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A,2))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A,2))
		
		X4#=(X1+X2)/2.0
		Y4#=(Y1+Y2)/2.0
		Z4#=(Z1+Z2)/2.0
		U4#=(U1+U2)/2.0
		V4#=(V1+V2)/2.0
		
		X5#=(X2+X3)/2.0
		Y5#=(Y2+Y3)/2.0
		Z5#=(Z2+Z3)/2.0
		U5#=(U2+U3)/2.0
		V5#=(V2+V3)/2.0
		
		X6#=(X3+X1)/2.0
		Y6#=(Y3+Y1)/2.0
		Z6#=(Z3+Z1)/2.0
		U6#=(U3+U1)/2.0
		V6#=(V3+V1)/2.0
		
		Vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original
		Vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		Vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		
		Vert4 = AddVertex (Surf,X4,Y4,Z4,U4,V4)
		Vert5 = AddVertex (Surf,X5,Y5,Z5,U5,V5)
		Vert6 = AddVertex (Surf,X6,Y6,Z6,U6,V6)
		
		AddTriangle Surf,Vert1,Vert4,Vert6
		AddTriangle Surf,Vert2,Vert5,Vert4
		AddTriangle Surf,Vert3,Vert6,Vert5
		AddTriangle Surf,Vert4,Vert5,Vert6
		
	Next 
	UpdateNormals DestMesh
	FreeEntity Mesh
	Return DestMesh
End Function

Function LOD_Reduce(Mesh)
	
	Local Destmesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	Local Vert1,Vert2,Vert3
	
	Destmesh=CreateMesh()
	Surf=CreateSurface(Destmesh)
	RefSurf=GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt=CountTriangles(RefSurf)
	For A=0 To Cnt-1 Step 4
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A+0,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A+0,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+0,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A+0,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A+0,0))
		
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A+1,0))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A+1,0))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+1,0))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A+1,0))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A+1,0))
		
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A+2,0))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A+2,0))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+2,0))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A+2,0))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A+2,0))
		
		Vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original
		Vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		Vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		AddTriangle Surf,Vert1,Vert2,Vert3
	Next
	UpdateNormals Destmesh
	FreeEntity Mesh
	Return Destmesh
	
End Function


Function CreateRandomTexture(size)
	t = CreateTexture(size,size)
	
	SetBuffer TextureBuffer(t)
	For i = 0 To 99
		Color Rand(255),Rand(255),Rand(255)
		Rect Rand(size),Rand(size),Rand(size),Rand(size),0
	Next
	
	Return t
	
End Function

Warner

2010

The above code seems to be missing the Perin3D function?

MusicianKool

2010

oops forgot to include: requires 3D_PerlinNoise.dll
download:http://www.mediafire.com/?wzg2ymntxmg

MusicianKool

2010

Update!

I'm working on an infinite plane using lod. I will post as soon as its done.

MusicianKool

2010

ok Infinite plane.. I still don't know how to get the edges of different lod to match up...
also I'm sure it has something to do with normalizing the tiles, but you can see the tile outlines.

you will need this : http://www.mediafire.com/?kwno5wnty4i
put the "Modules.bb" and "Multifractals.bb" with the below code and travel forever.


;w forward
;s backward
;a strafe left
;d strafe right
;spacebar toggle wireframe
;j 10xforward
;m 10xbacward
;mouselook

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

Include "modules.bb"

;LOD/Tile settings
Const INIT_LOD			= 0
Const MAX_LOD_LVLS 		= 5		;Maximum levels of detail to use.
Const COLOR_DEPTH 		= 512			;The color range to use, Maximum 768
Const COLOR_RANGE 		= 0				;Random variation of color
Const TILE_GRID_SIZE	= 32
Const TILE_SIZE 		= 64			;The size of the tile
Const TILE_RANGE#		= (Float TILE_SIZE/2.0)*TILE_GRID_SIZE
Global NOISEID = CreateNoiseGenerator(MilliSecs())
;Setup LOD ranges
Const SET_LOD_MIN_RANGE#=64*2
Const SET_LOD_MULTIPLIER#=2
Dim LOD_DISTANCES#(MAX_LOD_LVLS)
tslmr# = SET_LOD_MIN_RANGE
For i = 1 To MAX_LOD_LVLS
	LOD_DISTANCES(i) = tslmr#
	tslmr#=tslmr#*SET_LOD_MULTIPLIER
Next

;Tile Template
Type TileTemplate
	Field Entity
End Type

;Tile Type
Type Tile
	Field Entity
	Field LOD[MAX_LOD_LVLS]
	Field T_LOD
	Field X#,Z#
End Type 

;Array's used to add LOD to Mesh
; ------------------------------------------------------------------------------------------------------------
Dim Vert_x#(6)
Dim Vert_y#(6)
Dim Vert_z#(6)
Dim Vert_u#(6)
Dim Vert_v#(6)
Dim Vert(6)    
; ------------------------------------------------------------------------------------------------------------


;Create the Template tile ===================================================================================
Global TEMP_TILE.Tiletemplate = New TileTemplate
TEMP_TILE\Entity = CreateQuad(1)
EntityAlpha TEMP_TILE\Entity,0
For i = 1 To INIT_LOD
	TEMP_TILE\Entity=LOD_Divide(TEMP_TILE\Entity)
Next
ScaleMesh TEMP_TILE\Entity,TILE_SIZE/2,0,TILE_SIZE/2
;============================================================================================================

;Noise Settings
Const DETAIL			= 512
Const MULTIPLIER#		= TILE_SIZE*4
;Const OFFSET#			= 0
Global RANDOM_SEED 		= MilliSecs()	;Random Seed
Global ID1 = Init_Noise( MilliSecs() )
Global ID2 = Init_Noise( MilliSecs() )

Global TotalTiles = 0
Global ClosestTile# = 0
Global HighestLOD = 0

;Create color gradients
Restore Planet
Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0)
CreateGradient(10,COLOR_DEPTH)

Global camera = CreateCamera()
PositionEntity camera,0,500,0
CameraRange camera,0.001*TILE_SIZE,64*TILE_SIZE
CameraClsColor camera,150,200,255
CameraFogColor camera,150,200,255
CameraFogMode camera,1
CameraFogRange camera,1*TILE_SIZE,(TILE_GRID_SIZE)*TILE_SIZE

sunpivot=CreatePivot()

sun=CreateSphere(8,sunpivot)
EntityFX sun,1+8
ScaleEntity sun,TILE_SIZE,TILE_SIZE,TILE_SIZE
EntityColor sun,255,255,0
PositionEntity sun,20*TILE_SIZE,20*TILE_SIZE,20*TILE_SIZE

light=CreateLight(2,sun)
PositionEntity light,0,0,0
LightRange light,30*TILE_SIZE
AmbientLight 32,32,32

water=CreateSprite()
SpriteViewMode water,2
RotateEntity water,90,0,0
ScaleSprite water,TILE_RANGE#,TILE_RANGE#
EntityFX water,1+16
EntityColor water,17,82,112
EntityBlend water,3
CreateTiles() 

Local wire=0
 
While Not KeyHit(1)
	Cls
	PositionEntity sunpivot,EntityX(camera),0,EntityZ(camera)
	UpdateLOD(camera) 
	If KeyHit(57) Then wire = 1-wire:WireFrame wire
	
	If KeyDown ( 30 ) Then MoveEntity camera,-1,0,0 ;a
	If KeyDown ( 32 ) Then MoveEntity camera,1,0,0;d
	If KeyDown ( 17 ) Then MoveEntity Camera,0,0,1;w
	If KeyDown ( 31 ) Then MoveEntity Camera,0,0,-1 ;s 
	If KeyDown ( 36 ) Then MoveEntity camera,0,0,10
	If KeyDown ( 50 ) Then MoveEntity camera,0,0,-10
	
	mxs# = mxs# + MouseXSpeed()
	mys# = mys# + MouseYSpeed()
	
	If mxs# > 360 Then mxs = 0
	If mxs < 0 Then mxs = 360
	If mys > 80 Then mys = 80
	If mys < -80 Then mys = -80
	
	RotateEntity camera,mys,-mxs,0
	
	MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
	PositionEntity water,EntityX(camera),0,EntityZ(camera)
	RenderWorld
	
		;Framecounter--------------------------------------------
	Framecounter_counter=Framecounter_counter+1
	If Framecounter_time=0 Then Framecounter_time=MilliSecs()
	If Framecounter_time+1001 <MilliSecs() Then
		Framecounter_framerate=Framecounter_counter
		Framecounter_counter=0
		Framecounter_time=MilliSecs()
	EndIf
	Locate 0,0:Color 255,255,255
	Print "FPS: " + Framecounter_framerate
		;========================================================
		
	Print "Triangles Rendered: " + TrisRendered()
	Print "Camera Position: " + EntityX(camera) +"  " +  EntityY(camera)+ "   "+EntityZ(camera)
	Print "Distance to Closest Tile: " + ClosestTile
	
	Flip False
	
Wend

Free_Noise(ID1)
Free_Noise(ID2)
End

Function UpdateLOD(cam)
	ClosestTile# = 9999
	For t.tile = Each tile
		fe = 0
		vx# = t\x
		vz# = t\z 
		cx# = EntityX(cam)
		cz# = EntityZ(cam)
		ClosestTile# = GetMin(Sqr((cx-vx)*(cx-vx)+(cz-vz)*(cz-vz)),ClosestTile#)
		cdx# = cx#-t\x
		cdz# = cz#-t\z 
		If (cdx > TILE_RANGE)Then
			t\x = t\x + TILE_RANGE*2.0:fe = 1
		EndIf 
		If (cdx < -TILE_RANGE) Then
			t\x = t\x - TILE_RANGE*2.0:fe = 1
		EndIf
		If (cdz > TILE_RANGE) Then
			t\z = t\z + TILE_RANGE*2.0:fe = 1
		EndIf
		If (cdz < -TILE_RANGE) Then
			t\z = t\z - TILE_RANGE*2.0:fe = 1
		EndIf
		If fe = 1 Then 
			t\entity = ApplyNoise(t\entity,t)
			PositionEntity t\entity,t\x,0,t\z
		EndIf
		For i = 1 To MAX_LOD_LVLS
			If EntityDistance(t\entity,camera) < LOD_DISTANCES(i) And t\lod[i] = 0 Then
				t\entity = LOD_Divide(t\entity)
				t\entity = ApplyNoise(t\entity,t)
				PositionEntity t\entity,t\x,0,t\z
				t\lod[i] =1
			EndIf
			If EntityDistance(t\entity,camera) > LOD_DISTANCES(i) And t\lod[i] = 1 Then
				t\entity = LOD_Reduce(t\entity)
				t\entity = ApplyNoise(t\entity,t)
				PositionEntity t\entity,t\x,0,t\z
				t\lod[i] =0
			EndIf
		Next
	Next
End Function

Function CreateTiles()
	ms = MilliSecs()
	k = (TILE_GRID_SIZE-1)
	For x = 0 To k
		For z = 0 To k
			t.tile = New Tile
			o# = -(Float (Float TILE_GRID_SIZE*TILE_SIZE)/2.0) + TILE_SIZE/2.0
			tx# = Float (Float TILE_SIZE*x)+o#
			tz# = Float (Float TILE_SIZE*z)+o#
			t\x = tx#
			t\z = tz#
			t\entity = ApplyNoise(CopyMesh(TEMP_TILE\Entity),t)
			PositionEntity t\entity,t\x#,0,t\z#
			EntityFX t\entity,2
			pt=pt+1
			AppTitle "Generating Landscape: "+Int(pt*100.0/(TILE_GRID_SIZE^2))+"% | "+(MilliSecs()-ms)+"ms"
		Next
	Next
	HideEntity TEMP_TILE\Entity
End Function

Function CreateQuad%(Axis%=0,Parent%=0)
	Local o%,v%,Width#=1,Height#=1,Depth#=0,Container,s
	If Axis = 1 Then Height# = 0:Depth# = 1
	If Axis = 2 Then Width = -1
	container=CreateMesh(Parent)
	s=CreateSurface(container)
	v=AddVertex(s,- Width#,- Height#,- Depth# , 0.0,1.0)
	AddVertex  (s,  Width#,- Height#,- Depth# , 1.0,1.0)
	AddVertex  (s,- Width#,  Height#,  Depth# , 0.0,0.0)
	AddVertex  (s,  Width#,  Height#,  Depth# , 1.0,0.0)
	AddTriangle s,v+0,v+2,v+1
	AddTriangle s,v+1,v+2,v+3
	UpdateNormals container
	Return container
End Function

;#Region ;ARGB to A,R,G,B and vis versa
Function GetRGB(r,g,b,a=255)
	Return b Or (g Shl 8) Or (r Shl 16) Or (a Shl 24)
End Function

Function GetA(RGB)
	Return RGB Shr 24 And %11111111
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function
;#End Region 
 
Function ApplyNoise%(mesh,t.tile)
	s = GetSurface(mesh,1)
	cv = CountVertices(s)
	
	Frequency# 	= .001
	Lacunarity#	= 2
	Persistence#= .45	;smooth/roughness
	Octaves    	= 16
	Quality    	= 1		;Quality range (0 - 4), any other number bypasses blending

	Exponent#  = 2.1
	Offset#    = .000002
	Gain#      = .000005
	seed = 5029
	PrecalulateSpectralWeights(Frequency,Lacunarity,Exponent,3)

	For i = 0 To cv - 1
		vx# = VertexX(s,i)
		vz# = VertexZ(s,i)
		ty# = VertexY(s,i)
		tmx1# = t\x+vx
		tmz1# = t\z+vz
		
		pn1# = Perlin#(NOISEID,tmx1,0,tmz1,Frequency,Lacunarity,Persistence,Octaves,Quality)
		pn2# = RidgedMulti#(NOISEID,tmx1,0,tmz1,Frequency,Lacunarity,Gain,Offset,3,seed,quality)/1.5   
		pn3# = Billow#(NOISEID,tmx1,0,tmz1,Frequency,Lacunarity,.4,seed,Octaves,Quality)
		alpha# = (pn3# +1) /2
		pn# = LinearInterpolation#(pn1,pn2,alpha)
		
		If pn <-1 Then pn = -1
		vy# = pn# * MULTIPLIER
		
		
		col = ((PN#)*(COLOR_DEPTH/2))+(COLOR_DEPTH/2)+Rand( - COLOR_RANGE,COLOR_RANGE)	;Convert Perlin noise to colorGradient
		If col < 0 Then col = 0		;limit color
		If col > COLOR_DEPTH Then col = COLOR_DEPTH ;limit color
		s1#=Sqr(TILE_SIZE)/(TILE_SIZE/4.0)
		;vy = Normalize(vy,-1,1,-s1,s1)*MULTIPLIER
		VertexCoords(s,i,vx,vy,vz)
		VertexColor(s,i,GradientR(col),GradientG(col),GradientB(col))
		TFormNormal VX#, VY#, VZ#, 0, 0
		VertexNormal s,i, TFormedX(), TFormedY(), TFormedZ()
	Next
	EntityFX mesh,2
	UpdateNormals mesh
	Return mesh
End Function

Function Normalize#(value#=128.0,value_min#=0.0,value_max#=255.0,norm_min#=0.0,norm_max#=1.0)
	
	Return ((value#-value_min#)/(value_max#-value_min#))*(norm_max#-norm_min#)+norm_min#
	
End Function

;#Region ;LOD Mesh Manipulation code   
;
;LOD_Divide -Is a blank mesh divider. ie. if you divide a low poly sphere you will notice
;			no changes to the shape of the sphere, only with 'wireframe true' will you see
;			the added vertecies. 
;			Increases the number of trianges (Number of tiangles * 4). 
;
;LOD_Reduce -reduces the number of triangels a mesh has by (number of triangles / 4).
;			DO NOT TRY to reduce the original mesh!  LOD_Reduce was not made to reduce the 
;			triangles of just any mesh, just meshes that have had LOD_Divide applied to them!
	    
Function LOD_Divide(Mesh)
	
	Local DestMesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	Local X4#,Y4#,Z4#,U4#,V4#
	Local X5#,Y5#,Z5#,U5#,V5#
	Local X6#,Y6#,Z6#,U6#,V6#
	Local Vert1,Vert2,Vert3,Vert4,Vert5,Vert6
	
	DestMesh = CreateMesh()
	Surf = CreateSurface(DestMesh)
	RefSurf = GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt = CountTriangles(RefSurf)
	
	
	For A = 0 To Cnt-1
		
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A,0))
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A,1))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A,1))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,1))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A,1))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A,1))
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A,2))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A,2))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A,2))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A,2))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A,2))
		
		X4#=(X1+X2)/2.0
		Y4#=(Y1+Y2)/2.0
		Z4#=(Z1+Z2)/2.0
		U4#=(U1+U2)/2.0
		V4#=(V1+V2)/2.0
		
		X5#=(X2+X3)/2.0
		Y5#=(Y2+Y3)/2.0
		Z5#=(Z2+Z3)/2.0
		U5#=(U2+U3)/2.0
		V5#=(V2+V3)/2.0
		
		X6#=(X3+X1)/2.0
		Y6#=(Y3+Y1)/2.0
		Z6#=(Z3+Z1)/2.0
		U6#=(U3+U1)/2.0
		V6#=(V3+V1)/2.0

		Vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original
		Vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		Vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		
		Vert4 = AddVertex (Surf,X4,Y4,Z4,U4,V4)
		Vert5 = AddVertex (Surf,X5,Y5,Z5,U5,V5)
		Vert6 = AddVertex (Surf,X6,Y6,Z6,U6,V6)
		
		AddTriangle Surf,Vert1,Vert4,Vert6
		AddTriangle Surf,Vert2,Vert5,Vert4
		AddTriangle Surf,Vert3,Vert6,Vert5
		AddTriangle Surf,Vert4,Vert5,Vert6
		
	Next 
	UpdateNormals DestMesh
	FreeEntity Mesh
	Return DestMesh
End Function

Function LOD_Reduce(Mesh)
	
	Local Destmesh,Surf,RefSurf,Cnt,A
	Local X1#,Y1#,Z1#,U1#,V1#
	Local X2#,Y2#,Z2#,U2#,V2#
	Local X3#,Y3#,Z3#,U3#,V3#
	
	Destmesh=CreateMesh()
	Surf=CreateSurface(Destmesh)
	RefSurf=GetSurface(Mesh,CountSurfaces(Mesh))
	Cnt=CountTriangles(RefSurf)
	For A=0 To Cnt-1 Step 4
		X1#=VertexX(RefSurf,TriangleVertex(RefSurf,A+0,0))
		Y1#=VertexY(RefSurf,TriangleVertex(RefSurf,A+0,0))
		Z1#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+0,0))
		U1#=VertexU(RefSurf,TriangleVertex(RefSurf,A+0,0))
		V1#=VertexV(RefSurf,TriangleVertex(RefSurf,A+0,0))
		
		X2#=VertexX(RefSurf,TriangleVertex(RefSurf,A+1,0))
		Y2#=VertexY(RefSurf,TriangleVertex(RefSurf,A+1,0))
		Z2#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+1,0))
		U2#=VertexU(RefSurf,TriangleVertex(RefSurf,A+1,0))
		V2#=VertexV(RefSurf,TriangleVertex(RefSurf,A+1,0))
		
		X3#=VertexX(RefSurf,TriangleVertex(RefSurf,A+2,0))
		Y3#=VertexY(RefSurf,TriangleVertex(RefSurf,A+2,0))
		Z3#=VertexZ(RefSurf,TriangleVertex(RefSurf,A+2,0))
		U3#=VertexU(RefSurf,TriangleVertex(RefSurf,A+2,0))
		V3#=VertexV(RefSurf,TriangleVertex(RefSurf,A+2,0))
		
		vert1 = AddVertex (Surf,X1,Y1,Z1,U1,V1)	;Original
		vert2 = AddVertex (Surf,X2,Y2,Z2,U2,V2)	;Original
		vert3 = AddVertex (Surf,X3,Y3,Z3,U3,V3)	;Original
		AddTriangle Surf,vert1,vert2,vert3
	Next
	UpdateNormals Destmesh
	FreeEntity Mesh
	Return Destmesh
	
End Function  

;#End Region

.Planet
Data   0.0,  2, 43, 68   ; very dark blue: deep water 
Data  10.0,  9, 62, 92   ; dark blue: water
Data  20.0, 17, 82,112   ; blue: shallow water
Data  49.0, 69,108,118   ; light blue: shore
Data  50.0,255,246,143   ; gold:Beach
Data  51.0, 42,102, 41   ; green: grass
Data  85.0,115,128, 77   ; light green: veld
Data  90.0,153,143, 92   ; brown: tundra
Data  97.0,179,179,179   ; grey: rocks
Data 100.0,255,255,255   ; white: snow

;Color Gradient
Function CreateGradient(colors%,steps%)
	
	Dim GradientR(steps),GradientG(steps),GradientB(steps),Percent(colors),Red(colors),Green(colors),Blue(colors)
	
	Local i%,pos1%,pos2%,pdiff%
	Local rdiff%,gdiff%,bdiff%
	Local rstep#,gstep#,bstep#
	Local counter%=1
	
    ; read color codes
	For i=1 To colors : Read Percent(i),Red(i),Green(i),Blue(i) : Next
	
    ; calculate gradient
	While counter<colors
		
        ; transform percent value into step position
		pos1%=Percent(counter)*steps/100
		pos2%=Percent(counter+1)*steps/100
		
        ; calculate position difference
		pdiff%=pos2-pos1
		
        ; calculate color difference
		rdiff%=Red(counter)-Red(counter+1)
		gdiff%=Green(counter)-Green(counter+1)
		bdiff%=Blue(counter)-Blue(counter+1)
		
        ; calculate color steps
		rstep#=rdiff*1.0/pdiff
		gstep#=gdiff*1.0/pdiff
		bstep#=bdiff*1.0/pdiff
		
        ; calculate "in-between" color codes
		For i=0 To pdiff
			
			GradientR(pos1+i)=Int(Red(counter)-(rstep*i))
			GradientG(pos1+i)=Int(Green(counter)-(gstep*i))
			GradientB(pos1+i)=Int(Blue(counter)-(bstep*i))
			
		Next
		
        ; increment counter
		counter=counter+1
		
	Wend
	
End Function

Function CalcSphereNormals(Mesh)
	surf=GetSurface(Mesh,1)
	
	For v=0 To CountVertices(surf)-1
		
		VX#=VertexX(surf,v)
		VY#=VertexY(surf,v)
		VZ#=VertexZ(surf,v)
		
		TFormNormal VX#, VY#, VZ#, 0, 0
		VertexNormal surf,v, TFormedX(), TFormedY(), TFormedZ()
	Next
End Function

Code Archives Forum