piece of code made by pf_shadoko. It is way better than the
one in Purebasic. So I've made it into a reusable module.
It has some quirks (doesn't look right) and if someone can spot the error or missing/misplaced
variables - it would be appreciated. I've gone blind looking at the code - for now.
Code: Select all
DeclareModule Sea
Declare.i InitWater(l = 128, wamp = 8, wlissage = 0)
Declare.i UpdateSea()
Declare.i Amplitude(valu = 1)
Declare.i Smoothing(valu = 1)
EndDeclareModule
Module Sea
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)
Global Dim MeshData.PB_MeshVertex(0)
Global Dim ewater.i(81)
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 * 2
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 * Cos(2)
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 * 2
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
Procedure Amplitude(valu = 1)
wamp + Valu
wamp = limite(wamp,1,16)
EndProcedure
Procedure Smoothing(valu = 1)
wlissage + Valu
wlissage = limite(wlissage,0,8)
EndProcedure
Procedure initwater(l = 128, wamp = 8, wlissage = 0)
Define foam, j, z, x, y = 0
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
CreateTexture(0,512,512)
StartDrawing(TextureOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels )
DrawingMode(#PB_2DDrawing_AlphaBlend!#PB_2DDrawing_Gradient)
GradientColor(0,$ff6666)
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))
AddMaterialLayer(0, TextureID(foam), #PB_Material_Add)
ScrollMaterial(0, 0.006, 0.033, #PB_Material_Animated, 1)
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
If IsEntity(ewater(y)) : FreeEntity(ewater(y)) : EndIf
ewater(y) = CreateEntity(#PB_Any ,MeshID(0),MaterialID(0),i*(wlarg+1),0,j*(wlarg+1))
y + 1
;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)
EndProcedure
Procedure.i UpdateSea()
Static.f dif
Static i1, i2, di, dj, cpt, cv
Define i, j, jj, c, v
If wamp<>awamp Or wlissage<>awlissage:initwater(wlarg,wamp,wlissage):EndIf
;------------------- wave movement
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)
ProcedureReturn #True
EndProcedure
EndModule
InitEngine3D()
InitSprite()
InitKeyboard()
OpenWindow(0, 0, 0, 800, 600, "Waves made by pf Shadoko - moduled by DK_PETER", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, 800, 600)
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 10, 0)
Sea::InitWater()
Repeat
Repeat : ev = WindowEvent() : Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_A) ; Amplitude
Sea::Amplitude()
ElseIf KeyboardReleased(#PB_Key_S) ; Smoothing
Sea::Smoothing()
EndIf
ret = Sea::UpdateSea()
RenderWorld()
FlipBuffers()
Until KeyboardReleased(#PB_Key_Escape)