demo 3D - Grotte V2 - normalmapping (pb 5.71)
Publié : jeu. 29/août/2019 11:42
salut les codeurs,
une petite mise à jour de ma demo 'grotte' avec normal mapping
elle utilise un script materiel integré dans pb 5.71
ce dernier ne fonctionne que sous windows (HLSL), la demo marche toutefois en mode dégradé
(si quelqu'un trouve une version GLSL...)
les textures sont basées sur une simple Heightmap
- la texture diffuse est obtenue à partir d'un degradé de couleur basé sur la heightmap
- la texture normalmap est obtenue via la procedure 'textureArray2NM' (qui converti un tableau heightmap en normalmap)
c'est rudimentaire, mais ça suffit à donner un rendu très réaliste
[EDIT]
Erratum :
en fait le script n'a pas été integré à la 5.71...
pour faire fonctionner le normal mapping:
télécharger:
http://cg.racine.free.fr/MaterialScripts_Generic.zip
et copier l'archive décompressée dans 'examples/3d/Data/Scripts/'
[EDIT 20/04/2020]
le dossier examples/3d/Data/Scripts/MaterialScriptsGenericà été ajouté à la 5.72
donc le code devrai fonctionner tel quel
Code : Tout sélectionner
; demo 3d - grotte-v2 - Pf Shadoko - 2019
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 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 string2f2(Array s.f2(1),txt.s)
Dim tt.s(0)
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,p
n-1
Dim pal(n)
split(lt(),gradient,"/")
Macro lparam(i)
pos=ValF(lt(i))*n
p=FindString(lt(i),",")
If p: col=Val(Mid(lt(i),p+1)):Else:col=acol:EndIf
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)
string2f2(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.l(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.l(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.l(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 heightmap(Array t.l(2),rnd, dx.w, dy.w, Re.w)
Protected i,j,n,d,dd,dx1=dx-1,dy1=dy-1,R, rr,dec,tt
Dim t.l(dy1, dx1)
RandomSeed(rnd)
n = 1<<re
dd=min(dx,dy) / n: If dd<1:dd=1:EndIf
rr = $4000-1:r=rr>>1
j=0:While j<dy1:i=0:While i<dx1: t(j,i) = Random(rr) - R:i+dd:Wend:j+dd:Wend
While dd > 1
d = dd / 2
j=d:While j<dy
i=d:While i<dx
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
i+dd:Wend
j+dd:Wend
dec=0
j=0:While j<dy:dec=1-dec
i=dec*d:While i<dx
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
i+dd:Wend
j+d:Wend
dd/2:r/2:rr/2:d=dd/2
Wend
EndProcedure
Procedure.i triangle(Array t.l(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.l(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(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(4000)
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 textureArray2NM(Array hm.l(2),imgNM,amplitude.f)
Protected i,j,dx,dy,h00,h10,h01
Protected.f x,y,z,l, max=255/amplitude,max2=max*max
Protected.f3 p
dx=ArraySize(hm(),2)+1
dy=ArraySize(hm(),1)+1
Dim bmp.l(dy-1,dx-1)
For j=0 To dy-1
For i=0 To dx-1
h00=hm(j,i)
h10=hm(j,(i+1) % dx)
h01=hm((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
CreateTexture(imgNM,dx,dy)
StartDrawing(TextureOutput(imgNM)):CopyMemory(@bmp(0,0),DrawingBuffer(),dx*dy*4):StopDrawing()
EndProcedure
Procedure textureHM2NM(imgHM,imgNM,amplitude.f)
Protected i,j,dx,dy,c
StartDrawing(TextureOutput(imgHM))
dx=OutputWidth()
dy=OutputHeight()
Dim hm.l(dy-1,dx-1)
Dim bmp.l(dy-1,dx-1)
CopyMemory(DrawingBuffer(),@bmp(0,0),dx*dy*4)
StopDrawing()
For j=0 To dy-1
For i=0 To dx-1
c=bmp(j,i)
hm(j,i)=Red(c)+Green(c)+Blue(c)
Next
Next
textureArray2NM(hm(),imgNM,amplitude/3)
EndProcedure
Procedure Embos(Array s.l(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.l(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.l(2),n.w=1)
Protected i,j,k,dx,dy,x,y,ii,jj
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim T.l(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 minauto(Array s.l(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.l(2),lissage.w=1)
Protected i,j,k,dx,dy
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim T.l(dy,dx)
CopyArray(s(),t())
lisser2d(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.l(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)
;heightmapcristal(t(),rnd,dx,dy,16)
lisser2d(t(),lissage,lissage,2)
If Embos<>100:Embos(t(),Embos,0):EndIf
;minauto(t())
;superpose(t(),2)
;contraste(t(),2)
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()
textureArray2NM(t(),tex+1,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)
Protected i,j,k,kj, di=128,di1=di-1,di2=di/2, dj=1024,dj1=dj-1, icolor, ntile=8,brillance,stadens
Protected.f r,a,x,y,z, sta, liss,ampl, ray,rayam
Protected.f3 p1,p2,n,ni,dir,ddir,adir,diram,p,pc,rnd
Dim hmr.l(0,0)
Dim ligness.f3(dj+1)
Dim rayon.f(dj+1)
Select num
Case 1:brillance= 8:stadens=20:liss=2:ampl=0.5:texture(1,512,512,0, 4,1,100,2,"0,0/0.7,0.4/1,1","0,$66ccff/0.4,$4488ff/0.4,$4477ff/1,$4477ff")
Case 2:brillance= 1:stadens= 0:liss=1:ampl=0.6:texture(1,512,512,1, 4,0,100,2,"0,0/0.8,1/1,0","0,$88bbff/0.7,$4488bb/1,$ffffff")
Case 3:brillance=10:stadens= 0:liss=2:ampl=0.8:texture(1,512,512,1, 2,0,100,2,"0,1/0.4,0.5/0.5,0/0.6,0.5/1,1","0,$6699aa/0.5,$99eeff/1,$77ddff")
Case 4:brillance= 8:stadens=20:liss=1:ampl=0.7:texture(1,512,512,1, 2,2,10,2,"0,0/0.3,0.7/1,1","0,$88bbff/0.7,$4488bb/1,$ffffff")
Case 5:brillance= 4:stadens= 5:liss=0:ampl=0.6:texture(1,512,512,0, 4,1,100,4,"0,0/0.6,0.6/0.75,0.8/1,1","0,$0088ff/0.6,$0055bb/1,$2288ff")
Case 6:brillance=4:stadens= 0:liss=1:ampl=0.5:texture(1,512,512,0, 3,2,0,1,"0,1/0.4,0.8/0.8,0/1,0","0,$006688/0.7,$00aaff/1,$ffffff")
Case 7:brillance=2:stadens= 0:liss=2:ampl=0.7:texture(1,512,512,0, 3,1,100,4,"0,0/0.4,0.3/0.6,0.7/1,1","0,$66bbff/0.3,$6688bb/0.35,$44aaff/0.6,$4488bb/0.65,$66bbee/1,$4488ff")
;Case 8:brillance=8:stadens= 0:liss=1:ampl=0.5:texture(1,512,512,1, 3,1,100,1,"0,1/0.4,0.5/0.45,0.3/0.5,0/0.55,0.3/0.6,0.5/1,1","0,$446688/0.5,$88ccff/1,$ffffff")
;Case 8:brillance=8:stadens= 0:liss=0:ampl=0.5:texture(1,512,512,1, 5,0,100,2,"0,0/1,1","0,$00ffff/1,$ffff00")
Case 8:brillance=4:stadens= 0:liss=2:ampl=0.5:texture(1,512,512,1, 3,4,100,4,"0,0/0.5,0.5/1,1","0,$00ffff/1,$ffff00")
EndSelect
CreateBillboardGroup(0,MaterialID(#halo),0.5,0.5):HideBillboardGroup(0,1-lum)
SetLightColor(10, #PB_Light_SpecularColor, $111111*brillance):HideLight(10,lum)
MoveCamera(0,0,0,0.5,#PB_Absolute):CameraLookAt(0,0,0,2)
;texture paroie
GetScriptMaterial(1,"ParallaxOcclusionMapping"):MaterialTextureAliases(1,TextureID(1),TextureID(2),0,0)
;CreateMaterial(1,TextureID(1))
MaterialFilteringMode(1,#PB_Material_Anisotropic,4)
;relief
heightmap(hmr(),num,di,dj,2)
lisser2d(hmr(),liss,liss,1)
t2norme(hmr(),-1024,1024,"0,0/0.1,0/0.9,1/1,1")
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/4)-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
r=rayon(kj)*10*(1+hmr(kj & dj1,i & di1)/1024*ampl)
a=i/di*2*#PI
vec3d(p,0,-Cos(a)*r,-Sin(a)*r)
calcmatrot(p,p)
add3d(p,p,ligness(kj))
sub3d(p,p,pc)
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(t(i,j)\p,p\x,p\y-sta, p\z)
t(i,j)\u= i/di*ntile
t(i,j)\v=kj/128*ntile
Next
Next
CreateDataMesh(k,t())
NormalizeMesh(k)
BuildMeshTangents(k)
CreateEntity(k,MeshID(k),MaterialID(1),pc\x,pc\y,pc\z)
CreateLight(k, $111111*15, pc\x,pc\y,pc\z)
SetLightColor(k, #PB_Light_SpecularColor, $111111*brillance)
LightAttenuation(k, 30,1)
HideLight(k,1-lum)
blight(k)= AddBillboard(0,pc\x,pc\y,pc\z)
;Debug BillboardX(1,0)
;BillboardLocate(0,0,pc\x,pc\y,pc\z)
plight(k)=pc
Next
EndProcedure
Procedure affiche3d()
Static.f MouseX,Mousey,keyx,keyz, fdf.l, i.l,a,ai,n.i,pl.f3
Repeat
ExamineMouse()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
ExamineKeyboard()
keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*0.02
keyz=(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up )<>0)+MouseButton(1)-MouseButton(2))*0.02+MouseWheel()*2
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):MoveCamera (0, KeyX, 0, -keyz) :MoveCamera(0,CameraX(0),max(CameraY(0),-1.9),CameraZ(0),#PB_Absolute)
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
;For i=0 To 7:pl=plight(i):MoveLight(i,pl\x,pl\y+Sin(a),pl\z,#PB_Absolute):BillboardLocate(blight(i),0,pl\x,pl\y+Sin(a),pl\z):Next:a+0.1
;For i=0 To 7:pl=ligness((n+i*128)& 1023):MoveLight(i,pl\x,pl\y+Sin(a),pl\z,#PB_Absolute):BillboardLocate(blight(i),0,pl\x,pl\y+Sin(a),pl\z):Next:n+1
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] -> [F7]","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,#PB_Light_Spot):SpotLightRange(10, 0, 80,2):LightAttenuation(10, 50,1)
AmbientColor($111111*2)
CreateCamera(0, 0, 0, 100, 100)
CameraBackColor(0,$ff8888)
CameraRange(0,0,100000)
; halo lumineux
CreateTexture(#halo,256,256):StartDrawing(TextureOutput(#halo))
DrawingMode(#PB_2DDrawing_Gradient):GradientColor(0,$ffffff):GradientColor(1,0):CircularGradient(128,128,128):Circle(128,128,128,$ffffff)
StopDrawing()
CreateMaterial(#halo,TextureID(#halo))
MaterialBlendingMode(#halo,#PB_Material_Add)
SetMaterialColor(#halo,#PB_Material_SelfIlluminationColor,$ffffff)
; eau
CreateCamera(1,0,0,100,100) :CameraBackColor(1,$ff8888)
CreateRenderTexture(#eau,CameraID(1),ex/2,ey/2)
CreateMaterial(#eau,TextureID(#eau))
SetMaterialColor(#eau,#PB_Material_SelfIlluminationColor,$ffffffff)
SetMaterialAttribute(#eau,#PB_Material_ProjectiveTexturing,1)
CreateTexture(#eau+1,4,4):StartDrawing(TextureOutput(#eau+1)):DrawingMode(#PB_2DDrawing_AllChannels):Box(0,0,4,4,$88ffcc88):StopDrawing()
AddMaterialLayer(#eau,TextureID(#eau+1),#PB_Material_Modulate)
MaterialBlendingMode(#eau,#PB_Material_AlphaBlend)
CreatePlane(#eau,25,100,1,1,1,1)
CreateEntity(#eau,MeshID(#eau),MaterialID(#eau),0,-2,50)
grotte(1)
affiche3d()
EndProcedure
main()
