Page 1 sur 1

demo - Perlin

Publié : jeu. 28/mars/2019 22:42
par Guillot
Image

salut les gars,

j'ai mis au propres un ancien code pour faire du bruit de perlin en 3d, ça permet de deformer des objets
c'est assez simple d'utilisation:
on definit notre 'espace de perlin' avec la fonction InitPerlinNoise en entrant une liste de frequences et d'amplitudes
ensuite il suffit d'utiliser la fonction PerlinNoise3D pour modifier les coordonnées 3d
dans l'exemple suivant la forme d'origine est une sphere

j'ai également tester cette fonction pour appliquer une texture, (appuyer sur [F2])
les resultats sont tres inegaux, mais je pense qu'avec une texture appropriée on doit pouvoir faire de tres joli mappage de bois ou de marbre
l'interet est surtout de pouvoir couvrir des formes 'fermée' (genre sphere) en evitant le probleme de 'convergence polaire' ou de 'couture' visible (si vous voyez ce que je veux dire...)
couvrir une sphere est un vrai casse tête
(la prochaine version de PB gérera les textures cubemap, mais pour les creer c'est pas fastoche)

[EDIT]
j'ai ajouté la possibilité de changer de mesh:
sphere, tore, cylindre et cone
(appuyer sur [F1] )

Code : Tout sélectionner

; 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()

Re: demo - Perlin

Publié : jeu. 28/mars/2019 23:05
par SPH
Ho la vache, je suis fou !!!!!!!! 8O

Vivement que je m'y mette aussi (a la 3D) :idea:

Re: demo - Perlin

Publié : ven. 29/mars/2019 8:34
par Micoute
Merci professeur Shadoko, ça valait le coup de mettre au propre, c'est fantastiquement inouï, les résultats qui en ressortent.

Re: demo - Perlin

Publié : ven. 29/mars/2019 9:57
par MLD
Un Seul mot Génial :lol: :lol: :lol:

Re: demo - Perlin

Publié : ven. 29/mars/2019 16:53
par Ar-S
Concis, beau, fonctionnel, fluide... Toujours top quoi.
Merci.

Re: demo - Perlin

Publié : ven. 29/mars/2019 20:27
par Mouillard
Bravo une nouvelle fois PF Shadoko :)
C'est tout simplement FORMIDABLE :roll:
Incroyable que l'on puisse obtenir autant de clarté et de mise en forme avec 3D de PureBasic ... :idea: Merci

Re: demo - Perlin

Publié : ven. 29/mars/2019 21:50
par falsam
SPH a écrit :Ho la vache, je suis fou !!!!!!!! 8O

Vivement que je m'y mette aussi (a la 3D) :idea:
Fou c'est pas une nouveauté ^^
Commence par comprendre les procédures ...... hahahahha ..... banane :P

Merci Guillot pour ce partage qui a rejoint tes autres codes sur mon disque ;)

Re: demo - Perlin

Publié : dim. 31/mars/2019 19:10
par Kwai chang caine
Kwaï chang caine déjà a écrit :Si seulement il existait des mots pour qualifier ton travail 8O :oops:
Image

Image