Salut,
le 2eme numéro d'une série de code dont le but est de faire des décors naturels
pour la v2 on à le terrain illimité (en fait une matrice 1024*1024 bouclée)
j'ai ajouté la possibilité de voler pour mieux en profiter.
sinon, pas difference (j'ai même pas pris la peine de changer la copie d'écran...)
pour la V3 on aura la gestion du LOD (level of distance)
les mesh sont créés en plusieurs versions dont le niveau de détail varie.
les entité proche sont affichées avec le niveau de détail maximum,
plus les entité sont éloignées et plus leur niveau de détail diminue
Code : Tout sélectionner
; ----------------------------------------------------------------------------------------------------------
; Paysage V2 - pf Shadoko - 2018
; ----------------------------------------------------------------------------------------------------------
;{ ============================= biblio
Structure Vector2
x.f
y.f
EndStructure
Structure Vector3
x.f
y.f
z.f
EndStructure
Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
EndMacro
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.f iif(cond.b,voui.f,vnon.f)
If cond:ProcedureReturn voui:Else:ProcedureReturn vnon:EndIf
EndProcedure
Macro vec2d(v,vx,vy)
v\x=vx
v\y=vy
EndMacro
Procedure.f interpolarray2d(Array tt.w(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
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 string2vector2(Array s.vector2(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 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.vector2(0)
string2vector2(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.w(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.w(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.w(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 Embos(Array s.w(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.w(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 heightmap(Array t.w(2),rnd, dy.w, dx.w, Re.w)
Protected i,j,ii,jj,n,d,dd,dx1=dx-1,dy1=dy-1,l,R, rr,dec
RandomSeed(rnd)
n = 1<<re
dd=min(dx,dy) / n: If dd<1:dd=1:EndIf
Dim t.w(dy-1, dx-1)
rr = $1fff:r=rr>>1
For jj = 0 To dy/dd - 1:j=jj*dd: For ii = 0 To dx/dd - 1:i=ii*dd: t(j,i) = Random(rr) - R: Next: Next
l = dd
While dd > 1
d = dd / 2
For jj = 0 To dy/dd - 1 :j=jj*dd+d
For ii = 0 To dx/dd - 1:i=ii*dd+d
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
Next
Next
For jj = 0 To dy/d - 1 :j=jj*d:dec=1- jj & 1
For ii = 0 To dx/dd - 1:i=ii*dd+dec*d
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
Next
Next
l/2
dd/2
r/2:rr/2
Wend
EndProcedure
;}
;######################################################################################################
Global lumnb,lum,ex,ey
Global Dim h.w(0,0)
Global Dim g.w(0,0)
#tt=64:#tt1=#tt-1:#tt2=#tt/2
#di=512*2:#di1=#di-1:#dit=#di/#tt:#dit1=#dit-1
#dj=512*2:#dj1=#dj-1:#djt=#dj/#tt:#djt1=#djt-1
Enumeration objet:#ciel=10:#eau:#terrain=100:EndEnumeration
Procedure terrain_tile(Array h.w(2),Array g.w(2),pi,pj,n)
Protected i,j,ii,jj, h,g, c
Dim t.PB_MeshVertex(#tt,#tt)
For j=0 To #tt:jj=pj+j
For i=0 To #tt:ii=pi+i
h=h(ii & #di1,jj & #dj1)
g=g(ii & #di1,jj & #dj1)
With t(i,j)
\x=(i-#tt2)
\y=h/16
\z=(j-#tt2)
\u=i/8
\v=j/8
color=$ffffff
If h<700+pom(100)
If g<40:color=iif(Random(1),$00cc22,$44cc88) :Else:color=iif(Random(8),$88aaaa,$aaaa88):EndIf
EndIf
If h<20:color=$00ccff:EndIf
If h<-20:color=$000000:EndIf
\color=color
EndWith
Next
Next
CreateDataMesh(n,t())
NormalizeMesh(n)
EndProcedure
Procedure terrain(liss=2)
Protected i,j,k,n,is,js
heightmap(h(),5,#di,#dj,4)
lisser2d(h(),liss,liss,1)
;t2norme(h(),-10,90,"0,0/0.4,0.2/0.7,0.4/0.7,1/1,1")
t2norme(h(),-200,800,"0,0/0.4,0.2/0.7,0.4/1,1")
;t2norme(h(),-100,1000,"0,0/0.3,0.1/0.6,0.2/0.7,0.5/1,1")
CopyArray(h(),g())
embos(g(),0,0)
For j=0 To #djt1
For i=0 To #dit1
terrain_tile(h(),g(),i*#tt,j*#tt,#terrain+j*#dit+i)
Next
Next
EndProcedure
Procedure rendertile()
Static api,pi=1000, apj,pj=1000, i0,i1, j0,j1, e,m,cpt
Protected i,j
api=pi:pi=(CameraX(0)-#di/2)/#tt:If pi<api:i0=pi:i1=api-1:Else:i0=api+1+#dit1:i1=pi+#dit1:EndIf
apj=pj:pj=(CameraZ(0)-#dj/2)/#tt:If pj<apj:j0=pj:j1=apj-1:Else:j0=apj+1+#djt1:j1=pj+#djt1:EndIf
cpt=0
For j=pj To pj+#djt1
For i=pi To pi+#dit1
If (i>=i0 And i<=i1) Or (j>=j0 And j<=j1)
e=#terrain+(j & #djt1)*#dit+(i & #dit1)
m=#terrain+(j & #djt1)*#dit+(i & #dit1)
CreateEntity(e,MeshID(m),MaterialID(1),i*#tt+#tt2,0,j*#tt+#tt2)
cpt+1
EndIf
Next
Next
MoveEntity(#eau,pi*#tt+#di/2,0,(pj+#djt/2)*#tt,#PB_Absolute)
EndProcedure
Procedure affiche3d()
Static.f MouseX,Mousey,keyx,keyy,keyz, ysol,y, fly=1,fdf,ymin=-1000
Protected i,transit=200
Repeat
ExamineMouse()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
ExamineKeyboard()
keyx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*0.1
keyz=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up )))*0.1+MouseWheel()*10
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
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
MoveCamera (0, KeyX, 0, -keyz-fly*0.1)
ysol=max(0.2,interpolarray2d(h(), CameraZ(0)+#dj*100, CameraX(0)+#di*100)/16+1.6):If fly:y=max(ysol,CameraY(0)):Else:y=ysol:EndIf
MoveCamera(0,CameraX(0),y,CameraZ(0),#PB_Absolute)
rendertile()
CameraReflection(1,0,EntityID(#eau))
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
EndProcedure
Procedure menu()
Protected p=4
Macro DT(t1,t2)
DrawText(8,p,t1)
DrawText(100,p,t2)
p+22
EndMacro
CreateSprite(0,220,160,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,220,160,$44000000)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,220,160,$ffffffff)
BackColor($44000000)
FrontColor($ffffffff)
dt("Moving :","")
dt("Arrow keys + Mouse","")
dt("","")
dt("Controls :","")
dt("[F11]","Fly / Walk")
dt("[F12]","Wireframe")
dt("[Esc]","Quit")
StopDrawing()
EndProcedure
Procedure main()
Protected i,r.f=1
ExamineDesktops()
ex=DesktopWidth(0)*r
ey=DesktopHeight(0)*r
InitKeyboard():InitMouse():InitEngine3D():InitSprite()
;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",12)
menu()
;-------------------- scene
CreateLight(0, $777777, 10000, 10000, 10000)
AmbientColor($777777)
CreateCamera(0, 0, 0, 100, 100)
CameraLookAt(0, 0, 0, 1)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)
Parse3DScripts()
Fog($ff8888,200,0,800)
;terrain
LoadTexture(1,"dirt.jpg")
LoadTexture(#ciel,"clouds.jpg")
CreateMaterial(1,TextureID(1));:MaterialCullingMode(1,#PB_Material_NoCulling)
SetMaterialColor(1, #PB_Material_AmbientColor,-1)
terrain()
;AddMaterialLayer(1,TextureID(1),#PB_Material_Modulate):ScaleMaterial(1,0.3,0.3,1)
;MaterialBlendingMode(1,
;eau
CreateCamera(1,0,0,100,100)
CreateRenderTexture(#eau,CameraID(1),ex/1,ey/1)
CreateMaterial(#eau,TextureID(#eau))
SetMaterialAttribute(#eau,#PB_Material_ProjectiveTexturing,1)
CreateTexture(#eau+1,4,4):StartDrawing(TextureOutput(#eau+1)):DrawingMode(#PB_2DDrawing_AllChannels):Box(0,0,4,4,$bbffccaa):StopDrawing()
AddMaterialLayer(#eau,TextureID(#eau+1),#PB_Material_Modulate)
MaterialBlendingMode(#eau,#PB_Material_AlphaBlend)
CreatePlane(#eau,#di,#dj,16,16,1,1)
CreateEntity(#eau,MeshID(#eau),MaterialID(#eau))
;ciel
CameraBackColor(0,$ff8888):CameraRange(0,0.1,10000)
; texture(ciel,256,256,0,0,0,-1000,"0,$ff0000/1,$ffffff")
CreateMaterial(#ciel,TextureID(#ciel))
SetMaterialColor(#ciel,#PB_Material_SelfIlluminationColor,$ffffff):MaterialCullingMode(#ciel, #PB_Material_AntiClockWiseCull)
CreatePlane(#ciel,10000,10000,1,1,64,64): CreateEntity(#ciel,MeshID(#ciel),MaterialID(#ciel),0,200,0)
affiche3d()
EndProcedure
main()