PureBasic

Forums PureBasic
Nous sommes le Ven 22/Nov/2019 9:10

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 
Auteur Message
 Sujet du message: Paysage V3 - variante 2 couches UV
MessagePosté: Sam 16/Fév/2019 10:22 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 268
Image

Salut l'équipe,

Une variante de la v3 avec 2 couches UV, pour rendre les strates rocheuse
je pense pas approfondir cette variante, mais comme le rendu est assez réaliste, je vous la montre

pour la v4, je rajoute de la végétation : juste de l'herbe pour l'instant, mais vous allez voir on peux en mettre beaucoup
c'est quand même plus chouette de se promener dans des prairies fleuries...

[EDIT 14/10/19]
quelques améliorations, notamment :
- meilleur coloration (nécessite la 5.71)
- champ de vision 2x plus lointain


Code:
; ----------------------------------------------------------------------------------------------------------
;   Paysage V3-variante 2 couches UV - 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_MeshVertexV2
  p.vector3
  n.vector3
  t.vector3
  u.f
  v.f
  u2.f
  v2.f
  color.l
EndStructure

Procedure CreateDataMesh2(mesh,Array t.PB_MeshVertexV2(2))
  Protected p,i,j,m,diag,nx=ArraySize(t(),2),nz=ArraySize(t(),1)
  Protected.vector3 d1,d2,n
  If mesh>-2:m=CreateMesh(mesh):If mesh=-1:mesh=m:EndIf:EndIf
  For j=0 To nz
    For i=0 To nx
      With t(j,i)
        MeshVertex(\P\x,\p\y,\p\z,\u,\v,\color,\n\x,\n\y,\n\z):MeshVertexTextureCoordinate(\u2,\v2)
      EndWith
    Next
  Next 
  For j=0 To nz-1
    For i=0 To nx-1
      p=j*(nx+1)+i
        sub3d(d1,t(j,i)\p,t(j+1,i+1)\p)
        sub3d(d2,t(j+1,i)\p,t(j,i+1)\p)
        If lng3d(d1)>lng3d(d2):diag=1:Else:diag=-1:EndIf
      If diag=1
        MeshFace(p,p+1,p+nx+1): MeshFace(p+nx+2,p+nx+1,p+1)
      Else
        MeshFace(p+nx+1,p,p+nx+2): MeshFace(p+1,p+nx+2,p)
      EndIf
    Next
  Next
  If mesh>-2:FinishMesh(1):UpdateMeshBoundingBox(mesh):EndIf
  ProcedureReturn mesh
EndProcedure

;######################################################################################################

#tt=64:#tt1=#tt-1:#tt2=#tt/2
#di=1024:#di1=#di-1:#dit=#di/#tt:#dit1=#dit-1
#dj=1024:#dj1=#dj-1:#djt=#dj/#tt:#djt1=#djt-1
#da=1024*2:#dat=#da/#tt:#dat1=#dat-1
#nblod=3

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_MeshVertexV2(#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_MeshVertexV2 vv
  Dim t.PB_MeshVertexV2(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):CreateDataMesh2(-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):MeshVertexTextureCoordinate(vv\u2,vv\v2):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
 
  c1 | $ff000000
  c2 | $ff000000
  cp | $ff000000
  cb | $ff000000
  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/512)*Sin(j*#PI/512)*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)
      h2=h2(i,j)
      g=g(i,j)
      c=$ffffffff
      If h<1000+pom(100):If Random(1):c=c1:Else:c=c2:EndIf:EndIf
      If h<40+pom(20):c=cb:EndIf
      If h<-20:c=$ff44ff88: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
        \u2=Random(4)*0.005
        \v2=(h-h2)/12+pom(0.2)
        \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,100*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)-#da/2)/#tt:If pi<api:i0=pi:i1=api-1:Else:i0=api+1+#dat1:i1=pi+#dat1:EndIf
  apj=pj:pj=(CameraZ(0)-#da/2)/#tt:If pj<apj:j0=pj:j1=apj-1:Else:j0=apj+1+#dat1:j1=pj+#dat1:EndIf
  cpt=0
  For j=pj To pj+#dat1
    For i=pi To pi+#dat1
      If (i>=i0 And i<=i1) Or (j>=j0 And j<=j1)
        e=#terrain+(j & #dat1)*#dat+(i & #dat1)
        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+#da/2,0.1,pj*#tt+#da/2,#PB_Absolute)
EndProcedure

Procedure selectterrain(n)
  Select n
    Case 1:terrain(3,2,-200,1600,"0,0/0.4,0.2/0.7,0.4/1,1",$44cc88,$33ccaa,$88aaaa,$44ccff)
    Case 2:terrain(3,2,-200,1000,"0,0.3/0.3,0.2/0.6,0.0/0.7,0.5/1,1",$00bbbb,$0088ff,$ffffff,$006666)
    Case 3:terrain(2,1,-200,2000,"0,1/0.3,0.6/0.5,0.0/0.7,0.4/1,1",$aaaa88,$cc8888,$666666,$88ffff)
    Case 4:terrain(3,1,-200,1000,"0,0/0.4,0.2/0.45,0.4/0.7,0.6/0.8,1/1,0.9",$226644,$228866,$aaccff,$ffffff)
    Case 5:terrain(3,1,-200,1200,"0,0/0.5,0.2/0.51,0.3/0.58,0.33/0.59,0.5/0.62,0.51/0.63,0.6/0.69,0.62/0.71,0.75/0.75,0.78/0.76,0.85/1,1",$4466aa,$5588cc,$66aaff,$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
    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_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, $ffffff, 10000, 10000, 10000)
  AmbientColor($444444)
  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,100,0,#da*0.6)
 
  ;terrain
  LoadTexture(1,"soil_wall.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)
  DisableDebugger:SetMaterialAttribute(1,21,3):EnableDebugger
  AddMaterialLayer(1,TextureID(1),#PB_Material_Modulate,1):ScaleMaterial(1,1,32,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,#da,#da,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,400,400):  CreateEntity(#ciel,MeshID(#ciel),MaterialID(#ciel),0,200,0)
   
  selectterrain(5)
  affiche3d()
EndProcedure
 
main()


Dernière édition par Guillot le Lun 14/Oct/2019 14:29, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Sam 16/Fév/2019 11:28 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 24/Aoû/2005 10:42
Messages: 470
Magnifique, vraiment !!
C'est marrant, autant le V1 me faisait un IMA sur mon Mac, autant les V2 et 3 fonctionnent parfaitement

Et c'est vraiment du beau boulot, bravo :D

_________________
Bureau : Win10 64bits
Maison : Macbook Pro 13" Retina / SSD 512 Go / Ram 16 Go - iPad Pro 32 Go (pour madame) - iPhone X 256 Go


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Sam 16/Fév/2019 12:13 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 17/Déc/2007 12:44
Messages: 1635
Bonjour,

Franchement cool, rien d'autre a dire ^^, peut être continu a nous faire de tel beau exemple.

Cordialement,
GallyHC

_________________
Image

Image

Image Official site of PureBasic
Image Official site of SpiderBasic

Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.71 LTS (x86 et x64)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Sam 16/Fév/2019 20:20 
Hors ligne

Inscription: Mer 13/Sep/2017 14:35
Messages: 64
Localisation: Picardie (Somme)
Bonjour pf Shadoko,
j'ai testé les 2 versions V3 1 v3 2, avec la version 1 : mode avion ok et en plus j'avais la version "sous marin sous fond de ciel , mais quand même ..." en m'aidant des flèches + souris (je suis peut être vicelard ...., mais que je ne parviens à retrouver aussi nette avec la version 2....Le fond ciel est partagé avec les reliefs montagneux.Bon, peut être suis je le seul à l'avoir "essayé" , c'est pour dire que la version " sous marin "est probante aussi...Quel beau résultat :P :idea: Merci et chapeau pour ce superbe travail de vos méninges...pf Shadoko


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Dim 17/Fév/2019 7:46 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2203
Localisation: 50200 Coutances
Merci professeur Shadoko pour cette démonstration fulgurante, l'effet de stratification est très bien réalisé, du bon travail bien fait,
mais j'ai du commenter la ligne 497 et décommenter sa précédente,
sinon j'avais une erreur à la ligne 470 : [ERREUR] StartDrawing(): La sortie spécifiée est NULL (Valeur 0).

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Lun 18/Fév/2019 20:33 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4224
Localisation: Arras, France
Magnifique ! :D


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Lun 14/Oct/2019 14:33 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 268
[EDIT 14/10/19]
quelques améliorations, notamment :
- meilleur coloration (nécessite la 5.71)
- champ de vision 2x plus lointain


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V3 - variante 2 couches UV
MessagePosté: Mar 15/Oct/2019 7:42 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2203
Localisation: 50200 Coutances
Merci professeur pour ce merveilleux partage.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye