[bb] Improved Perlin Noise 2D and 3D by MusicianKool [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:39

Previous topic - Next topic
Print
Go Down Pages1
User actions

BlitzBot

June 29, 2017, 00:28:39
Title : Improved Perlin Noise 2D and 3D
Author : MusicianKool
Posted : 1+ years ago

Description : Update, I have converted the Improved perlin noise into a user library.  the examples below will only work with the blitz3d perlin code.  But can be modified to work with the User library.

Download the Blitz3d Userlib:
<a href="http://www.mediafire.com/?kwno5wnty4i" target="_blank">http://www.mediafire.com/?kwno5wnty4i</a> (Final)
<a href="http://www.mediafire.com/?2ynmwqyoqmz" target="_blank">http://www.mediafire.com/?2ynmwqyoqmz</a> (version 3)

Updated the 3d perlin mesh deform (little vector glitch).

Added Color Gradient by Krischan to the lib. (Hope thats ok.)  Found in the code archives.
<a href="codearcs63e7.html?code=2415" target="_blank">http://www.blitzbasic.com/codearcs/codearcs.php?code=2415</a>

Mesh deform used from the code archives as well.
<a href="codearcs8745.html?code=1120" target="_blank">http://www.blitzbasic.com/codearcs/codearcs.php?code=1120</a>

Fixed small bug that would sometimes access outside a banks size/range.

The Library.
Code Select

;#Region ImprovedPerlin
;Define the Permutation and Gradient Lookup Bank
Const Limit=1024
Global PermutationBank = CreateBank ((Limit*2)*4)
Global GradientBank = CreateBank ((Limit*2)*4)

;#region ;Create Permutations
Dim perm ( Limit)
For i = 1 To Limit
perm(i) = i
Next

For i = 1 To Limit
j = Rand(1,Limit)
t = perm(j)
perm(j) = perm(i)
perm(i) = t
Next

;Fill PermutationBank and GradientBank
For i=0 To limit-1
;Read perm
PokeInt PermutationBank,i*4,perm(i+1)
PokeInt PermutationBank,(Limit+i)*4,perm(i+1)
PokeFloat GradientBank,i*4,Rnd(-.7,.7)
PokeFloat GradientBank,(Limit+i)*4,Rnd(-.7,.7)
Next
Dim perm(0) ;free this Dim
;#end region

Function Perlin2D( Image , ImageType , Seed , z# , MinOctaves , MaxOctaves )
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, MinOctaves , MaxOctaves )) * (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 = Abs( Floor(x) Mod (limit-1) );,                  // FIND UNIT CUBE THAT
y1 = Abs( Floor(y) Mod (limit-1) );,                  // CONTAINS POINT.
z1 = Abs( Floor(z) Mod (limit-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):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, MinOctaves = 0 , MaxOctaves = 9999)
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#;

For i = 1 To MinOctaves
size = size/2
Next
;//Add finer and finer hues of smoothed noise together
While(size >= 1.0) And MaxOctaves > MinOctaves

value# = value# + SmoothNoise#(x / size, y / size, z / size, seed) * size
size = size / 2.0;
MaxOctaves = MaxOctaves - 1
Wend

;//Return the result over the initial size
Return  (value# / Float initialSize);

End Function

Function FreePerlin()
FreeBank PermutationBank
FreeBank GradientBank
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

;#Region Color Gradient maker
Restore Planet
Global DEPTH = 256
Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0)
CreateGradient(10,DEPTH)

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

;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

;#End Region

;#region Mesh Deformation
Global VertXBank = CreateBank()
Global VertYBank = CreateBank()
Global VertZBank = CreateBank()

Function InitMeshDeform(Mesh%)
; monkey with the verts
as1=GetSurface(Mesh,1)
; record the locations of the verts
VC = CountVertices(as1)
ResizeBank (VertXBank , vc*4)
ResizeBank (VertYBank , vc*4)
ResizeBank (VertZBank , vc*4)
For n=0 To VC-1
PokeFloat (VertXBank,n*4,VertexX#(as1,n))
PokeFloat (VertYBank,n*4,VertexY#(as1,n))
PokeFloat (VertZBank,n*4,VertexZ#(as1,n))
Next
End Function

Function MeshDeform(Image,Mesh%,Size,Seed,MinOctaves,MaxOctaves,Multiplyer#,z#,Scale#)
; monkey with the verts
as1=GetSurface(Mesh,1)
IS = TextureWidth(Image)
IB = TextureBuffer(Image)

LockBuffer IB

VC = CountVertices(as1)

For n= nnn To vc-1
;get UV coordinates
u# = VertexU#(as1,n)*IS-1
v# = VertexV#(as1,n)*IS-1

;get 3D Perlin Noise coordinates
VX# = PeekFloat (VertXBank,n*4)
VY# = PeekFloat (VertYBank,n*4)
VZ# = PeekFloat (VertZBank,n*4)

v1# = (VX#+z#)*Scale#
v2# = (VY#+z#)*Scale#
v3# = (VZ#+z#)*Scale#

;Get Perlin 3D noise at 3D Perlin Noise coordinates
pn# = Perlin3D#(v1#,v2#,v3#,Size,Seed,MinOctaves,MaxOctaves)
If pn# < 0 Then pn# = 0 ;Limit Noise to 0 or greater
col = Floor(255 - pn#*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(GradientR(col),GradientG(col),GradientB(col));Convert color to ARGB
WritePixelFast u,v,argb,IB ;Write pixel to Texture


Spherical(VX#,VY#,VZ#,1+pn#*Multiplyer) ;Calculate Spherical vector
xm# = Spherical_X() ;Get Spherical x vector
ym# = Spherical_Y() ;Get Spherical y vector
zm# = Spherical_Z() ;Get Spherical z vector

VertexCoords as1,n,xm#,ym#,zm#

Next

UnlockBuffer IB

End Function

;#end region

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

3D Mesh deformation!
Code Select
;Setup Blitz graphics and Buffer.
Graphics3D 800,600,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
;Include the Library.
Include "Improved Perlin Lib.bb"

seed   = 1200 ;Random seed (anything larger then this will produce bad perlin noise)
size   = 64 ;ImageSize power of 2
MinOctaves = 0 ;Minimum Octave
MaxOctaves = 11 ;Maximum Octave
ImageType   = 1 ;(0 = image: is disabled for this example), 1 = texture
Multiplyer# = .2 ;Height multiplier (1=very tall, 0 = flat)
Scale#   = size ;Scale of the randomness (255 = static) (0 = nothing)
SeedRnd seed

;Create an Image
Image = CreateTexture(size,size,257)


camera = CreateCamera()
PositionEntity camera,0,0,-3
sph = CreateSphere(8)
piv = CreatePivot()
light = CreateLight(2,piv)
PositionEntity light,0,0,-3
AmbientLight 0,0,0

ms = MilliSecs()
TempSphere = CreateSphere(size)
InitMeshDeform(tempsphere)
MeshDeform(Image,TempSphere,Size,Seed,MinOctaves,MaxOctaves,Multiplyer#, z#/10,Scale#)
EntityTexture TempSphere,Image
UpdateNormals TempSphere
Ms2 = MilliSecs()

While Not KeyHit(1)
Cls
If KeyDown(17) Then wf = 1 - wf:WireFrame(wf)
RenderWorld
If KeyDown (57)
FreeEntity TempSphere
ms = MilliSecs()
TempSphere = CreateSphere(size)
MeshDeform(Image,TempSphere,Size,Seed,MinOctaves,MaxOctaves,Multiplyer#, z#/10,Scale#)
EntityTexture TempSphere,Image
UpdateNormals TempSphere
ms2 = MilliSecs()
z# = z# + 1
Else
TurnEntity piv,0,1,3
TurnEntity tempsphere,0,-.1,0
EndIf

Text 0,0,"Done at (ms): "+(Ms2-ms)
Text 0,13,"Press or hold space to cycle through perlin noise!"
Text 0,24,"Triangles: " + TrisRendered()
Flip
Wend

FreePerlin()

End


3D Texture example!
Code Select
;Setup Blitz graphics and Buffer.
Graphics3D 800,600,32,2
SetBuffer BackBuffer()

;Include the Library.
Include "Improved Perlin Lib.bb"

seed   = 1200 ;Random seed
size   = 64 ;ImageSize
MinOctaves = 0 ;Minimum Octave
MaxOctaves = 11 ;Maximum Octave
ImageType  = 1 ;0 = image, 1 = texture

;Create an Image
If ImageType = 0 Then Image = CreateImage(size,size)
If ImageType = 1 Then Image = CreateTexture(size,size)

sphere = CreateSphere(64)
camera = CreateCamera()
PositionEntity camera,0,0,-3
AmbientLight 255,255,255
EntityTexture sphere,Image

While Not KeyHit(1)
Cls
ms = MilliSecs()
Perlin2D(Image,ImageType,seed,z,MinOctaves,MaxOctaves)
z = z + 1
RenderWorld
Text 0,0,"Done at (ms): "+(MilliSecs()-ms)
Flip
Wend

FreePerlin()

End


2D Example!
Code Select
;Setup Blitz graphics and Buffer.
Graphics3D 800,600,32,2
SetBuffer BackBuffer()

;Include the Library.
Include "Improved Perlin Lib.bb"


seed   = 1200 ;Random seed
size   = 256 ;ImageSize
MinOctaves = 0 ;Minimum Octave
MaxOctaves = 11 ;Maximum Octave
ImageType  = 0 ;0 = image, (1 = texture Not working in this example)

;Create an Image
Img = CreateImage(size,size)

While Not KeyHit(1)
Cls
ms = MilliSecs()
Perlin2D(img,ImageType,seed,z,MinOctaves,MaxOctaves)
z = z + 1
DrawImage Img,0,0
Color 255,255,255
Text GraphicsWidth()/2,GraphicsHeight()/2,"Done at (ms): "+(MilliSecs()-ms)
Flip
Wend

FreePerlin()

End


Code :
Code (blitzbasic) Select
...

Comments :


MusicianKool(Posted 1+ years ago)

 Update, Huge speed increase with 3d Perlin Mesh deformation.


lo-tekk(Posted 1+ years ago)

 I got a MAV running the 3d mesh example in line:
Code Select
WritePixelFast x,y,rgb,IB in the include file.


MusicianKool(Posted 1+ years ago)

 Try changing the line near the top fromImage = createtexture(imagesize,imagesize,257)toImage = createtexture(imagesize,imagesize)The 3D mesh Deformation example will only work on my system with the 257 flag.


Krischan(Posted 1+ years ago)

 This is really nice and very fast. Here some caribbean-style islands generated in runtime:
Code Select
Graphics3D 800,600,32,2

Const patches=16
Const scale#=2
Const detail#=128.0
Const octaves%=5
Const patchsize%=32
Const maxcols%=2^16
Const multi#=2.0


Dim p(512)
Dim grayd#(512)
;ms = MilliSecs()
Restore permutation
For i=0 To 256-1
Read perm
p(i) = ( perm )
p(256+i)= ( perm )
grayd#(i) = Rnd(-0.7,0.7)
grayd#(256+i) = Rnd(-0.7,0.7)
Next

Global GameSpeed%=60
Global Screenwidth%=GraphicsWidth()
Global Screenheight%=GraphicsHeight()
Global FramePeriod%=1000/GameSpeed
Global FrameTime%=MilliSecs()-FramePeriod
Global DeltaTimeOld%



Global min%,max%

Global PlanetR%[maxcols],PlanetG%[maxcols],PlanetB%[maxcols]
Dim Red%(0),Green%(0),Blue%(0),Percent#(0)
Restore Temperate
CreateGradient(11,maxcols,True,PlanetR,PlanetG,PlanetB)

Dim patch(patches,patches)

xoff=Rand(0,128)
yoff=Rand(0,128)


For x=0 To patches-1

For z=0 To patches-1

patch(x,z)=CreatePatch(patchsize,patchsize,x,z,xoff,yoff,scale,multi)
EntityFX patch(x,z),2

pt=pt+1

AppTitle "Generating Landscape: "+Int(pt*100.0/(patches^2))+"%"

If KeyHit(1) Then End

Next

Next

For x=0 To patches-2

For z=0 To patches-1

AlignMeshVertices(patch(x,z),patch(x+1,z),patchsize,3,1)

Next

Next

For x=0 To patches-1

For z=0 To patches-2

AlignMeshVertices(patch(x,z),patch(x,z+1),patchsize,0,2)

Next

Next


cam=CreateCamera()
CameraRange cam,0.001*scale,64*scale
PositionEntity cam,scale*patches/2.0,scale/2.0,-scale
CameraClsColor cam,150,200,255
CameraFogColor cam,150,200,255
CameraFogMode cam,1
CameraFogRange cam,1*scale,32*scale

sunpivot=CreatePivot()

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

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

water=CreateSprite()
SpriteViewMode water,2
PositionEntity water,scale*patches/2.0,0,scale*patches/2.0
RotateEntity water,90,0,0
ScaleSprite water,scale*patches/2.0,scale*patches/2.0
EntityFX water,1+16
EntityColor water,17,82,112
EntityBlend water,3

MoveMouse Screenwidth/2,Screenheight/2

While Not KeyHit(1)

; Frametween calculation
Local FrameElapsed%,FrameTicks%,FrameTween#,t%
Repeat FrameElapsed=MilliSecs()-FrameTime Until FrameElapsed
FrameTicks=FrameElapsed/FramePeriod
FrameTween=Float(FrameElapsed Mod FramePeriod)/Float(FramePeriod)

; Frametween loop
For t=1 To FrameTicks

; Frametween Captureworld
FrameTime=FrameTime+FramePeriod : If t=FrameTicks Then CaptureWorld

If KeyHit(57) Then wf=1-wf : WireFrame wf

FreeCam(cam,85,0.02*scale)

;TurnEntity sunpivot,0,1,0

Next

RenderWorld

Flip 0

Wend

End

; creates a nice color gradient
Function CreateGradient(colors%,steps%,inverse=False,R%[maxcols],G%[maxcols],B%[maxcols])

Dim Percent#(colors),Red%(colors),Green%(colors),Blue%(colors)

Local i%,pos1%,pos2%,pdiff%
Local rdiff%,gdiff%,bdiff%
Local rstep#,gstep#,bstep#
Local counter%=0

If inverse Then
For i=colors To 1 Step -1
Read Percent(i),Red(i),Green(i),Blue(i)
Percent(i)=100.0-Percent(i)
Next
Else
For i=0 To colors-1 : Read Percent(i),Red(i),Green(i),Blue(i) : Next
EndIf

    While counter<colors

        pos1=Percent(counter)*steps*1.0/100
pos2=Percent(counter+1)*steps*1.0/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

R[pos1+i]=Int(Red(counter)-(rstep*i))
G[pos1+i]=Int(Green(counter)-(gstep*i))
B[pos1+i]=Int(Blue(counter)-(bstep*i))

Next

        counter=counter+1

Wend

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

Function FreeCam(camera%,maxpitch#=85.0,movespeed#,rotspeed#=16.666,rotfloat#=8.0)

Local movex#,movez#,dx#,dy#,dk#,dt%,t%
Local pitch#

; Arrows = Move
movex=KeyDown(205)-KeyDown(203)
movez=KeyDown(200)-KeyDown(208)

; smooth movement
t=MilliSecs() : dt=t-DeltaTimeOld : DeltaTimeOld=t : dk=Float(dt)/rotspeed
dx=(Screenwidth/2-MouseX())*0.01*dk : dy=(Screenheight/2-MouseY())*0.01*dk
TurnEntity camera,-dy,dx*0.1*dk*rotfloat,0

; limit pitch
pitch=EntityPitch(camera,1) : If pitch>maxpitch Then pitch=maxpitch Else If pitch<-maxpitch Then pitch=-maxpitch

; rotate and move
RotateEntity camera,pitch,EntityYaw(camera,1),0,1
MoveEntity camera,movex*movespeed,0,movez*movespeed

End Function

Function CreatePatch(size%=32,seed%=1,xstart#=0.0,zstart#=0.0,xoff#=0.0,zoff#=0.0,scale#=1.0,yscale#=1.0)

Local x%,z%,h#,c%
Local vx#,vz#,u#,v#,vertex%
Local v0%,v1%,v2%,v3%

Local mesh%=CreateMesh()
Local surf%=CreateSurface(mesh)

For z=0 To size

For x=0 To size

; calculate vertex coordinates / texture coordinates
vx=1.0/size*x
vz=1.0/size*z
u=x*1.0/size
v=z*1.0/size

h=noise((x+((xstart+xoff)*size))*scale,(z+((zstart+zoff)*size))*scale,0,detail,seed,0,octaves)

If h<-1 Then h=-1 Else If h>1 Then h=1

;If h>-0.05 And h<0.05 Then h=0.01

If Not min Then min=0
If Not max Then max=maxcols

c=Floor(Normalize(h,-1,1,min,max))

If c<min Then min=c
If c>max Then max=c

s#=Sqr(size)/(size/4.0)

; place vertex
vertex=AddVertex(surf,vx*scale,Normalize(h,-1,1,-s,s)*yscale,vz*scale,u,v)

; set vertex color and texture coordinates
VertexColor surf,vertex,PlanetR[Int(c)],PlanetG[Int(c)],PlanetB[Int(c)],1

; set triangles
If z<size And x<size Then

v0=x+((size+1)*z)
v1=x+((size+1)*z)+(size+1)
v2=(x+1)+((size+1)*z)
v3=(x+1)+((size+1)*z)+(size+1)

AddTriangle(surf,v0,v1,v2)
AddTriangle(surf,v2,v1,v3)

EndIf

Next

Next

;Goto skip

For t=0 To CountTriangles(surf)-1

v0=TriangleVertex(surf,t,0)
v1=TriangleVertex(surf,t,1)
v2=TriangleVertex(surf,t,2)

vx0#=VertexX(surf,v0)
vy0#=VertexY(surf,v0)
vz0#=VertexZ(surf,v0)

vx1#=VertexX(surf,v1)
vy1#=VertexY(surf,v1)
vz1#=VertexZ(surf,v1)

vx2#=VertexX(surf,v2)
vy2#=VertexY(surf,v2)
vz2#=VertexZ(surf,v2)

px#=vx1-vx0
py#=vy1-vy0
pz#=vz1-vz0

qx#=vx2-vx0
qy#=vy2-vy0
qz#=vz2-vz0

nx#=(py*qz)-(pz*qy)
ny#=(pz*qx)-(px*qz)
nz#=(px*qy)-(py*qx)

VertexNormal surf,v0,nx,ny,nz
VertexNormal surf,v1,nx,ny,nz
VertexNormal surf,v2,nx,ny,nz

Next

.skip

;UpdateNormals mesh

PositionEntity mesh,xstart*scale,0,zstart*scale

Return mesh

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 255 );,                  // FIND UNIT CUBE THAT
y1 = ( Floor(y) And 255 );,                  // CONTAINS POINT.
z1 = ( Floor(z) And 255 );,
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# = p(x1)+y1
aa# = p(a)+z1
ab# = p(a+1)+z1;,      // HASH COORDINATES OF
b# = p(x1+1)+y1
ba# = p(b)+z1
bb# = p(b+1)+z1;      // THE 8 CUBE CORNERS,

g1# = grayd#(bb+1)
g2# = grayd#(ab+1)
g3# = grayd#(ba+1)
g4# = grayd#(aa+1)
g5# = grayd#(bb)
g6# = grayd#(ab)
g7# = grayd#(ba)
g8# = grayd#(aa)
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):Return s#:End Function
Function lerp#( t#, a#, b#): z# = a + t * (b - a): Return z#:End Function

Function noise#(x#,y#,z#,size#=64,seed% = 0, MinOctaves = 0 , MaxOctaves = 9999)
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#;

For i = 1 To MinOctaves
size = size/2
Next
;//Add finer and finer hues of smoothed noise together
While(size >= 1.0) And MaxOctaves > MinOctaves

value# = value# + SmoothNoise#(x / size, y / size, z / size, seed) * size
size = size / 2.0;
MaxOctaves = MaxOctaves - 1
Wend

;//Return the result over the initial size
Return  (value# / Float initialSize);

End Function




Function AlignMeshVertices(mesh1%,mesh2%,size%,side1%=0,side2%=0,colors=True,normals=True,flipped=False,colored=False)

Local surf1%=GetSurface(mesh1,1)
Local surf2%=GetSurface(mesh2,1)

Local i%,s%,t%,mag#
Local r%,g%,b%,a#,nx#,ny#,nz#

For i=0 To size

; 0 = upper side
; 1 = left side
; 2 = lower side
; 3 = right side

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=0 And flipped Then t=(size^2)+(2*size)-i

If side2=1 Then t=(size*i)+i
If side2=1 And flipped Then t=(size^2)+size-(size*i)-i

If side2=2 Then t=i
If side2=2 And flipped Then t=size-i

If side2=3 Then t=(size*i)+size+i
If side2=3 And flipped Then t=(size^2)+(2*size)-(size*i)-i

; align colors
If colors Then

r=(VertexRed(surf1,s)+VertexRed(surf2,t))/2
g=(VertexGreen(surf1,s)+VertexGreen(surf2,t))/2
b=(VertexBlue(surf1,s)+VertexBlue(surf2,t))/2
a=(VertexAlpha(surf1,s)+VertexAlpha(surf2,t))/2.0

VertexColor surf1,s,r,g,b,a
VertexColor surf2,t,r,g,b,a

EndIf

; draw sides
If colored Then
r=255:g=0:b=0:a=1.0
VertexColor surf1,s,r,g,b,a
VertexColor surf2,t,r,g,b,a
EndIf

; align normals
If normals Then

nx=VertexNX(surf1,s)+VertexNX(surf2,t)
ny=VertexNY(surf1,s)+VertexNY(surf2,t)
nz=VertexNZ(surf1,s)+VertexNZ(surf2,t)

mag=Sqr(nx*nx+ny*ny+nz*nz)

nx=nx/mag
ny=ny/mag
nz=nz/mag

VertexNormal surf1,s,nx,ny,nz
VertexNormal surf2,t,nx,ny,nz

EndIf

Next

End Function

.Temperate
Data   0.0,255,255,255 ; icy mountains
Data   5.0,179,179,179 ; transition
Data  10.0,153,143, 92 ; tundra
Data  25.0,115,128, 77 ; high grasslands
Data  40.0, 42,102, 41 ; low grasslands
Data  45.0, 42,102, 41 ; low grasslands
Data  50.0,200,200,118 ; coast / should be a 0 height
Data  55.0, 17, 82,112 ; shallow ocean
Data  70.0, 17, 82,112 ; shallow ocean
Data  75.0,  9, 62, 92 ; ocean
Data 100.0,  9, 62, 92 ; deep ocean

.permutation
Data 151,160,137,91,90,15
Data 131,13,201,95,96,53,194,233,7,225,140,36,103,30,69,142,8,99,37,240,21,10,23
Data 190, 6,148,247,120,234,75,0,26,197,62,94,252,219,203,117,35,11,32,57,177,33
Data 88,237,149,56,87,174,20,125,136,171,168, 68,175,74,165,71,134,139,48,27,166
Data 77,146,158,231,83,111,229,122,60,211,133,230,220,105,92,41,55,46,245,40,244
Data 102,143,54, 65,25,63,161, 1,216,80,73,209,76,132,187,208, 89,18,169,200,196
Data 135,130,116,188,159,86,164,100,109,198,173,186, 3,64,52,217,226,250,124,123
Data 5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,16,58,17,182,189,28,42
Data 223,183,170,213,119,248,152, 2,44,154,163, 70,221,153,101,155,167, 43,172,9
Data 129,22,39,253, 19,98,108,110,79,113,224,232,178,185, 112,104,218,246,97,228
Data 251,34,242,193,238,210,144,12,191,179,162,241, 81,51,145,235,249,14,239,107
Data 49,192,214, 31,181,199,106,157,184, 84,204,176,115,121,50,45,127, 4,150,254
Data 138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,180


slenkar(Posted 1+ years ago)

 looks good, dont really use B3D much anymore though


Ian Thompson(Posted 1+ years ago)

 Really nice, well done and thanks!


MusicianKool(Posted 1+ years ago)

 Well spent most of yesterday trying to make This improved perlin noise into a .dll and have done so success fully.  a huge speed increase came with it as well.  on my system, it draws a 512*512 image in 2670 millisecs,  with blitz code it takes 7880 so I think its worth making it a userLib.  as soon as I figure out were to host it, I'll put it up.ok Here you go.<a href="http://www.mediafire.com/?d0lmdzkm2h4" target="_blank">http://www.mediafire.com/?d0lmdzkm2h4</a>just put the .dll and .decls  in your blitz3d userlib folder.You must use InitPerlinNoise() at least once before you can use Perlin3D( )


Krischan(Posted 1+ years ago)

 Well done, here my island code with your DLL, takes now 707ms compared to 1276ms before = 45% faster!:
Code Select
Graphics3D 800,600,32,2

InitPerlinNoise()

Const patches=16
Const scale#=2
Const detail#=128.0
Const octaves%=5
Const patchsize%=32
Const maxcols%=2^16
Const multi#=2.0

Global GameSpeed%=60
Global Screenwidth%=GraphicsWidth()
Global Screenheight%=GraphicsHeight()
Global FramePeriod%=1000/GameSpeed
Global FrameTime%=MilliSecs()-FramePeriod
Global DeltaTimeOld%

Global min%,max%

Global PlanetR%[maxcols],PlanetG%[maxcols],PlanetB%[maxcols]
Dim Red%(0),Green%(0),Blue%(0),Percent#(0)
Restore Temperate
CreateGradient(11,maxcols,True,PlanetR,PlanetG,PlanetB)

Dim patch(patches,patches)

xoff=Rand(0,128)
yoff=Rand(0,128)


ms=MilliSecs()

For x=0 To patches-1

For z=0 To patches-1

patch(x,z)=CreatePatch(patchsize,patchsize,x,z,xoff,yoff,scale,multi)
EntityFX patch(x,z),2

pt=pt+1

AppTitle "Generating Landscape: "+Int(pt*100.0/(patches^2))+"% | "+(MilliSecs()-ms)+"ms"

If KeyHit(1) Then End

Next

Next

For x=0 To patches-2

For z=0 To patches-1

AlignMeshVertices(patch(x,z),patch(x+1,z),patchsize,3,1)

Next

Next

For x=0 To patches-1

For z=0 To patches-2

AlignMeshVertices(patch(x,z),patch(x,z+1),patchsize,0,2)

Next

Next


cam=CreateCamera()
CameraRange cam,0.001*scale,64*scale
PositionEntity cam,scale*patches/2.0,scale/2.0,-scale
CameraClsColor cam,150,200,255
CameraFogColor cam,150,200,255
CameraFogMode cam,1
CameraFogRange cam,1*scale,32*scale

sunpivot=CreatePivot()

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

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

water=CreateSprite()
SpriteViewMode water,2
PositionEntity water,scale*patches/2.0,0,scale*patches/2.0
RotateEntity water,90,0,0
ScaleSprite water,scale*patches/2.0,scale*patches/2.0
EntityFX water,1+16
EntityColor water,17,82,112
EntityBlend water,3

MoveMouse Screenwidth/2,Screenheight/2

While Not KeyHit(1)

; Frametween calculation
Local FrameElapsed%,FrameTicks%,FrameTween#,t%
Repeat FrameElapsed=MilliSecs()-FrameTime Until FrameElapsed
FrameTicks=FrameElapsed/FramePeriod
FrameTween=Float(FrameElapsed Mod FramePeriod)/Float(FramePeriod)

; Frametween loop
For t=1 To FrameTicks

; Frametween Captureworld
FrameTime=FrameTime+FramePeriod : If t=FrameTicks Then CaptureWorld

If KeyHit(57) Then wf=1-wf : WireFrame wf

FreeCam(cam,85,0.02*scale)

;TurnEntity sunpivot,0,1,0

Next

RenderWorld

Flip 0

Wend

End

; creates a nice color gradient
Function CreateGradient(colors%,steps%,inverse=False,R%[maxcols],G%[maxcols],B%[maxcols])

Dim Percent#(colors),Red%(colors),Green%(colors),Blue%(colors)

Local i%,pos1%,pos2%,pdiff%
Local rdiff%,gdiff%,bdiff%
Local rstep#,gstep#,bstep#
Local counter%=0

If inverse Then
For i=colors To 1 Step -1
Read Percent(i),Red(i),Green(i),Blue(i)
Percent(i)=100.0-Percent(i)
Next
Else
For i=0 To colors-1 : Read Percent(i),Red(i),Green(i),Blue(i) : Next
EndIf

    While counter<colors

        pos1=Percent(counter)*steps*1.0/100
pos2=Percent(counter+1)*steps*1.0/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

R[pos1+i]=Int(Red(counter)-(rstep*i))
G[pos1+i]=Int(Green(counter)-(gstep*i))
B[pos1+i]=Int(Blue(counter)-(bstep*i))

Next

        counter=counter+1

Wend

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

Function FreeCam(camera%,maxpitch#=85.0,movespeed#,rotspeed#=16.666,rotfloat#=8.0)

Local movex#,movez#,dx#,dy#,dk#,dt%,t%
Local pitch#

; Arrows = Move
movex=KeyDown(205)-KeyDown(203)
movez=KeyDown(200)-KeyDown(208)

; smooth movement
t=MilliSecs() : dt=t-DeltaTimeOld : DeltaTimeOld=t : dk=Float(dt)/rotspeed
dx=(Screenwidth/2-MouseX())*0.01*dk : dy=(Screenheight/2-MouseY())*0.01*dk
TurnEntity camera,-dy,dx*0.1*dk*rotfloat,0

; limit pitch
pitch=EntityPitch(camera,1) : If pitch>maxpitch Then pitch=maxpitch Else If pitch<-maxpitch Then pitch=-maxpitch

; rotate and move
RotateEntity camera,pitch,EntityYaw(camera,1),0,1
MoveEntity camera,movex*movespeed,0,movez*movespeed

End Function

Function CreatePatch(size%=32,seed%=1,xstart#=0.0,zstart#=0.0,xoff#=0.0,zoff#=0.0,scale#=1.0,yscale#=1.0)

Local x%,z%,h#,c%
Local vx#,vz#,u#,v#,vertex%
Local v0%,v1%,v2%,v3%

Local mesh%=CreateMesh()
Local surf%=CreateSurface(mesh)

For z=0 To size

For x=0 To size

; calculate vertex coordinates / texture coordinates
vx=1.0/size*x
vz=1.0/size*z
u=x*1.0/size
v=z*1.0/size

;h=0;noise((x+((xstart+xoff)*size))*scale,(z+((zstart+zoff)*size))*scale,0,detail,seed,0,octaves)

h=Perlin3D((x+((xstart+xoff)*size))*scale,(z+((zstart+zoff)*size))*scale,99,detail,seed,0,octaves)

If h<-1 Then h=-1 Else If h>1 Then h=1

;If h>-0.05 And h<0.05 Then h=0.01

If Not min Then min=0
If Not max Then max=maxcols

c=Floor(Normalize(h,-1,1,min,max))

If c<min Then min=c
If c>max Then max=c

s#=Sqr(size)/(size/4.0)

; place vertex
vertex=AddVertex(surf,vx*scale,Normalize(h,-1,1,-s,s)*yscale,vz*scale,u,v)

; set vertex color and texture coordinates
VertexColor surf,vertex,PlanetR[Int(c)],PlanetG[Int(c)],PlanetB[Int(c)],1

; set triangles
If z<size And x<size Then

v0=x+((size+1)*z)
v1=x+((size+1)*z)+(size+1)
v2=(x+1)+((size+1)*z)
v3=(x+1)+((size+1)*z)+(size+1)

AddTriangle(surf,v0,v1,v2)
AddTriangle(surf,v2,v1,v3)

EndIf

Next

Next

;Goto skip

For t=0 To CountTriangles(surf)-1

v0=TriangleVertex(surf,t,0)
v1=TriangleVertex(surf,t,1)
v2=TriangleVertex(surf,t,2)

vx0#=VertexX(surf,v0)
vy0#=VertexY(surf,v0)
vz0#=VertexZ(surf,v0)

vx1#=VertexX(surf,v1)
vy1#=VertexY(surf,v1)
vz1#=VertexZ(surf,v1)

vx2#=VertexX(surf,v2)
vy2#=VertexY(surf,v2)
vz2#=VertexZ(surf,v2)

px#=vx1-vx0
py#=vy1-vy0
pz#=vz1-vz0

qx#=vx2-vx0
qy#=vy2-vy0
qz#=vz2-vz0

nx#=(py*qz)-(pz*qy)
ny#=(pz*qx)-(px*qz)
nz#=(px*qy)-(py*qx)

VertexNormal surf,v0,nx,ny,nz
VertexNormal surf,v1,nx,ny,nz
VertexNormal surf,v2,nx,ny,nz

Next

.skip

;UpdateNormals mesh

PositionEntity mesh,xstart*scale,0,zstart*scale

Return mesh

End Function


Function AlignMeshVertices(mesh1%,mesh2%,size%,side1%=0,side2%=0,colors=True,normals=True,flipped=False,colored=False)

Local surf1%=GetSurface(mesh1,1)
Local surf2%=GetSurface(mesh2,1)

Local i%,s%,t%,mag#
Local r%,g%,b%,a#,nx#,ny#,nz#

For i=0 To size

; 0 = upper side
; 1 = left side
; 2 = lower side
; 3 = right side

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=0 And flipped Then t=(size^2)+(2*size)-i

If side2=1 Then t=(size*i)+i
If side2=1 And flipped Then t=(size^2)+size-(size*i)-i

If side2=2 Then t=i
If side2=2 And flipped Then t=size-i

If side2=3 Then t=(size*i)+size+i
If side2=3 And flipped Then t=(size^2)+(2*size)-(size*i)-i

; align colors
If colors Then

r=(VertexRed(surf1,s)+VertexRed(surf2,t))/2
g=(VertexGreen(surf1,s)+VertexGreen(surf2,t))/2
b=(VertexBlue(surf1,s)+VertexBlue(surf2,t))/2
a=(VertexAlpha(surf1,s)+VertexAlpha(surf2,t))/2.0

VertexColor surf1,s,r,g,b,a
VertexColor surf2,t,r,g,b,a

EndIf

; draw sides
If colored Then
r=255:g=0:b=0:a=1.0
VertexColor surf1,s,r,g,b,a
VertexColor surf2,t,r,g,b,a
EndIf

; align normals
If normals Then

nx=VertexNX(surf1,s)+VertexNX(surf2,t)
ny=VertexNY(surf1,s)+VertexNY(surf2,t)
nz=VertexNZ(surf1,s)+VertexNZ(surf2,t)

mag=Sqr(nx*nx+ny*ny+nz*nz)

nx=nx/mag
ny=ny/mag
nz=nz/mag

VertexNormal surf1,s,nx,ny,nz
VertexNormal surf2,t,nx,ny,nz

EndIf

Next

End Function

.Temperate
Data   0.0,255,255,255 ; icy mountains
Data   5.0,179,179,179 ; transition
Data  10.0,153,143, 92 ; tundra
Data  25.0,115,128, 77 ; high grasslands
Data  40.0, 42,102, 41 ; low grasslands
Data  45.0, 42,102, 41 ; low grasslands
Data  50.0,200,200,118 ; coast / should be a 0 height
Data  55.0, 17, 82,112 ; shallow ocean
Data  70.0, 17, 82,112 ; shallow ocean
Data  75.0,  9, 62, 92 ; ocean
Data 100.0,  9, 62, 92 ; deep ocean


_PJ_(Posted 1+ years ago)

 Overall, it really is exceptionally fast in real terms. Very nice functions, thanks :)@Krischan - I'm sure there's more optimisation can be done there, but overall I doubt it would make a really significant  improvement and probably not worth the effort put in to doing so.I'm (slowly, amongst a million other bots and pieces) using this to patch together a super-terrain of tiles... possibly for making into a sphere, hopefiully I'll get a neat method for matching the edges :)


Krischan(Posted 1+ years ago)

 You could try to port this code to BB, this is a complete "infinite" planet, done in Darkbasic:<a href="http://forumfiles.thegamecreators.com/download/1527504" target="_blank">http://forumfiles.thegamecreators.com/download/1527504</a>It could look like that (same technique):<a href="http://www.youtube.com/watch?v=DCzDKj3hjOE&feature=related" target="_blank">http://www.youtube.com/watch?v=DCzDKj3hjOE&feature=related</a>


MusicianKool(Posted 1+ years ago)

 fun little screen saver like thing. a  cube traversing through volumetric Perlin space.
Code Select
Graphics3D 800,600,32,2
SeedRnd MilliSecs()
SetBuffer BackBuffer()
seed = Rand(1000,10000)

l = 10  
cpiv = CreatePivot()
Camera = CreateCamera(cpiv)
PositionEntity camera,0,0,-l*2
AmbientLight 255,255,255
InitPerlinNoise(millisecs())
piv = CreatePivot()
Dim per(l*l*l)
For i = 0 To l-1
For j = 0 To l-1
For k = 0 To l-1
pn# = Perlin3D(i-l,j-l,k-l,64,seed,0,999)
If pn# > 1 Then pn# = 1
If pn# < 0 Then pn# = 0
t = k+j*l+i*l*l
per(t) = CreateQuad(3,piv);CreateSprite(piv)
PositionEntity(per(t),i-l/2,j-l/2,k-l/2)
EntityAlpha per(t),pn#
Next
Next
Next
;Print "Done"
;WaitKey()
r# = Rand(255)
g# = Rand(255)
b# = Rand(255)
While Not KeyDown(1)
Cls
z# = z# + 1
For i = 1 To CountChildren(piv)
chi = GetChild(piv,i)
pn# = Perlin3D(EntityX(chi,1),EntityY(chi,1),EntityZ(chi,1)+z,64,0,999)
If pn# > 1 Then pn# = 1
If pn# < 0 Then pn# = 0
EntityAlpha chi,pn#    
PointEntity chi,camera
EntityColor chi, r ,g,b
Next
If r >= 255 Then addr = False
If r <= 0 Then addr = True
If addr Then r = r + .5
If Not addr Then r = r - .5

If b >= 255 Then addb = False
If b <= 0 Then addb = True
If addb Then b = b + 2
If Not addb Then b = b - 2  

If g >= 255 Then addg = False
If g <= 0 Then addg = True
If addg Then g = g + 1
If Not addg Then g = g - 1
TurnEntity cpiv,0,-4,4
PositionEntity camera,0,0,(-l*2)+Sin(a)*(l/1.5)    
a = a + 10
RenderWorld
Flip
Wend

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 = 0:Height = 1:Depth=1
If Axis = 3 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


MusicianKool(Posted 1+ years ago)

 Aw poop. I released the Lib to soon, I just made it faster.ok...smaller and faster<a href="http://www.mediafire.com/?wzg2ymntxmg" target="_blank">http://www.mediafire.com/?wzg2ymntxmg</a>..And done..  wait, made faster ... err maybe not.. whatever it's good enough done!..


Krischan(Posted 1+ years ago)

 Well done, now only 610ms, excellent oO


MusicianKool(Posted 1+ years ago)

 @ Krischan:  Your Island code takes my sad laptop, 2000 ms.  I need to upgrade..


MusicianKool(Posted 1+ years ago)

 
QuoteYou could try to port this code to BB, this is a complete "infinite" planet, done in Darkbasic:<a href="http://forumfiles.thegamecreators.com/download/1527504" target="_blank">http://forumfiles.thegamecreators.com/download/1527504</a>
QuoteI dont think blitz3d can do this, cause you cant delete verticies.


puki(Posted 1+ years ago)

 You can do that in Blitz3D.


MusicianKool(Posted 1+ years ago)

 @puki oh.. you can make your own lod?  I'm gonna try it then.


puki(Posted 1+ years ago)

 Yep.


puki(Posted 1+ years ago)

 For a cheaper way of doing it, have a look at 'Blitz3DSamplesBlitz 3D SamplesirdielodBalls'.


MusicianKool(Posted 1+ years ago)

 Updated The Lib for the last time.InitPerlinNoise() now requires a random seedInitPerlinNoise(seed)I did this so that a map or terrain or whatever will look the same every time that seed is used.  Perlin3D no longer takes a seed as it was never really a seed, it was just adding the value to the x,y,z location in Perlin space.  The seed now generates the Permutation , gradient,and fade arrays so the perlin noise is truly dependent on the seed.Download here: <a href="http://www.mediafire.com/?wzg2ymntxmg" target="_blank">http://www.mediafire.com/?wzg2ymntxmg</a>Includes the free basic source.


MusicianKool(Posted 1+ years ago)

 I guess I lied... I've added a lot and changed a lot.FNL.dll (Fractal noise library)Added :Fractal Browian Motion - fBmRidged Multifractal (2 versions) - RidgedMF and RidgedMF2Turbulence Fractal - TurbulenceDownload here: <a href="http://www.mediafire.com/?nyjnyw2dyyr" target="_blank">http://www.mediafire.com/?nyjnyw2dyyr</a>Here is the basic flow now.
Code Select
;Fractal Noise Library
Graphics3D 800,600,32,2
SetBuffer BackBuffer()
size = 128
img = CreateImage(size,size)

n1 = InitNoise(MilliSecs())
n2 = InitNoise(MilliSecs())
n3 = InitNoise(MilliSecs())
n4 = InitNoise(MilliSecs())
n5 = InitNoise(MilliSecs())
While Not KeyHit(1)
Cls
LockBuffer ImageBuffer(img)
For x = 0 To size-1
For y = 0 To size-1

   f1# = fBm#(n1,x,y,z,9,.5,1) ;Fractal Browian Motion
   f2# = Perlin3D(n2,x,y,z,size,0,999)   ;Fractal Perlin
   f3# = RidgedMF2#(n3,x,y,z,9,.5,1.5,.3) ;Ridged MultiFractal(staticy)  
   f4# = RidgedMF#(n4,x,y,z,size,0,999,1,.8) ;Ridged MultiFractal
   f5# = Turbulence#(n5,x,y,z,size,0,999) ;Turbulence Fractal
   
   f# =  ( f2 + f4 + f5 ) / 3          ;Combine all Fractal noise types
   
   col = (f*255)
   If col < 0 Then col = 0
   If col > 255 Then col = 255
   argb = GetRGB(col,col,col)
   WritePixelFast x,y,argb,ImageBuffer(img)
Next
Next
UnlockBuffer ImageBuffer(img)
DrawImage img,0,0                                                            
;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
;========================================================
Flip  0
z = z + 1
Wend  
FreeNoise(n1)
FreeNoise(n2)
FreeNoise(n3)
FreeNoise(n4)
FreeNoise(n5)
End

;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

And because I've changed the name of the dll you will need to delete all other versions of the library first before you can use this one.Future:Simplex noiseVoronoi..not sure what else to add but then I might not add them. dont know


Krischan(Posted 1+ years ago)

 Very nice! What you could add: Hetero Multifractal, Hybrid Multifractal, take a look at these pages to see examples:<a href="http://www.ylilammi.com/BerconNoise.shtml" target="_blank">http://www.ylilammi.com/BerconNoise.shtml</a> (has source, too)<a href="http://ypoart.com/downloads/Musgrave.htm" target="_blank">http://ypoart.com/downloads/Musgrave.htm</a>Tiled Voronoi would be nice :-)


DareDevil(Posted 1+ years ago)

 Good work :)hi have changed your code for zoom image
Code Select
;Fractal Noise Library
Graphics3D 800,600,32,2
SetBuffer BackBuffer()

size = 128
img = CreateTexture(size,size,1+2+256)

n1 = InitNoise(MilliSecs())
n2 = InitNoise(MilliSecs())
n3 = InitNoise(MilliSecs())
n4 = InitNoise(MilliSecs())
n5 = InitNoise(MilliSecs())

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

plane=CreateSprite(camera)
PositionEntity(plane,0,0,1.4)
EntityTexture(plane,img)


While Not KeyHit(1)
Cls
Local l_BufTex%= TextureBuffer(img)
LockBuffer(l_BufTex)
SetBuffer(l_BufTex)
For x = 0 To size-1
For y = 0 To size-1

f1# = fBm#(n1,x,y,z,9,.5,1) ;Fractal Browian Motion
f2# = Perlin3D(n2,x,y,z,size,0,999)   ;Fractal Perlin
f3# = RidgedMF2#(n3,x,y,z,9,.5,1.5,.3) ;Ridged MultiFractal(staticy)  
f4# = RidgedMF#(n4,x,y,z,size,0,999,1,.8) ;Ridged MultiFractal
f5# = Turbulence#(n5,x,y,z,size,0,999) ;Turbulence Fractal

f# =  ( f2 + f4 + f5 ) / 3          ;Combine all Fractal noise types

col = (f*255)
If col < 0 Then col = 0
If col > 255 Then col = 255
argb = GetRGB(col,col,col)
WritePixelFast x,y,argb
Next
Next
UnlockBuffer(l_BufTex)

SetBuffer(BackBuffer())
UpdateWorld()
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
;========================================================
Flip  0
z = z + 1
Wend  
FreeNoise(n1)
FreeNoise(n2)
FreeNoise(n3)
FreeNoise(n4)
FreeNoise(n5)
End

;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


Krischan(Posted 1+ years ago)

 I found a problem - the noise doesn't tile correct with the new version. Here is a demo of a sphere texture cut off the noise cloud, with the old version it tiles perfect. Is it a bug or is it a mistake by me? LMB creates a new random planet.Old version:
Code Select
Const WIDTH% = 512 ; Planet Texture Width
Const HEIGHT% = 256 ; Planet Texture Height
Const MAXCOLS% = 2^16 ; Maximum Color steps
Const MULTI% = 1 ; Multisampling Factor
Const OFFSET% = 0 ; Horizontal Offset in Pixels
Const SCALE# = 3.0 ; Feature Scaler
Const ROUGH# = 256.0 ; Feature Roughness (1=smooth...higher=rough)
Const SHINE# = 0.2 ; Shininess
Global SEED% = 42 ; Planet Seed

init=False

Global FreeLookXS#,FreeLookZS#,FreeLookRotXS#,FreeLookRotYS#
Global R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS]
Dim Red%(0),Green%(0),Blue%(0),Percent#(0)

Graphics3D 800,600,32,2

; central pivot
pivot=CreatePivot()

; planet
planet=CreateSphere(32,pivot)
EntityShininess planet,SHINE
EntityFX planet,2

; camera
cam=CreateCamera(campivot)
CameraRange cam,0.01,100
MoveEntity cam,0,0,-2

; lighting
light=CreateLight(1)
AmbientLight 2,4,8
TurnEntity light,45,-45,0

; color gradient
Restore ClassMT : CreateGradient(9,MAXCOLS,0,R,G,B)

MoveMouse 400,300

While Not KeyHit(1)

If KeyHit(57) Then wf=1-wf : WireFrame wf

If MouseHit(1) Or (Not init) Then
start=MilliSecs()
SEED=Rand(1,2^32)
InitPerlinNoise(SEED)
FreeTexture tex
tex=CreatePlanet(WIDTH,HEIGHT,MULTI,OFFSET,SCALE,ROUGH)
EntityTexture planet,tex
ms=MilliSecs()-start
init=True
EndIf

TurnEntity pivot,0,-0.05,0

FreeLook(cam,0.01,0.9,0.9)

RenderWorld

Text 0, 0,"Time: "+ms+"ms"
Text 0,15,"Seed: "+SEED

Flip 1

Wend

End

Function FreeLook(camera,movespeed#=1.0,smoothness#=0.8,rotspeed#=0.9,maxpitch#=85.0)

Local p#,pitch#

If movespeed>0 Then
FreeLookXS=(FreeLookXS+((KeyDown(205))-(KeyDown(203)))*movespeed)*smoothness
FreeLookZS=(FreeLookZS+((KeyDown(200))-(KeyDown(208)))*movespeed)*smoothness
MoveEntity camera,FreeLookXS,0,FreeLookZS
EndIf

FreeLookRotXS=((MouseXSpeed()-FreeLookRotXS)*0.2+FreeLookRotXS)*rotspeed
FreeLookRotYS=((MouseYSpeed()-FreeLookRotYS)*0.2+FreeLookRotYS)*rotspeed

p=EntityPitch(camera)+FreeLookRotYS
If p<-maxpitch Then pitch=-maxpitch ElseIf p>maxpitch Then pitch=maxpitch Else pitch=p
RotateEntity camera,pitch,-FreeLookRotXS+EntityYaw(camera),0

MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

End Function

Function CloudExpCurve(v%,density%=128,fuzzy#=0.99)

Local c%=v-density
If c<0 Then c=0

Return 255-((fuzzy^c)*255)

End Function

Function CreatePlanet(w%,h%,m%,o%,s#,d#)

Local image%=CreateTexture(w,h,16+32)
Local buffer%=TextureBuffer(image)
Local x%,y%,z%,m1%,m2%,rgb%
Local a1#,a2#

LockBuffer buffer

For x=0 To w-1

For y=0 To h-1

For m1=0 To m-1

a1=((((x+o)*m)+m1)+0.5)*360.0/(w*m)

For m2=0 To m-1

a2=((((y*m)+m2)+0.5)*180.0/(h*m))

z=Norm(Perlin3D(Cos(a1)*Sin(a2)*s*d,Cos(a2)*s*d,Sin(a1)*Sin(a2)*s*d,d,0,15),-1,1,0,MAXCOLS-1)
If z<0 Then z=0 Else If z>MAXCOLS-1 Then z=MAXCOLS-1

If KeyHit(1) Then End

Next

Next

rgb=R[z]*$10000+G[z]*$100+B[z]
WritePixelFast x,y,rgb,buffer

Next

Next

UnlockBuffer buffer

Return image

End Function

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

Function CreateGradient(colors%,steps%,inverse=False,R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS])

Dim Percent#(colors),Red%(colors),Green%(colors),Blue%(colors)

Local i%,pos1%,pos2%,pdiff%
Local rdiff%,gdiff%,bdiff%
Local rstep#,gstep#,bstep#
Local counter%=0

If inverse Then

For i=colors To 1 Step -1

Read Percent(i),Red(i),Green(i),Blue(i)
Percent(i)=100.0-Percent(i)

Next

Else

For i=0 To colors-1 : Read Percent(i),Red(i),Green(i),Blue(i) : Next

EndIf

    While counter<colors

        pos1=Percent(counter)*steps*1.0/100
pos2=Percent(counter+1)*steps*1.0/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

R[pos1+i]=Int(Red(counter)-(rstep*i))
G[pos1+i]=Int(Green(counter)-(gstep*i))
B[pos1+i]=Int(Blue(counter)-(bstep*i))

Next

        counter=counter+1

Wend

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, 92New Version:
Code Select
Const WIDTH% = 512 ; Planet Texture Width
Const HEIGHT% = 256 ; Planet Texture Height
Const MAXCOLS% = 2^16 ; Maximum Color steps
Const MULTI% = 1 ; Multisampling Factor
Const OFFSET% = 0 ; Horizontal Offset in Pixels
Const SCALE# = 3.0 ; Feature Scaler
Const ROUGH# = 256.0 ; Feature Roughness (1=smooth...higher=rough)
Const SHINE# = 0.2 ; Shininess
Global SEED% = 42 ; Planet Seed

init=False

Global FreeLookXS#,FreeLookZS#,FreeLookRotXS#,FreeLookRotYS#
Global R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS]
Dim Red%(0),Green%(0),Blue%(0),Percent#(0)

Graphics3D 800,600,32,2

; central pivot
pivot=CreatePivot()

; planet
planet=CreateSphere(32,pivot)
EntityShininess planet,SHINE
EntityFX planet,2

; camera
cam=CreateCamera(campivot)
CameraRange cam,0.01,100
MoveEntity cam,0,0,-2

; lighting
light=CreateLight(1)
AmbientLight 2,4,8
TurnEntity light,45,-45,0

; color gradient
Restore ClassMT : CreateGradient(9,MAXCOLS,0,R,G,B)

MoveMouse 400,300

While Not KeyHit(1)

If KeyHit(57) Then wf=1-wf : WireFrame wf

If MouseHit(1) Or (Not init) Then
start=MilliSecs()
SEED=Rand(1,2^32)
id=InitNoise(SEED)
FreeTexture tex
tex=CreatePlanet(id,WIDTH,HEIGHT,MULTI,OFFSET,SCALE,ROUGH)
EntityTexture planet,tex
ms=MilliSecs()-start
init=True
EndIf

TurnEntity pivot,0,-0.05,0

FreeLook(cam,0.01,0.9,0.9)

RenderWorld

Text 0, 0,"Time: "+ms+"ms"
Text 0,15,"Seed: "+SEED

Flip 1

Wend

End

Function FreeLook(camera,movespeed#=1.0,smoothness#=0.8,rotspeed#=0.9,maxpitch#=85.0)

Local p#,pitch#

If movespeed>0 Then
FreeLookXS=(FreeLookXS+((KeyDown(205))-(KeyDown(203)))*movespeed)*smoothness
FreeLookZS=(FreeLookZS+((KeyDown(200))-(KeyDown(208)))*movespeed)*smoothness
MoveEntity camera,FreeLookXS,0,FreeLookZS
EndIf

FreeLookRotXS=((MouseXSpeed()-FreeLookRotXS)*0.2+FreeLookRotXS)*rotspeed
FreeLookRotYS=((MouseYSpeed()-FreeLookRotYS)*0.2+FreeLookRotYS)*rotspeed

p=EntityPitch(camera)+FreeLookRotYS
If p<-maxpitch Then pitch=-maxpitch ElseIf p>maxpitch Then pitch=maxpitch Else pitch=p
RotateEntity camera,pitch,-FreeLookRotXS+EntityYaw(camera),0

MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

End Function

Function CloudExpCurve(v%,density%=128,fuzzy#=0.99)

Local c%=v-density
If c<0 Then c=0

Return 255-((fuzzy^c)*255)

End Function

Function CreatePlanet(id%,w%,h%,m%,o%,s#,d#)

Local image%=CreateTexture(w,h,16+32)
Local buffer%=TextureBuffer(image)
Local x%,y%,z%,m1%,m2%,rgb%
Local a1#,a2#

LockBuffer buffer

For x=0 To w-1

For y=0 To h-1

For m1=0 To m-1

a1=((((x+o)*m)+m1)+0.5)*360.0/(w*m)

For m2=0 To m-1

a2=((((y*m)+m2)+0.5)*180.0/(h*m))

z=Norm(Perlin3D(id,Cos(a1)*Sin(a2)*s*d,Cos(a2)*s*d,Sin(a1)*Sin(a2)*s*d,d,0,15),-1,1,0,MAXCOLS-1)
If z<0 Then z=0 Else If z>MAXCOLS-1 Then z=MAXCOLS-1

If KeyHit(1) Then End

Next

Next

rgb=R[z]*$10000+G[z]*$100+B[z]
WritePixelFast x,y,rgb,buffer

Next

Next

UnlockBuffer buffer

Return image

End Function

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

Function CreateGradient(colors%,steps%,inverse=False,R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS])

Dim Percent#(colors),Red%(colors),Green%(colors),Blue%(colors)

Local i%,pos1%,pos2%,pdiff%
Local rdiff%,gdiff%,bdiff%
Local rstep#,gstep#,bstep#
Local counter%=0

If inverse Then

For i=colors To 1 Step -1

Read Percent(i),Red(i),Green(i),Blue(i)
Percent(i)=100.0-Percent(i)

Next

Else

For i=0 To colors-1 : Read Percent(i),Red(i),Green(i),Blue(i) : Next

EndIf

    While counter<colors

        pos1=Percent(counter)*steps*1.0/100
pos2=Percent(counter+1)*steps*1.0/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

R[pos1+i]=Int(Red(counter)-(rstep*i))
G[pos1+i]=Int(Green(counter)-(gstep*i))
B[pos1+i]=Int(Blue(counter)-(bstep*i))

Next

        counter=counter+1

Wend

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


MusicianKool(Posted 1+ years ago)

 its not you christian, not a bug either.  if your using ridged multifractal its in the way it combines together to make a ridge in the noise. Here is why its not tile perfect:
Code Select
;this is the main code behind ridged multifractal.
WHILE(ImageSize >= 1.0) AND MaxOctaves > MinOctaves
        value = (*this).ridge((*this).Noise(x / ImageSize, y / ImageSize, z / ImageSize),offset) '* ImageSize

; this line and the next is why it's not tile perfect.
;it uses the previous noise value retreaved to make a ridge.
; not sure how to fix this but I will look into it.
        sum += value * amplitude * prev
        prev = value ;

        ImageSize = ImageSize / 2.0
        amplitude *=  Gain
        MaxOctaves = MaxOctaves - 1
    WEND
 I will have to find out if there is a tile perfect ridged multi fractal.Edit:   errm, guess i should have looked at your code first, has to be a bug in the lib.


MusicianKool(Posted 1+ years ago)

 Well I kind of figured out the bug... but I'm not sure what I can do about it..  it has to do with type handling from free basic to blitz3d or vise verse.  I'm still looking for answers.


MusicianKool(Posted 1+ years ago)

 a quick fix i guess would be to :Perlin3d(noise handle, x+1000,y+1000,z+1000 ....)until I get the next version out. will be soon.


MusicianKool(Posted 1+ years ago)

 OK updated!<a href="http://www.mediafire.com/?2ynmwqyoqmz" target="_blank">http://www.mediafire.com/?2ynmwqyoqmz</a>


MusicianKool(Posted 1+ years ago)

 Christian:  you need to add FreeNoise(id) to your second example.  the noise is not deleted if you create a new one, and you will never be able to delete it later on over write the pointer.  you will get an overload error eventually.This works without any memory errors:
Code Select
Const WIDTH% = 512 ; Planet Texture Width
Const HEIGHT% = 256 ; Planet Texture Height
Const MAXCOLS% = 2^16 ; Maximum Color steps
Const MULTI% = 1 ; Multisampling Factor
Const OFFSET% = 0 ; Horizontal Offset in Pixels
Const SCALE# = 3.0 ; Feature Scaler
Const ROUGH# = 256.0 ; Feature Roughness (1=smooth...higher=rough)
Const SHINE# = 0.2 ; Shininess
Global SEED% = 42 ; Planet Seed


init=False

Global FreeLookXS#,FreeLookZS#,FreeLookRotXS#,FreeLookRotYS#
Global R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS]
Dim Red%(0),Green%(0),Blue%(0),Percent#(0)

Graphics3D 800,600,32,2

; central pivot
pivot=CreatePivot()

; planet
planet=CreateSphere(32,pivot)
EntityShininess planet,SHINE
EntityFX planet,2

; camera
cam=CreateCamera(campivot)
CameraRange cam,0.01,100
MoveEntity cam,0,0,-2

; lighting
light=CreateLight(1)
AmbientLight 2,4,8
TurnEntity light,45,-45,0

; color gradient
Restore ClassMT : CreateGradient(9,MAXCOLS,0,R,G,B)

MoveMouse 400,300

While Not KeyHit(1)

If KeyHit(57) Then wf=1-wf : WireFrame wf

If MouseHit(1) Or (Not init) Then
start=MilliSecs()
SEED=Rand(1,2^32)

id=InitNoise(SEED)
FreeTexture tex
tex=CreatePlanet(id,WIDTH,HEIGHT,MULTI,OFFSET,SCALE,ROUGH)
FreeNoise(id)
EntityTexture planet,tex
ms=MilliSecs()-start
init=True
EndIf

TurnEntity pivot,0,-0.05,0

FreeLook(cam,0.01,0.9,0.9)

RenderWorld

Text 0, 0,"Time: "+ms+"ms"
Text 0,15,"Seed: "+SEED

Flip 1

Wend
FreeNoise(id)
End

Function FreeLook(camera,movespeed#=1.0,smoothness#=0.8,rotspeed#=0.9,maxpitch#=85.0)

Local p#,pitch#

If movespeed>0 Then
FreeLookXS=(FreeLookXS+((KeyDown(205))-(KeyDown(203)))*movespeed)*smoothness
FreeLookZS=(FreeLookZS+((KeyDown(200))-(KeyDown(208)))*movespeed)*smoothness
MoveEntity camera,FreeLookXS,0,FreeLookZS
EndIf

FreeLookRotXS=((MouseXSpeed()-FreeLookRotXS)*0.2+FreeLookRotXS)*rotspeed
FreeLookRotYS=((MouseYSpeed()-FreeLookRotYS)*0.2+FreeLookRotYS)*rotspeed

p=EntityPitch(camera)+FreeLookRotYS
If p<-maxpitch Then pitch=-maxpitch ElseIf p>maxpitch Then pitch=maxpitch Else pitch=p
RotateEntity camera,pitch,-FreeLookRotXS+EntityYaw(camera),0

MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

End Function

Function CloudExpCurve(v%,density%=128,fuzzy#=0.99)

Local c%=v-density
If c<0 Then c=0

Return 255-((fuzzy^c)*255)

End Function

Function CreatePlanet(id%,w%,h%,m%,o%,s#,d#)

Local image%=CreateTexture(w,h,16+32)
Local buffer%=TextureBuffer(image)
Local x%,y%,z%,m1%,m2%,rgb%
Local a1#,a2#

LockBuffer buffer

For x=0 To w-1

For y=0 To h-1

For m1=0 To m-1

a1=((((x+o)*m)+m1)+0.5)*360.0/(w*m)

For m2=0 To m-1

a2=((((y*m)+m2)+0.5)*180.0/(h*m))
px# = Cos(a1)*Sin(a2)*s*d
py# = Cos(a2)*s*d
pz# = Sin(a1)*Sin(a2)*s*d
z=Norm(Perlin3D(id,px,py,pz,d,0,15),-1,1,0,MAXCOLS-1)
If z<0 Then z=0 Else If z>MAXCOLS-1 Then z=MAXCOLS-1

If KeyHit(1) Then End

Next

Next

rgb=R[z]*$10000+G[z]*$100+B[z]
WritePixelFast x,y,rgb,buffer

Next

Next

UnlockBuffer buffer

Return image

End Function

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

Function CreateGradient(colors%,steps%,inverse=False,R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS])

Dim Percent#(colors),Red%(colors),Green%(colors),Blue%(colors)

Local i%,pos1%,pos2%,pdiff%
Local rdiff%,gdiff%,bdiff%
Local rstep#,gstep#,bstep#
Local counter%=0

If inverse Then

For i=colors To 1 Step -1

Read Percent(i),Red(i),Green(i),Blue(i)
Percent(i)=100.0-Percent(i)

Next

Else

For i=0 To colors-1 : Read Percent(i),Red(i),Green(i),Blue(i) : Next

EndIf

    While counter<colors

        pos1=Percent(counter)*steps*1.0/100
pos2=Percent(counter+1)*steps*1.0/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

R[pos1+i]=Int(Red(counter)-(rstep*i))
G[pos1+i]=Int(Green(counter)-(gstep*i))
B[pos1+i]=Int(Blue(counter)-(bstep*i))

Next

        counter=counter+1

Wend

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

you can however use a random offset to the X,Y,Z achieve the same thing.  Should be slightly faster too:[code]
Const WIDTH%   =   512      ; Planet Texture Width
Const HEIGHT%   =   256      ; Planet Texture Height
Const MAXCOLS%   =   2^16   ; Maximum Color steps
Const MULTI%   =   1      ; Multisampling Factor
Const OFFSET%   =   0      ; Horizontal Offset in Pixels
Const SCALE#   =   3.0      ; Feature Scaler
Const ROUGH#   =   256.0   ; Feature Roughness (1=smooth...higher=rough)
Const SHINE#   =   0.2      ; Shininess
Global SEED%   =   42      ; Planet Seed

id=InitNoise(SEED)

init=False

Global FreeLookXS#,FreeLookZS#,FreeLookRotXS#,FreeLookRotYS#
Global R%[MAXCOLS],G%[MAXCOLS],B%[MAXCOLS]
Dim Red%(0),Green%(0),Blue%(0),Percent#(0)

Graphics3D 800,600,32,2

; central pivot
pivot=CreatePivot()

; planet
planet=CreateSphere(32,pivot)
EntityShininess planet,SHINE
EntityFX planet,2

; camera
cam=CreateCamera(campivot)
CameraRange cam,0.01,100
MoveEntity cam,0,0,-2

; lighting
light=CreateLight(1)
AmbientLight 2,4,8
TurnEntity light,45,-45,0

; color gradient
Restore ClassMT : CreateGradient(9,MAXCOLS,0,R,G,B)

MoveMouse 400,300

While Not KeyHit(1)
   
   If KeyHit(57) Then wf=1-wf : WireFrame wf
   
   If MouseHit(1) Or (Not init) Then
      start=MilliSecs()
      SEED=Rand(1,2^26)
      
      FreeTexture tex
      tex=CreatePlanet(id,WIDTH,HEIGHT,MULTI,OFFSET,SCALE,ROUGH)
      
      EntityTexture planet,tex
      ms=MilliSecs()-start
      init=True
   EndIf
   
   TurnEntity pivot,0,-0.05,0
   
   FreeLook(cam,0.01,0.9,0.9)
   
   RenderWorld
   
   Text 0, 0,"Time: "+ms+"ms"
   Text 0,15,"Seed: "+SEED
   
   Flip 1
   
Wend
FreeNoise(id)
End

Function FreeLook(camera,movespeed#=1.0,smoothness#=0.8,rotspeed#=0.9,maxpitch#=85.0)
   
   Local p#,pitch#
   
   If movespeed>0 Then
      FreeLookXS=(FreeLookXS+((KeyDown(205))-(KeyDown(203)))*movespeed)*smoothness
      FreeLookZS=(FreeLookZS+((KeyDown(200))-(KeyDown(208)))*movespeed)*smoothness
      MoveEntity camera,FreeLookXS,0,FreeLookZS
   EndIf
   
   FreeLookRotXS=((MouseXSpeed()-FreeLookRotXS)*0.2+FreeLookRotXS)*rotspeed
   FreeLookRotYS=((MouseYSpeed()-FreeLookRotYS)*0.2+FreeLookRotYS)*rotspeed
   
   p=EntityPitch(camera)+FreeLookRotYS
   If p<-maxpitch Then pitch=-maxpitch ElseIf p&g
Print
Go Up Pages1
User actions