demo - Perlin noise
Posted: Thu Mar 28, 2019 11:08 pm
Hi, guys,
a 3d perlin noise code: it allows to deform objects
it's pretty easy to use:
we define our "perlin space" with the InitPerlinNoise function by entering a list of frequencies and amplitudes
then just use the PerlinNoise3D function to modify the 3d coordinates
in the example following the original shape is a sphere
I also test this function to apply a texture, (press[F2])
the results are very uneven, but I think that with the right texture you can make very nice maps of wood or marble
the interest is above all to be able to cover "closed" shapes (sphere type) avoiding the problem of "polar convergence" or visible "sewing" (if you know what I mean...)
covering a sphere is a real headache
(the next version of PB will support cubemap textures, but to create them is not easy)
[EDIT]
I added the possibility to change the mesh:
sphere, torus, cylinder and cone
(press [F1])
Code: Select all
; demo - Perlin 3D - Pf Shadoko -2019
EnableExplicit
;{ ============================= biblio
Structure Vector2
x.f
y.f
EndStructure
Structure Vector3
x.f
y.f
z.f
EndStructure
Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
EndMacro
Procedure.f lng3D(*v.Vector3)
ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure
Procedure Norme3D(*V.Vector3,l.f=1)
Protected.f lm
lm = l / lng3d(*v)
*V\x * lm
*V\y * lm
*V\z * lm
EndProcedure
Macro sub3D(p,p1,p2)
p\x=p1\x-p2\x
p\y=p1\y-p2\y
p\z=p1\z-p2\z
EndMacro
Macro add3d(p,p1,p2)
p\x=p1\x+p2\x
p\y=p1\y+p2\y
p\z=p1\z+p2\z
EndMacro
Macro div3d(p1,v)
p1\x/(v)
p1\y/(v)
p1\z/(v)
EndMacro
Macro mul3d(p1,v)
p1\x*(v)
p1\y*(v)
p1\z*(v)
EndMacro
Procedure.f POM(v.f)
ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure
;}
;################################################################# Perlin Noise ###############################################################
Procedure InitPerlinNoise(seed=0, fq1.f=1,amp1.f=0.5, fq2.f=0,amp2.f=0, fq3.f=0,amp3.f=0, fq4.f=0,amp4.f=0)
#per_Size = 1023
Global Dim per_grad.Vector3(#per_Size)
Global Dim per_fq.f(4)
Global Dim per_am.f(4)
Global per_nb=0,per_dim
Protected i
If fq1>0:per_fq(1)=fq1:per_am(1)=amp1/fq1:per_nb=1:EndIf
If fq2>0:per_fq(2)=fq2:per_am(2)=amp2/fq2:per_nb=2:EndIf
If fq3>0:per_fq(3)=fq3:per_am(3)=amp3/fq3:per_nb=3:EndIf
If fq4>0:per_fq(4)=fq4:per_am(4)=amp4/fq4:per_nb=4:EndIf
RandomSeed(Seed)
For i = 0 To #per_Size
vec3d(per_grad(i),pom(1),pom(1),pom(1)):norme3d(per_grad(i))
Next
EndProcedure
Procedure.f per_gr(X.i, Y.i, Z.i, *V.Vector3)
Protected Index.i= (x+y * 101+z * 241+ per_dim * 409)&#per_Size
ProcedureReturn per_grad(Index)\X * (*V\X-X) + per_grad(Index)\Y * (*V\Y-Y) + per_grad(Index)\Z * (*V\Z-Z)
EndProcedure
Procedure.f PerlinValue(*p.vector3,fq.f)
Protected.i X0, X1, Y0, Y1, Z0, Z1
Protected.f WX0, WY0, WZ0, WX1, WY1, WZ1
Protected p.vector3
vec3d(p,*p\x*fq,*p\y*fq,*p\z*fq)
X0 = Int(p\X+1<<30)-1<<30:X1 = X0+1
Y0 = Int(p\Y+1<<30)-1<<30:Y1 = Y0+1
Z0 = Int(p\Z+1<<30)-1<<30:Z1 = Z0+1
WX0 = X0-p\X:wx0=(2* wx0+3)* wx0 * wx0 :wx1=1-wx0
WY0 = Y0-p\Y:wy0=(2* wy0+3)* wy0 * wy0 :wy1=1-wy0
WZ0 = Z0-p\Z:wz0=(2* wz0+3)* wz0 * wz0 :wz1=1-wz0
ProcedureReturn ( (per_gr(X0, Y0, Z0, p)*WX1+per_gr(X1, Y0, Z0, p)*WX0)*wy1 +
(per_gr(X0, Y1, Z0, p)*WX1+per_gr(X1, Y1, Z0, p)*WX0)*WY0 ) * wz1 +
( (per_gr(X0, Y0, Z1, p)*WX1+per_gr(X1, Y0, Z1, p)*WX0)*wy1 +
(per_gr(X0, Y1, Z1, p)*WX1+per_gr(X1, Y1, Z1, p)*WX0)*WY0 ) * WZ0
EndProcedure
Procedure.f PerlinNoise(*p.vector3,_dimension=0)
Protected i, Noise.f
per_dim=_dimension
For i = 1 To per_nb:Noise + PerlinValue(*p,per_fq(i)) * per_am(i):Next
ProcedureReturn Noise
EndProcedure
Procedure.f PerlinNoise3D(*p.vector3,*r.vector3, mode) ; mode -> #PB_Absolute: return the new position, #PB_Relative: retrun the offset
*r\x=PerlinNoise(*p.vector3,0)
*r\y=PerlinNoise(*p.vector3,1)
*r\z=PerlinNoise(*p.vector3,2)
If mode=#PB_Absolute:add3d(*r,*p,*r):EndIf
EndProcedure
;######################################################################################################
Structure PB_MeshVertexV
p.vector3
n.vector3
t.vector3
u.f
v.f
color.l
EndStructure
Global ptype,ptext,objet,fdf
Procedure test_perlin()
Protected i,j,n,num,nv,u.f,v.f,p.vector3
For num=1 To 6
Select objet
Case 0:CreateSphere(num,0.7,64,64)
Case 1:CreateTorus(num,0.6,0.3,64,64)
Case 2:CreateCylinder(num,0.5,1,64,64,1)
Case 3:CreateCone(num,0.8,1,64,64)
EndSelect
CreateEntity(num,MeshID(num),MaterialID(num))
Select ptype
Case 0:InitPerlinNoise(num,1,0.7)
Case 1:InitPerlinNoise(num,2,0.6)
Case 2:InitPerlinNoise(num,6,0.5)
Case 3:InitPerlinNoise(num,0.2,0.3,2,0.4,6,0.5)
EndSelect
nv=MeshVertexCount(num)-1
Dim v.PB_MeshVertexv(nv)
GetMeshData(num,0,v(),#PB_Mesh_Vertex|#PB_Mesh_UVCoordinate,0,nv)
For n=0 To nv
With v(n)
If ptext:\u=0.5+PerlinNoise(\p,3)*4:v(n)\v=0.5+PerlinNoise(\p,4)*4:EndIf
p=\p:PerlinNoise3d(p,\p,#PB_Absolute)
EndWith
Next
SetMeshData(num,0,v(),#PB_Mesh_Vertex|#PB_Mesh_UVCoordinate,0,nv)
NormalizeMesh(num)
If ptext:ScaleMaterial(num,1,1):Else:ScaleMaterial(num,1/8,1/8):EndIf
Next
EndProcedure
Procedure init()
Protected i
InitEngine3D(#PB_Engine3D_DebugLog):InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0,0,800,600, "Perlin 3d - [F1] Change objects - [F2] Change Perlin parameters - [F3] Change texture mode - [F12] Wireframe - [Esc] quit",#PB_Window_Maximize)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures",#PB_3DArchive_FileSystem)
Parse3DScripts()
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,1+4*0,4):CameraLookAt(0,0,-0.5,0)
CreateLight(0,$ffffff, -100, 100, 50):SetLightColor(0,#PB_Light_SpecularColor,$ffffff)
AmbientColor($444444)
CameraBackColor(0,$880044)
CreateTexture(1,1,64):StartDrawing(TextureOutput(1)):For i=0 To 63:Plot(0,i,Random($ffffff)):Next:StopDrawing()
LoadTexture(2,"Dirt.jpg")
LoadTexture(3,"MRAMOR6X6.jpg")
LoadTexture(4,"RustySteel.jpg")
LoadTexture(5,"soil_wall.jpg")
LoadTexture(6,"Wood.jpg")
For i=1 To 6
CreateMaterial(i,TextureID(i))
SetMaterialColor(i,#PB_Material_SpecularColor,$888888):MaterialShininess(i,40)
Next
test_perlin()
EndProcedure
Procedure rendu()
Protected.f rx,ry,a,ai,i.l
Repeat
ExamineMouse()
ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1):objet=(objet+1)%4:test_perlin():EndIf
If KeyboardReleased(#PB_Key_F2):ptype=(ptype+1)%4:test_perlin():EndIf
If KeyboardReleased(#PB_Key_F3):ptext=1-ptext:test_perlin():EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
ry=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*1
rx=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up )))*1
a+0.002:For i=1 To 6:ai=a+i*2*#PI/6:MoveEntity(i,Cos(ai)*2,0,Sin(ai)*2,#PB_Absolute):RotateEntity(i,0.2,0.25,0.3,#PB_Relative):Next
RenderWorld()
FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardReleased(#PB_Key_Escape)
EndProcedure
init()
rendu()
