Démo - onde 2D

Guillot · Message par **Guillot** » jeu. 25/juin/2015 22:48

Bonjour à tous,

je suis nouveau sur ce site
j'ai découvert PB y'a 3 mois (et je regrette est de ne pas l'avoir découvert plus tot)
j'ai retrouvé l'envie de programmer que j'avais sur Amiga (je vous parle d'un temps, que les gens de vingt ans...)
il me faudrait des pages pour dire tout le bien que j'en pense, mais bon c'est pas l'endroit

donc ici une petite demo de propagation d'une onde 2D, mais en 3D
plusieurs parametre à faire varier dans le code
resolution, largeur, amplitude des "vagues"...
vous verrez dans les commentaires

Code : Tout sélectionner

; onde 2D - Pf shadoko - 2015

Procedure limite(V, i, s)
  If V < i :ProcedureReturn i:EndIf
  If V > s :ProcedureReturn s:EndIf
  ProcedureReturn V
EndProcedure
Procedure Tlimite(Array T(1), max, marge)
  Protected i
  Dim T(max + 2*marge): For i = 0 To max + marge: T(i+marge) = limite(i, 0, max): Next
EndProcedure
Procedure lisser(Array s.w(2),Array d.w(2), di.w, dj.w)
  Protected i,j,dx,dy,dij,tx
  dy = ArraySize(s(), 1)
  dx = ArraySize(s(), 2)
  Dim ty.l(dx)
  dij = (di * 2 + 1) * (dj * 2 + 1)
  Dim lx(0): Tlimite (lx(), dx, di + 1)
  Dim ly(0): Tlimite (ly(), dy, dj + 1)  
  For i = 0 To dx: ty(i) = s(0,i) * (dj + 1): Next
  For j = 0 To dj - 1: For i = 0 To dx: ty(i) = ty(i) + s(j,i): Next: Next
  For j = 0 To dy
    For i = 0 To dx: ty(i) = ty(i) + s(ly(dj+1+j + dj),i) - s(ly(dj+1+j - dj - 1),i): Next
    tx = ty(0) * (di + 1): For i = 0 To di - 1: tx = tx + ty(i): Next
    For i = 0 To dx: tx = tx + ty(lx(di+1+i + di)) - ty(lx(di+1+i - di - 1) ): d(j,i) = tx / dij: Next
  Next
EndProcedure

Structure Tonde
  cpt.l
  lv.w
  ct.w
  ef.b
  GoNb.b
  dx.w
  dy.w
  Array a0.w(0,0)
  Array a1.w(0,0)
  Array a2.w(0,0)
  Array Tonde.w(255)
  Array gocp.l(63)
  Array mx.l(63)
  Array my.l(63)
EndStructure
Procedure onde2D(*o.tonde)
  Macro sinL(a, li, ls)
    (Sin(a / 512) + 1) * (ls - li) / 2 + li
  EndMacro
  Protected i,pox,poy,aa1
  With *o
    If \cpt=0
      Dim \a0(\dy - 1,\dx - 1)
      Dim \a1(\dy - 1,\dx - 1)
      Dim \a2(\dy - 1,\dx - 1)
      Dim \Tonde(255)
      Dim \gocp(63)
      Dim \mx(63)
      Dim \my(63)
      For i = 0 To \lv: \tonde(i) = \ct * \lv*Sin((2 * i * #PI)/\lv ): Next
      For i = 0 To \GoNb - 1: \gocp(i) = i * (\lv / \GoNb): \mx(i) = 0: \my(i) = 0: Next
    ElseIf \cpt<500
      ; arrivée des perturbations
      For i = 0 To \GoNb - 1
        If \gocp(i) = 0
          Select \ef
            Case 1: pox = Random (\dx - 16,16)         : poy = Random (\dy - 16,16)
            Case 2: pox = sinL(\cpt * 40, 16, \dx - 16): poy = sinL(\cpt * 48, 16, \dy - 16)
            Case 3: pox = sinL(\cpt * 20, 16, \dx - 16): poy = sinL(\cpt * 24, 16, \dy - 16)
          EndSelect
          \mx(i) = pox
          \my(i) = poy
        EndIf
        \a1( \my(i),\mx(i))  - \tonde(\gocp(i))
        \gocp(i) = (\gocp(i) + 1) % \lv
      Next
    EndIf
    ; propagation (si un programmeur ASM veut bien convertir cette routine...)
    CopyArray(\a1(),\a0())
    CopyArray(\a2(),\a1())
    For j = 1 To \dy-2
      For i = 1 To \dx-2
        aa1 = \a1(j,i) /2
        \a2(j,i + 1) + aa1
        \a2(j,i - 1) + aa1
        \a2(j + 1,i) + aa1
        \a2(j - 1,i) + aa1
        \a2(j,i) - \a1(j,i) - \a0(j,i)
      Next
    Next
    ; attenuation (sur les bords), mettez en commentaire, l'onde se reflechira !
    For i = 0 To \dx - 1: \a1(1,i)/2: \a1(\dy-2,i)/2: Next
    For j = 0 To \dy - 1: \a1(j,1)/2: \a1(j,\dx-2)/2: Next 
    \cpt+1
  EndWith
  
EndProcedure

Procedure planmodif(*o.tonde)
  Protected Dim MeshData.PB_MeshVertex(0)
  Protected Dim t.w(*o\dy - 1,*o\dx - 1)
  onde2d(*o)
  ;lissage utile pour éviter un effet de "rides", remplacer "1,1" par "0,0" pour comprendre. inutile si la matiere n'est pas réfléchissante 
  lisser (*o\a2(),t(),1,1)
  GetMeshData(0, 0, MeshData(), #PB_Mesh_Vertex,0, MeshVertexCount(0,0)-1)
  For j=2 To *o\dy-3
    For i=2 To *o\dx-3
      MeshData(j* *o\dx+i)\y =-t(j,i)/64
    Next
  Next
  SetMeshData(0,0, MeshData(), #PB_Mesh_Vertex, 0, MeshVertexCount(0,0)-1)
  NormalizeMesh(0)
EndProcedure

Define.f KeyX, KeyY,keyz, MouseX, MouseY
Define o.tonde
o\dx= 128     ;essayez avec 256 pour les machines un peu rapide
o\dy= 128     ;                    "           "      
o\lv = 8*4    ;largeur des vagues (valeur minimum: 8) 
o\ct = 64     ;hauteur des vagues
o\ef = 1      ;effets [F1/F2/F3]
o\GoNb = 8    ;nombre de "gouttes" simultanées

modif=1  
cpt.l=0   

InitEngine3D()
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Packs/desert.zip", #PB_3DArchive_Zip)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Scripts", #PB_3DArchive_FileSystem)
Parse3DScripts()

InitSprite()
InitKeyboard()
InitMouse()

OpenWindow(0, 0, 0, 0,0, "Onde 2D",#PB_Window_Maximize)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)

CreateCamera(0, 0, 0, 100, 100):MoveCamera(0, -500, 300, -500, #PB_Absolute):CameraLookAt(0, 0, 100, 0)
CreateLight(0,$777777, -10000, 10000, -10000)
AmbientColor($888888)

GetScriptMaterial(1,"CubeMapMaterial"):CubeMapTexture = CreateCubeMapTexture(#PB_Any, 256, 256, "CubeMapTexture")
CreatePlane(0,1025,1025,o\dx-1,o\dy-1,1,1)
CreateEntity(0, MeshID(0), MaterialID(1))
EntityCubeMapTexture(CubeMapTexture, 0)

GetScriptMaterial(2, "SphereMap/SphereMappedRustySteel")
For i=-1 To 1
  For j=-1 To 1
    If i<>0 Or j<>0:CreateEntity(-1,CreateCube(1,1000), MaterialID(2),i*1000,-480,j*1000):EndIf
  Next
Next

SkyBox("Desert07.jpg")


Macro DT(t1,t2)
  DrawText(4,p,t1)
  DrawText(60,p,t2)
  p+16
EndMacro
CreateSprite(0,120,210,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AlphaClip|#PB_2DDrawing_Outlined )
Box(0,0,120,210)
BackColor($0000ff)
dt("Déplacements:","")
dt("[Left]","")
dt("[Right]","")
dt("[Up]","")
dt("[Down]","")
dt("Mouse+wheel","")
dt("","")
dt("Commandes:","")
dt("[F1]","Pluie")
dt("[F2]","Courbe1")
dt("[F3]","Courbe2")
dt("[Space]","Pause")
dt("[Esc]","Quitter")
StopDrawing()


Repeat
  WindowEvent()
  ExamineMouse()
  MouseX = -MouseDeltaX() *  0.05
  MouseY = -MouseDeltaY() *  0.05
  ExamineKeyboard()
  keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*2
  keyy=(-Bool(KeyboardPushed(#PB_Key_Up  )<>0)+Bool(KeyboardPushed(#PB_Key_Down )<>0))*2+-MouseWheel()*50
  modif+Bool(KeyboardReleased(#PB_Key_Space)<>0)
  If KeyboardReleased(#PB_Key_F1):o\cpt=0:o\ef=1:modif=1:EndIf
  If KeyboardReleased(#PB_Key_F2):o\cpt=0:o\ef=2:modif=1:EndIf
  If KeyboardReleased(#PB_Key_F3):o\cpt=0:o\ef=3:modif=1:EndIf
  RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
  MoveCamera  (0, KeyX, keyz, KeyY)
  cpt+1
  If (modif & 1) And (cpt%2=0):planmodif(o):EndIf
  RenderWorld()
  DisplayTransparentSprite(0, 8,8,128)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

End

Tous ce que je vais enfin pouvoir faire...

comtois · Message par **comtois** » ven. 26/juin/2015 0:05

Splendide !

Tu démarres fort, sois le bienvenu.

microdevweb · Message par **microdevweb** » ven. 26/juin/2015 6:38

Très belle démo, et bienvenue.

falsam · Message par **falsam** » ven. 26/juin/2015 7:22

Je suis fan et sois le bienvenu. Vivement le prochain code

Guillot a écrit :j'ai découvert PB y'a 3 mois

Comment avez vous (ou as tu) connu PureBasic ?

majikeyric · Message par **majikeyric** » ven. 26/juin/2015 7:22

Très joli! Bienvenu !

djes · Message par **djes** » ven. 26/juin/2015 8:14

Miam ! Superbe ! Bienvenue ! (un amigaïste, forcément quelqu'un de bien

)

Marc56 · Message par **Marc56** » ven. 26/juin/2015 8:37

Whao

Le résultat est splendide et le code est plein petites de subtilités.
On sent le programmeur expérimenté, découvrant PB et qui à pris soin de lire toute la doc pour tirer le meilleur parti.

Chapeau Monsieur.

Message par **Fred** » ven. 26/juin/2015 8:58

Tres bien foutu

Guillot · Message par **Guillot** » ven. 26/juin/2015 11:12

merci à tous pour votre accueil, ça fait plaisir
(je vois que même le grand manitou s'est déplacé !)

a falsam:
ouai, c'est une bonne question
ça mériterai d'ouvrir un sujet de discussion (si c'est pas dejà fait)
PB est trop peu visible sur la toile
je me suis demandé comment j'avais pu passer à coté si longtemps

Ar-S · Message par **Ar-S** » ven. 26/juin/2015 11:27

djes a écrit :Miam ! Superbe ! Bienvenue ! (un amigaïste, forcément quelqu'un de bien )

Djes à tout dit

Welcome et bravo.

majikeyric · Message par **majikeyric** » ven. 26/juin/2015 15:06

djes a écrit :(un amigaïste, forcément quelqu'un de bien )

je plussoie

G-Rom · Message par **G-Rom** » ven. 26/juin/2015 16:10

j'ai découvert PB y'a 3 mois

donc ici une petite demo de propagation d'une onde 2D, mais en 3D

T'envoie du paté , bienvenu à toi parmi nous.

blendman · Message par **blendman** » ven. 26/juin/2015 20:16

Bienvenue à toi.
C'est très sympa, et ça tourne plutôt pas mal.

C'est vrai que Purebasic manque un peu de visibilité et quand on le découvre, on regrette de ne pas l'avoir découvert avant ^^.

case · Message par **case** » ven. 26/juin/2015 22:45

blendman a écrit : C'est très sympa, et ça tourne plutôt mal.

t'as pas oublié un mot ?

sinon bienvenue a toi Guillot:)

G-Rom · Message par **G-Rom** » sam. 27/juin/2015 1:36

Tu picoles case ?

PureBasic

Démo - onde 2D

Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D

Re: Démo - onde 2D