adapted for PB6 (no scripting required, shaders are created in code)
Hi guys,
I made a shader for the waves
you'll see, it's much more realistic.
put on your oilskin
Code: Select all
; Océan v2 - pf Shadoko - 2020
EnableExplicit
DeclareModule ext_3D
EnableExplicit
Global inittime
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 vec3d(*v.f3,vx.f,vy.f,vz.f)
Declare sub3D(*p.f3,*p1.f3,*p2.f3)
Declare mul3d(*p1,v.f)
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 ColorBlend(color1.l, color2.l, blend.f)
Declare GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
Declare Noise2d(Array t.f(2), dx.w, dy.w,rnd, oinit.b, onb.b=16)
Declare blur2D(Array s.f(2),di.w, dj.w,pass=1,loop=1)
Declare Embos2D(Array s.f(2), px.w=0, py.w=0)
Declare grad2D(Array s.f(2),delta=1)
Declare outline2d(Array t.f(2),dmin.f,dmax.f,outline.s="0,0/1,1",sminl.f=0,smaxl.f=0)
Declare textureArrayToColor(tex,Array t.f(2),grad.s="0,$000000/1,$ffffff")
Declare textureArrayToNM(tex,Array t.f(2),amplitude.f,alphavalue=0)
;________________ océan ________________
Global oc_mesh,oc_material,oc_txtnm,oc_txtdif,oc_particule, oc_waveb.f, oc_wavel.f,oc_swell.f, oc_foam.f
Global oc_tilesize,oc_tilesize2,oc_prec,oc_tilenb,oc_tilenb1
Global oc_tn,oc_tn1,oc_tn2
Declare initocean(tilesize,prec,range,wavebig.f,wavelittle.f,swell.f,foam.f,watercolor.l,skycolor.l,particule=-1,heightmap=-1)
Declare freeocean()
Declare renderocean()
Declare.f oceanHeight(x.f,z.f)
Declare oceanset(wavebig.f,wavelittle.f,swell.f,foam.f,watercolor.l=0,skycolor.l=0)
;________________ SkyDome2 ________________
Global skydome_m, skydome_e
Declare SkyDome2(rayon.f,hauteur.f,material,degrade.s="0,$ffffff/1,$ffffff")
Declare SkyDome2AddLayer(txt,scale.f,scroll.f=0,angle.f=0)
EndDeclareModule
Module ext_3D
DisableDebugger
;{ ============================= biblio
Procedure vec3d(*v.f3,vx.f,vy.f,vz.f)
*v\x=vx
*v\y=vy
*v\z=vz
EndProcedure
Procedure sub3D(*p.f3,*p1.f3,*p2.f3)
*p\x=*p1\x-*p2\x
*p\y=*p1\y-*p2\y
*p\z=*p1\z-*p2\z
EndProcedure
Procedure add3d(*p.f3,*p1.f3,*p2.f3)
*p\x=*p1\x+*p2\x
*p\y=*p1\y+*p2\y
*p\z=*p1\z+*p2\z
EndProcedure
Procedure mul3d(*p1.f3,v.f)
*p1\x*v
*p1\y*v
*p1\z*v
EndProcedure
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
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 POM(v.f)
ProcedureReturn (Random(v*1000)-v*500)/500
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 i,j, apos,pos, acol.l,col.l,p,lt.s
n-1
Dim pal(n)
Repeat
apos=pos
acol=col
i+1
lt=StringField(gradient,i,"/"):If lt="":Break:EndIf
pos=ValF(lt)*n
p=FindString(lt,",")
If p
col=Val(Mid(lt,p+1))
If inv :col=CoRBinv(col):EndIf
If alpha:col | $ff000000:EndIf
Else
col=acol
EndIf
For j=apos To pos:pal(j)=ColorBlend(acol,col,(j-apos)/(pos-apos)):Next
ForEver
EndProcedure
Procedure Array2Dlimit(Array t.f(2),*min.float,*max.float)
Protected i,j,dx1,dy1
Protected.f v,smin,smax
dy1 = ArraySize(t(), 1)
dx1 = ArraySize(t(), 2)
smax = -1e10
smin = 1e10
For j=0 To dy1
For i=0 To dx1
v=t(j,i)
If v<smin : smin=v: EndIf
If v>smax : smax=v: EndIf
Next
Next
*min\f=smin
*max\f=smax
EndProcedure
Procedure Array2Dclamp(Array t.f(2),min.f,max.f)
Protected i,j,dx1,dy1
dy1 = ArraySize(t(), 1)
dx1 = ArraySize(t(), 2)
For j=0 To dy1
For i=0 To dx1
t(j,i)=limite(t(j,i),min,max)
Next
Next
EndProcedure
Procedure blur2D(Array s.f(2),di.w, dj.w,pass=1,loop=1)
If di=0 And dj=0:ProcedureReturn:EndIf
Protected i,j,k,d,dii,djj,dx,dy,dij,tx.f
dx = ArraySize(s(), 2):di=min(di,dx)
dy = ArraySize(s(), 1):dj=min(dj,dy)
Dim d.f(dy,dx)
dii=di+1
djj=dj+1
dij = dii * djj
If loop
d=dx-dii/2:Dim lx(dx + 2*dii): For i = 0 To dx + 2*dii: lx(i) = (i+d) % (dx+1): Next
d=dx-dii/2:Dim ly(dy + 2*djj): For i = 0 To dy + 2*djj: ly(i) = (i+d) % (dy+1): Next
Else
Dim lx(dx + 2*dii): For i = 0 To dx + 2*dii: lx(i) = limite(i-1-dii/2, 0, dx): Next
Dim ly(dy + 2*djj): For i = 0 To dy + 2*djj: ly(i) = limite(i-1-djj/2, 0, dy): Next
EndIf
For k=1 To pass
Dim ty.f(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 Embos2D(Array s.f(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)
t(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 T.f(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)
CopyArray(t(),s())
EndProcedure
Procedure grad2D(Array s.f(2),delta=1)
Protected i,j,dx,dy
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim d.f(dy,dx)
For j=0 To dy
For i=0 To dx
d(j,i)= 4*s(j,i) -s(j,(i-delta) & dx)-s(j,(i+delta) & dx)-s((j-delta) & dy,i)-s((j+delta) & dy,i)
Next
Next
CopyArray(d(),s())
EndProcedure
Procedure superpose(Array s.f(2),n.w=1)
Protected i,j,k,dx,dy,x,y,ii,jj
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim T.f(dy,dx)
For k=1 To n
x=Random(dx)
y=Random(dy)
For j=0 To dy
For i=0 To dx
t(i,j)+s((i+x) & dx,(j+y) & dy)
Next
Next
Next
CopyArray(t(),s())
EndProcedure
Procedure Noise2d(Array t.f(2), dx.w, dy.w,rnd, oinit.b, onb.b=16)
Protected i,j,n,d,dd,d3,dx1=dx-1,dy1=dy-1,coef.f=9,den.f=1/(2*coef-2),amp.f=1/$1000
Dim t(dy1, dx1)
RandomSeed(rnd)
n = 1<<oinit
dd=min(dx,dy) / n: If dd<1:dd=1:EndIf
j=0:While j<dy1:i=0:While i<dx1: t(j,i) = (Random($2000) - $1000)*amp:i+dd:Wend:j+dd:Wend
While dd > 1
If onb=0:amp=0:EndIf
d = dd / 2:d3=d*3:amp/2
j=d:While j<dy
i=0:While i<dx
t(j,i) = (-t((j - d3) & dy1,i) - t((j +d3) & dy1,i) + coef*(t((j - d) & dy1,i) + t((j + d) & dy1,i))) *den + (Random($2000) - $1000)*amp
i+dd:Wend
j+dd:Wend
j=0:While j<dy
i=d:While i<dx
t(j,i) = (-t(j,(i - d3) & dx1) - t(j,(i +d3) & dx1) + coef*(t(j,(i - d) & dx1) + t(j,(i + d) & dx1))) *den + (Random($2000) - $1000)*amp
i+dd:Wend
j+d:Wend
dd/2:onb-1
Wend
EndProcedure
Procedure Finterpol(Array F.f(1),profil.s,dmin.f=1,dmax.f=0)
Protected.l i,j,n,c,ac,rx, t.s
Protected.f y,dx,dy,p
rx=ArraySize(f())
n=CountString(profil,"/")
Dim s.f2(n)
For i=0 To n
t=StringField(profil,i+1,"/")
s(i)\x=ValF(t)*rx
s(i)\y=ValF(StringField(t,2,","))*(dmax-dmin)+dmin
Next
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 outline2d(Array t.f(2),dmin.f,dmax.f,outline.s="0,0/1,1",sminl.f=0,smaxl.f=0)
Protected dx1,dy1,i,ii,j,k,xi
Protected.f smin,smax,sr,tt,x,y0,y1,x0,dminl,dmaxl
dy1 = ArraySize(t(), 1)
dx1 = ArraySize(t(), 2)
Array2Dlimit(t(),@smin,@smax)
sr=smax-smin
Dim conv.f(256)
Finterpol(conv(),outline,dmin,dmax)
If smaxl-sminl<>0
ii=(sminl-smin)/sr*255:For i=0 To ii:conv(i)=conv(ii):Next
ii=(smaxl-smin)/sr*255:For i=ii To 255:conv(i)=conv(ii):Next
EndIf
For j=0 To dy1
For i=0 To dx1
x=(t(j,i)-smin)/sr*255
xi=Int(x):x0=x-xi
y0=conv(xi)
y1=conv(xi+1)
t(j,i)=y1*x0+y0*(1-x0)
Next
Next
EndProcedure
Procedure textureArrayToColor(tex,Array t.f(2),grad.s="0,$000000/1,$ffffff")
Protected i,j,n,dx,dy
Protected.f min,max,r
dx=ArraySize(t(),2)+1
dy=ArraySize(t(),1)+1
Dim bmp.l(dy-1,dx-1)
Protected Dim grad.l(0):gradienttoarray(grad(),1024,grad,1)
Array2Dlimit(t(),@min,@max):r=1023/(max-min)
For j=0 To dy-1:For i=0 To dx-1:n=(t(j,i)-min)*r:bmp(j,i)=grad(n):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
Procedure textureArrayToNM(tex,Array t.f(2),amplitude.f,alphavalue=0)
Protected i,j,nn,dx,dy
Protected.f h00,h10,h01, max=1/amplitude
Protected.f3 n
Dim a.f(0,0) :CopyArray(t(),a())
Select alphavalue
Case 0:outline2d(a(),0,255)
Case 1:grad2d(a(),4):Array2Dclamp(a(),-1,0):outline2d(a(),0,255,"0,0/1,1")
EndSelect
dx=ArraySize(t(),2)+1
dy=ArraySize(t(),1)+1
Dim bmp.l(dy-1,dx-1)
For j=0 To dy-1
For i=0 To dx-1
h00=t(j,i)
h10=t(j,(i+1) % dx)
h01=t((j+1) % dy,i)
vec3d(n,h00-h10, max, h00-h01):Norme3D(n,127)
bmp(j,i)=RGBA(n\y+128,n\z+128,n\x+128,a(j,i))
Next
Next
nn=CreateTexture(tex,dx,dy):If tex=-1:tex=nn:EndIf
StartDrawing(TextureOutput(tex)):CopyMemory(@bmp(0,0),DrawingBuffer(),dx*dy*4):StopDrawing()
ProcedureReturn tex
EndProcedure
Procedure.f interpolarray2d(Array tt.f(2),x.f,y.f)
Protected.l i0, j0,i1,j1,dx1,dy1
Protected.f dx, dy
dx1=ArraySize(tt(),1)
dy1=ArraySize(tt(),2)
i0 = Int(X) & dx1:i1=(i0+1) & dx1: dx = X - Int(x)
j0 = Int(Y) & dy1:j1=(j0+1) & dy1: dy = Y - Int(y)
ProcedureReturn (((1 - dx) * tt(j0,i0) + dx * tt(j0,i1)) * (1 - dy) + ((1 - dx) * tt(j1,i0) + dx * tt(j1,i1)) * dy)
EndProcedure
;}===================================================================================================================================================
;{ Océan
Procedure initocean(tilesize,prec,range,wavebig.f,wavelittle.f,swell.f,foam.f,watercolor.l,skycolor.l,particule=-1,heightmap=-1)
; 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
; wavebig,wavelittle,swell,foam : value: 0.0 -> 1.0
; particule : for sea spray
; heightmap : texture containing the depth. only the red component is used : red=depth*16+128, and clamped between 0 and 255
Protected i,j,k,r,n,a.f,vert_pg.s,frag_pg.s
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_particule=particule
Global Dim oc_h.f(oc_tn1,oc_tn1)
Global Dim oc_entity(oc_tilenb1,oc_tilenb1)
Dim t.f(0,0)
;Waves (noramlmap)
Noise2d(oc_h(),512,512,0,4)
outline2d(oc_h(),0,1,"0,0/0.5,1/1,0")
blur2D(oc_h(),1,1,1)
oc_txtnm=textureArraytoNM(-1,oc_h(),16)
;foam (diffusemap)
Noise2d(t(),512,512,0,7)
outline2d(t(),0,1,"0,0/0.2,0.2/0.5,1/0.7,0.2/1,0")
oc_txtdif=textureArrayToColor(-1,t())
vert_pg="%%%%%uniform mat4 P0;//+0%uniform mat4 P16;//+16%uniform vec4 P76;//+76%uniform vec4 P43;//+43 0%uniform vec4 P32;//+32%uniform float P86;//+86 0.01%%uniform sampler2D heightMap;//2%uniform sampler2D normalMapv;//0%%varying vec3 oviewdir;%varying vec3 olightdir;%varying vec3 onormal;%varying float owave;%varying float odist;%varying vec2 ouv;%%void main(void)%{%vec4 opos=(P0*gl_Vertex);%vec2 uv=opos.xz/256;%vec2 duv=vec2(P86,0);%vec4 wave=texture2D(normalMapv,uv+duv)+texture2D(normalMapv,uv+0.5-duv)-1;wave.xy*=(P32.x);%float a=uv.y*20-P86*100;%float sweel=sin(a);%opos.y=wave.w*P32.x*4+sweel*P32.z*4;%wave.y-=cos(a)*P32.z*1;%onormal=normalize(wave.xzy);%owave=wave.w;%float height=texture2D(heightMap,uv).r*16-8;%float fond=clamp((height-opos.y)*0.25+1,0,1);%opos.y+=fond*wave.w;%owave=owave+fond*2;%gl_Position=P16*opos;%odist=gl_Position.z;%oviewdir=normalize(P76.xyz-opos.xyz);%olightdir=normalize(P43.xyz-opos.xyz);%ouv=uv*16;%}%%%%%%%%%%%%%%"
frag_pg="%%%%%uniform vec4 P40;//+40 0%uniform vec4 P32;//+32%uniform float P36;//+36%uniform vec4 P31;//+31%uniform vec4 P30;//+30%uniform vec4 water;%uniform vec4 P69;//+69 0%uniform vec4 P70;//+70 0%uniform float P86;//+86 0.01%%uniform sampler2D normalMap;//0%uniform sampler2D diffuseMap;//1%%varying vec3 oviewdir;%varying vec3 olightdir;%varying vec3 onormal;%varying float owave;%varying float odist;%varying vec2 ouv;%%%void main()%{%float f;%vec4 fcolor;%if(P31.z>0){f=min(odist*P31.w,1);fcolor=P30;}%%vec2 duv=vec2(P86*4,0);%vec4 txt=texture2D(normalMap,ouv+duv)+texture2D(normalMap,ouv+0.5-duv)-1;%vec3 tnor=normalize(txt.xyz);%vec3 normal=onormal;normal.xz+=tnor.xy*P32.y*2;%normal=normalize(normal);%float fresnel=1-abs(dot(oviewdir,normal));%float ecume=clamp((txt.w+owave-2+P32.w)*2,0,1);%vec4 color=mix(P69,P70,fresnel*fresnel);%%vec3 halfangle=normalize(olightdir+oviewdir);%float spe=pow(max(dot(halfangle,normal),0),P36);%color+=P40*mix(spe,texture2D(diffuseMap,ouv*4).r,ecume);%%gl_FragColor=mix(color,fcolor,f);%}%%%%%%%%%%%%%%"
CreateShader(1000,vert_pg,frag_pg)
oc_material=CreateShaderMaterial(-1,1000):MaterialShaderTexture(oc_material,TextureID(oc_txtnm),TextureID(oc_txtdif),TextureID(heightmap),0)
MaterialFilteringMode(oc_material,#PB_Material_Anisotropic,4)
MaterialShininess(oc_material,64*2)
SetMaterialAttribute(oc_material,#PB_Material_TAM,#PB_Material_ClampTAM,2)
oceanset(wavebig,wavelittle,swell,foam,watercolor,skycolor)
For k=0 To 4:r=1<<k
Dim mv.PB_MeshVertexv(oc_tn/r,oc_tn/r)
For j=0 To oc_tn/r
For i=0 To oc_tn/r
With mv(j,i)
vec3d(\p,(i*r-oc_tn2)*oc_prec,pom(8),-(j*r-oc_tn2)*oc_prec)
\u=i*r/oc_tn
\v=j*r/oc_tn
EndWith
Next
Next
If k=0
oc_mesh=CreateDataMesh(-1,mv())
Else
n=CreateDataMesh(-1,mv())
AddMeshManualLOD(oc_mesh,n,128 *r)
SetMeshMaterial(n,MaterialID(oc_material))
EndIf
Next
For j=0 To oc_tilenb1
For i=0 To oc_tilenb1
oc_entity(j,i)=CreateEntity(-1,MeshID(oc_mesh),MaterialID(oc_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())
FreeMaterial(oc_material)
FreeTexture(oc_txtnm)
FreeTexture(oc_txtdif)
EndProcedure
Procedure.f oceanHeight(x.f,z.f)
Protected time.f=(ElapsedMilliseconds()-inittime)/1000*0.01, dx.f=time*512
x*2-0.5
z*2-0.5
ProcedureReturn (interpolarray2d(oc_h(),x+dx,z)+interpolarray2d(oc_h(),x+256-dx,z+256)-1)*oc_waveb*4+Sin(z/512*20-time*100)*oc_swell*4
EndProcedure
Procedure oceanset(wavebig.f,wavelittle.f,swell.f,foam.f,watercolor.l=0,skycolor.l=0)
oc_waveb=wavebig
oc_wavel=wavelittle
oc_swell=swell
oc_foam =foam
SetMaterialColor(oc_material,1,RGBA(wavebig*255,wavelittle*255,swell*255,foam*255))
If watercolor:SetMaterialColor(oc_material,2,watercolor):EndIf
If skycolor:SetMaterialColor(oc_material,4,skycolor):EndIf
EndProcedure
Procedure renderocean()
Protected i,j, pos.f3
If oc_particule>=0
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)+1
If pos\y>0:MoveParticleEmitter(oc_particule,pos\x,pos\y,pos\z,#PB_Absolute):EndIf
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))
Fog($332200,100,0,30)
MaterialCullingMode(oc_material,#PB_Material_AntiClockWiseCull)
Else
Fog($ffaa88,100,0,da/2)
MaterialCullingMode(oc_material,#PB_Material_ClockWiseCull)
EndIf
EndProcedure
;}
;{ SkyDome2
Procedure SkyDome2(rayon.f,hauteur.f,material,degrade.s="0,$ffffff/1,$ffffff")
If skydome_m:FreeMesh(skydome_m):EndIf
If skydome_e:FreeEntity(skydome_e):EndIf
Protected i,j,d=16,icol ,d1=d-1,d2=d/2,mesh
Protected.f x,y,z, xo,yo, u,v, ai,aj, lat,lng, mx
Dim t.PB_MeshVertexv(d,d)
Dim col.l(0)
CreateMaterial(0,0)
GradientToArray(col(),256,degrade)
For j=0 To d
For i=0 To d
With t(i,j)
xo=1-i/d2
yo=1-j/d2
lng=ATan2(xo,yo)
mx=max(Abs(xo),Abs(yo))
\u=(Cos(lng)* mx+1)/2
\v=(Sin(lng)* mx+1)/2
lat=mx* #PI/2
x=Cos(lng)* Sin(lat)*rayon
z=Sin(lng)* Sin(lat)*rayon
y=Cos(lat)*hauteur
vec3d(\p,-x,y,z)
icol=255*(x+rayon)/(2*rayon)
\color=$ff000000+col(icol)
EndWith
Next
Next
skydome_m=CreateDataMesh(-1,t())
skydome_e=CreateEntity(-1,MeshID(skydome_m),MaterialID(material))
DisableMaterialLighting(material,1)
EndProcedure
Procedure SkyDome2AddLayer(txt,scale.f,scroll.f=0,angle.f=0)
Protected layer
AddMaterialLayer(0,TextureID(txt),#PB_Material_AlphaBlend)
layer=CountMaterialLayers(0)-1
ScaleMaterial(0,scale,scale,layer)
RotateMaterial(0,angle,#PB_Material_Fixed,layer)
ScrollMaterial(0,0,scroll,#PB_Material_Animated,layer)
EndProcedure
;}
EnableDebugger
EndModule
;#####################################################################################################################################################
UseModule ext_3d
Procedure texturecolor(tex,dx,dy,rnd=0,f=0,lissage=0,grad.s="0,$000000/1,$ffffffff",outline.s="0,0/1,1")
Protected Dim t.f(0,0)
Noise2d(t(),dx,dy,rnd,f)
blur2D(t(),lissage,lissage,2)
outline2d(t(),0,1,outline)
ProcedureReturn textureArrayToColor(tex,t(),grad)
EndProcedure
Procedure texturenormal(tex,dx,dy,rnd=0,f=0,lissage=0,relief.f=1,outline.s="0,0/1,1",alphavalue=0)
Protected Dim t.f(0,0)
Noise2d(t(),dx,dy,rnd,f)
outline2d(t(),0,1,outline)
blur2D(t(),lissage,lissage,3)
ProcedureReturn textureArraytoNM(tex,t(),relief,alphavalue)
EndProcedure
Procedure menu(waveb.f,wavel.f,swell.f,foam.f)
Protected p=4
Macro DT(t1,t2="")
DrawText(8,p,t1)
DrawText(100,p,t2)
p+8+10*Bool(t1>"")
EndMacro
CreateSprite(0,240,200,#PB_Sprite_AlphaBlending)
; ProcedureReturn
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,240,200,$44000000)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,240,200,$ffffffff)
BackColor($44000000)
FrontColor($ffffffff)
dt("Moving:")
dt("Mouse + wheel+ arrow keys")
dt("")
dt("Commandes:")
dt("[F1] / [F2]","Wave big: "+Str(waveb*100)+"%")
dt("[F3] / [F4]","Wave little: "+Str(wavel*100)+"%")
dt("[F5] / [F6]","Swell height: "+Str(swell*100)+"%")
dt("[F7] / [F8]","foam: "+Str(foam*100)+"%")
dt("[F11]","Fly/Walk")
dt("[F12]","Wireframe")
dt("[Esc]","Quit")
StopDrawing()
EndProcedure
Procedure main()
Protected sky,heightmap,seaspray
Protected ex,ey,c,v, i,j, fly=1,fdf
Protected.f MouseX,Mousey,keyx,keyy,keyz,dist,aval, och, waveb,wavel,swell,foam
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
ExamineDesktops()
ex=DesktopWidth(0)
ey=DesktopHeight(0)
OpenWindow(0,0,0,ex,ey,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered):OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0),WindowHeight(0))
; OpenScreen(ex,ey,32,"")
LoadFont(0,"arial",11*100/DesktopScaledX(100))
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)
Parse3DScripts()
;------------------- scene
CreateCamera(0, 0, 0, 100, 100):CameraBackColor(0,$886644)
MoveCamera(0,0,10,0)
CameraLookAt(0, 0,10,-10)
CreateLight(0,$ffffff, 10000, 10000,0)
AmbientColor($444444)
;---- ilot / island
Protected di=256,dj=256,di1=di-1,dj1=dj-1,ii,jj,h.f,g.f, x.f,y.f
Dim h.f(0,0)
Dim g.f(0,0)
Dim t.PB_MeshVertexv(di,dj)
Noise2d(h(),di,dj,0,3):outline2d(h(),0,20,"0,0/0.4,0.4/0.6,0.7/1,1")
For j=0 To dj1:For i=0 To di1:x=i/di*#PI:y=j/dj*#PI:h(i,j)*Sin(x)*Sin(y)*#PI-8:Next:Next
CopyArray(h(),g()):Embos2D(g(),0,0):outline2d(g(),0,255)
For j=0 To dj: jj=j & dj1
For i=0 To di:ii=i & di1
h=h(ii,jj)
g=g(ii,jj)
With t(i,j)
vec3d(\p,i,h,j)
vec3d(\n,h((i-1) & di1,jj)-h((i+1) & di1,jj),2,h(ii,(j-1) & dj1)-h(ii,(j+1) & dj1)):norme3d(\n)
\u=i*0.1
\v=j*0.1
Select g
Case 0 To 80:\color=$44556677
Case 80 To 120:\color=$445599aa
Default:\color=$4488aadd
EndSelect
If h<7:\color | $ff000000 :EndIf
EndWith
Next
Next
CreateDataMesh(10,t())
BuildMeshTangents(10)
texturecolor (10,1024,1024,0,5,0,"0,$00888888/1,$ffffffff","0,1/0.4,1/0.5,0/0.55,1/1,1")
texturenormal(11,1024,1024,0,2,0,50,"0,1/0.3,0.4/0.5,0/0.7,0.4/1,1")
CreateShaderMaterial(10,#PB_Material_BumpShader):MaterialShaderTexture(10,TextureID(10),TextureID(11),0,0)
MaterialFilteringMode(10,#PB_Material_Anisotropic,4)
MaterialShininess(10,64):SetMaterialColor(10,4,$ffffff)
CreateEntity(10,MeshID(10),MaterialID(10))
;heightmap
heightmap=CreateTexture(-1,256,256)
StartDrawing(TextureOutput(heightmap))
For j=0 To dj1:For i=0 To di1:Plot(i,j,limite(h(i,j)*16+128,0,255)):Next:Next
StopDrawing()
;---- sky / ciel
sky=texturecolor(-1,512,512,0,3,0,"0,$00ffffff/0.4/0.7,$ffffffff/1,$ff888888")
SkyDome2(1024,200,0,"0,$ff8800/1,$ff8800")
SkyDome2AddLayer(sky,0.1,0.04,0)
SkyDome2AddLayer(sky,0.2,0.04,90)
SkyDome2AddLayer(sky,0.4,0.04,180)
; Sea spray / embruns
LoadTexture(4, "water.png")
CreateMaterial(4, TextureID(4))
DisableMaterialLighting(4, 1)
MaterialBlendingMode (4, #PB_Material_AlphaBlend)
SetMaterialAttribute(4,#PB_Material_TAM,#PB_Material_ClampTAM)
seaspray=CreateParticleEmitter(-1,8, 2, 8, #PB_Particle_Box)
ParticleMaterial (Seaspray, MaterialID(4))
ParticleSize (Seaspray, 0.25,0.25):ParticleScaleRate(Seaspray,4)
ParticleColorFader(Seaspray, 0, 0, 0, -1)
ParticleEmitterDirection(Seaspray, 0, 0.2, 1)
ParticleTimeToLive (Seaspray, 1,1)
ParticleVelocity(Seaspray, 2,20)
ParticleAcceleration(Seaspray, 0, -0.1, 0)
ParticleAngle(Seaspray,-180,180)
ParticleEmissionRate(Seaspray, 500)
waveb=1
wavel=0.4
swell=0.4
foam=0.6
initocean(128,1,1024,waveb,wavel,swell,foam, $ff332200, $ff886644,Seaspray,heightmap)
menu(waveb.f,wavel.f,swell.f,foam.f)
inittime=ElapsedMilliseconds()
Repeat
While WindowEvent() :Wend
ExamineMouse()
ExamineKeyboard()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
Macro param(val,key1,key2)
aval=val :val +(-KeyboardReleased(key1)+KeyboardReleased(key2))*0.1:val =limite(val ,0.1,1)
If val <>aval:menu(waveb,wavel,swell,foam):oceanset(waveb,wavel,swell,foam):EndIf
EndMacro
param(waveb,#PB_Key_F1,#PB_Key_F2)
param(wavel,#PB_Key_F3,#PB_Key_F4)
param(swell,#PB_Key_F5,#PB_Key_F6)
param(foam ,#PB_Key_F7,#PB_Key_F8)
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.5
keyz=(-Bool(KeyboardPushed(#PB_Key_Up ))+Bool(KeyboardPushed(#PB_Key_Down )))*0.5-MouseWheel()*10;-fly*0.2
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):dist+(keyz-dist)*0.05:MoveCamera (0, KeyX, 0, dist)
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()
MoveEntity(skydome_e,CameraX(0), -8,CameraZ(0),#PB_Absolute)
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(3)
EndProcedure
main()
