It is currently Mon Sep 23, 2019 5:06 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 11 posts ] 
Author Message
 Post subject: demo - Perlin noise
PostPosted: Thu Mar 28, 2019 11:08 pm 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 74
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:
; 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.

Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 10:30 am 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1052
Location: right here
Very nice, thanks!

On Linux I had to make these changes:

- adapt the Texture filenames:
Code:
  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:
OpenWindow(0, 0,0,800,600, ...

- swallow events:
Code:
  Repeat
    While WindowEvent() : Wend
    ExamineMouse()


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 11:22 am 
Offline
User
User

Joined: Mon Jul 17, 2017 7:22 am
Posts: 59
Location: Cotswolds England
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!


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 11:28 am 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 74
@ #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


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 11:45 am 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1052
Location: right here
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 7:12 pm 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 74
EDIT]
I added the possibility to change the mesh:
sphere, torus, cylinder and cone
(press [F1])
and I add shininess


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 7:59 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1671
Location: Uttoxeter, UK
@pf shadoko,
Looks very nice on my MacBook Pro. :D
Impressive!

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Fri Mar 29, 2019 9:40 pm 
Offline
PureBasic Team
PureBasic Team
User avatar

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1701
Location: Germany (Saxony, Deutscheinsiedel)
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)


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Sun Mar 31, 2019 2:15 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 775
Location: Denmark
Short and to the point.
Thanks for sharing. :)

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 7/10, Intel 6800K, Gtx 970, 32 gb ram.


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Tue Apr 02, 2019 10:53 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4578
Location: Spa, relaxing and thinking, and learning...
Nice :!: :)

_________________
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend


Top
 Profile  
Reply with quote  
 Post subject: Re: demo - Perlin noise
PostPosted: Wed Apr 03, 2019 11:22 am 
Offline
User
User
User avatar

Joined: Thu Oct 26, 2017 12:13 pm
Posts: 10
wow, always amazed about the stuff PureBasic is able to produce.

_________________
Michael

Windows 10, PureBasic 5.70 LTS


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 11 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye