Demo 3D - Ocean v1.5

Everything related to 3D programming
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Demo 3D - Ocean v1.5

Post by pf shadoko »

Image

I updated my ocean demo.
I'm now dealing with the swell, the sea spray and the foam...
I put it in a module for easier implementation.

- initocean(tilesize,prec,range,material,particule,waveheight.f,swellheight.f) (some explanations in the code)
- freeocean()
- oceanHeight(x.f,z.f)
- oceanset(waveheight.f,swellheight.f)
- renderocean()

remains the management of the LOD

Disable the debugger

Code: Select all

; Démo 3D : Océanv1.5 - Pf Shadoko - 2020

EnableExplicit

DeclareModule ext_3D
    EnableExplicit
        
    Structure f3
        x.f
        y.f
        z.f
    EndStructure
    
    Structure f2
        x.f
        y.f
    EndStructure
    
    Structure PB_MeshVertexV
        p.f3
        n.f3
        t.f3
        u.f
        v.f
        color.l
    EndStructure
    
    ;________________ Lib ________________
    Declare.f lng3D(*v.f3)    
    Declare norme3d(*v.f3,l.f=1)    
    Declare.f Max(v1.f,v2.f)
    Declare.f Min(v1.f,v2.f)
    Declare.f limite(V.f, i.f, s.f) 
    Declare.i Modi(v,divisor)
    Declare.f interpolarray2d(Array tt.f(2),x.f,y.f) 
    Declare Split(Array t.s(1),l.s,sep.s=",",nmax=100)
    Declare ColorBlend(color1.l, color2.l, blend.f) 
    Declare GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0) 
    Declare heightmap(Array t.w(2),rnd, dx.w, dy.w, Re.w) 
    Declare texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=-10,grad.s="0,$000000/1,$ffffff",profil.s="0,0/1,1") 
    
    ;________________ océan ________________
    Declare initocean(tilesize,prec,range,material,particule,waveheight.f,swellheight.f)
    Declare freeocean()
    Declare renderocean()
    Declare.f oceanHeight(x.f,z.f)
    Declare oceanset(waveheight.f,swellheight.f)
EndDeclareModule

Module ext_3D
    
    ;{ lib
    Macro vec3d(v,vx,vy,vz)
        v\x=vx
        v\y=vy
        v\z=vz
    EndMacro
    
    Procedure.f lng3D(*v.f3)
        ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
    EndProcedure
    
    Procedure Norme3D(*V.f3,l.f=1)
        Protected.f lm
        lm = l / lng3D(*v)
        *V\x * lm
        *V\y * lm
        *V\z * lm  
    EndProcedure
    
    Macro add3d(p,p1,p2)
        p\x=p1\x+p2\x
        p\y=p1\y+p2\y
        p\z=p1\z+p2\z
    EndMacro
    
    Macro sub3D(p,p1,p2)
        p\x=p1\x-p2\x
        p\y=p1\y-p2\y
        p\z=p1\z-p2\z
    EndMacro
    
    Macro mul3d(p1,v)
        p1\x*(v)
        p1\y*(v)
        p1\z*(v)
    EndMacro
    
    Procedure.f Max(v1.f,v2.f)
        If v1>v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
    EndProcedure
    
    Procedure.f Min(v1.f,v2.f)
        If v1<v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
    EndProcedure
    
    Procedure.f limite(V.f, i.f, s.f)
        If V < i :v=i:EndIf
        If V > s :v=s:EndIf
        ProcedureReturn V
    EndProcedure
    
    Procedure.i Modi(v,divisor)  
        ProcedureReturn (V+$10000*divisor) % divisor
    EndProcedure
   
    Procedure.f interpolarray2d(Array tt.f(2),x.f,y.f)
        Protected.l i0, j0,i1,j1,dx1,dy1, ix=Int(x)-Bool(x<0),iy=Int(y)-Bool(y<0)
        Protected.f dx, dy
        dx1=ArraySize(tt(),1)
        dy1=ArraySize(tt(),2)
        i0 = ix & dx1:i1=(i0+1) & dx1: dx = X - ix
        j0 = iy & dy1:j1=(j0+1) & dy1: dy = Y - iy
        ProcedureReturn (((1 - dx) * tt(j0,i0) + dx * tt(j0,i1)) * (1 - dy) + ((1 - dx) * tt(j1,i0) + dx * tt(j1,i1)) * dy)
    EndProcedure
    
    Procedure.f POM(v.f)
        ProcedureReturn (Random(2000)-1000)*0.001*v
    EndProcedure
    
    Procedure Split(Array t.s(1),l.s,sep.s=",",nmax=100)
        Protected ap.l,p.l,n,ls
        Dim t(nmax)
        ls=Len(sep)
        l+sep
        p=1-ls
        Repeat
            ap=p+ls:p=FindString(l,sep,ap)
            If p=0:Break:EndIf
            n+1
            t(n)= Mid(l,ap,p-ap)
        ForEver
        ReDim t(n)
    EndProcedure
    
    Procedure string2vector2(Array s.f2(1),txt.s)
        Protected Dim tt.s(0)
        Protected Dim t.s(0)
        Protected i,n
        
        Split(tt(),txt,"/",100)
        n=ArraySize(tt())
        Dim s(n-1)
        For i=1 To n
            Split(t(),tt(i)+",0",",")
            With s(i-1)
                \x=ValF(t(1))
                \y=ValF(t(2))
            EndWith
        Next
    EndProcedure
    
    Procedure CoRBinv(c.l)
        ProcedureReturn  RGBA(Blue(c),Green(c),Red(c),Alpha(c))
    EndProcedure
    
    Procedure ColorBlend(color1.l, color2.l, blend.f)
        Protected r.w,g.w,b.w,a.w
        r=  Red(color1) + (Red(color2)     - Red(color1)) * blend
        g=Green(color1) + (Green(color2) - Green(color1)) * blend
        b= Blue(color1) + (Blue(color2) -   Blue(color1)) * blend
        a=Alpha(color1) + (Alpha(color2) - Alpha(color1)) * blend
        ProcedureReturn  RGBA(r,g,b,a)
    EndProcedure
    
    Procedure GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
        Protected Dim lt.s(0)
        Protected i,j, apos,pos, acol.l,col.l
        n-1
        Dim pal(n)
        Split(lt(),gradient,"/")
        
        Macro lparam(i)
            pos=ValF(lt(i))*n
            col=Val(Mid(lt(i),FindString(lt(i),",")+1))
            If inv  :col=CoRBinv(col):EndIf
            If alpha:col | $ff000000:EndIf
        EndMacro
        
        lparam(1)
        For i=2 To ArraySize(lt())
            apos=pos
            acol=col
            lparam(i)
            For j=apos To pos:pal(j)=ColorBlend(acol,col,(j-apos)/(pos-apos)):Next
        Next
    EndProcedure
    
    Procedure Finterpol(Array F.f(1),t.s,rx.f=1,ry.f=1,oy.f=0)
        Protected.l i,j,n,c,ac
        Protected.f y,dx,dy,p
        Protected Dim s.f2(0)
        string2vector2(s(),t)
        n=ArraySize(s())
        For i=0 To n
            s(i)\x*rx
            s(i)\y*ry+oy
        Next  
        Dim f(Int(s(n)\x))
        For j=0 To n-1
            y=s(j)\y
            dx=s(j+1)\x-s(j)\x
            dy=s(j+1)\y-s(j)\y
            p=dy/dx
            ac=c
            While c<=s(j+1)\x
                f(c)=y+p*(c-ac):c+1
            Wend
        Next
    EndProcedure
    
    Procedure t2norme(Array t.w(2),dmin.w,dmax.w,profil.s="")
        Protected smin.w,smax.w,dx1,dy1,i,j,sr,dr
        If profil="":profil="0,0/1,1":EndIf
        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
        
        Protected Dim conv.f(sr)
        Finterpol(conv(),profil,sr,dr,dmin)
        
        For j=0 To dy1
            For i=0 To dx1
                t(j,i)=conv(t(j,i)-smin)
            Next
        Next
    EndProcedure
    
    Procedure Tmodulo(Array T(1), max, marge)
        Protected i,d=max-marge/2
        Dim T(max + 2*marge): For i = 0 To max + 2*marge: T(i) = (i+d) % (max+1): Next 
    EndProcedure
    
    Procedure Tlimite(Array T(1), max, marge)
        Protected i
        Dim T(max + 2*marge): For i = 0 To max + 2*marge: T(i) = limite(i-1-marge/2, 0, max): Next
    EndProcedure
    
    Procedure lisser2D(Array s.w(2),di.w, dj.w,pass=1,loop=1)
        If di=0 And dj=0:ProcedureReturn:EndIf
        Protected i,j,k,dii,djj,dx,dy,dij,tx
        dx = ArraySize(s(), 2):di=Min(di,dx)
        dy = ArraySize(s(), 1):dj=Min(dj,dy)
        Dim d.w(dy,dx)
        dii=di+1
        djj=dj+1
        dij = dii * djj
        Dim lx(0)
        Dim ly(0)
        If loop
            Tmodulo (lx(), dx, di+1)
            Tmodulo (ly(), dy, dj+1) 
        Else
            Tlimite(lx(), dx, di+1)
            Tlimite(ly(), dy, dj+1)
        EndIf  
        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 Embos(Array d.w(2),Array s.w(2), px.w=0, py.w=0)
        Protected i,j,dx,dy
        px=1<<Int(Abs(px))*Sign(px)
        py=1<<Int(Abs(py))*Sign(py)
        
        Macro gra(j0,i0,j1,i1)
            d(j0,i0)=Abs(s(j0,i0)-s(j0,i1)+px)+Abs(s(j0,i0)-s(j1,i0)+py)
        EndMacro
        dy = ArraySize(s(), 1)
        dx = ArraySize(s(), 2)
        Dim d(dy,dx)
        For j=0 To dy-1
            For i=0 To dx-1
                gra(j,i,j+1,i+1)
            Next
            gra(j,dx,j+1,0)
        Next
        For i = 0 To dx-1
            gra(dy,i,0,i+1)
        Next
        gra(dy,dx,0,0)
    EndProcedure
    
    Procedure heightmap(Array t.w(2),rnd, dx.w, dy.w, Re.w)
        Protected i,j,ii,jj,n,d,dd,dx1=dx-1,dy1=dy-1,l,R, rr,dec
        
        RandomSeed(rnd)
        n = 1<<re
        dd=Min(dx,dy) / n: If dd<1:dd=1:EndIf
        Dim t.w(dy-1, dx-1)
        rr = $1fff:r=rr>>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(rr) - R: Next: Next
        l = dd
        While dd > 1
            d = dd / 2
            For jj = 0 To dy/dd - 1  :j=jj*dd+d
                For ii = 0 To dx/dd - 1:i=ii*dd+d
                    t(j,i) = (t((j - d) & dy1,(i - d) & dx1) + t((j - d) & dy1,(i + d) & dx1) + t((j + d) & dy1,(i + d) & dx1) + t((j + d) & dy1,(i - d) & dx1)) / 4 + Random(rr) - R
                Next
            Next
            For jj = 0 To dy/d - 1  :j=jj*d:dec=1- jj & 1
                For ii = 0 To dx/dd - 1:i=ii*dd+dec*d
                    t(j,i) = (t(j,(i - d) & dx1) + t(j,(i + d) & dx1) + t((j - d) & dy1,i) + t((j + d) & dy1,i)) / 4 + Random(rr) - R
                Next
            Next
            l/2
            dd/2
            r/2:rr/2
        Wend 
    EndProcedure
    
    Procedure texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=-10,grad.s="0,$000000/1,$ffffff",profil.s="0,0/1,1")
        Protected Dim t.w(0,0)
        Protected Dim bmp.l(dy-1,dx-1)
        Protected Dim grad.l(0):gradienttoarray(grad(),1024,grad,1)
        Protected i,j,n
        
        heightmap(t(),rnd,dx,dy,f)
        lisser2d(t(),lissage,lissage,1) 
        t2norme(t(),0,1023,profil)
        For j=0 To dy-1:For i=0 To dx-1:bmp(j,i)=grad(t(j,i)):Next:Next
        
        n=CreateTexture(tex,dx,dy):If tex=-1:tex=n:EndIf
        StartDrawing(TextureOutput(tex))
        CopyMemory(@ bmp(0,0),DrawingBuffer(),dx*dy*4)
        StopDrawing()
        ProcedureReturn tex
    EndProcedure
    
    ;} ----------------------------------------------------------------------------------------------------------------------------------
    
    ;{ Océan
    
    Global oc_mesh,oc_material,oc_particule,   oc_wave.f,oc_swell.f  
    Global oc_tilesize,oc_tilesize2,oc_prec,oc_tilenb,oc_tilenb1
    Global oc_tn,oc_tn1,oc_tn2
    
    Procedure initocean(tilesize,prec,range,material,particule,waveheight.f,swellheight.f)
        ;tilesize: must be a power of 2 
        ;precision : 1-> 1 meters,  2->2 meters, 3->4 meters, 4-> 8 meters...
        ;range : distance to the camera where the oocean should be rendered
        ;material : For water
        ;particule : for sea spay
        
        Protected i,j,n,a.f
        oc_tilesize=tilesize:oc_tilesize2=oc_tilesize/2
        oc_prec=1<<(prec-1)
        oc_tilenb=range/tilesize*2:oc_tilenb1=oc_tilenb-1 
        oc_tn=oc_tilesize/oc_prec:oc_tn1=oc_tn-1:oc_tn2=oc_tn/2
        oc_material=material
        oc_particule=particule
        oceanset(waveheight,swellheight)
        
        Global Dim oc_t.w(oc_tn1,oc_tn1)
        Global Dim oc_h.f(oc_tn1,oc_tn1)
        Global Dim oc_entity(oc_tilenb1,oc_tilenb1)
        
        heightmap(oc_t(),0,oc_tn,oc_tn,0)
        t2norme(oc_t(),-128,128,"0,0/0.5,1/1,0")
        
        Dim mv.PB_MeshVertexv(oc_tn,oc_tn)
        For j=0 To oc_tn
            For i=0 To oc_tn
                With mv(j,i) 
                    vec3d(\p,(i-oc_tn2)*oc_prec,pom(16),(j-oc_tn2)*oc_prec)          
                    \u=i/16*oc_prec
                    \v=j/16*oc_prec
                EndWith
            Next
        Next
        oc_mesh=CreateDataMesh(-1,mv())
        Global Dim oc_MD.PB_MeshVertexv(MeshVertexCount(oc_mesh)-1)
        GetMeshData(oc_mesh, 0, oc_MD(), #PB_Mesh_Vertex,0, MeshVertexCount(oc_mesh)-1)          
        For j=0 To oc_tilenb1
            For i=0 To oc_tilenb1
                oc_entity(j,i)=CreateEntity(-1,MeshID(oc_mesh),MaterialID(material))
            Next
        Next
    EndProcedure
    
    Procedure freeocean()
        Protected i,j
        For j=0 To ArraySize(oc_entity(),1)
            For i=0 To ArraySize(oc_entity(),2)
                FreeEntity(oc_entity(j,i))
            Next
        Next
        FreeMesh(oc_mesh)
        FreeArray(oc_entity())
    EndProcedure
    
    Procedure.f oceanHeight(x.f,z.f)
        ProcedureReturn interpolarray2d(oc_h(),x/oc_prec,z/oc_prec)
    EndProcedure
    
    Procedure oceanset(waveheight.f,swellheight.f)
        oc_wave=waveheight
        oc_Swell=swellheight
    EndProcedure
    
    Procedure renderocean()
        Static dif.f
        Protected i,j,ii,jj,  di,cv
        Protected.f hc,hg,hd,hh,hb,ecume,ecumf=1.5/oc_prec,a,houle,pos.f3,w=oc_wave/128,r0=0.05/oc_prec,r1=1-r0
        
        ;------------------- mouvement des vagues
        dif+0.2/oc_prec:di=dif
        For j=0 To oc_tn1
            jj=(j-di) & oc_tn1
            a=2*jj/oc_tn*#PI
            houle=Sin(a) *oc_Swell*2
            For i=0 To oc_tn1
                ii=(i-di) & oc_tn1
                oc_h(j,i)*r1+((oc_t(ii,j)+oc_t(oc_tn1-jj,oc_tn1-i))*w +houle)*r0 
            Next
        Next
        For jj=0 To oc_tn:j=jj & oc_tn1
            For ii=0 To oc_tn:i=ii & oc_tn1
                With oc_MD(cv)
                    hc=oc_h(j,i)
                    hg=oc_h(j,(i-1) & oc_tn1)
                    hd=oc_h(j,(i+1) & oc_tn1)
                    hh=oc_h((j-1) & oc_tn1,i)
                    hb=oc_h((j+1) & oc_tn1,i)
                    \p\y =hc
                    ecume=limite((hc*4-hg-hd-hh-hb)*ecumf,0.2,1):ecume*ecume
                    vec3d(\n,hg-hd,2,hh-hb):norme3d(\n)
                    \color=RGBA(255,255,255,ecume*255)
                    cv+1
                EndWith
            Next
        Next
        SetMeshData(oc_mesh,0, oc_MD(), #PB_Mesh_Vertex|#PB_Mesh_Normal|#PB_Mesh_Color, 0, MeshVertexCount(oc_mesh)-1)
        pos\x=CameraX(0)+pom(100)+CameraDirectionX(0)*100
        pos\z=CameraZ(0)+pom(100)+CameraDirectionZ(0)*100
        pos\y=oceanHeight(pos\x,pos\z)+2
        If pos\y>0:MoveParticleEmitter(oc_particule,pos\x,pos\y,pos\z,#PB_Absolute):EndIf
        
        ;------------------- tuiles
        Protected da=oc_tilenb*oc_tilesize
        Static api=0,pi=1000,  apj=0,pj=1000,  i0,i1,  j0,j1,  e
        api=pi:pi=(CameraX(0)-da/2)/oc_tilesize:If pi<api:i0=pi:i1=api-1:Else:i0=api+1+oc_tilenb1:i1=pi+oc_tilenb1:EndIf
        apj=pj:pj=(CameraZ(0)-da/2)/oc_tilesize:If pj<apj:j0=pj:j1=apj-1:Else:j0=apj+1+oc_tilenb1:j1=pj+oc_tilenb1:EndIf
        For j=pj To pj+oc_tilenb1
            For i=pi To pi+oc_tilenb1
                If (i>=i0 And i<=i1) Or (j>=j0 And j<=j1)
                    MoveEntity(oc_entity(Modi(j,oc_tilenb),Modi(i,oc_tilenb)), i*oc_tilesize+oc_tilesize2,0,j*oc_tilesize+oc_tilesize2,#PB_Absolute)
                EndIf
            Next
        Next 
        
        ;------------------- sous / sur l'eau
        If CameraY(0)<oceanHeight(CameraX(0),CameraZ(0))
            CameraBackColor(0,$332200):Fog($332200,100,0,100)
            MaterialCullingMode(oc_material,#PB_Material_ClockWiseCull)
        Else
            CameraBackColor(0,$ffaa88):Fog($ffaa88,100,0,da/2)
            MaterialCullingMode(oc_material,#PB_Material_AntiClockWiseCull)
        EndIf       
    EndProcedure
    ;}
EndModule
;#####################################################################################################################################################


UseModule ext_3d

Procedure menu(p1.s="",p2.s="")
    Protected p=8
    Macro DT(t1,t2)
        DrawText(8,p,t1)
        DrawText(100,p,t2)
        p+20
    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]","Wave height: "+p1)
    dt("[F3] / [F4]","Swell height: "+p2)
    dt("[F11]","Fly / Swim")
    dt("[F12]","Wireframe")
    dt("[Esc]","Quit")
    StopDrawing()
EndProcedure

Procedure main()
    #sky=100
    #water=2
    #Seaspray=1
    
    Protected ex,ey,c,v, fly=1,fdf
    Protected.f MouseX,Mousey,keyx,keyy,keyz,aval, och, wave.f,swell.f
    
    InitEngine3D():InitSprite():InitKeyboard():InitMouse()
    
    OpenWindow(0, 0, 0, 0,0, "",#PB_Window_Maximize|#PB_Window_BorderLess)
    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",12)
    
    ;------------------- scene
    
    CreateCamera(0, 0, 0, 100, 100):CameraRange(0,0,1000)
    MoveCamera(0,0,10,0)
    CameraLookAt(0, 0,10,-10)
    CreateLight(0,$aaaaaa, 10000, 5000, 2000)
    AmbientColor($888888)
    
    ;---- sky / ciel
    texture(#sky,512,512,0,0,0,-10,"0,$ffff4400/0.5,$ffffffff/1,$ff888888")
    CreateMaterial(#sky,TextureID(#sky)):ScaleMaterial(#sky,1,1)
    SetMaterialColor(#sky,#PB_Material_SelfIlluminationColor,$ffffff):MaterialCullingMode(#sky, #PB_Material_AntiClockWiseCull):ScrollMaterial(#sky,0,-0.04,#PB_Material_Animated)
    CreatePlane(#sky,100000,100000,1,1,320,320):  CreateEntity(#sky,MeshID(#sky),MaterialID(#sky),0,100,0)
    
    ;--- water / eau
    ; EnvironmentMap
    texture(0,512,512,0, 0,0,-10,"0,$ff221100/1,$ffaa8866","0,0/0.1,0/1,1")
    StartDrawing(TextureOutput(0))
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
    GradientColor(0,$ffffFFFF)
    GradientColor(0.25,$ffffFFFF)
    GradientColor(1,$00ffffff)
    CircularGradient(256,80,80)     
    Circle(256,80,80)
    StopDrawing()   
    
    ; Sea foam / écume
    texture(1,256,256,0,3,0,0,"0,$442200/1,$ffffff","0,0/0.4,0.2/0.5,1/0.6,0.2/1,0")   
    CreateMaterial(#water, TextureID(0))
    SetMaterialAttribute(#water,#PB_Material_EnvironmentMap,#PB_Material_ReflectionMap)
    DisableDebugger
    AddMaterialLayer(#water, TextureID(1),13)
    SetMaterialAttribute(#water,21,3)
    EnableDebugger
    
    ; Sea spray / embruns
    Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem):Parse3DScripts()
    LoadTexture(4, "water.png")
    CreateMaterial(4, TextureID(4))
    DisableMaterialLighting(4, 1)
    MaterialBlendingMode   (4, #PB_Material_AlphaBlend)
    SetMaterialAttribute(4,#PB_Material_TAM,#PB_Material_ClampTAM)
    CreateParticleEmitter(#Seaspray,10, 2, 10, #PB_Particle_Box)
    ParticleMaterial    (#Seaspray, MaterialID(4))
    ParticleSize        (#Seaspray, 0.5,0.5):ParticleScaleRate(#Seaspray,10)
    ParticleColorFader(#Seaspray, 0, 0, 0, -2)
    ParticleEmitterDirection(#Seaspray, 0, 0, 1)
    ParticleTimeToLive  (#Seaspray, 0.5,0.5)
    ParticleVelocity(#Seaspray, 2,20)
    ParticleAcceleration(#Seaspray, 0, -0.2, 0)
    ParticleAngle(#Seaspray,-180,180,-180,180)
    ParticleEmissionRate(#Seaspray, 1000)
    
    wave=3
    swell=2   
    menu(Str(wave),Str(swell))
    initocean(128,1,512,#water,#Seaspray,wave,swell)
    
    Repeat
        WindowEvent() 
        ExamineMouse()
        ExamineKeyboard()
        MouseX = -MouseDeltaX() *  0.05
        MouseY = -MouseDeltaY() *  0.05
        aval=wave :wave +(KeyboardReleased(#PB_Key_F2)-KeyboardReleased(#PB_Key_F1)):wave =limite(wave ,1,4):If wave <>aval:oceanset(wave,swell):menu(Str(wave),Str(swell)):EndIf
        aval=swell:swell+(KeyboardReleased(#PB_Key_F4)-KeyboardReleased(#PB_Key_F3)):swell=limite(swell,0,4):If swell<>aval:oceanset(wave,swell):menu(Str(wave),Str(swell)):EndIf
        If KeyboardReleased(#PB_Key_F11):fly=1-fly:EndIf
        If KeyboardReleased(#PB_Key_F12):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)))*0.1
        keyz=(-Bool(KeyboardPushed(#PB_Key_Up  ))+Bool(KeyboardPushed(#PB_Key_Down )))*0.1-MouseWheel()*4-fly*0.5
        RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera  (0, KeyX, 0, keyz)
        If fly=0:och+(oceanHeight(CameraX(0),CameraZ(0))+1-och)*0.2:MoveCamera(0,CameraX(0),och,CameraZ(0),#PB_Absolute):EndIf
        renderocean()
        RenderWorld()
        DisplayTransparentSprite(0,8,8)
        FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(1)
EndProcedure

main()
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Demo 3D - Ocean v1.5

Post by DK_PETER »

That is absolutely beautyful and your code is much cleaner and easier to follow.
Thank you for creating it! 8)
Edit: Just took a swim :wink:
This kind of water should be part of Purebasic instead of the regular one.
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Fred
Administrator
Administrator
Posts: 16619
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: Demo 3D - Ocean v1.5

Post by Fred »

This is just beautiful !
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Demo 3D - Ocean v1.5

Post by BarryG »

pf shadoko wrote:Disable the debugger
If I do that, I get this error: "InitKeyboard() must be called successfully before using any Keyboard commands."

I fixed it by pulling the following line out of the "main()" procedure, and making it the second line of code (after "DisableDebugger" as the first line):

Code: Select all

InitEngine3D():InitSprite():InitKeyboard():InitMouse()
Other that, beautiful code/effect and I love it! Very hypnotic and relaxing to watch for a long time. Good job!
User avatar
Psychophanta
Addict
Addict
Posts: 4975
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Demo 3D - Ocean v1.5

Post by Psychophanta »

Nice, no sharks there :) :!:
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Demo 3D - Ocean v1.5

Post by BarryG »

Psychophanta wrote:Nice, no sharks there :) :!:
I was actually going to suggest putting a faded hint of a shark (a faint sprite?) in there from time to time when the user is underwater. But it probably wouldn't look realistic, so I didn't bother.
Cyllceaux
Enthusiast
Enthusiast
Posts: 458
Joined: Mon Jun 23, 2014 1:18 pm
Contact:

Re: Demo 3D - Ocean v1.5

Post by Cyllceaux »

Nice work...
If you change line 524/525 to

Code: Select all

ex=DesktopScaledX(WindowWidth (0,#PB_Window_InnerCoordinate))
ey=DesktopScaledY(WindowHeight(0,#PB_Window_InnerCoordinate))
Line 492/496/498:

Code: Select all

...DesktopScaledX(220),DesktopScaledY(200)...
Line 490:

Code: Select all

p+DesktopScaledY(20)
You will not have any DPI-Problems :)
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Demo 3D - Ocean v1.5

Post by Kwai chang caine »

Splendid like always :shock:
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
Tenaja
Addict
Addict
Posts: 1948
Joined: Tue Nov 09, 2010 10:15 pm

Re: Demo 3D - Ocean v1.5

Post by Tenaja »

This is really cool! Thanks for sharing.
Justin
Addict
Addict
Posts: 829
Joined: Sat Apr 26, 2003 2:49 pm

Re: Demo 3D - Ocean v1.5

Post by Justin »

Awesome. I disabled the particles to have a more relaxing effect with low waves commenting this line in renderocean()

Code: Select all

If pos\y>0:MoveParticleEmitter(oc_particule,pos\x,pos\y,pos\z,#PB_Absolute):EndIf
Is it possible to decrease the initial camera moving speed?
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Demo 3D - Ocean v1.5

Post by applePi »

@Justin , in line 599 change MoveCamera (0, KeyX, 0, keyz) to
MoveCamera(0, KeyX/3, 0, keyz/3) . any other values will be slower
Justin
Addict
Addict
Posts: 829
Joined: Sat Apr 26, 2003 2:49 pm

Re: Demo 3D - Ocean v1.5

Post by Justin »

Great, thanks.
Post Reply