PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Démo 3D : Océan

https://www.purebasic.fr/french/viewtopic.php?t=17164

Page 1 sur 2

Démo 3D : Océan

Publié : mar. 20/févr./2018 21:10
par Guillot
Image

Salut les gars,

je voulais tester l’efficacité d'une méthode simple pour simuler des vagues
j'ai trouvé le résultat tellement réaliste que j'en ai fait une petite démo

PPS : un petit bug : les entités formant les tuilles de l'océan disparaissent parfois avant d'être complétement sorti de l'écran, si quelqu'un trouve la solution...

Code : Tout sélectionner

; Démo 3D : Océan - Pf Shadoko - 2018

Procedure.f Mini(v1.f,v2.f)
  If v1<v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure

Procedure.f Maxi(v1.f,v2.f)
  If v1>v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure

Procedure limite(V, i, s)
  If V < i :v=i:EndIf
  If V > s :v=s:EndIf
  ProcedureReturn V
EndProcedure

Procedure carte(Array t.w(2), dx.w, dy.w, Re.w)
  Protected i,j,ii,jj,im,jm,ip,jp,n,d,dd,dx1=dx-1,dy1=dy-1,l,ap,ap2,R, rr
  Macro calcij(v)
    im=(i - v) & dx1
    jm=(j - v) & dy1
    ip=(i + v) & dx1
    jp=(j + v) & dy1
  EndMacro 
  n = 1<<re
  dd=mini(dx,dy) / n: If dd<1:dd=1:EndIf
  Dim t.w(dy1, dx1)
  ap = $1fff:ap2=ap>>1
  For jj = 0 To dy/dd - 1:j=jj*dd: For ii = 0 To dx/dd - 1:i=ii*dd: t(j,i) = Random(ap)-ap2: Next: Next
  l = dd
  While dd > 1
    d = dd / 2
    rr = ap * Sqr(2): R = rr / 2
    For jj = 0 To dy/dd - 1  :j=jj*dd+d
      For ii = 0 To dx/dd - 1:i=ii*dd+d
        calcij(d)
        t(j,i) = (t(jm,im) + t(jm,ip) + t(jp,ip) + t(jp,im)) / 4 + Random(rr) - R
      Next
    Next
    rr = ap: R = rr / 2
    For jj = 0 To dy/dd - 1  :j=jj*dd
      For ii = 0 To dx/dd - 1:i=ii*dd+d
        calcij(d)
        t(j,i) = (t(j,im) + t(j,ip) + t(jm,i) + t(jp,i)) / 4 + Random(rr) - R
      Next
    Next
    For jj = 0 To dy/dd - 1  :j=jj*dd+d
      For ii = 0 To dx/dd - 1:i=ii*dd
        calcij(d)
        t(j,i) = (t(j,im) + t(j,ip) + t(jm,i) + t(jp,i)) / 4 + Random(rr) - R
      Next
    Next
    l >> 1
    dd>>1
    ap >> 1
  Wend 
EndProcedure

Procedure t2norme(Array t.w(2),dmin.w,dmax.w)
  Protected smin.w,smax.w,dx1,dy1,i,j,sr,dr
  dy1 = ArraySize(t(), 1)
  dx1 = ArraySize(t(), 2)
  smax = -32768
  smin =  32767
  For j=0 To dy1
    For i=0 To dx1
      If t(j,i)>smax : smax=t(j,i): EndIf
      If t(j,i)<smin : smin=t(j,i): EndIf
    Next
  Next
  sr=smax-smin
  dr=dmax-dmin
  
  For j=0 To dy1
    For i=0 To dx1
      t(j,i)=(t(j,i)-smin)*dr/sr+dmin
    Next
  Next
EndProcedure

Procedure Tmodulo(Array T(1), max, marge)
  Protected i,d=max-(marge+1)/2
  Dim T(max + 2*marge+2): For i = 0 To max + 2*marge+2: T(i) = (i+d) % (max+1): Next 
EndProcedure

Procedure lisser2D(Array s.w(2),di.w, dj.w,pass=1)
  If di=0 And dj=0:ProcedureReturn:EndIf
  Protected i,j,k,dii,djj,dx,dy,dij,tx
  dx = ArraySize(s(), 2):di=mini(di,dx)
  dy = ArraySize(s(), 1):dj=mini(dj,dy)
  Dim d.w(dy,dx)
  dii=di+1
  djj=dj+1
  dij = dii * djj
  Dim lx(0): Tmodulo (lx(), dx, di)
  Dim ly(0): Tmodulo (ly(), dy, dj) 
  For k=1 To pass
  Dim ty.l(dx)
  For j = 0 To djj - 1: For i = 0 To dx: ty(i) + s(ly(j),i): Next: Next    
  For j = 0 To dy
    For i = 0 To dx: ty(i) + s(ly(djj+j),i) - s(ly(j),i): Next
    tx=0:For i = 0 To dii-1: tx+ty(lx(i)): Next
    For i = 0 To dx: tx + ty(lx(dii+i)) - ty(lx(i) ): d(j,i) = tx / dij: Next
  Next
  CopyArray(d(),s())
  Next
EndProcedure

;###############################################################################################################################
Global wlarg=128,wlarg1=wlarg-1,    awamp,wamp=8,   awlissage,wlissage=0
Global Dim t.w(wlarg1,wlarg1)
Global Dim tf.f(wlarg1,wlarg1)
Global Dim atf.f(wlarg1,wlarg1)

Procedure menu()
  Protected p=8
  Macro DT(t1,t2)
    DrawText(8,p,t1)
    DrawText(100,p,t2)
    p+22
  EndMacro
  CreateSprite(0,220,200,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(0))
  DrawingMode(#PB_2DDrawing_AllChannels)
  DrawingFont(FontID(0))
  Box(0,0,220,200,$44000000)
  DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
  Box(0,0,220,200,$ffffffff)
  BackColor($44000000)
  FrontColor($ffffffff)
  dt("Déplacements:","")
  dt("Curseur + Souris","")
  dt("","")
  dt("Commandes:","")
  dt("[F1] / [F2]","Ampliture: "+wamp)
  dt("[F3] / [F4]","Lissage: "+wlissage)
  dt("[F5]","Fil de fer")
  dt("[Esc]","Quitter")
  StopDrawing()
EndProcedure

Procedure initwater(l,wamp,wlissage)
  ReDim tf.f(wlarg1,wlarg1)
  ReDim atf.f(wlarg1,wlarg1)
  RandomSeed(1)
  carte(t(),wlarg,wlarg,1)
  lisser2d(t(),wlissage,wlissage)
  t2norme(t(),-wamp*64,wamp*64)
  awamp=wamp
  awlissage=wlissage
  menu()
EndProcedure

Procedure vagues3d()
  Define ex,ey
  Define.f x,y,z,dif
  Define i,j,jj,c,v
  Define i1,i2,  di,dj, cpt,cv
  
  Define.f MouseX,Mousey,keyx,keyy,keyz, fdf
  Dim MeshData.PB_MeshVertex(0)
  
  InitEngine3D():InitSprite():InitKeyboard():InitMouse()
  
  OpenWindow(0, 0, 0, 0,0, "",#PB_Window_Maximize|#PB_Window_SystemMenu)
  ex=WindowWidth (0,#PB_Window_InnerCoordinate)
  ey=WindowHeight(0,#PB_Window_InnerCoordinate)
  OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
  LoadFont(0,"arial",14)
  
  ;------------------- scene
  initwater(wlarg,wamp,wlissage)
  CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,10,1)
  CameraBackColor(0,$ff8888) :CameraLookAt(0,-10,10,-10)
  CreateLight(0,$888888, 10000, 5000, 2000)
  AmbientColor($aaaaaa)
  Fog($ff8888,100,0,4*wlarg)
  
  CreateTexture(0,512,512)
  StartDrawing(TextureOutput(0))
  DrawingMode(#PB_2DDrawing_AllChannels  )
  DrawingMode(#PB_2DDrawing_AlphaBlend!#PB_2DDrawing_Gradient)
  GradientColor(0,$ffFFFF)
  GradientColor(0.2,$ff885500)
  GradientColor(0.4,$ff443300)
  GradientColor(0.6,$ff222200)
  GradientColor(1.0,$ff2222000)
  CircularGradient(256,160,600)     
  Box(0,0,512,512)
  StopDrawing()
  CreateMaterial(0, TextureID(0))
  SetMaterialAttribute(0,#PB_Material_EnvironmentMap,#PB_Material_ReflectionMap)
  
  ;------------------- océan
  CreatePlane(0,wlarg+1,wlarg+1,wlarg,wlarg,1,1)
  For i=-4 To 4
    For j=-4 To 4
      CreateEntity(-1,MeshID(0),MaterialID(0),i*(wlarg+1),0,j*(wlarg+1))
    Next
  Next
  
  GetMeshData(0, 0, MeshData(), #PB_Mesh_Vertex,0, MeshVertexCount(0,0)-1)
  
  Repeat
    WindowEvent()  
    ExamineMouse()
    ExamineKeyboard()
    MouseX = -MouseDeltaX() *  0.05
    MouseY = -MouseDeltaY() *  0.05
    wamp    +(KeyboardReleased(#PB_Key_F2)-KeyboardReleased(#PB_Key_F1)):wamp=limite(wamp,1,16)
    wlissage+(KeyboardReleased(#PB_Key_F4)-KeyboardReleased(#PB_Key_F3)):wlissage=limite(wlissage,0,8)
    If wamp<>awamp Or wlissage<>awlissage:initwater(wlarg,wamp,wlissage):EndIf
    If KeyboardReleased(#PB_Key_F5):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
    keyx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*1
    keyz=(-Bool(KeyboardPushed(#PB_Key_Up  ))+Bool(KeyboardPushed(#PB_Key_Down )))*1-MouseWheel()*2-1
    RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera  (0, KeyX, 0, keyz) :MoveCamera(0,Mod(CameraX(0),wlarg+1),maxi(CameraY(0),0.1),Mod(CameraZ(0),wlarg+1),#PB_Absolute) 
    
    ;------------------- mouvement des vagues
    dif+0.1:di=dif
    For j=0 To wlarg1
      For i=0 To wlarg1
        i1=(i-di) & wlarg1
        i2=(i+di) & wlarg1
        tf(i,j)+((t(i1,j)+t(wlarg1-i2,wlarg1-j))/128-atf(i,j))*0.1        
      Next
    Next
    CopyArray(tf(),atf())
    cv=0
    For j=0 To wlarg:jj=j & wlarg1
      For i=0 To wlarg
        MeshData(cv)\y =tf(jj,i & wlarg1):cv+1
      Next
    Next
    SetMeshData(0,0, MeshData(), #PB_Mesh_Vertex, 0, MeshVertexCount(0,0)-1)
    NormalizeMesh(0)
    ;UpdateMeshBoundingBox(0)
    
    RenderWorld()
    DisplayTransparentSprite(0,8,8)
    FlipBuffers()
  Until KeyboardPushed(#PB_Key_Escape)
EndProcedure

vagues3d()

Re: Démo 3D : Océan

Publié : mar. 20/févr./2018 21:19
par Ar-S
Salut Shadoko
On te voit peu mais quand on te voit ça claque.
Je n'ai pas remarqué de bug spéciaux.

Re: Démo 3D : Océan

Publié : mar. 20/févr./2018 21:35
par falsam
J'aime beaucoup et tout comme Ar-s Je n'ai pas vu de bug. Bravo et merci :)

Re: Démo 3D : Océan

Publié : mar. 20/févr./2018 21:43
par SPH
super :idea:

Le bug dont tu parles, c'est l'artefact blanc que l'on vois parfois en bas de l"'ecran ?

Re: Démo 3D : Océan

Publié : mar. 20/févr./2018 23:36
par djes
Magnifique ! Ce ne serait pas un portage du plugin ocean qui sert dans de nombreux softs 3D ? Je m'étais servi de la version pour lightwave https://www.lightwave3d.com/assets/plug ... lightwave/
J'adore :D

Re: Démo 3D : Océan

Publié : mer. 21/févr./2018 8:47
par Micoute
Merci pour le partage, je suis enthousiasmé, j'adore ce travail bien fait.

Re: Démo 3D : Océan

Publié : mer. 21/févr./2018 16:43
par microdevweb
superbe

Re: Démo 3D : Océan

Publié : mer. 21/févr./2018 17:58
par Zorro
tres joli , :)

cependant il y a un truc qui manque !

là tes vagues restent figées , et c'est les "microvague" a leur surface qui bougent (tres bien )
mais le Relief c'ets a dire les Vraies Vagues , elles restent figées ...
il faudrai que tu puisses modifier la hauteur de ce relief (les Grandes Vagues ) :)

Re: Démo 3D : Océan

Publié : mer. 21/févr./2018 18:38
par Guillot
à zorro:
non, pour t'en rendre compte, appuis sur la touche "curseur bas", ça immobilisera la camera
tu peux aussi appuyer sur f4 pour lisser les vagues (gommer les les "microvagues")

Re: Démo 3D : Océan

Publié : mer. 21/févr./2018 19:45
par Zorro
oui effectivement, mais le changement d'amplitude des grands relief est bien trop long
alors que celui des sous-vagues est lui parfait

il faudrai accélérer le changement de phase des Gros relief (grosses vagues )
sinon , c'est vraiment tres bon comme rendu :)

Re: Démo 3D : Océan

Publié : jeu. 22/févr./2018 10:18
par SPH
Salut,

en essayant de compiler le code de guillot, l'exe buggue.

C'est important pour moi car je veux utiliser cet effet dans un de mes programmes.

Pourriez vous de dire ce qui buggue ?

ps : je suis en 5.60

Re: Démo 3D : Océan

Publié : jeu. 22/févr./2018 10:47
par falsam
Sacré SPH. Je crois qu'on sait lire. Pas la peine de mettre en gras, rouge etc .... :mrgreen:
SPH a écrit :l'exe buggue
1-Crée un exe que tu nomme test-directx11.exe
2-Dans les options de compilation, ajoute le sous-system OpenGL
3-Crée un autre exe que tu nommes test-opengl.exe
4-Crée un dossier bin dans lequel tu copies ces deux exe et engine3d.dll que tu trouveras dans ton dossier d'installation de PB 5.60 (Dossier compiler)
5-Tu peux maintenant tester les exe.

Re: Démo 3D : Océan

Publié : jeu. 22/févr./2018 11:12
par falsam
j'ai fait un essai Directx11 et OpenGl : Pas de souci

Lien : http://falsam.com/Download/purebasic/Vagues.zip

Les codes sont compilés avec PB 5.62 (x64). La dll ne convient pas à PB 5.61 (x86)

Re: Démo 3D : Océan

Publié : jeu. 22/févr./2018 11:17
par SPH
11:16 falsam send gesture /yeah
11:16 falsam héhé
11:16 SPH YOUPPIIIIIIIIII
11:16 SPH j'ai fini mon jeu
11:16 SPH ha la vache, c'est super ! ca marche
11:15 falsam Et dit merci sur le forum insolent ::p
:mrgreen:

Re: Démo 3D : Océan

Publié : jeu. 22/févr./2018 11:19
par falsam
Pti con :mrgreen:
Fuseau horaire sur UTC+01:00
Page 1 sur 2

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru