PureBasic

Forums PureBasic
Nous sommes le Jeu 20/Juin/2019 22:22

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 14 messages ] 
Auteur Message
 Sujet du message: Paysage V4
MessagePosté: Lun 25/Fév/2019 19:28 
Hors ligne
Avatar de l’utilisateur

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

Salut les codeurs,

Dans cette version j'ai ajouté de l'herbe
et vous allez voir, on peut en mettre beaucoup, ça m'a étonné, d'autant que le rendu est effectué 2 fois (pour la reflexion)
sinon, je me suis pas casser le derche pour les textures, mais ça rend pas mal

Pour la v5 je vais ajouter des arbres


PS : enlevez le debogeur, sinon c'est un peu long la creation du décors
si ça rame, vous pouvez reduire la resolution de la RTT (ligne 638 -> CreateRenderTexture(#eau,CameraID(1),ex/2,ey/2)

Code:
; ----------------------------------------------------------------------------------------------------------
;   Paysage V4 - 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

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 GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
  Protected Dim lt.s(0)
  Protected i,j, apos,pos, acol.l,col.l
  n-1
  Dim pal(n)
  split(lt(),gradient,"/")
 
  Macro lparam(i)
    pos=ValF(lt(i))*n
    col=Val(Mid(lt(i),FindString(lt(i),",")+1))
    If inv  :col=CoRBinv(col):EndIf
    If alpha:col | $ff000000:EndIf
  EndMacro
 
  lparam(1)
  For i=2 To ArraySize(lt())
    apos=pos
    acol=col
    lparam(i)
    For j=apos To pos:pal(j)=ColorBlend(acol,col,(j-apos)/(pos-apos)):Next
  Next
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 copyimagetotexture(im,tx)
  Protected n=CreateTexture(tx,ImageWidth(im),ImageHeight(im))
  If tx=-1:tx=n:EndIf
  StartDrawing(TextureOutput(tx))
  DrawingMode(#PB_2DDrawing_AllChannels)
  DrawImage(ImageID(im),0,0)
  StopDrawing()
  ProcedureReturn tx
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
;}================================================================================================


Procedure texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=-1000,grad.s="0,$000000/1,$ffffff")
  Protected Dim t.w(0,0)
  Protected Dim bmp.l(dy-1,dx-1)
  Protected Dim grad.l(0):gradienttoarray(grad(),1024,grad,1)
  Protected i,j,n
 
  heightmap(t(),rnd,dx,dy,f)
  lisser2d(t(),lissage,lissage,2)
  If embos<>-1000:embos(t(),embos,embos):EndIf
  t2norme(t(),0,1023)
  For j=0 To dy-1:For i=0 To dx-1:bmp(j,i)=grad(t(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 matiereherbes(num,dx,dy,pal.s,c3,base.f,gr,nb)
  c3 | $ff000000
  Protected i,j,px1,py1,px2,py2,a.f,c,dx2=dx/2,dy2=dy/2,rx,ry,gg,im,mat,tex,n
  Protected Dim pal.l(100)
 
  GradientToArray(pal(),256,pal,0,1)
  im=CreateImage(-1,dx,dy,32, #PB_Image_Transparent )
  StartDrawing(ImageOutput(im))
  Box(0, 0, dx,dy, pal(50))
  StopDrawing()
  StartVectorDrawing(ImageVectorOutput(im))
  For i=0 To dx
    c=pal(Random(255))
    px2=dx2+pom(dx2*base):py2=dy
    px1=px2+pom(dx2*(1-base)):py1=dy*0.5+pom(dy*0.2)
    MovePathCursor(px2-0.1,py2):AddPathLine(px1,py1):AddPathLine(px2+0.1,py2):VectorSourceColor(c):FillPath(#PB_Path_Preserve):StrokePath(1)
    If gr And i<nb:gg=gr*(1+pom(0.2)):AddPathEllipse(px1,py1+gg,gg*2,gg):VectorSourceColor(c3):FillPath():EndIf
  Next
  StopVectorDrawing()
  n=CopyImagetotexture(im,num):If num=-1:tex=n:Else:tex=num:EndIf
  n=CreateMaterial(num,TextureID(tex)):If num=-1:mat=n:Else:mat=num:EndIf
  MaterialFilteringMode(mat,#PB_Material_Anisotropic,4)
  SetMaterialAttribute(mat,#PB_Material_AlphaReject,128)
  MaterialCullingMode(mat, #PB_Material_NoCulling)
  ;SetMaterialColor(mat, #PB_Material_AmbientColor,-1)
  ProcedureReturn mat
EndProcedure
;######################################################################################################
Structure PB_MeshVertexV
  p.vector3
  n.vector3
  t.vector3
  u.f
  v.f
  color.l
EndStructure

Structure sobjet
  col.l
  nb.w
  mat.i
EndStructure

#dd=10:#tt=1<<6:#tt1=#tt-1:#tt2=#tt/2
#di=1<<#dd:#di1=#di-1:#dit=#di/#tt:#dit1=#dit-1
#dj=1<<#dd:#dj1=#dj-1:#djt=#dj/#tt:#djt1=#djt-1
#nblod=1

Global lumnb,lum,ex,ey
Global Dim h.w(0,0)
Global Dim g.w(0,0)
Global Dim c.w(#di,#dj)
Global Dim v.PB_MeshVertexV(#di,#dj)
Global Dim repartition.b(300,200,9)
Global Dim obj.sobjet(10)
Enumeration objet:#ciel=10:#eau:#terrain=100:EndEnumeration

Procedure DefObjet(num,altmin.w,altmax.w,pentemin.w,pentemax.w,couleur.l,nombre=0,mat=0,proba=10)
  Protected i,j,k
  For i=altmin To altmax
    For j=pentemin To pentemax
      For k=0 To proba-1
        repartition(i,j,k)=num
        obj(num)\col=couleur
        obj(num)\nb=nombre
      Next
    Next
  Next
EndProcedure

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))
  ; ------------- herbes
  If r=1
    For o=1 To 6
      nb=obj(o)\nb
      If nb
        h=TextureHeight(20+o)/128
        AddSubMesh():nv=0:nsm+1
        SetMeshMaterial(n,MaterialID(20+o),SubMeshCount(n)-1)
        ;Debug o
        For j=0 To #tt
          For i=0 To #tt
            vv=v(pi+i,pj+j)
            ;mul3d(vv\n,2)
            If c(pi+i,pj+j)=o
              For k=1 To nb
                a=pom(#PI):ca=Cos(a):sa=Sin(a)
                x=vv\p\x+pom(0.5)
                z=vv\p\z+pom(0.5)
                x1=x+ca:z1=z+sa:y1=interpolarray2d(h(),z1,x1)/16
                x2=x-ca:z2=z-sa:y2=interpolarray2d(h(),z2,x2)/16
                Protected hh.f=h*(1+pom(0.2))
                MeshVertex(x1-decx,y1+hh,z1-decz,0,0,$ffffff,vv\n\x,vv\n\y,vv\n\z)
                MeshVertex(x2-decx,y2+hh,z2-decz,1,0,$ffffff,vv\n\x,vv\n\y,vv\n\z)
                MeshVertex(x1-decx,y1+0,z1-decz ,0,1,$ffffff,vv\n\x,vv\n\y,vv\n\z)
                MeshVertex(x2-decx,y2+0,z2-decz ,1,1,$ffffff,vv\n\x,vv\n\y,vv\n\z)
                MeshFace(nv+0,nv+1,nv+2)
                MeshFace(nv+2,nv+1,nv+3)
                nv+4
              Next
            EndIf
          Next
        Next
      EndIf
    Next
  EndIf
 
  FinishMesh(1)
EndProcedure

Procedure terrain(rep,liss,hmin,hmax,profil.s)
  Protected i,j,k,n,r ,h,g, c
  heightmap(h(),5,#di,#dj,rep-10+#dd);!!!
  lisser2d(h(),liss,liss)
  t2norme(h(),hmin,hmax,profil)
  For j=0 To #dj1:For i=0 To #dj1:h(i,j)+Sin(i*#PI/256)*Sin(j*#PI/128)*200: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(i,j)=repartition(h/8+100,g,Random(9))
      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=obj(c(i,j))\col
      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.4,(pj+#djt/2)*#tt,#PB_Absolute)
EndProcedure

Procedure selectterrain(n)
  DefObjet(0,0,300,0,200,$777777)
  Select n
    Case 1     
      DefObjet(1,101,200,0,10,$009922,2,Matiereherbes(21,256,64*1.5,"0,$003311/1,$227744",$ffffff, 0.8,1,100))
      DefObjet(2,101,200,10,15,$008844,2,Matiereherbes(22,256,64*2,"0,$003322/1,$226655",$0000ff, 0.8,2,25))
      DefObjet(3,101,200,15,200,$006666)
      DefObjet(4,0,100,0,200,$00ccff)
      DefObjet(8,0,99,0,200,$004400,0,0,8)
      DefObjet(5,100,101,0,2,$002200,8,Matiereherbes(25,256,128,"0,$002200/1,$335522",0, 0.2,0,0),4)
      DefObjet(6,100,101,2,4,$88ffff,4,Matiereherbes(26,256,256,"0,$002222/1,$66aaaa",0, 0.2,0,0),2)
      DefObjet(7,0,200,25,200,$ffffaaaa)
      terrain(4,2,-200,800,"0,0/0.4,0.2/0.7,0.4/1,1")
    Case 2
      DefObjet(1,101,200,0,10,$004444,3,Matiereherbes(21,256,64*1.5,"0,$002222/1,$225544",$880088, 0.8,1,200))
      DefObjet(2,101,200,10,200,$0088ff)
      DefObjet(4,0,101,0,200,$00ccff)
      DefObjet(5,0,100,0,200,$004400,0,0,4)
      DefObjet(6,100,101,0,4,$002200,8,Matiereherbes(26,256,128,"0,$002200/1,$335522",0, 0.2,0,0),4)
      DefObjet(7,0,200,25,200,$ffffff)
      terrain(4,2,-100,500,"0,0.5/0.3,0.3/0.6,0.0/0.7,0.5/1,1")
    Case 3
      DefObjet(1,0,300,0,200,$aaaa88)
      DefObjet(2,101,300,0,10,$224422,4,Matiereherbes(22,256,64*2,"0,$002200/1,$224444",$ffffff, 0.6,2,30))
      DefObjet(3,101,300,0,4,$003322,4,Matiereherbes(23,256,64*4,"0,$002222/1,$224444",$004422, 0.2,3,100))
      terrain(3,1,-100,1000,"0,1/0.3,0.6/0.5,0.0/0.7,0.4/1,1")
    Case 4
      DefObjet(1,101,300,0,100,$006600,4,Matiereherbes(21,256,64*1,"0,$002211/1,$226644",$ff8888, 0.8,1,20))
      DefObjet(3,101,150,0,4,$000000,4,Matiereherbes(23,256,64*4,"0,$001111/1,$333333",$004400, 0.2,3,400),1)
      DefObjet(4,0,100,0,200,$ffffff)
      DefObjet(7,0,200,25,200,$88aaff)
      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")
    Case 5
      DefObjet(1,101,200,0,5,$008888)
      DefObjet(2,101,200,5,15,$0066aa)
      DefObjet(3,101,200,15,200,$0066ff)
      DefObjet(5,100,100,0,5,$002200,8,Matiereherbes(25,256,128,"0,$002200/1,$335555",0, 0.2,0,0),8)
      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")
  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, $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
  texture(1,512*2,512*2,1,2,1,-10,"0,$ff112222/1,$ff66cccc")
  CreateMaterial(1,TextureID(1))
  MaterialFilteringMode(1,#PB_Material_Anisotropic,4)
  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)
  texture(#ciel,256,256,0,0,0,-1000,"0,$ffff0000/0.5,$ffffffff/1,$ff888888")
  CreateMaterial(#ciel,TextureID(#ciel)):ScaleMaterial(#ciel,2,2)
  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,100,0)
 
  selectterrain(1)
  affiche3d()
EndProcedure

main()


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Lun 25/Fév/2019 20:03 
Hors ligne

Inscription: Mer 13/Sep/2017 14:35
Messages: 61
Localisation: Picardie (Somme)
Bonsoir à tous, toujours aussi " Baiaise " pf Shadoko , de l'herbe, des fleurs.... les insectes et/les oiseaux ne devraient plus tarder. :P
Merci pour le spectacle. :roll: Bonne soirée ... :wink:


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Lun 25/Fév/2019 23:14 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2745
Localisation: Klyntar
Qu'est-ce que ça rend bien. Merci de nous partager tout ça 8)






@++

_________________
Windows 10 x64, PureBasic 5.71 Beta 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Mar 26/Fév/2019 8:24 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2135
Localisation: 50200 Coutances
Merci professeur Shadoko pour le partage de cette magnifique œuvre d'art, mais je ne sais toujours pas pourquoi l'openscreen ne fonctionne pas, heureusement qu'il existe une autre façon.

_________________
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 V4
MessagePosté: Mar 26/Fév/2019 10:08 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8670
ça commence à vraiment avoir de la gueule bravo.
Petits défauts :
- Trop de Clipping quand on vol au dessus des montagnes
- certaines touffes d'herbes ne touchent pas la terre en haut de certaines cimes (peut-être réduire la hauteur max pour l'apparition de végétation et ne pas en faire apparaitre sur les arrêtes trop saillantes ?)
- Le décor F4 a un aspect visuel bizarre avec les rochers verts et fleurs dessus. (pas réussi à screenshoté)

Dans la V10 on aura des PNJ et des quêtes ? :wink:

Merci pour ces demos ça pulse.

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Mar 26/Fév/2019 13:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 22/Nov/2004 13:05
Messages: 352
Encore un superbe travail, Bravo !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Mar 26/Fév/2019 19:55 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 5161
J'attends la version avec les deudeuches :)

Si elle sort un jour je pourrai essayer de modifier le code pour utiliser la lib vehicle avec les deudeuches, histoire de comparer le comportement avec la physique que tu utilises.

Sinon merci pour ces codes, c'est magnifique.

_________________
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Mar 26/Fév/2019 20:42 
Hors ligne

Inscription: Mer 13/Sep/2017 14:35
Messages: 61
Localisation: Picardie (Somme)
Citation:
Bonsoir Micoute , je pense que tu as regardé par là...

https://www.purebasic.com/french/documentation/screen/openscreen.html


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Mer 27/Fév/2019 15:41 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2135
Localisation: 50200 Coutances
Bonjour Mouillard,

effectivement, j'ai regardé, mais j'ai bien d'autres programmes qui tournent avec OpenScreen(), mais pas cette série là, et je ne comprends pas pourquoi, si je mets mon sous système à DirectX12, le système me dit qu'il ne le trouve pas, donc je reviens toujours à OpenGL.

_________________
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 !


Dernière édition par Micoute le Jeu 28/Fév/2019 7:50, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Mer 27/Fév/2019 20:03 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3418
C'est très bien, Pr Shadoko, d'avoir réussi à faire pousser de l'herbe. Ce sont des calculs précieux que tu publies. C'est très proche de l'Art.

Représenter le vent sur les végétations, ça semble à portée de main?


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Jeu 28/Fév/2019 12:39 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6628
Localisation: Isere
Superbe, et le déplacement est rapide...
Ouahh on se croirait dans un helico au vietnam 8O, avec peut etre un peu moins de "végétal"

Image

Du coup...le mal de mer :oops: :mrgreen:
Merci beaucoup 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Jeu 28/Fév/2019 12:56 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6858
Localisation: IDF (Yvelines)
Parcourir ce paysage fleuri en deudeuche sa serait super glamour. Merci pour ce partage ^^

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat & http://purebasic.chat/forum

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Jeu 28/Fév/2019 13:03 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 255
à Micoute:
faudrait que t'arrive à isoler le probleme
par exemple en commentant
rendertile, camerareflextion, ... (affiche3d)
le bloc 'eau', 'ciel', ... (main)

à Ar-s:
- pour le clipping on peut regler la distance du changement de lod (AddMeshManualLOD)
- pour les touffe qui ne touche pas terre, je pense pas que soit tres difficile de resoudre ce probleme, mais là, j'ai voulu faire au plus simple
- les 'rochers verts' : je voulais faire des buisson, mais c'est pas tres reussis !!
pour les copies d'ecran, faut mettre en windowedscreen, et ajouter windowevent dans la boucle de rendu
- pour les pnj, libre à vous de vous approprier le code et de les rajouter
les tableaux h,g,c contiennent respectivement la carte des hauteurs, des gradients (pentes) et des objets (couleurs)
pour connaitre l'altitude à une position données, voir la ligne ysol... (affiche3d)
bon c'est sur que le source mériterai quelque commentaires et une meilleur encapsulation (dans les versions ultérieurs...)

à comtois:
ouai, pour la prochaine version de superdeudeuche, j'utiliserai mes fonctions 'paysage'
je vais poster un code qui montre comment je gere une voiture (c'est tres simple)

à Olivier:
pour le vent, il est bien sur hors de question de modifier les mesh en temps reel
je crois que ce genre de chose se fait avec les shaders
j'ai vu un exemple qui anime les vertex pour une matière données
ça doit etre un genre de bruit de perlin animé
donc ça me parait tout à fait possible


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Paysage V4
MessagePosté: Ven 01/Mar/2019 21:39 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3418
Représenter le vent n'est pas simple : on est obligé de détruire le réalisme pour arriver à quelque chose de faisable. Je ne connais pas le principe via les shaders.


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 14 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