PureBasic

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