PureBasic

Forums PureBasic
Nous sommes le Lun 24/Juin/2019 18:32

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 
Auteur Message
 Sujet du message: demo - Perlin
MessagePosté: Jeu 28/Mar/2019 22:42 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 257
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:
; 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 édition par Guillot le Ven 29/Mar/2019 19:14, édité 2 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Jeu 28/Mar/2019 23:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3964
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Ven 29/Mar/2019 8:34 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2137
Localisation: 50200 Coutances
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 GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Ven 29/Mar/2019 9:57 
Hors ligne

Inscription: Jeu 05/Fév/2009 17:58
Messages: 880
Un Seul mot Génial :lol: :lol: :lol:


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Ven 29/Mar/2019 16:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8668
Concis, beau, fonctionnel, fluide... Toujours top quoi.
Merci.

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Ven 29/Mar/2019 20:27 
Hors ligne

Inscription: Mer 13/Sep/2017 14:35
Messages: 61
Localisation: Picardie (Somme)
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Ven 29/Mar/2019 21:50 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6821
Localisation: IDF (Yvelines)
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 ;)

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: demo - Perlin
MessagePosté: Dim 31/Mar/2019 19:10 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6623
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye