Hello, guys,
I wanted to test the effectiveness of a simple method to simulate waves.
I found the result so realistic that I made a little demo of it.
PS: a small bug: the entities forming the ocean tiles sometimes disappear before they are completely removed from the screen, if someone finds the solution...
Code: Select all
; 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("Moving:","")
dt("Cursor + Mouse","")
dt("","")
dt("Commandes:","")
dt("[F1] / [F2]","Amplitude: "+wamp)
dt("[F3] / [F4]","smoothing: "+wlissage)
dt("[F5]","Wireframe")
dt("[Esc]","Quit")
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.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
While WindowEvent() :Wend
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()