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

All times are UTC + 1 hour




Post new topic Reply to topic  [ 29 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Demo 3d - Ocean
PostPosted: Tue Feb 20, 2018 9:23 pm 
Offline
User
User

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

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)

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.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)
  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
    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
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Tue Feb 20, 2018 10:04 pm 
Offline
Addict
Addict

Joined: Mon Feb 16, 2015 2:49 pm
Posts: 1450
This is awesome! :shock: 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
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Tue Feb 20, 2018 10:22 pm 
Offline
Enthusiast
Enthusiast
User avatar

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

_________________
“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
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Tue Feb 20, 2018 10:28 pm 
Offline
Addict
Addict
User avatar

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

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Tue Feb 20, 2018 11:20 pm 
Offline
Addict
Addict

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

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Wed Feb 21, 2018 5:30 am 
Offline
Addict
Addict

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Wed Feb 21, 2018 7:05 am 
Offline
Enthusiast
Enthusiast

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

Great!


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Thu Feb 22, 2018 9:11 am 
Offline
Administrator
Administrator

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Thu Feb 22, 2018 11:34 am 
Offline
User
User
User avatar

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
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Thu Feb 22, 2018 11:37 am 
Offline
PureBasic Protozoa
PureBasic Protozoa
User avatar

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.

_________________
Amateur Radio, D-STAR/VK3HAF


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Thu Feb 22, 2018 3:16 pm 
Offline
Addict
Addict

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
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Thu Feb 22, 2018 6:03 pm 
Offline
User
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
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Thu Feb 22, 2018 10:15 pm 
Offline
Addict
Addict

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Fri Feb 23, 2018 12:49 pm 
Offline
Addict
Addict
User avatar

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

While world=business:world+mafia:Wend
While (world==business) {world+=mafia}


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo 3d - Ocean
PostPosted: Fri Feb 23, 2018 7:40 pm 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 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 forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye