Improved Perlin Noise 2D and 3D

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

Improved Perlin Noise 2D and 3D by MusicianKool

2010

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:
http://www.mediafire.com/?kwno5wnty4i (Final)
http://www.mediafire.com/?2ynmwqyoqmz (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.
http://www.blitzbasic.com/codearcs/codearcs.php?code=2415

Mesh deform used from the code archives as well.
http://www.blitzbasic.com/codearcs/codearcs.php?code=1120

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

The Library.


;#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!

;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!

;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!

;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

...

Comments

MusicianKool

2010

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

lo-tekk

2010

I got a MAV running the 3d mesh example in line:

WritePixelFast x,y,rgb,IB

in the include file.

MusicianKool

2010

Try changing the line near the top from

Image = createtexture(imagesize,imagesize,257)
to
Image = createtexture(imagesize,imagesize)

The 3D mesh Deformation example will only work on my system with the 257 flag.

Krischan

2010

This is really nice and very fast. Here some caribbean-style islands generated in runtime:

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

2010

looks good, dont really use B3D much anymore though

Ian Thompson

2010

Really nice, well done and thanks!

MusicianKool

2010

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.

http://www.mediafire.com/?d0lmdzkm2h4

just put the .dll and .decls in your blitz3d userlib folder.

You must use InitPerlinNoise() at least once before you can use Perlin3D( )

Krischan

2010

Well done, here my island code with your DLL, takes now 707ms compared to 1276ms before = 45% faster!:

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_

2010

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

2010

You could try to port this code to BB, this is a complete "infinite" planet, done in Darkbasic:

http://forumfiles.thegamecreators.com/download/1527504

It could look like that (same technique):

http://www.youtube.com/watch?v=DCzDKj3hjOE&feature=related

MusicianKool

2010

fun little screen saver like thing. a cube traversing through volumetric Perlin space.

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

2010

Aw poop. I released the Lib to soon, I just made it faster.

ok...

smaller and faster

http://www.mediafire.com/?wzg2ymntxmg

..And done.. wait, made faster ... err maybe not.. whatever it's good enough done!..

Krischan

2010

Well done, now only 610ms, excellent oO

MusicianKool

2010

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

MusicianKool

2010

[quote]
You could try to port this code to BB, this is a complete "infinite" planet, done in Darkbasic:

http://forumfiles.thegamecreators.com/download/1527504
[\quote]

I dont think blitz3d can do this, cause you cant delete verticies.

puki

2010

You can do that in Blitz3D.

MusicianKool

2010

@puki oh.. you can make your own lod?

I'm gonna try it then.

puki

2010

Yep.

puki

2010

For a cheaper way of doing it, have a look at 'Blitz3D\Samples\Blitz 3D Samples\birdie\lodBalls\'.

MusicianKool

2010

Updated The Lib for the last time.

InitPerlinNoise() now requires a random seed
InitPerlinNoise(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: http://www.mediafire.com/?wzg2ymntxmg
Includes the free basic source.

MusicianKool

2010

I guess I lied... I've added a lot and changed a lot.

FNL.dll (Fractal noise library)

Added :
Fractal Browian Motion - fBm
Ridged Multifractal (2 versions) - RidgedMF and RidgedMF2
Turbulence Fractal - Turbulence

Download here: http://www.mediafire.com/?nyjnyw2dyyr

Here is the basic flow now.

;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 noise
Voronoi
..not sure what else to add but then I might not add them. dont know

Krischan

2010

Very nice! What you could add: Hetero Multifractal, Hybrid Multifractal, take a look at these pages to see examples:

http://www.ylilammi.com/BerconNoise.shtml (has source, too)
http://ypoart.com/downloads/Musgrave.htm

Tiled Voronoi would be nice :-)

DareDevil

2010

Good work :)

hi have changed your code for zoom image

;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

2010

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:

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, 92

New Version:

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

2010

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:

;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

2010

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

2010

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

2010

OK updated!

http://www.mediafire.com/?2ynmwqyoqmz

MusicianKool

2010

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:

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:

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>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+SEED,py+SEED,pz+SEED,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

slenkar

2010

any chance of a blitzmax.minib3d version ? :)

MusicianKool

2010

if you want to port it, then yep. otherwise I don't have bmax so....I can't.
But here is the source so far:
http://www.mediafire.com/?xqudnowmt2y

MusicianKool

2010

using Christians terrain code here is Volcanic islands.

Graphics3D 800,600,32,2

Global id = InitNoise(MilliSecs())

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
FreeNoise(id)
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)
			x1# = (x+((xstart+xoff)*size))*scale
			y1# = (z+((zstart+zoff)*size))*scale
			z1# = 99
			h1#=S_Perlin3D(id,x1,y1#,z1#,detail,0,octaves)
			h2#=S_RidgedMF(id,x1,y1#,z1#,detail,0,2,1,.8)
						
			h = (h1/2+h2/2)/2
			If h<-1 Then h=-1 Else If h>1 Then h=1-(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

MusicianKool

2010

arrg!... o.k. I'm going to change the structure of the Lib again.
Why, cause you can then make your own Noise fractals in Blitz3D!
It is however slightly slightly slower (on a 512*512 pic its 20 ms slower then FNL lib) .
It will work in the same way as FNL, but instead of calling the function Perlin3D(...) you will need to write the function Perlin3D(....) in Blitz.
This way its easier for me, as this makes the lib only about 400 lines of code instead of the 3 or 4 thousand it could be for every combination of noise engine and Fractal algorithm.
Will post soon.

MusicianKool

2010

Ok here it is. Now you can make your own noise fractals.
Plus it now has voronoi (the lib has one included inside of it and I have made a quick blitz3d version of the code(although flawed)). all the information you need is in the "MultiFractals.bb" file it's not commented but you should beable to get the idea. If not then wait or ask and I or someone else will post a code snip of the type of noise fractal you desire.

Download: http://www.mediafire.com/?kwno5wnty4i

MusicianKool

2010

Continue the conversation here: http://www.blitzbasic.com/Community/posts.php?topic=90465

Code Archives Forum