Author Topic: [bb] Improved Perlin Noise 2D and 3D by MusicianKool [ 1+ years ago ] (Read 855 times)

BlitzBot · « **on:** June 29, 2017, 12:28:39 AM »

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[/url] (Final)
<a href="http://www.mediafire.com/?2ynmwqyoqmz" target="_blank">http://www.mediafire.com/?2ynmwqyoqmz[/url] (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[/url]

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[/url]

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

...

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[/url]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[/url]It could look like that (same technique):<a href="

&feature=related" target="_blank">

&feature=related[/url]

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[/url]..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)

Quote

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[/url]
Quote
I 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[/url]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[/url]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 FunctionAnd 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[/url] (has source, too)<a href="http://ypoart.com/downloads/Musgrave.htm" target="_blank">http://ypoart.com/downloads/Musgrave.htm[/url]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[/url]

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

Author Topic: [bb] Improved Perlin Noise 2D and 3D by MusicianKool [ 1+ years ago ] (Read 855 times)

BlitzBot

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