PureBasic

Forums PureBasic
Nous sommes le Mer 18/Sep/2019 14:46

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 16 messages ]  Aller à la page 1, 2  Suivante
Auteur Message
 Sujet du message: Démo 3D : Océan
MessagePosté: Mar 20/Fév/2018 21:10 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 267
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:
; 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()


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo 3D : Océan
MessagePosté: Mar 20/Fév/2018 21:19 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8750
Salut Shadoko
On te voit peu mais quand on te voit ça claque.
Je n'ai pas remarqué de bug spéciaux.

_________________
~~~~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: Démo 3D : Océan
MessagePosté: Mar 20/Fév/2018 21:35 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6849
Localisation: IDF (Yvelines)
J'aime beaucoup et tout comme Ar-s Je n'ai pas vu de bug. Bravo et merci :)

_________________

➽ 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: Démo 3D : Océan
MessagePosté: Mar 20/Fév/2018 21:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4066
super :idea:

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

_________________
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: Démo 3D : Océan
MessagePosté: Mar 20/Fév/2018 23:36 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4223
Localisation: Arras, France
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo 3D : Océan
MessagePosté: Mer 21/Fév/2018 8:47 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2172
Localisation: 50200 Coutances
Merci pour le partage, je suis enthousiasmé, j'adore ce travail bien fait.

_________________
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: Démo 3D : Océan
MessagePosté: Mer 21/Fév/2018 16:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1655
Localisation: Belgique
superbe

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo 3D : Océan
MessagePosté: Mer 21/Fév/2018 17:58 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2065
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 ) :)

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo 3D : Océan
MessagePosté: Mer 21/Fév/2018 18:38 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 267
à 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")


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo 3D : Océan
MessagePosté: Mer 21/Fév/2018 19:45 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2065
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 :)

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo 3D : Océan
MessagePosté: Jeu 22/Fév/2018 10:18 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4066
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

_________________
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: Démo 3D : Océan
MessagePosté: Jeu 22/Fév/2018 10:47 
Hors ligne
Avatar de l’utilisateur

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

_________________

➽ 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: Démo 3D : Océan
MessagePosté: Jeu 22/Fév/2018 11:12 
Hors ligne
Avatar de l’utilisateur

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

_________________

➽ 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: Démo 3D : Océan
MessagePosté: Jeu 22/Fév/2018 11:17 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4066
Citation:
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:

_________________
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: Démo 3D : Océan
MessagePosté: Jeu 22/Fév/2018 11:19 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6849
Localisation: IDF (Yvelines)
Pti con :mrgreen:

_________________

➽ 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  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 16 messages ]  Aller à la page 1, 2  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


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