an update of my cave demo
not much improvement, except that I added strata
I can now vary the brightness (texture alpha layer X stratum colour alpha layer)
ha yes also, it must work everywhere, it uses glsl shaders
so:
compile in opengl
ps: a little bug when underwater, should be fixed with the new version of PB
Code: Select all
; demo 3d - grotte-v3 - Pf Shadoko - 2020
EnableExplicit
;{ ============================= biblio
Structure f2
x.f
y.f
EndStructure
Structure f3
x.f
y.f
z.f
EndStructure
Structure PB_MeshVertexV
p.f3
n.f3
t.f3
u.f
v.f
color.l
EndStructure
Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
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 add3d(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 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 Pvectoriel3d(*r.f3,*p.f3,*q.f3)
*r\x=*p\y * *q\z - *p\z * *q\y
*r\y=*p\z * *q\x - *p\x * *q\z
*r\z=*p\x * *q\y - *p\y * *q\x
EndProcedure
Procedure defmatrot(*p.f3,w.f, orientation=0)
Global.f3 lo_p,lo_q,lo_r
Protected pp.f3, l.f
vec3d(lo_p,*p\x,*p\y,*p\z)
l=lng3d(lo_p)
Select orientation
Case 0:vec3d(pp,Cos(w),0,Sin(w))
Case 1:vec3d(pp,0,Cos(w),Sin(w))
Case 2:vec3d(pp,Cos(w),Sin(w),0)
EndSelect
pvectoriel3d(lo_q,lo_p,pp ):Norme3d(lo_q,l)
pvectoriel3d(lo_r,lo_p,lo_q):Norme3d(lo_r,l)
EndProcedure
Procedure calcmatrot(*v.f3, *u.f3)
Protected.f x=*u\x, y=*u\y, z=*u\z
*v\x=lo_p\x * x + lo_q\x * y + lo_r\x * z
*v\y=lo_p\y * x + lo_q\y * y + lo_r\y * z
*v\z=lo_p\z * x + lo_q\z * y + lo_r\z * z
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
Macro interpol(v,v1,v2,r=0.5)
v=v1*(1-r)+v2*r
EndMacro
Procedure interpol3D(*R.f3, *V1.f3, *V2.f3, r.f)
*R\x = *V1\x + r * (*V2\x - *V1\x)
*R\y = *V1\y + r * (*V2\y - *V1\y)
*R\z = *V1\z + r * (*V2\z - *V1\z)
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 Finterpol(Array F.f(1),profil.s,rx.f=1,ry.f=1,oy.f=0)
Protected.l i,j,n,c,ac, t.s
Protected.f y,dx,dy,p
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,","))*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 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 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 outline2d(Array t.f(2),dmin.f,dmax.f,outline.s="0,0/1,1")
Protected dx1,dy1,i,j,k,xi
Protected.f smin,smax,sr,dr,tt,x,y0,y1,x0
dy1 = ArraySize(t(), 1)
dx1 = ArraySize(t(), 2)
Array2Dlimit(t(),@smin,@smax)
sr=smax-smin
dr=dmax-dmin
Protected Dim conv.f(100)
Finterpol(conv(),outline,100)
For j=0 To dy1
For i=0 To dx1
x=(t(j,i)-smin)/sr*99
xi=Int(x):x0=x-xi
y0=conv(xi)
y1=conv(xi+1)
t(j,i)=(y1*x0+y0*(1-x0))*dr+dmin
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)
Protected i,j,n,dx,dy
Protected.f h00,h10,h01,x,y,z,l, max=1/amplitude,max2=max*max
Protected.f3 p
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)
p\x=h00-h10
p\y=h00-h01
l=min(p\x*p\x+p\y*p\y,max2)
p\z=Sqr(max2-l)
Norme3D(p,127)
bmp(j,i)=RGBA(p\z+128,p\y+128,p\x+128,255)
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 SelfAddArray2d(Array s.f(2))
Protected i,j,dx,dy,dx2,dy2
dy = ArraySize(s(), 1):dy2=dy/2
dx = ArraySize(s(), 2):dx2=dx/2
Dim t.f(0,0):CopyArray(s(),t())
For j=0 To dy:For i=0 To dx:s(j,i)=t(j,i)+t((j+dy2) & dy,i):Next:Next
EndProcedure
Procedure triangle(Array t.f(2),*p1.f3, *p2.f3, *p3.f3)
Protected.f3 e,p1,p2,p3,p4, vg,vd, vdg,vdd
Protected i,j, dx1,dy1,dc.f
dx1=ArraySize(t(),1)
dy1=ArraySize(t(),2)
vec3d(p1,*p1\x,*p1\y,*p1\z)
vec3d(p2,*p2\x,*p2\y,*p2\z)
vec3d(p3,*p3\x,*p3\y,*p3\z)
If p1\y>p3\y:e=p1:p1=p3:p3=e:EndIf
If p1\y>p2\y:e=p1:p1=p2:p2=e:EndIf
If p2\y>p3\y:e=p2:p2=p3:p3=e:EndIf
interpol3D(p4,p1,p3,(p2\y-p1\y)/(p3\y-p1\y))
If p4\x>p2\x:e=p4:p4=p2:p2=e:EndIf
Macro demitriangle(pgh,pgb,pdh,pdb)
vg=pgh:sub3d(vdg,pgb,pgh):mul3d(vdg,1/(pgb\y-pgh\y))
vd=pdh:sub3d(vdd,pdb,pdh):mul3d(vdd,1/(pdb\y-pdh\y))
For j=pgh\y To pgb\y-1
For i=vg\x To vd\x:t(i & dx1,j & dy1)=vg\z+(i-vg\x)*dc:Next
add3d(vg,vg,vdg)
add3d(vd,vd,vdd)
Next
EndMacro
dc=(p4\z-p2\z)/(p4\x-p2\x)
If p4\y>p1\y:demitriangle(p1,p4,p1,p2):EndIf
If p3\y>p4\y:demitriangle(p4,p3,p2,p3):EndIf
EndProcedure
Procedure heightmapcristal(Array h.f(2),rnd, dx.w, dy.w, d.w)
Protected i,j,dx1=dx-1,dy1=dy-1,r=d*0.25,n=dx/d,n1=n-1
Protected.f3 t00,t10,t01,t11,e
Dim t.f3(n,n)
Dim h.f(dx1,dy1)
RandomSeed(rnd)
For j=0 To n
For i=0 To n
With t(i,j)
\x=i*d+Random(2*r)-r
\y=j*d+Random(2*r)-r
\z=Random($1000)/$1000
EndWith
Next:Next
For i=0 To n:t(i,n)=t(i,0):t(i,n)\y+n*d:Next
For j=0 To n:t(n,j)=t(0,j):t(n,j)\x+n*d:Next
For i=0 To n1:For j=0 To n1
t00=t(i+0,j+0)
t10=t(i+1,j+0)
t01=t(i+0,j+1)
t11=t(i+1,j+1)
If Random(1):e=t00:t00=t10:t10=e: e=t01:t01=t11:t11=e:EndIf
triangle(h(),t00,t11,t01)
triangle(h(),t00,t11,t10)
Next:Next
EndProcedure
Procedure minauto(Array s.f(2),n.w=1)
Protected i,j,dx,dy,dy1,dy2
dy = ArraySize(s(), 1):dy2=dy/2
dx = ArraySize(s(), 2)
Dim t.l(0,0):CopyArray(s(),t())
For j=0 To dy:For i=0 To dx:s(j,i)=min(t(j,i),t((j+dy2) & dy,i)):Next:Next
EndProcedure
Procedure contraste(Array s.f(2),lissage.w=1)
Protected i,j,k,dx,dy
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim T.f(dy,dx)
CopyArray(s(),t())
blur2D(t(),lissage,lissage)
For j=0 To dy
For i=0 To dx
s(i,j)-t(i,j)
Next
Next
EndProcedure
Procedure texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=100,amplitude.f=1,profil.s="0,0/1,1",grad.s="0,$000000/1,$ffffff")
Protected Dim t.f(0,0)
Protected Dim tr.f(0,0)
Protected i,j,n
Noise2d(t(),dx,dy,rnd,f)
;heightmapcristal(t(),rnd,dx,dy,16)
blur2D(t(),lissage,lissage,2)
If Embos<>100:Embos2D(t(),Embos,0):EndIf
outline2d(t(),0,1,profil)
textureArraytocolor(tex,t(),grad)
textureArraytoNM(tex+1,t(),amplitude)
ProcedureReturn tex
EndProcedure
;}===================================================================================================================================================
;######################################################################################################
#halo=20
#eau=21
Global lum=1,ex,ey
Global Dim plight.f3(7)
Global Dim blight(7)
Global Dim ligness.f3(0)
Procedure grotte(num=1, prec=512)
Protected i,j,k,kj,is,js, di=128,di1=di-1,di2=di/2, dj=1024,dj1=dj-1, icolor, ntile=8,brillance,stadens,strate_grad.s
Protected.f r,a,x,y,z, sta, liss,ampl, amps, ray,rayam
Protected.f3 p1,p2,n,ni,dir,ddir,adir,diram,p,pc,rnd
Dim hmr.f(0,0)
Dim hms.f(0,0)
Dim grads.l(0)
Dim ligness.f3(dj+1)
Dim rayon.f(dj+1)
Select num
Case 1:stadens=20:liss=2:ampl=0.5:texture(1,prec,prec,0, 4,1,100,12,"0,0/0.7,0.4/1,1","0,$ff66ccff/0.4,$ff4488ff/1,$00ffffff"):amps=0.5:strate_grad="0,$888888/0.4,$ffffff/0.7,$ff0088ff/1,$ff00aaaa"
Case 2:stadens= 0:liss=0:ampl=1.0:texture(1,prec,prec,1, 4,0,100,12,"0,0/0.8,1/1,0","0,$4488bbff/0.8,$444488bb/0.9,$ffffffff/1"):amps=0.8:strate_grad="0,$ffaa8888/0.4,$ff88aaff/0.6,$ffffffff/0.7,$ffffffff/1,$ff888888"
Case 3:stadens= 0:liss=2:ampl=0.8:texture(1,prec,prec,1, 2,0,100,12,"0,1/0.4,0.5/0.5,0/0.6,0.5/1,1","0,$ff888888/0.2,$ffaaaaaa/0.5,$ffffffff/1"):amps=0.2:strate_grad="0,$00aadddd/0.2/0.6,$ffaaffff/1"
Case 4:stadens=20:liss=1:ampl=0.4:texture(1,prec,prec,1, 2,2,10,8,"0,0/0.3,0.7/1,1","0,$00448888/0.5,$00448888/0.7,$ff4488bb/1,$ffffffff"):amps=0.5:strate_grad="0,$ff88ffff/0.4,$ffffffff/0.6,$8888ff/1"
Case 5:stadens= 0:liss=2:ampl=0.6:texture(1,prec,prec,0, 4,0,100,12,"0,0/1,1","0,$0088ff88/0.7,$00ff8888/0.8,$ff66ffff/1,$ff66ffff"):amps=0.8:strate_grad="0,$ffffff88/0.6,$ff8888ff/0.7/1,$ffffffff"
EndSelect
CreateBillboardGroup(0,MaterialID(#halo),0.5,0.5):HideBillboardGroup(0,1-lum):HideLight(10,lum)
MoveCamera(0,0,0,0.5,#PB_Absolute):CameraLookAt(0,0,0,2)
;texture paroie
GetScriptMaterial(1,"bump"):MaterialTextureAliases(1,TextureID(1),TextureID(2),0,0)
MaterialFilteringMode(1,#PB_Material_Anisotropic,4)
SetMaterialColor(1, #PB_Light_SpecularColor, $111111*8):MaterialShininess(1,$11*8)
;relief
Noise2d(hmr(),di,dj,num,2)
blur2D(hmr(),liss,liss,1)
outline2d(hmr(),-1,1)
;strates
Noise2d(hms(),128,128,0,3)
blur2D(hms(),8,0,1)
outline2d(hms(),-1,1,"0,0/0.4,0.3/0.6,0.7/1,1")
gradienttoarray(grads(),1024,strate_grad)
RandomSeed(num)
r=0.01
vec3d(ddir,0,0,10)
For j=0 To dj+1
ray=ray+pom(1)-(ray-2)*0.01
interpol(rayam,rayam,ray,0.01)
rayam=limite(rayam,1,3)
rayon(j)=rayam
vec3d(rnd,pom(1)-p\x*r,pom(1/2)-p\y*r*4,0.05)
add3d(ddir,ddir,rnd):norme3d(ddir,rayon(j)*4)
add3d(dir,dir,ddir)
norme3d(dir,0.1)
interpol3D(diram,diram,dir,0.1)
add3d(p,p,diram)
ligness(j)=p
Next
rayon(0)=0
Dim t.PB_MeshVertexV(di,128)
For k=0 To (dj-1)/128
pc=ligness(k*128+64)
For j=0 To 128:kj=k*128+j
adir=dir:sub3d(dir,ligness(kj+1),ligness(kj))
defmatrot(dir,0)
For i=0 To di
With t(i,j)
r=rayon(kj)*10*(1+hmr(kj & dj1,i & di1)*ampl)
a=i/di*2*#PI
vec3d(p,0,-Cos(a)*r,-Sin(a)*r)
calcmatrot(p,p)
add3d(p,p,ligness(kj))
p\x-pc\x
p\z-pc\z
If Random(1000)<stadens And Abs(i-di2)<16 And j>0 And j<127 And r>25:sta=pom(0.4)+0.4:Else:sta=0:EndIf
vec3d(\p,p\x,p\y-sta, p\z)
is=kj & 127
js=Int(p\y*32) & 127
\p\x+hms(is,js)*amps*Sin(a)
\u= i/di*ntile
\v=kj/128*ntile
\color=grads(Int((hms(is,js)+1)*512))
If p\y+2<0:\color=ColorBlend(\color,$444400,limite(-(p\y+2)/2,0,1)):EndIf
EndWith
Next
Next
CreateDataMesh(k,t())
NormalizeMesh(k)
BuildMeshTangents(k)
CreateEntity(k,MeshID(k),MaterialID(1),pc\x,0,pc\z)
CreateLight(k, $ffffff, pc\x,pc\y,pc\z)
LightAttenuation(k, 20,1)
HideLight(k,1-lum)
blight(k)= AddBillboard(0,pc\x,pc\y,pc\z)
plight(k)=pc
Next
EndProcedure
Procedure affiche3d()
Static.f MouseX,Mousey,depX,depz,dist, fdf.l, i.l,a,ai,n.i,pl.f3
Repeat
ExamineMouse()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
ExamineKeyboard()
depX=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*0.02
depz=(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up )<>0)+MouseButton(1)-MouseButton(2))*0.02+MouseWheel()*1
For i=1 To 7
If KeyboardReleased(#PB_Key_F1+i-1):grotte(i):EndIf
Next
If KeyboardReleased(#PB_Key_F11):lum=1-lum:HideLight(10,lum):HideBillboardGroup(0,1-lum):For i=0 To 7:HideLight(i,1-lum):Next:EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):dist+(depz-dist)*0.1:MoveCamera (0, depX, 0, -dist)
If CameraY(0)>-2
Fog($000000,1,0,200):MaterialCullingMode(#eau,#PB_Material_ClockWiseCull)
Else
Fog($222200,1,0,10 ):MaterialCullingMode(#eau,#PB_Material_AntiClockWiseCull)
EndIf
For i=0 To 7:ai=a+i:pl=plight(i):pl\x+Sin(ai*3)/2:pl\y+Sin(ai*5)/2:pl\z+Sin(ai*7)/2:MoveLight(i,pl\x,pl\y,pl\z,#PB_Absolute):BillboardLocate(blight(i),0,pl\x,pl\y,pl\z):Next:a+0.01
MoveLight(10,CameraX(0),CameraY(0),CameraZ(0),#PB_Absolute):LightDirection(0,CameraDirectionX(0),CameraDirectionY(0),CameraDirectionZ(0))
CameraReflection(1,0,EntityID(#eau))
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until WindowEvent()=#PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape) Or MouseButton(2)
EndProcedure
Procedure menu()
Protected p=6
Macro DT(t1,t2)
DrawText(8,p,t1)
DrawText(100,p,t2)
p+21
EndMacro
CreateSprite(0,220,180,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,220,180,$44000000)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,220,180,$44ffffff)
BackColor($44000000)
FrontColor($ffffffff)
dt("Moving:","")
dt("Arrow keys + Mouse","")
dt("","")
dt("Controls:","")
dt("[F1] -> [F5]","Select cave")
dt("[F11]","Flashlight")
dt("[F12]","Wireframe")
dt("[Esc]","Quit")
StopDrawing()
EndProcedure
Procedure main()
InitKeyboard():InitMouse():InitEngine3D():InitSprite()
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))
LoadFont(0,"arial",12)
menu()
;-------------------- scene
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Scripts/MaterialScriptsGeneric", #PB_3DArchive_FileSystem ):Parse3DScripts()
CreateLight( 10, $111111*15, 0, 0, 0):LightAttenuation(10, 25,1)
AmbientColor($111111*2)
CreateCamera(0, 0, 0, 100, 100)
;CameraBackColor(0,$ff8888)
CameraRange(0,0,1000)
Fog($0,1,0,1000)
; halo lumineux
CreateTexture(#halo,256,256):StartDrawing(TextureOutput(#halo))
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Gradient):GradientColor(0,$ffffffff):GradientColor(1,$00ffffff):CircularGradient(128,128,128):Box(0,0,256,256)
StopDrawing()
CreateMaterial(#halo,TextureID(#halo))
MaterialBlendingMode(#halo,#PB_Material_AlphaBlend)
SetMaterialColor(#halo,#PB_Material_SelfIlluminationColor,$ffffff)
; eau
CreateCamera(1,0,0,100,100) :CameraBackColor(1,$ff8888)
CreateRenderTexture(#eau,CameraID(1),ex/2,ey/2)
Protected Dim t.f(0,0)
Noise2d(t(),128,128,0,2):blur2D(t(),1,1,2):outline2d(t(),-0.1,0.1,"0,0/0.5,1/1,0"):textureArraytoNM(#eau+1,t(),8)
GetScriptMaterial(#eau,"water_rtt"):MaterialTextureAliases(#eau,TextureID(#eau+1),TextureID(#eau),0,0):SetMaterialColor(#eau,#PB_Material_DiffuseColor,$22000000)
MaterialBlendingMode(#eau,#PB_Material_AlphaBlend)
MaterialCullingMode(#eau, #PB_Material_NoCulling)
CreatePlane(#eau,64,128,64,128,32,64);:TransformMesh(#eau,0,-0.05,0,1,1,1,0,0,0)
CreateEntity(#eau,MeshID(#eau),MaterialID(#eau),0,-2,50)
grotte(1, 512)
affiche3d()
EndProcedure
main()