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