demo - Perlin

Généralités sur la programmation 3D
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

demo - Perlin

Message 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()
Dernière modification par Guillot le ven. 29/mars/2019 19:14, modifié 2 fois.
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: demo - Perlin

Message par SPH »

Ho la vache, je suis fou !!!!!!!! 8O

Vivement que je m'y mette aussi (a la 3D) :idea:
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: demo - Perlin

Message par Micoute »

Merci professeur Shadoko, ça valait le coup de mettre au propre, c'est fantastiquement inouï, les résultats qui en ressortent.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: demo - Perlin

Message par MLD »

Un Seul mot Génial :lol: :lol: :lol:
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: demo - Perlin

Message par Ar-S »

Concis, beau, fonctionnel, fluide... Toujours top quoi.
Merci.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Mouillard
Messages : 77
Inscription : mer. 13/sept./2017 14:35
Localisation : Picardie (Somme)

Re: demo - Perlin

Message 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
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: demo - Perlin

Message 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 ;)
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: demo - Perlin

Message 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
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Répondre