PureBasic Forum

 It is currently Sun Jul 22, 2018 9:32 pm

 All times are UTC + 1 hour

 Page 1 of 2 [ 29 posts ] Go to page 1, 2  Next
 Print view Previous topic | Next topic
Author Message
 Post subject: Demo 3d - OceanPosted: Tue Feb 20, 2018 9:23 pm
 User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 28

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:
; 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)

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
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)

;------------------- 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  )
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()

Top

 Post subject: Re: Demo 3d - OceanPosted: Tue Feb 20, 2018 10:04 pm

Joined: Mon Feb 16, 2015 2:49 pm
Posts: 1450
This is awesome! Way above my level of understanding but it looks fantastic. Can you make it so going under the water turns the screen blue, instead of clear?

Top

 Post subject: Re: Demo 3d - OceanPosted: Tue Feb 20, 2018 10:22 pm
 Enthusiast

Joined: Sat Feb 19, 2011 10:06 am
Posts: 727
Location: Denmark
Wow! That is damn awesome!! Very nicely done!

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 7/10, Intel 6800K, Gtx 970, 32 gb ram.

Top

 Post subject: Re: Demo 3d - OceanPosted: Tue Feb 20, 2018 10:28 pm

Joined: Fri May 12, 2006 6:51 pm
Posts: 1293
Location: Germany
Very nice

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu

Top

 Post subject: Re: Demo 3d - OceanPosted: Tue Feb 20, 2018 11:20 pm

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1581
Location: Uttoxeter, UK
Awesome!

_________________
DE AA EB

Top

 Post subject: Re: Demo 3d - OceanPosted: Wed Feb 21, 2018 5:30 am

Joined: Sun Jun 25, 2006 7:28 pm
Posts: 1308
very nice demo as usual.
Thanks

Top

 Post subject: Re: Demo 3d - OceanPosted: Wed Feb 21, 2018 7:05 am
 Enthusiast

Joined: Fri Feb 19, 2010 3:42 am
Posts: 472
Wow; I don't understand where comes all the water from

Great!

Top

 Post subject: Re: Demo 3d - OceanPosted: Thu Feb 22, 2018 9:11 am

Joined: Fri May 17, 2002 4:39 pm
Posts: 13330
Location: France
This is very nice, thanks !

Top

 Post subject: Re: Demo 3d - OceanPosted: Thu Feb 22, 2018 11:34 am
 User

Joined: Mon Jan 31, 2005 11:57 am
Posts: 41
Quote:
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...

I've been looking at that, it seems to be a camera clipping issue.

If the camera is travelling when y is 0 then the mesh never disappears early.

If you manage to stop the camera moving when an error appears then you can look up and it disappears and down and it reappears.
It only seems to happen on the corners of an entity when there is a high point nearby.

I'll have another think and get back to you again

Top

 Post subject: Re: Demo 3d - OceanPosted: Thu Feb 22, 2018 11:37 am
 PureBasic Protozoa

Joined: Fri Apr 25, 2003 3:08 pm
Posts: 4235
Location: Not Sydney!!! (Bad water, no goats)
I wish I had your talent. Would love to have those waves as a program heading with floating text above it.

_________________

Top

 Post subject: Re: Demo 3d - OceanPosted: Thu Feb 22, 2018 3:16 pm

Joined: Sun Jun 25, 2006 7:28 pm
Posts: 1308
i have faced this hole in the waves but can't repeat it again:
https://s18.postimg.org/hpskzic55/ocean.jpg
this is when stopping the camera from moving (by commenting -MouseWheel()*2-1 at the end of line 215) then going down and again up then looking down
but with the camera move sometimes a transient thing like in the picture happened but it is barely noticed.

Top

 Post subject: Re: Demo 3d - OceanPosted: Thu Feb 22, 2018 6:03 pm
 User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 28
for Dude:
replace line 216 by this
Code:
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera  (0, KeyX, 0, keyz) :MoveCamera(0,Mod(CameraX(0),wlarg),CameraY(0),Mod(CameraZ(0),wlarg),#PB_Absolute)
If CameraY(0)<0
CameraBackColor(0,\$332200):Fog(\$332200,100,0,200)
MaterialCullingMode(0,#PB_Material_AntiClockWiseCull)
Else
CameraBackColor(0,\$ff8888):Fog(\$ff8888,100,0,4* wlarg)
MaterialCullingMode(0,#PB_Material_ClockWiseCull)
EndIf

for ApplePi:
I didn't find the reason for this bug.
UpdateMeshBoundingBox does not change anything

Top

 Post subject: Re: Demo 3d - OceanPosted: Thu Feb 22, 2018 10:15 pm

Joined: Mon Feb 16, 2015 2:49 pm
Posts: 1450
Thanks for the "underwater" fix. Much more realistic now.

Top

 Post subject: Re: Demo 3d - OceanPosted: Fri Feb 23, 2018 12:49 pm

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4423
Location: Spa, relaxing and thinking, and learning...
Looks great, but here it doesn't work with PB5.62, WinXP pro 32bit, nVidia GForce 730
With debugger:
Get Message "debugger quits unexpectatly", and program ends.
Without debugger:
Program just ends as soon is starts.

_________________
http://www.zeitgeistmovie.com

Top

 Post subject: Re: Demo 3d - OceanPosted: Fri Feb 23, 2018 7:40 pm
 Enthusiast

Joined: Mon Jul 09, 2007 4:47 pm
Posts: 214
Location: Courthouse
Incredible, but only runs with debugger for me?

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 2 [ 29 posts ] Go to page 1, 2  Next

 All times are UTC + 1 hour

Who is online

Users browsing this forum: No registered users and 2 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite