HeightMapped GeoSphere

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

HeightMapped GeoSphere by MusicianKool

2010

Update 3!
Create a tiled geosphere, so that not every triangle need be rendered. Planets can be millions of Triangles and still be fast!

Now using Improved 3d perlin noise to generate a heightmap. It looks pretty.

Future:
Foliage ?

Example below:

ms = MilliSecs()
Graphics3D 800,600,32,2
SetBuffer BackBuffer()
SeedRnd ms

Include "Planet Maker3.bb"

Global TotalTriangles
Global TotalTiles
Global TilesRendered

Tiles 				= 	32				;Tiles*Tiles per each face of the cube
Segments 			= 	8				;Segments*Segments per each Tile of the cube
ImageSize 			= 	1024			;Imagesize must be a power of 2
PlanetSize			= 	100				;Scale the planet n times bigger
PlanetRenderRange 	= 	PlanetSize/2	;The range at which the tile will be render
seed 	   			= 	Rand(0,999999)	;Random seed (anything larger then this will produce bad perlin noise)		
MinOctaves 			=	0				;Minimum Octave
MaxOctaves 			=	0				;Maximum Octave
Multiplier#			=	.1				;Height multiplier (1=very tall, 0 = flat)
Offset#				=	.1				;Height Offset (0 = normal, > 0 force higher, < 0 force lower)
Scale#	   			= 	((((tiles*tiles*6)*(Segments*Segments))/Tiles ))/Segments *2
;Scale# of the randomness:
; (((((tiles*tiles*6)*(Segments*Segments))/Tiles )) = extreme Random) (0 = no random)


SeedRnd seed


Camera = CreateCamera()
Light = CreateLight()

PositionEntity Camera,0,0,-(PlanetSize+(planetsize/3)),1
PositionEntity Light,0,0,-(PlanetSize*2)
AmbientLight (255,255,255)

Locate 0,0
Cls:Print "Creating HeightMap.":Flip
PHM = CreateImage(ImageSize,Imagesize)

Locate 0,0
Cls:Color 255,255,255:Print "Creating Tiled Segmented cube.":Flip
Planet = CreatePivot()
CreateSegCube(tiles,segments,Planet);Create a Segmented Cube

Locate 0,0
Cls:Color 255,255,255:Print "Applying HeightMap to Tiled Segmented cube and making Geosphere.":Flip

GeodesicHeightmapedSphere(PHM,scale#,Multiplier#,Offset,Seed,MinOctaves,MaxOctaves,Planet)

For i = 0 To 6-1
	For j = 1 To tiles*tiles
		CalcSphereNormals(GetChild(Planet,j+i*(Tiles*Tiles)))
	Next
Next
SaveImage PHM,"PHM.BMP"
PT = Create_Load_HeightMappedTexture(PHM)

SetupTiles(planet,tiles,PlanetSize)

Locate 0,0
Cls:Color 255,255,255:Print "Applying Texture and Detail to each tile.":Flip
detail 	= 	LoadTexture( "detail.png")
ApplyTexture(planet,tiles,PT,detail)

final = MilliSecs()-ms

ScaleEntity Planet,PlanetSize,PlanetSize,PlanetSize
PointEntity light,Planet ;point the light at the Mesh
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

While Not KeyHit(1)
	Cls
	HideShowTiles(Camera,planet,PlanetRenderRange,planetsize) ; show tiles within range.
	If KeyHit(57) Then wf=1-wf : WireFrame wf
	If KeyDown (17) Then MoveEntity camera,0,0,1 	;W
	If KeyDown (31) Then MoveEntity camera,0,0,-1	;S
	If KeyDown (30) Then MoveEntity camera,-.3,0,0	;A
	If KeyDown (32) Then MoveEntity camera,.3,0,0	;D
	If KeyDown (16) Then TurnEntity camera,0,0,2	;Q
	If KeyDown (18) Then TurnEntity camera,0,0,-2	;E
	
	TurnEntity camera,MouseYSpeed(),-MouseXSpeed(),0
	MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
	UpdateWorld
	RenderWorld
	Locate 0,0
	Print "Triangles Rendered: " + TrisRendered()
	Print "Total Triangles: " + TotalTriangles
	Print "Tiles Rendered: " + TilesRendered
	Print "Total Tiles: " + TotalTiles
	Print "Inital render time: " + final
	Print "Distance to Planet Core: " + EntityDistance#(camera,planet)
	Print "Render Distance: " + planetrenderrange
	Print "Closest Tile: " + ClosestTile#
	Flip
Wend
DeletePlanet(planet)
FreePerlin()
End

Engine below:

;Dim planetTiled#(1,1)
Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0)
Dim PlanetTiles(0,3)
Restore Planet
Global DEPTH = 256
Global ClosestTile#
CreateGradient(11,DEPTH)

;#Region GeoSphere & segmented cube

; transform a cube to sphere Using Heightmap Data
Function GeodesicHeightmapedSphere(SphereHeightMap,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))
				
				Spherical(vx#,vy#,vz#,Scale#)
				pn# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),IW,seed))
				
				col = ((pn#+Offset#))*255	;Convert Perlin noise to colorGradient
				If col < 0 Then col = 0		;limit color
				If col > 255 Then col = 255 ;limit color
				
				argb = Get_ARGB_From(col,col,col);Convert color to ARGB
				WritePixelFast u,v,argb,ImageBuffer (SphereHeightMap)	;Write pixel to Texture
				
				sx# = Spherical_X#((1.0+Offset#) + (pn#*Multiplier#))
				sy# = Spherical_Y#((1.0+Offset#) + (pn#*Multiplier#))
				sz# = Spherical_Z#((1.0+Offset#) + (pn#*Multiplier#))
				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 PlanetTiles((Tiles*Tiles)*6,3)
	; sides
	For side=0 To 3
		For t = 0 To tiles-1
			For q = 0 To tiles-1
				mesh%=CreateMesh( parent )
				surf=CreateSurface( mesh )
				PlanetTiles(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 )
				PlanetTiles(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
	
	RotateEntity parent,0,0,180
End Function

Function ApplyTexture(Planet,tiles,PlanetTexture,Detail = 0)
	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

;#End Region 


;#Region Cube Heightmap Grayscale to color

Function Create_Load_HeightMappedTexture(HM)
	Local Texture%
	Texture = CreateImage(ImageWidth(HM),ImageHeight(HM))
	Convert_Gray_Color(Texture,HM)
	SaveBuffer ImageBuffer(Texture),"tx"+(i)+".bmp"
	FreeImage Texture
	Texture = LoadTexture ("tx"+i+".bmp",1+16+32)
	Return Texture
End Function

Function Convert_Gray_Color(t,H)
	tw = ImageWidth( t)
	th = ImageHeight( t)
	LockBuffer ImageBuffer(t)
	LockBuffer ImageBuffer (H)
	For y = 0 To tH
		For x = 0 To tw
			cc = ReadPixelFast (x,y,ImageBuffer(H))
			i = (Get_RED_From(cc))
			r = GradientR(i)
			g = GradientG(i)
			b = GradientB(i)
			WritePixelFast x,y,Get_ARGB_From(r,g,b),ImageBuffer(t)
		Next
	Next
	UnlockBuffer ImageBuffer(t)
	UnlockBuffer ImageBuffer(H)
End Function

;#End Region


;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

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

;========================================
;		     Color Functions
;#Region  ;========================================

Function Get_ARGB_From(r,g,b):		Return b Or(g Shl 8)Or(r Shl 16):	End Function

Function Get_ALPHA_From(ARGB):		Return ARGB Shr 32 And %11111111 :	End Function

Function Get_RED_From(ARGB):	    Return ARGB Shr 16 And %11111111 :	End Function

Function Get_GREEN_From(ARGB):		Return ARGB Shr 8 And %11111111 :	End Function

Function Get_BLUE_From(ARGB):		Return ARGB 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
;#End Region

Function HideShowTiles(Source,Parent,Distance#,scale#)
	TilesRendered = 0:ClosestTile# = 99999
	For i = 0 To TotalTiles-1
		ent = PlanetTiles(i,0)
		ex# = PlanetTiles(i,1):ey# = PlanetTiles(i,2):ez# = PlanetTiles(i,3)
		sX# = -EntityX#(Source,1):sY# = -EntityY#(Source,1):sZ# = EntityZ#(Source,1)
		Dist# = ((eX#-sX#)*(eX#-sX#) + (eY#-sY#)*(eY#-sY#) + (eZ#-sZ#)*(eZ#-sZ#))
		If dist# < Distance#*Distance# Then 
			di# = Sqr(dist#)
			If  di# < ClosestTile# Then ClosestTile# = di#
			ShowEntity (ent)
			TilesRendered = TilesRendered + 1
		Else
			HideEntity (ent)
		EndIf
	Next
End Function

Function SetupTiles(Parent,Tiles,Scale#)
	For i = 0 To totaltiles-1
		ent = PlanetTiles(i,0)
		surf = GetSurface(ent,1)
		cv = CountVertices(surf)/2
		PlanetTiles(i,1) = VertexX#(surf,cv)*Scale#
		PlanetTiles(i,2) = VertexY#(surf,cv)*Scale#
		PlanetTiles(i,3) = VertexZ#(surf,cv)*Scale#
	Next
End Function

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


;========================================
;			Perlin Noise
;#Region;========================================
	
;#Region ImprovedPerlin
;Define the Permutation and Gradient Lookup Bank
Const PermutationLimit= 512
Global PermutationBank = CreateBank ((PermutationLimit*2)*4)
Global GradientBank = CreateBank ((PermutationLimit*2)*4)

;#Region ;Create Permutations
Dim perm ( PermutationLimit)
For i = 0 To PermutationLimit-1
	perm(i) = i
Next

For i = 0 To PermutationLimit-1
	j = Rand(0,PermutationLimit-1)
	t = perm(j)
	perm(j) = perm(i)
	perm(i) = t
Next

;Fill PermutationBank and GradientBank
For i=0 To PermutationLimit -1
	PokeInt PermutationBank,i*4,perm(i+1)
	PokeInt PermutationBank,(PermutationLimit+i)*4,perm(i+1)
	PokeFloat GradientBank,i*4,Rnd(-.7,.7)
	PokeFloat GradientBank,(PermutationLimit+i)*4,Rnd(-.7,.7)
Next
Dim perm(0) ;free this Dim
;#End Region

Function Perlin2D( Image , ImageType , Seed , z# )
	If ImageType = 0 Then IB = ImageBuffer(Image):size = ImageWidth(Image)
	If ImageType = 0 Then LockBuffer IB
	If ImageType = 1 Then IB = TextureBuffer(Image):size = TextureWidth(Image)
	If ImageType = 1 Then LockBuffer IB
	For x = 0 To size-1
		For y = 0 To size-1
			col# = ( Perlin3D#( Float x, Float y , Float z , size , Seed)) * (255/2)
			If col < 0 Then col = 0
			If col > 255 Then col = 255
			rgb = Get_ARGB_From(col,col,col)
			WritePixelFast x,y,rgb,IB
		Next
	Next
	UnlockBuffer IB
End Function

Function SmoothNoise#( x#, y#, z#,Seed = 0) 
	x = x + Seed: y = y + Seed: z = z + Seed
	Local x1#,y1#,z1#,u#,v#,w#,a#,aa#,ab#,b#,ba#,bb#
	Local g1#,g2#,g3#,g4#,g5#,g6#,g7#,g8#
	Local l1#,l2#,l3#,l4#,l5#,l6#,l7#
	x1 = ( Floor(x) And (PermutationLimit-1) );,                  // FIND UNIT CUBE THAT
	y1 = ( Floor(y) And (PermutationLimit-1) );,                  // CONTAINS POINT.
	z1 = ( Floor(z) And (PermutationLimit-1) );,
	x = x - Floor( x );                                // FIND RELATIVE X,Y,Z
	y = y - Floor( y );                                // OF POINT IN CUBE.
	z = z - Floor( z );
	u# = fade#(x);,                                // COMPUTE FADE CURVES
	v# = fade#(y);,                                // FOR EACH OF x,y,z.
	w# = fade#(z);
	a#  = PeekInt(PermutationBank, x1*4)    +y1
	aa# = PeekInt(PermutationBank, a*4)     +z1
	ab# = PeekInt(PermutationBank, (a+1)*4) +z1;,      // HASH COORDINATES OF
	b#  = PeekInt(PermutationBank, (x1+1)*4)+y1
	ba# = PeekInt(PermutationBank, b*4)     +z1
	bb# = PeekInt(PermutationBank, (b+1)*4) +z1;      // THE 8 CUBE CORNERS,
	
	g1# = PeekFloat(GradientBank,(bb+1)*4)
	g2# = PeekFloat(GradientBank,(ab+1)*4)
	g3# = PeekFloat(GradientBank,(ba+1)*4)
	g4# = PeekFloat(GradientBank,(aa+1)*4)
	g5# = PeekFloat(GradientBank,(bb)*4)
	g6# = PeekFloat(GradientBank,(ab)*4)
	g7# = PeekFloat(GradientBank,(ba)*4)
	g8# = PeekFloat(GradientBank,(aa)*4)

	l1# = lerp#(u, g2#, g1#)
	l2# = lerp#(u, g4#, g3#)
	l3# = lerp#(v, l2#, l1#)
	l4# = lerp#(u, g6#, g5#)
	l5# = lerp#(u, g8#, g7#)
	l6# = lerp#(v, l5#, l4#)
	l7# = lerp#(w, l6#, l3#)
	Return l7#
End Function

Function fade#( t# ) 
	;s# = t * t * t * (t * (t * 6 - 15) + 10)
	s# = t * t * (3 - 2 * t)
	Return s#
End Function
	

Function lerp#( t#, a#, b#): z# = a + t * (b - a): Return z#:End Function

Function Perlin3D#(x#,y#,z#,size#=64,seed% = 0) 
		If seed = 0 Then seed = MilliSecs()
		x# = x# + seed
		y# = y# + seed
		z# = z# + seed
		;//Set the initial value and initial size
		value# = 0.0: initialSize# = size#;
		
		;//Add finer and finer hues of smoothed noise together
		While(size >= 1.0) 
	
			value# = value# + SmoothNoise#(x / size, y / size, z / size, seed) * size
			size = size / 2.0;
			
		Wend
		
		;//Return the result over the initial size
		Return  (value# / Float initialSize);
	
End Function

Function FreePerlin()
	FreeBank PermutationBank
	FreeBank GradientBank
End Function

;#End Region

;#End Region

...

Comments

MusicianKool

2010

...

lo-tekk

2010

This is really cool.

RifRaf

2010

very cool indeed.
just needs a way to used tiled textures for realtime up close environments

MusicianKool

2010

...

Krischan

2010

You could use Perlin Noise to generate a more realistic environment, should be faster, too. Here is an example how to apply noise to a spherized cube, including gradients for different types of planets (press SPACE to see the wireframed cube):

ms=MilliSecs()

SeedRnd ms

Global initseed%	= Rand(0,999999)			; planet seed
Const maxoctaves%	= 9							; maximum octaves to generate
Const range%		= 63						; leave untouched
Const persist#		= 0.66						; noise persistance
Const octaves%		= 4							; number of noise octaves
Const shininess		= 0.25						; planet shininess
Const size			= 16						; patch size

Global min%=255,max%=0,maps%=0
Local patch[2]

Dim s#(maxoctaves,2),r#(range,range,range)
Dim Noisemap%(23,65536),VertexBuffer%(128,128),MeshPart%(23)
Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0)

Restore ClassMT       : CreateGradient(9,255)		; Class M temperate
;Restore ClassMD       : CreateGradient(9,255)		; Class M dry
;Restore ClassMF       : CreateGradient(9,255)		; Class M frozen
;Restore ClassMO       : CreateGradient(9,255)		; Class M oceanic
;Restore Io            : CreateGradient(9,255)		; Io
;Restore Mars          : CreateGradient(9,255)		; Mars
;Restore Venus         : CreateGradient(9,255)		; Venus
;Restore Starflight1   : CreateGradient(9,255)		; Starflight 1 nostalgic (dry)
;Restore Starflight2   : CreateGradient(9,255)		; Starflight 1 nostalgic (frozen)
;Restore Starflight3   : CreateGradient(9,255)		; Starflight 1 nostalgic (volcanic)
;Restore Starflight4   : CreateGradient(9,255)		; Starflight 1 nostalgic (earthlike)

InitNoise(initseed,persist)

Graphics3D 800,600,32,2

; planet pivot
pivot=CreatePivot()
campivot=CreatePivot()

cam=CreateCamera(campivot)
PositionEntity cam,3,2,-5
CameraRange cam,0.1,120
CameraZoom cam,3

patch[0]=CreatePatch(size,1.0/(size)) : RotateMesh patch[0],  0,180,  0 : PositionMesh patch[0],0.5,0.5,-0.5
patch[1]=CreatePatch(size,1.0/(size)) : RotateMesh patch[1],  0,270,  0 : PositionMesh patch[1],0.5,0.5,-0.5
patch[2]=CreatePatch(size,1.0/(size)) : RotateMesh patch[2],270,  0,  0 : PositionMesh patch[2],0.5,0.5,-0.5


For i=0 To 7
	
	For j=0 To 2
		
		If counter<12 Then
			MeshPart(counter)=AddSpherePart(patch[j],pivot,shininess,  0, i*90,0)
		Else
			MeshPart(counter)=AddSpherePart(patch[j],pivot,shininess,180, i*90,0)
		EndIf
		
		counter=counter+1
		
	Next
	
Next

FreeEntity patch[0]
FreeEntity patch[1]
FreeEntity patch[2]

NormalizeNoise(0)
AlignPatches()
CalcSphereNormals()

; light source
light=CreateLight(1)
PositionEntity light,-1000,0,0
AmbientLight 1,2,4

MoveMouse 400,300

ende=MilliSecs()-ms

While Not KeyHit(1)
	
	If KeyHit(57) Then wf=1-wf : WireFrame wf
	
	; turn planet with mouse
	mxs#=MouseXSpeed()
	mys#=MouseYSpeed()
	TurnEntity pivot,0,mxs,0
	TurnEntity campivot,mys,0,mys
	MoveEntity cam,(KeyDown(205)-KeyDown(203))*2.0/30,0,(KeyDown(200)-KeyDown(208))*1.0/30 
	PointEntity cam,pivot
	
	RenderWorld
	
	Text 0, 0,"Tris.......: "+TrisRendered()
	Text 0,15,"Planet Seed: "+initseed
	Text 0,30,"Calc time..: "+ende+"ms"
	
	Flip 0
	
Wend

End

Function AddSpherePart(mesh%,pivot%,shininess#,rx#=0,ry#=0,rz#=0)
	
	Local m%=CopyMesh(mesh,pivot)
	Cube2Sphere(m)
	EntityFX m,2
	EntityShininess m,shininess
	RotateMesh m,rx,ry,rz
	AddNoise(m)
	;UpdateNormals m
	
	Return m
	
End Function
	
; calculate spherical X
Function SphericalX#(x#,y#,z#)
	
	Return x*Sqr(1.0-y*y*0.5-z*z*0.5+y*y*z*z*1.0/3)
	
End Function

; calculate spherical Y
Function SphericalY#(x#,y#,z#)
	
	Return y*Sqr(1.0-z*z*0.5-x*x*0.5+z*z*x*x*1.0/3)
	
End Function

; calculate spherical Z
Function SphericalZ#(x#,y#,z#)
	
	Return z*Sqr(1.0-x*x*0.5-y*y*0.5+x*x*y*y*1.0/3)
	
End Function

; transform a cube patch to sphere patch
Function Cube2Sphere(mesh%)
	
	Local s%,surf%,v%
	Local vx#,vy#,vz#
	
	For s=1 To CountSurfaces(mesh)
		
		surf=GetSurface(mesh,s)
		
		For v=0 To CountVertices(surf)-1
			
			vx=VertexX(surf,v)
			vy=VertexY(surf,v)
			vz=VertexZ(surf,v)
			
			VertexCoords surf,v,SphericalX(vx,vy,vz),SphericalY(vx,vy,vz),SphericalZ(vx,vy,vz)
			
		Next
		
	Next
	
End Function

Function AlignPatches()
	
	AlignMeshVertices(MeshPart( 0),MeshPart( 1),size,1,3)
	AlignMeshVertices(MeshPart( 1),MeshPart( 2),size,0,3)
	AlignMeshVertices(MeshPart( 3),MeshPart( 4),size,1,3)
	AlignMeshVertices(MeshPart( 4),MeshPart( 5),size,0,3)
	AlignMeshVertices(MeshPart( 6),MeshPart( 7),size,1,3)
	AlignMeshVertices(MeshPart( 7),MeshPart( 8),size,0,3)
	AlignMeshVertices(MeshPart( 9),MeshPart(10),size,1,3)
	AlignMeshVertices(MeshPart(10),MeshPart(11),size,0,3)
	AlignMeshVertices(MeshPart(12),MeshPart(13),size,1,3)
	AlignMeshVertices(MeshPart(13),MeshPart(14),size,0,3)
	AlignMeshVertices(MeshPart(15),MeshPart(16),size,1,3)
	AlignMeshVertices(MeshPart(16),MeshPart(17),size,0,3)
	AlignMeshVertices(MeshPart(18),MeshPart(19),size,1,3)
	AlignMeshVertices(MeshPart(19),MeshPart(20),size,0,3)
	AlignMeshVertices(MeshPart(21),MeshPart(22),size,1,3)
	AlignMeshVertices(MeshPart(22),MeshPart(23),size,0,3)
	
End Function


Function NormalizeNoise(offset%=0)
	
	If offset>0 Then max=max+offset
	If offset<0 Then min=min+offset
	
	For i=0 To maps-1
		
		surf=GetSurface(MeshPart(i),1)
		
		For v=0 To CountVertices(surf)-1
			
			h=Norm(Noisemap(i,v),min,max,0,255)
			
			r1=GradientR(h)
			g1=GradientG(h)
			b1=GradientB(h)
			VertexColor surf,v,r1,g1,b1
			
			If h<128 Then
			
				d#=Norm(Noisemap(i,v),min,max,0.1,-0.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()
				
				nx#=vx+(TFormedX()*d)
				ny#=vy+(TFormedY()*d)
				nz#=vz+(TFormedZ()*d)
				VertexCoords surf,v,nx,ny,nz
				
				
			
			EndIf
		
		Next
		
	Next
	
End Function

Function CalcSphereNormals()
	For i=0 To maps-1
		surf=GetSurface(MeshPart(i),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
	Next
End Function

Function AlignMeshVertices(mesh1%,mesh2%,size%,side1%=0,side2%=0)
	
	Local surf1%=GetSurface(mesh1,1)
	Local surf2%=GetSurface(mesh2,1)
	
	Local i%,s%,t%
	Local x#,y#,z#,r1%,g1%,b1%
	
	For i=0 To size
		
		; 0 = up
		; 1 = left
		; 2 = down
		; 3 = right
		
		If side1=0 Then s=(size^2)+size+i
		If side1=1 Then s=(size*i)+i
		If side1=2 Then s=i
		If side1=3 Then s=(size*i)+size+i
		
		If side2=0 Then t=(size^2)+size+i
		If side2=1 Then t=(size*i)+i
		If side2=2 Then t=i
		If side2=3 Then t=(size*i)+size+i
		
		r1=VertexRed(surf1,s)
		g1=VertexGreen(surf1,s)
		b1=VertexBlue(surf1,s)
		
		x=VertexX(surf1,s)
		y=VertexY(surf1,s)
		z=VertexZ(surf1,s)
		
		VertexColor surf2,t,r1,g1,b1
		VertexCoords surf2,t,x,y,z
		
	Next
	
	
End Function

; adds noise to mesh vertices using a gradient
Function AddNoise(mesh%)
	
	Local sc%,surf%,v%
	Local x#,y#,z#,h#
	
	For sc=1 To CountSurfaces(mesh)
		
		surf=GetSurface(mesh,sc)
		
		For v=0 To CountVertices(surf)-1
			
			x=VertexX(surf,v)+1
			y=VertexY(surf,v)+1
			z=VertexZ(surf,v)+1
			
			h=Int(Floor(Interpolate(x,y,z,octaves)*255))
			
			If h<min Then min=h Else If h>max Then max=h
			
			Noisemap(maps,v)=h
			
		Next
		
	Next
	
	maps=maps+1
	
End Function

; normalize a value
Function Norm#(v#=128.0,vmin#=0.0,vmax#=255.0,nmin#=0.0,nmax#=1.0)
	
	Return ((v-vmin)/(vmax-vmin))*(nmax-nmin)+nmin
	
End Function

; interpolate 3D point
Function Interpolate#(x#,y#,z#,octaves%)
	
	Local h#=0
	Local oct%
	Local fre#,amp#,xx%,yy%,zz%
	Local xb#,yb#,zb#,xa#,ya#,za#
	Local v000#,v100#,v010#,v001#,v101#,v110#,v011#,v111#
	
	octaves=octaves-1
	If octaves<=0 Then octaves=0
	If octaves=>maxoctaves Then octaves=maxoctaves
	
	For oct=0 To octaves
		
		fre=s(oct,0)
		amp=s(oct,1)
		
		xx=DBInt(x*fre)
		yy=DBInt(y*fre)
		zz=DBInt(z*fre)
		
		xb=CosinusInterpolation((x*fre)-Float(xx))
		yb=CosinusInterpolation((y*fre)-Float(yy))
		zb=CosinusInterpolation((z*fre)-Float(zz))
		xa=1-xb
		ya=1-yb
		za=1-zb
		
		v000=RandomPoint(xx,yy,zz)*xa*ya*za
		v100=RandomPoint(xx+1,yy,zz)*xb*ya*za
		v010=RandomPoint(xx,yy+1,zz)*xa*yb*za
		v001=RandomPoint(xx,yy,zz+1)*xa*ya*zb
		v101=RandomPoint(xx+1,yy,zz+1)*xb*ya*zb
		v110=RandomPoint(xx+1,yy+1,zz)*xb*yb*za
		v011=RandomPoint(xx,yy+1,zz+1)*xa*yb*zb
		v111=RandomPoint(xx+1,yy+1,zz+1)*xb*yb*zb
		
		h=h+(v000+v100+v010+v001+v101+v110+v011+v111)*amp
		
	Next
	
	h=h*s(octaves,2)
	
	Return h
	
End Function

; get random point
Function RandomPoint#(x,y,z)
	
	If x<0 Then x=x-(DBInt((x/64)-1)*64) Else x=x-(DBInt(x/64)*64)
	If y<0 Then y=y-(DBInt((y/64)-1)*64) Else y=y-(DBInt(y/64)*64)
	If z<0 Then z=z-(DBInt((z/64)-1)*64) Else z=z-(DBInt(z/64)*64)
	
	Return r(x,y,z)
	
End Function

; cosinus interpolation
Function CosinusInterpolation#(v#)
	
	Return (1-Cos(v*180))*0.5
	
End Function

; inits noise (positive values only!)
Function InitNoise(seed%,persistance#)
	
	Local x%,y%,z%,i%,j%
	
	SeedRnd seed
	
	For x=0 To range
		For y=0 To range
			For z=0 To range
				r#(x,y,z)=Noise(x,y,z,seed)
				;r#(x,y,z)=Rnd(1)
			Next
		Next
	Next
	
	For i=0 To maxoctaves
		
		s(i,0)=2^i
		s(i,1)=persistance^i
		s(i,2)=0.0
		
		For j=0 To i
			
			s(i,2)=s(i,2)+s(j,1)
			
		Next
		
		s(i,2)=1.0/s(i,2)
		
	Next
	
End Function

; the 3D perlin noise machine
Function Noise#(x%,y%,z%,seed)
	
	Local n%=x+y*57+z*131+seed
	
	n=n Shl (13^n)
	
	Return (1.0-((n*(n*n*15731+789221)+1376312589) And $7fffffff)/1073741824.0)
	
End Function

; "intelligent" INT
Function DBInt(x#)
	
	If x>=0 Then Return Floor(x) Else Return Ceil(x)
	
End Function

; creates a nice 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
	
	For i=1 To colors : Read Percent(i),Red(i),Green(i),Blue(i) : Next
	
	While counter<colors
		
		pos1=Percent(counter)*steps/100
		pos2=Percent(counter+1)*steps/100
		
		pdiff=pos2-pos1
		
		rdiff%=Red(counter)-Red(counter+1)
		gdiff%=Green(counter)-Green(counter+1)
		bdiff%=Blue(counter)-Blue(counter+1)
		
		rstep#=rdiff*1.0/pdiff
		gstep#=gdiff*1.0/pdiff
		bstep#=bdiff*1.0/pdiff
		
		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
		
		counter=counter+1
		
	Wend
	
End Function

Function CreatePatch(size%,scale#)
	
	Local x%,z%,v#,u#,v0%,v1%,v2%,v3%
	
	; create mesh and surface
	Local mesh%=CreateMesh()
	Local surf%=CreateSurface(mesh)
	
	For z=0 To size
		
		For x=0 To size
			
			; calculate uv coordinates that the texture fits to the tile
			u=x*1.0/size
			v=z*1.0/size*-1
			
			; set vertexposition
			VertexBuffer(x,z)=AddVertex (surf,-((size)/2.0)+x,-((size)/2.0)+z,size/2,u,v)
			VertexColor surf,VertexBuffer(x,z),255,255,255,1.0
			
		Next
		
	Next
	
	; set triangles
	For z=0 To size-1
		
		For x=0 To size-1
			
			v0=VertexBuffer(x,z)
			v1=VertexBuffer(x+1,z)
			v2=VertexBuffer(x+1,z+1)
			v3=VertexBuffer(x,z+1)
			
			AddTriangle (surf,v0,v2,v1)
			AddTriangle (surf,v0,v3,v2)
			
		Next
		
	Next
	
	; position, scale and fx
	ScaleMesh mesh,scale,scale,scale
	
	FlipMesh mesh
	
	Return mesh
	
End Function

.ClassMT
Data   0,255,255,255
Data   5,179,179,179
Data  10,153,143, 92
Data  25,115,128, 77
Data  45, 42,102, 41
Data  50, 69,108,118
Data  65, 17, 82,112
Data  75,  9, 62, 92
Data 100,  9, 62, 92

.ClassMD
Data    0,255,255,255
Data   10,219,191,143
Data   15,214,153,103
Data   20,181,148,105
Data   30,158,128, 79
Data   48,128,106, 70
Data   50,108,138,141
Data   52, 90,125,144
Data  100, 45, 94,101

.ClassMF
Data    0,238,255,255
Data   15,221,238,255
Data   25,187,221,238
Data   35,153,204,238
Data   45,153,187,221
Data   60,136,170,221
Data   75,119,153,204
Data   90,102,136,170
Data  100, 85,119,170

.ClassMO
Data   0,153,143, 92
Data   2,115,128, 77
Data   8, 42,102, 41
Data  10, 69,108,118
Data  12, 17, 82,112
Data  70,  9, 62, 92
Data  98,  2, 43, 68
Data  99,  2, 43, 68
Data 100,  2, 43, 68

.Mars
Data    0,235,221,131
Data    5,235,201,102
Data   10,222,159, 57
Data   15,211,137, 64
Data   25,200,121, 42
Data   45,162, 93, 31
Data   50,164, 77, 36
Data   70,134, 72, 43
Data  100, 98, 43, 24

.Venus
Data    0,255,238,187
Data   10,255,221,170
Data   20,255,221,153
Data   30,255,204,136
Data   50,238,187,119
Data   70,255,204,136
Data   80,255,221,153
Data   90,255,221,170
Data  100,255,238,187

.Io
Data    0,225,226,198
Data    5,244,238,147
Data   10,226,198, 28
Data   35,226,113,  0
Data   50,200, 67,  2
Data   60,170,  0,  0
Data   70,138, 56,  6
Data   80,118, 46,  3
Data  100, 92, 35,  1

.Starflight1
Data    0,255,255,255
Data   10,255,239,206
Data   15,239,170,115
Data   20,222,154, 66
Data   30,206,101, 16
Data   40,156, 85, 49
Data   50,115, 69, 66
Data   60,  0,  0,222
Data  100,  0,  0,222

.Starflight2
Data    0,255,255,255
Data   10,206,223,255
Data   15,156,186,239
Data   20, 99,154,222
Data   30, 66,187,189
Data   40, 33,101,156
Data   50,  0, 85,140
Data   60,  0,  0,222
Data  100,  0,  0,222

.Starflight3
Data    0,255,255,255
Data   10,255,239,140
Data   15,255,223, 49
Data   20,255, 85, 82
Data   30,222,  0,  0
Data   40,173,  0, 66
Data   50,140,  0, 99
Data   60, 66,  0, 82
Data  100, 66,  0, 82

.Starflight4
Data    0,255,255,255
Data   10,239,223,189
Data   15,239,207, 99
Data   20,222,186, 16
Data   30,156,170, 49
Data   40,  0,154,  0
Data   50,  0,117,  0
Data   60,  0,  0,222
Data  100,  0,  0,222

RifRaf

2010

Christian, I sent you an email.. From gamemaker04@...

RifRaf

2010

ive modified the code christian posted, to convert each patche of vertex colors into a 512x512 texture. I then created a blending program to blend highres textures into the solid gradients, and reexport to a more editable large texture, unwrapped like a cubemap..

Here you can load the image into photoshop or whatever for editing, the unwrapped image is easy to edit.

I made another routine to reexport this larger cubemap into individual chunks to use on the planet. the results so far are shown here.

if your interested in the end result , ill try to wrap a gui around all the bits and upload it somewhere.

http://www.empowergames.com/rifs_planets_test.jpg?

thanks for the interesting code & ideas.

MusicianKool

2010

Very nice Kristian and RifRaf!

Kristian, yours looks great and is fast too.

Charrua

2010

very nice work guys!
Juan

Bobysait

2010

nice job

ps : your function "CreateSegCube()" does not return anything. It should return "Mesh"
Here, it only works if we set a parent on the call fo the function then GetChild() to access created mesh.

MusicianKool

2010

Bobysait That is because "CreateSegCube()" makes 6 meshes , for a higher poly planet.

MusicianKool

2010

update!

Ian Thompson

2010

interesting to see this evolve... nice code. ;)

MusicianKool

2010

Update!

MusicianKool

2010

Update 3!

Axel Wheeler

2010

Whoa! Did anyone really try this?

Here's the function:

Function GeodesicHeightmapedSphere(SphereHeightMap,Scale#,Multiplier#,Offset#,seed,Parent=0)

Here's the call:

GeodesicHeightmapedSphere(PHM,scale#,Multiplier#,Offset,Seed,MinOctaves,MaxOctaves,Planet)

Note the different signatures. Note the "Not enough parameters" error.

I guess the last update(s) changed the signature, but the example didn't change.

Please advise. Looks very interesting.

NoOdle

2010

Very interested in trying this but the code at the top doesnt run at the moment. Does anyone have a version that does?

Thanks

puki

2010

Why does it not run - do you get an error message? Did you create the include file: Planet Maker3.bb?

NoOdle

2010

I get a MAV, and yes I remembered to include the file lol

Blitzplotter

2010

It would appear that the function call at the top codebox wants to pass minoctaves and maxoctaves, the function in the codebox at the top doesn't have these. There is posts in this thread hinting at updates though.

I also tried excluding the function call with the extra minoctave & maxoctave to no avail - i.e. MAV. A debug compile reveals SphereHeightMap does not exist. Made my own heightmap (a 512x512 .bmp) & attempted to assign this to SphereHeightMap at which point I discovered the PHM.bmp within the compiling folder, therefore PHM.bmp is being successfully created.

Also created a detail.PNG (a 512x512 image just black & grey) to try & compile, no joy.

My attempt at getting it to complie with the modified codebox calling code fails here:

Function Get_ARGB_From(r,g,b): Return b Or(g Shl 8)Or(r Shl 16): End Function


ms = MilliSecs()
Graphics3D 800,600,32,2
SetBuffer BackBuffer()
SeedRnd ms

Include "Planet Maker3.bb"

Global TotalTriangles
Global TotalTiles
Global TilesRendered

Tiles 				= 	32				;Tiles*Tiles per each face of the cube
Segments 			= 	8				;Segments*Segments per each Tile of the cube
ImageSize 			= 	1024			;Imagesize must be a power of 2
PlanetSize			= 	100				;Scale the planet n times bigger
PlanetRenderRange 	= 	PlanetSize/2	;The range at which the tile will be render
seed 	   			= 	Rand(0,999999)	;Random seed (anything larger then this will produce bad perlin noise)		
MinOctaves 			=	0				;Minimum Octave
MaxOctaves 			=	0				;Maximum Octave
Multiplier#			=	.1				;Height multiplier (1=very tall, 0 = flat)
Offset#				=	.1				;Height Offset (0 = normal, > 0 force higher, < 0 force lower)
Scale#	   			= 	((((tiles*tiles*6)*(Segments*Segments))/Tiles ))/Segments *2
;Scale# of the randomness:
; (((((tiles*tiles*6)*(Segments*Segments))/Tiles )) = extreme Random) (0 = no random)


SeedRnd seed


Camera = CreateCamera()
Light = CreateLight()

PositionEntity Camera,0,0,-(PlanetSize+(planetsize/3)),1
PositionEntity Light,0,0,-(PlanetSize*2)
AmbientLight (255,255,255)

Locate 0,0
Cls:Print "Creating HeightMap.":Flip
PHM = CreateImage(ImageSize,Imagesize)

SphereHeightMap = PHM ;inserted by Blitzplotter - getting a children MAV now...
;SphereHeightMap=LoadImage ("heightmap.bmp")

Locate 0,0
Cls:Color 255,255,255:Print "Creating Tiled Segmented cube.":Flip
Planet = CreatePivot()
CreateSegCube(tiles,segments,Planet);Create a Segmented Cube

Locate 0,0
Cls:Color 255,255,255:Print "Applying HeightMap to Tiled Segmented cube and making Geosphere.":Flip

;GeodesicHeightmapedSphere(PHM,scale#,Multiplier#,Offset,Seed,MinOctaves,MaxOctaves,Planet) ; 
GeodesicHeightmapedSphere(SphereHeightMap,Scale#,Multiplier#,Offset#,seed,Planet)

;Function GeodesicHeightmapedSphere(SphereHeightMap,Scale#,Multiplier#,Offset#,seed,Parent=0)

For i = 0 To 6-1
	For j = 1 To tiles*tiles
		CalcSphereNormals(GetChild(Planet,j+i*(Tiles*Tiles)))
	Next
Next
SaveImage PHM,"PHM.BMP"
PT = Create_Load_HeightMappedTexture(PHM)

SetupTiles(planet,tiles,PlanetSize)

Locate 0,0
Cls:Color 255,255,255:Print "Applying Texture and Detail to each tile.":Flip
detail 	= 	LoadTexture( "detail.png")
ApplyTexture(planet,tiles,PT,detail)

final = MilliSecs()-ms

ScaleEntity Planet,PlanetSize,PlanetSize,PlanetSize
PointEntity light,Planet ;point the light at the Mesh
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

While Not KeyHit(1)
	Cls
	HideShowTiles(Camera,planet,PlanetRenderRange,planetsize) ; show tiles within range.
	If KeyHit(57) Then wf=1-wf : WireFrame wf
	If KeyDown (17) Then MoveEntity camera,0,0,1 	;W
	If KeyDown (31) Then MoveEntity camera,0,0,-1	;S
	If KeyDown (30) Then MoveEntity camera,-.3,0,0	;A
	If KeyDown (32) Then MoveEntity camera,.3,0,0	;D
	If KeyDown (16) Then TurnEntity camera,0,0,2	;Q
	If KeyDown (18) Then TurnEntity camera,0,0,-2	;E
	
	TurnEntity camera,MouseYSpeed(),-MouseXSpeed(),0
	MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
	UpdateWorld
	RenderWorld
	Locate 0,0
	Print "Triangles Rendered: " + TrisRendered()
	Print "Total Triangles: " + TotalTriangles
	Print "Tiles Rendered: " + TilesRendered
	Print "Total Tiles: " + TotalTiles
	Print "Inital render time: " + final
	Print "Distance to Planet Core: " + EntityDistance#(camera,planet)
	Print "Render Distance: " + planetrenderrange
	Print "Closest Tile: " + ClosestTile#
	Flip
Wend
DeletePlanet(planet)
FreePerlin()
End

@Krischan - love your planet maker! Krischans code mentions maxoctaves....

Eric

2011

Function Convert_Gray_Color(t,H)
	tw = ImageWidth( t)-1
	th = ImageHeight( t)-1
	LockBuffer ImageBuffer(t)
	LockBuffer ImageBuffer (H)
	For y = 0 To tH
		For x = 0 To tw
			cc = ReadPixelFast (x,y,ImageBuffer(H))
			i = (Get_RED_From(cc))
			r = GradientR(i)
			g = GradientG(i)
			b = GradientB(i)
			WritePixelFast x,y,Get_ARGB_From(r,g,b),ImageBuffer(t)
		Next
	Next
	UnlockBuffer ImageBuffer(t)
	UnlockBuffer ImageBuffer(H)
End Function

I am not sure if this is the entire fix, but I got the code to run... update the Planet Maker code.

tw = ImageWidth( t)-1
	th = ImageHeight( t)-1

-1 from the image dimensions.

Code Archives Forum