une petite mise à jour
j'ai notamment amélioré les shaders, ça devrai etre plus joli (et plus fluide sur les "petites" machines)
(vous devez donc retélécharger le zip contenant les shaders)
salut,
un petit shader pour faire des montagnes
vous allez voir, c'est étonnant de réalisme
copier le contenu du zip dans le dossier "Examples\3D\Data\Scripts\MaterialScriptsGeneric"
http://cg.racine.free.fr/montagnes.zip
(pour le telecharger il faut copier le lien dans un nouvel onglet (je pense que c'est lié au fait que c'est pas du https))
si ça rame vous pouvez baisser le niveau de detail :
ligne 647 :
remplacer
initterrain(1024,0.5)
par
initterrain(1024,1)
compiler en opengl
bonne balade
Code : Tout sélectionner
CompilerIf Not Subsystem("OpenGL")
CompilerError "enter 'OpenGL' into the 'Compiler options / Library Subsystem' field"
CompilerEndIf
DeclareModule ext_3D
EnableExplicit
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
;________________ Lib ________________
Declare f3(*v.f3,vx.f,vy.f,vz.f)
Declare add3d(*p.f3,*p1.f3,*p2.f3)
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 CoRBinv(c.l)
Declare ColorBlend(color1.l, color2.l, blend.f)
Declare GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
Declare Array2Dclamp(Array t.f(2),min.f,max.f)
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 add2D(Array s.f(2),Array t.f(2),ampl.f=1,x=0,y=0)
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)
EndDeclareModule
Module ext_3D
DisableDebugger
; ============================= biblio
Procedure f3(*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 add2D(Array s.f(2),Array t.f(2),ampl.f=1,x=0,y=0)
Protected i,j,k,dx,dy
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
For j=0 To dy
For i=0 To dx
s(j,i)+t((j+y) & dy,(i+x) & dx)*ampl
Next
Next
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.f3(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,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 a.f(0,0) :CopyArray(t(),a())
Select alphavalue
Case 0:outline2d(a(),0,256)
Case 1:grad2d(a(),4):Array2Dclamp(a(),-0.4,0):outline2d(a(),0,256)
EndSelect
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,a(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
Procedure.f interpolarray2d(Array tt.f(2),x.f,y.f)
Protected.l i0, j0,i1,j1,dx1,dy1,ix,iy
Protected.f rx, ry
x-0.5:y-0.5;
#max=$1000000
dx1=ArraySize(tt(),1)
dy1=ArraySize(tt(),2)
ix=Int(X+#max)-#max:i0 = ix & dx1:i1=(i0+1) & dx1: rx = X - ix
iy=Int(Y+#max)-#max:j0 = iy & dy1:j1=(j0+1) & dy1: ry = Y - iy
ProcedureReturn (((1 - rx) * tt(j0,i0) + rx * tt(j0,i1)) * (1 - ry) + ((1 - rx) * tt(j1,i0) + rx * tt(j1,i1)) * ry)
EndProcedure
EnableDebugger
EndModule
UseModule ext_3d
Procedure.f POM(v.f)
ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure
Procedure CreateDome(Mesh,rayon.f,hauteur.f,d=16)
Protected i,j ,d1=d-1,d2=d/2
Protected.f x,y,z, xo,yo, lat,lng, mx
Dim t.PB_MeshVertexv(d,d)
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)
\v=(Sin(lng)* mx)
lat=mx* #PI/2
x=Cos(lng)* Sin(lat)*rayon
z=Sin(lng)* Sin(lat)*rayon
y=Cos(lat)*hauteur
f3(\p,-x,y,z)
EndWith
Next
Next
ProcedureReturn CreateDataMesh(Mesh,t())
EndProcedure
Global ri=12,rf=5,l=1<<ri, l2=l/2, rd=3,t_size,t_view
Global Dim mem.i(ri,5,5)
Global ex,ey
Global Dim h.f(0,0)
Procedure render_tile(tx,ty,ri,x,y)
Protected *mem.integer,i,j,ix,iy,v,l=1<<ri, ri1=ri-1, l2=l/2, xx=(tx-x)>>ri1+1, yy=(ty-y)>>ri1+1
ix=(tx>>ri) +30000
iy=(ty>>ri) +30000
*mem=@ mem(ri,ix % 6,iy % 6)
If xx>=-rd And xx<rd And yy>=-rd And yy<rd And ri>rf
If IsEntity(*mem\i):FreeEntity(*mem\i):*mem\i=0:EndIf
For j=0 To 1
For i=0 To 1
render_tile(tx+i*l2,ty+j*l2,ri-1,x,y)
Next
Next
Else
If IsEntity(*mem\i)
MoveEntity(*mem\i,tx,0,ty,0)
Else
*mem\i=CreateEntity(-1,MeshID(ri),MaterialID(0),tx,0,ty)
EndIf
EndIf
EndProcedure
Procedure renderTile()
Protected i,j,xx,yy, x=CameraX(0),y=CameraZ(0)
xx=((x-l/2)>>ri)<<ri
yy=((y-l/2)>>ri)<<ri
For j=-rd+1 To rd
For i=-rd+1 To rd
tx=xx+i*l
ty=yy+j*l
render_tile(tx,ty,ri,x,y)
Next
Next
EndProcedure
Procedure initterrain(txsize=1024,prec.f=1)
Protected l,tt,tt1,nv,im.f,amp=1.25*256
t_size=txsize
tt=32/prec :tt1=tt+1
For k=rf To ri
l=(1<<k)
Dim v.PB_MeshVertexV(tt,tt)
For j=0 To tt:For i=0 To tt:f3(v(j,i)\p,j/tt*l,-amp+200,i/tt*l):Next:Next:v(tt/2,tt/2)\p\y=amp+200
CreateMesh(k):CreateDataMesh(-2,v())
If k>rf; ------------- jointure des tuiles de LOD differents
nv=MeshVertexCount(k)
For i=0 To tt-1
im=(i+0.5)/tt*l
MeshVertexPosition(0 ,0 ,im):nv+1:MeshFace(nv,i+1,i)
MeshVertexPosition(l ,0 ,im):nv+1:MeshFace(nv,i+tt1*tt,i+1+tt1*tt)
MeshVertexPosition(im ,0 ,0 ):nv+1:MeshFace(nv,i*tt1,(i+1)*tt1)
MeshVertexPosition(im ,0 ,l ):nv+1:MeshFace(nv,(i+1)*tt1+tt,i*tt1+tt)
Next
EndIf
FinishMesh(1)
Next
EndProcedure
Procedure.f Terrain_Height(x.f,z.f)
x*t_size/4096
z*t_size/4096
ProcedureReturn interpolarray2d(h(),x,z)*510-255+ (interpolarray2d(h(),x*8,z*8)*510-255)*0.125 +230+2
EndProcedure
Procedure menu()
Protected p=4
Macro DT(t1,t2)
DrawText(8,p,t1)
DrawText(100,p,t2)
p+22
EndMacro
CreateSprite(0,220,182,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,220,182,$44000000)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,220,182,$44ffffff)
BackColor($44000000)
FrontColor($ffffffff)
dt("Moving :","")
dt("Arrow keys + Mouse","")
dt("","")
dt("Controls :","")
dt("[F1]->[F6]","Select terrain")
dt("[F11]","Fly / Walk")
dt("[F12]","Wireframe")
dt("[Esc]","Quit")
StopDrawing()
EndProcedure
Procedure selectterrain(n=1,rnd=5)
Protected i,j,k, prof.s,blur,r
Protected.l fogc,skytype=2,skyc ,hrzc, waterc,waterskyc, valley.f
Dim g.f(0,0)
For k=rf To ri:For j=0 To 5:For i=0 To 5:If mem(k,j,i):FreeEntity(mem(k,j,i)):mem(k,j,i)=0:EndIf:Next:Next:Next
#eau=20
t_view =1<<(ri-1)*6
fogc=$666688:skyc=$ff7722:hrzc=$4488ff:sunc=$ffffff
waterc=$00113300
waterskyc=$ffaa7766
Select n
Case 1:c1=$074488ff:c2=$11446666:c3=$44668888:blur=0:r=0:prof="0,0/0.2,0.3/0.6,0.4/1,1":fogc=$5577aa:skyc=$335588:waterskyc=$ff446699:valley=3:skytype=1
Case 2:c1=$22eeeecc:c2=$44ccaa88:c3=$11444444:blur=0:r=1:prof="0,0/0.3,0.1/1,1":waterc=$443322:valley=-4:skytype=1
Case 3:c1=$07004466:c2=$11004488:c3=$2288bbff:blur=0:r=1:prof="0,0.3/0.2,0/0.7,0.8/1,1"
Case 4:c1=$07004433:c2=$00113355:c3=$22446666:blur=0:r=1:prof="0,0/0.4,0.2/1,1":waterc=$00223311:valley=2:skytype=3
Case 5:c1=$004499ff:c2=$00224499:c3=$22666666:blur=0:r=0:prof="0,1/0.2,0.3/0.4,0.2/0.5,0/0.8,0.3/1,1":skytype=1
Case 6:c1=$00226688:c2=$00224499:c3=$22888899:blur=0:r=1:prof="0,0/0.2,0.1/0.3,0.3/0.5,0.45/0.56,0.6/0.8,0.72/0.86,0.9/1,1":valley=2
EndSelect
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,4,5):CameraLookAt(0,0,0,0):CameraBackColor(0,fogc)
Fog(fogc,1,0,t_view)
CreateLight(0, sunc, -10000*2, 10000,00)
AmbientColor($111111*4)
;---- sky / ciel
Select skytype
Case 1: Noise2d(h(),1024,1024,0,0,3):Noise2d(g(),1024,1024,1,6):add2D(h(),g(),0.1):textureArrayToColor(60,h(),"0,$00eeeeee/0.5/0.8,$ffeeeeee/1,$ffbbbbbb")
Case 2: Noise2d(h(),1024,1024,0,2):Noise2d(g(),1024,1024,1,5):outline2d(g(),0,1,"0,1/0.5,0/1,1"):add2D(h(),g(),0.8):textureArrayToColor(60,h(),"0,$00eeeeee/0.6/0.8,$ffeeeeee/1,$ffbbbbbb")
Case 3: Noise2d(h(),1024,1024,0,2):Noise2d(g(),1024,1024,1,5):add2D(h(),g(),0.3):textureArrayToColor(60,h(),"0,$00eeeeee/0.4/0.6,$ffeeeeee/1,$ff999999")
EndSelect
GetScriptMaterial(60,"sky"):MaterialTextureAliases(60,TextureID(60),0,0,0)
MaterialCullingMode(60,#PB_Material_NoCulling)
SetMaterialColor(60,#PB_Material_AmbientColor,skyc)
SetMaterialColor(60,#PB_Material_DiffuseColor,hrzc)
ScaleMaterial(60,0.5,0.5)
CreateDome(60,t_view,t_view/6)
CreateEntity(60,MeshID(60),MaterialID(60))
;---- water / eau (surface)
Noise2d(h(),512,512,0,5,5):outline2d(h(),0,1,"0,1/0.5,0/1,1"):textureArraytoNM(#eau,h(),6)
GetScriptMaterial(#eau,"water_s"):MaterialTextureAliases(#eau,TextureID(#eau),0,0,0)
MaterialBlendingMode(#eau,#PB_Material_AlphaBlend)
MaterialShininess(#eau,256)
SetMaterialColor(#eau,#PB_Material_DiffuseColor,waterc)
SetMaterialColor(#eau,#PB_Material_SpecularColor,waterskyc)
MaterialFilteringMode(#eau,#PB_Material_Anisotropic)
MaterialCullingMode(#eau,#PB_Material_NoCulling)
CreatePlane(#eau,t_view*2,t_view*2,16,16,t_view/32,t_view/32)
CreateEntity(#eau,MeshID(#eau),MaterialID(#eau))
;---- terrain
noise2d(h(),1024,1024,1,3):outline2d(h(),0,1,"0,1/0.5,0/1,1"):textureArrayToNM(3,h(),8)
grad2D(h(),2):textureArrayToColor(2,h())
Noise2d(h(),t_size,t_size,rnd+n,r)
If valley:Noise2d(g(),t_size,t_size,1,r):outline2d(g(),0,1,"0,1/0.5,0/1,1"):add2D(h(),g(),valley):EndIf
outline2d(h(),0,1,prof)
blur2D(h(),blur,blur);
textureArraytoNM(0,h(),32)
CopyArray(h(),g())
embos2D(g(),0,0)
outline2d(g(),0,255)
Dim c.l(t_size-1,t_size-1)
For j=0 To t_size-1
For i=0 To t_size-1
Select g(j,i)
Case 0 To 30:color=c1
Case 30 To 60:color=c2
Default:color=c3
EndSelect
c(j,i)=CoRBinv(color)
Next
Next
CreateTexture(1,t_size,t_size):StartDrawing(TextureOutput(1)):CopyMemory(@c(0,0),DrawingBuffer(),t_size*t_size*4):StopDrawing()
If IsMaterial(0):FreeMaterial(0):EndIf
GetScriptMaterial(0,"terrain_t"):MaterialTextureAliases(0,TextureID(0),TextureID(1),TextureID(2),TextureID(3))
MaterialShininess(0,64):SetMaterialColor(0,#PB_Material_SpecularColor,$ffffff)
SetMaterialColor(0,#PB_Material_SelfIlluminationColor,waterc)
ScaleMaterial(0,40,4)
EndProcedure
Procedure test3d()
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))
LoadFont(0,"arial",11*100/DesktopScaledX(100))
menu()
Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Scripts\MaterialScriptsGeneric", #PB_3DArchive_FileSystem )
Parse3DScripts()
initterrain(1024,0.5)
selectterrain(6)
Protected.f MouseX,Mousey, mdx,mdy,amo=0.1,depx,depz, ysol, dist,cp.f3
Protected fly=1, fdf
Repeat
ExamineMouse()
mdx+(MouseDeltaX()-mdx)*amo:MouseX-mdx * 0.1
mdy+(MouseDeltaY()-mdy)*amo:MouseY-mdy * 0.1
ExamineKeyboard()
For i=0 To 5:If KeyboardReleased(#PB_Key_F1+i):selectterrain(1+i):EndIf:Next
If KeyboardReleased(#PB_Key_F11):fly=1-fly:amo=1-fly*0.95:EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
depx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*0.1
depz=(-Bool(KeyboardPushed(#PB_Key_Down) Or MouseButton(2))+Bool(KeyboardPushed(#PB_Key_Up) Or MouseButton(1))+fly)*0.4+MouseWheel()*20
RotateCamera(0, MouseY, MouseX, -mdx *fly, #PB_Absolute)
dist+(depz-dist)*0.1
MoveCamera (0, depX, 0, -dist)
f3(cp,CameraX(0),CameraY(0),CameraZ(0))
ysol=Terrain_Height(cp\x,cp\z)+1.6:If fly:cp\y=Max(ysol,cp\y):Else:cp\y=ysol:EndIf
MoveCamera(0,cp\x,cp\y,cp\z,#PB_Absolute)
rendertile()
MoveEntity(60,cp\x,0,cp\z,#PB_Absolute)
MoveEntity(#eau,Int(cp\x/256)*256,0,Int(cp\z/256)*256,#PB_Absolute)
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
While WindowEvent():Wend
Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(3)
EndProcedure
test3d()
