Guillot wrote:
Hello, team,
this version manages the LOD (level of detail)
(AddMeshManualLOD function)
as there was no visual level improvement, on the contrary (it will be for the next version), I put 5 worlds[F1->F5]
and I added roll, when you turn in "plane" mode
before moving on to v4, I will show you a variant of v3 with 2 UV layers, to make the layers rocky
I don't think I'll go into this variant in more detail, but since the rendering is quite realistic, I'll show you how it works.
Translated with http://www.DeepL.com/TranslatorCode: Select all
; ---------------------------------------------------------------------------------------------------------- ; Paysage V3 - 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 lng3D(*v.Vector3) ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z) EndProcedure Procedure Norme3D(*V.Vector3,l.f=1) Protected.f lm lm = l / lng3d(*v) *V\x * lm *V\y * lm *V\z * lm EndProcedure Macro sub3D(p,p1,p2) p\x=p1\x-p2\x p\y=p1\y-p2\y p\z=p1\z-p2\z 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 ;} ;###################################################################################################### Structure PB_MeshVertexV p.vector3 n.vector3 t.vector3 u.f v.f color.l EndStructure #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 #nblod=2 Global lumnb,lum,ex,ey Global Dim h.w(0,0) Global Dim h2.w(#di,#dj) Global Dim g.w(0,0) Global Dim v.PB_MeshVertexV(#di,#dj) Enumeration objet:#ciel=10:#eau:#terrain=100:EndEnumeration Procedure terrain_tile(pi,pj,n, r=1) Protected i,j,k,o,im, tt=#tt/r, tt1=tt+1, nv, decx=pi+#tt2,decz=pj+#tt2 Protected.f x,y,z,a,ca,sa, x1,y1,z1, x2,y2,z2, h,l,nb,nsm Protected.PB_MeshVertexV vv Dim t.PB_MeshVertexV(tt,tt) For j=0 To tt For i=0 To tt t(i,j)=v(pi+i* r,pj+j* r) t(i,j)\p\x-decx t(i,j)\p\z-decz Next Next CreateMesh(n):CreateDataMesh(-2,t()) ; ------------- jointure des tuiles de LOD differents Macro addv:MeshVertex(vv\p\x-decx,vv\p\y,vv\p\z-decz, vv\u,vv\v, vv\color, vv\n\x,vv\n\y,vv\n\z):nv+1:EndMacro nv=MeshVertexCount(n) If r>1 For i=0 To tt-1 im=i*r+r/2 vv=v(pi,pj+im) :addV:MeshFace(nv,i+1,i) vv=v(pi+#tt,pj+im):addV:MeshFace(nv,i+tt1*tt,i+1+tt1*tt) vv=v(pi+im,pj) :addV:MeshFace(nv,i*tt1,(i+1)*tt1) vv=v(pi+im,pj+#tt):addV:MeshFace(nv,(i+1)*tt1+tt,i*tt1+tt) Next EndIf SetMeshMaterial(n,MaterialID(1)) FinishMesh(1) EndProcedure Procedure terrain(rep,liss,hmin,hmax,profil.s,c1,c2,cp,cb) Protected i,j,k,n,r ,h,h2,g, c heightmap(h(),5,#di,#dj,rep) lisser2d(h(),liss,liss) t2norme(h(),hmin,hmax,profil) For j=0 To #dj1:For i=0 To #dj1:h2(i,j)=Sin(i*#PI/256)*Sin(j*#PI/128)*200:h(i,j)+h2(i,j):Next:Next CopyArray(h(),g()) embos(g(),0,0) For j=0 To #dj1 For i=0 To #dj1 h=h(i,j) g=g(i,j) c=$ffffff If h<800+pom(100):If Random(1):c=c1:Else:c=c2:EndIf:EndIf If h<20:c=cb:EndIf If h<-20:c=$000000:EndIf If g>30:c=cp:EndIf With v(i,j) vec3d(\p,i,h/16,j) vec3d(\n,h-h((i+1) & #di1,j),16,h-h(i,(j+1) & #dj1)):norme3d(\n) \u=i/8 \v=j/8 \color=c EndWith Next Next For i=0 To #di:v(i,#dj)=v(i,0):v(i,#dj)\p\z=#dj:v(i,#dj)\v=#dj/8:Next For j=0 To #dj:v(#di,j)=v(0,j):v(#di,j)\p\x=#di:v(#di,j)\u=#di/8:Next For j=0 To #djt1 For i=0 To #dit1 For k=0 To #nblod:r=1<<k n=#terrain+j*#dit+i terrain_tile(i*#tt,j*#tt,n+256*k,r) If k:AddMeshManualLOD(n,n+256*k,64*r):EndIf Next Next Next EndProcedure Procedure rendertile(init=0) Static api,pi=1000, apj,pj=1000, i0,i1, j0,j1, e,m,cpt If init:api=0:pi=1000:apj=0:pj=1000:EndIf 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),#PB_Material_None,i*#tt+#tt2,0,j*#tt+#tt2) cpt+1 EndIf Next Next MoveEntity(#eau,pi*#tt+#di/2,0.1,(pj+#djt/2)*#tt,#PB_Absolute) EndProcedure Procedure selectterrain(n) Select n Case 1:terrain(4,2,-200,800,"0,0/0.4,0.2/0.7,0.4/1,1",$00aa22,$008844,$88aaaa,$00ccff) Case 2:terrain(4,2,-100,500,"0,0.5/0.3,0.3/0.6,0.0/0.7,0.5/1,1",$00bbbb,$0088ff,$ffffff,$006666) Case 3:terrain(3,1,-100,1000,"0,1/0.3,0.6/0.5,0.0/0.7,0.4/1,1",$aaaa88,$cc8888,$666666,$88ffff) Case 4:terrain(4,1,-120,500,"0,0/0.4,0.2/0.45,0.4/0.7,0.6/0.8,1/1,0.9",$004422,$008844,$88ccff,$ffffff) Case 5:terrain(5,1,-100,600,"0,0/0.5,0.2/0.51,0.3/0.6,0.35/0.61,0.6/0.7,0.65/0.71,0.85/1,1",$004488,$0066aa,$0066ff,$006644) EndSelect rendertile(1) EndProcedure Procedure affiche3d() Static.f MouseX,Mousey, mdx,mdy,amo=0.05,keyx,keyy,keyz,y, ysol Protected i, fly=1, fdf, ac CameraReflection(1,0,EntityID(#eau)) Repeat WindowEvent() ExamineMouse() mdx+(MouseDeltaX()-mdx)*amo:MouseX-mdx * 0.1 mdy+(MouseDeltaY()-mdy)*amo:MouseY-mdy * 0.1 ExamineKeyboard() If KeyboardReleased(#PB_Key_F1):selectterrain(1):EndIf If KeyboardReleased(#PB_Key_F2):selectterrain(2):EndIf If KeyboardReleased(#PB_Key_F3):selectterrain(3):EndIf If KeyboardReleased(#PB_Key_F4):selectterrain(4):EndIf If KeyboardReleased(#PB_Key_F5):selectterrain(5):EndIf If KeyboardReleased(#PB_Key_F10):ac=1-ac:For i=20 To 26:If IsMaterial(i):If ac:SetMaterialColor(i, #PB_Material_AmbientColor,-1):Debug i Else:SetMaterialColor(i, #PB_Material_AmbientColor,$ff):EndIf:EndIf:Next:EndIf 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 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 RotateCamera(0, MouseY, MouseX, -mdx *fly, #PB_Absolute) 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,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]->[F5]","Select terrain") 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,700) ;terrain LoadTexture(1,"dirt.jpg") CreateMaterial(1,TextureID(1));:MaterialCullingMode(1,#PB_Material_NoCulling) MaterialFilteringMode(1,#PB_Material_Anisotropic,4) ;SetLightColor(0,#PB_Light_SpecularColor,$777777):MaterialShininess(1,10):SetMaterialColor(1,#PB_Material_SpecularColor,$00444444) SetMaterialColor(1, #PB_Material_AmbientColor,-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*1.4,#dj*1.4,1,1,1,1) CreateEntity(#eau,MeshID(#eau),MaterialID(#eau)) ;ciel CameraBackColor(0,$ff8888):CameraRange(0,0.1,10000) LoadTexture(#ciel,"clouds.jpg") CreateMaterial(#ciel,TextureID(#ciel)) SetMaterialColor(#ciel,#PB_Material_SelfIlluminationColor,$ffffff):MaterialCullingMode(#ciel, #PB_Material_AntiClockWiseCull) CreatePlane(#ciel,100000,100000,1,1,640,640): CreateEntity(#ciel,MeshID(#ciel),MaterialID(#ciel),0,200,0) selectterrain(4) affiche3d() EndProcedure main()
Landscape v3
- pf shadoko
- Enthusiast
- Posts: 296
- Joined: Thu Jul 09, 2015 9:07 am