demo - Perlin noise

Everything related to 3D programming
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

demo - Perlin noise

Post by pf shadoko »

Image

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()
Last edited by pf shadoko on Fri Mar 29, 2019 7:06 pm, edited 2 times in total.
#NULL
Addict
Addict
Posts: 1440
Joined: Thu Aug 30, 2007 11:54 pm
Location: right here

Re: demo - Perlin noise

Post by #NULL »

Very nice, thanks!

On Linux I had to make these changes:

- adapt the Texture filenames:

Code: Select all

  LoadTexture(2,"Dirt.jpg")
  LoadTexture(3,"MRAMOR6X6.jpg")
  LoadTexture(4,"RustySteel.jpg")
  LoadTexture(5,"soil_wall.jpg")
  LoadTexture(6,"Wood.jpg")
- give the window some size:

Code: Select all

OpenWindow(0, 0,0,800,600, ...
- swallow events:

Code: Select all

  Repeat
    While WindowEvent() : Wend
    ExamineMouse()
User avatar
C87
Enthusiast
Enthusiast
Posts: 176
Joined: Mon Jul 17, 2017 7:22 am
Location: Cotswolds England

Re: demo - Perlin noise

Post by C87 »

Hi pf shadoko,
Coming from the database & commercial software brigade I find this sort of stuff simply amazing.
Now that I'm retired I often think I really must have a go to see what I can achieve sometime with the 3D library......definitely start tomorrow! :lol:

Excellent work 8)
If it's falling over......just remember the computer is never wrong!
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Re: demo - Perlin noise

Post by pf shadoko »

@ #NULL :
thank you for information
i'm suprise about windowevent
the line
"Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardReleased(#PB_Key_Escape)"
is not enough ?
you have a lot of events on linux...

@ C87 :
I advise you to try
it's exciting to create your own little universe
#NULL
Addict
Addict
Posts: 1440
Joined: Thu Aug 30, 2007 11:54 pm
Location: right here

Re: demo - Perlin noise

Post by #NULL »

For games/screens it's better to process all events per frame, instead of only one event per frame. Like a second event loop nested in the main loop. I'm not sure if the 3D commands generate events, but as soon as events would be generated by any means (by a SetGadgetWathever() for example) in the main loop, processing only one of them in that main loop will never catch up. And I also think Flipbuffers() relies on event processing.
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Re: demo - Perlin noise

Post by pf shadoko »

EDIT]
I added the possibility to change the mesh:
sphere, torus, cylinder and cone
(press [F1])
and I add shininess
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: demo - Perlin noise

Post by davido »

@pf shadoko,
Looks very nice on my MacBook Pro. :D
Impressive!
DE AA EB
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: demo - Perlin noise

Post by Andre »

Looks impressive :D (and I have no clue about 3D programming, I already fail with 3D VectorDrawing...)
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: demo - Perlin noise

Post by DK_PETER »

Short and to the point.
Thanks for sharing. :)
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
User avatar
Psychophanta
Addict
Addict
Posts: 4975
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: demo - Perlin noise

Post by Psychophanta »

Nice :!: :)
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
User avatar
ssg_mick
User
User
Posts: 10
Joined: Thu Oct 26, 2017 12:13 pm

Re: demo - Perlin noise

Post by ssg_mick »

wow, always amazed about the stuff PureBasic is able to produce.
Michael

Windows 10, PureBasic 5.70 LTS
Post Reply