a small update
I've improved the shaders, it should be nicer (and smoother on "small" machines)
(so you have to download the zip containing the shaders again)
hello,
a little shader to make mountains
you'll see, it's amazingly realistic
copy the content of the zip into the "Examples\3D\Data\Scripts\MaterialScriptsGeneric" folder
http://cg.racine.free.fr/montagnes.zip
(to download it you have to copy the link in a new tab (I think it's linked to the fact that it's not https))
if it's slow, you can lower the level of detail:
line 647 :
replace
initterrain(1024,0.5)
with
initterrain(1024,1)
compiler en opengl
have a good trip
Code: Select all
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()