It is currently Thu Sep 19, 2019 3:23 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 27 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Landscape v4
PostPosted: Mon Feb 25, 2019 7:41 pm 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 74
Image
Hello, coders,

In this version I added some grass
and you'll see, we can put a lot of it, it surprised me, especially since the rendering is done twice (for reflection)
Otherwise, I didn't bust my ass for the textures, but it looks pretty good.

For v5 I will add trees


PS: remove the debogger, otherwise the creation of the decor is a little long.
if it is slow, you can reduce the resolution of the RTT (line 638 -> CreateRenderTexture(#water,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,400,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()


Last edited by pf shadoko on Thu Jun 06, 2019 11:18 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Mon Feb 25, 2019 8:16 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Jun 24, 2006 3:29 am
Posts: 192
Very nice indeed. Grass and flowers look good. Keep going!

_________________
Proud supporter of PB! * Musician * C64/6502 Freak


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Mon Feb 25, 2019 10:59 pm 
Offline
New User
New User

Joined: Thu Jan 18, 2018 11:54 pm
Posts: 9
Wow, thank you Shadoko,
I especially like how you present successive versions with evolutions on each step.
Looks like a tutorial on how to develop a no man's sky like!
Will we have creatures on V6 :wink: ?


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Tue Feb 26, 2019 9:26 am 
Offline
Administrator
Administrator

Joined: Fri May 17, 2002 4:39 pm
Posts: 13612
Location: France
This work is way beyond my 3D understanding and i'm really amazed what can be done in such a few lines. Also very smooth on an old 3D card, good work !


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Tue Feb 26, 2019 12:39 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 19, 2010 3:42 am
Posts: 530
Stunning!!!
Thanks a lot for the source!


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Tue Feb 26, 2019 1:45 pm 
Offline
Addict
Addict

Joined: Mon Feb 16, 2015 2:49 pm
Posts: 1896
I'm loving this series of updates! :)


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Sat Mar 02, 2019 10:24 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 775
Location: Denmark
Looks really good.
Well done! :)

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 7/10, Intel 6800K, Gtx 970, 32 gb ram.


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Mon Mar 04, 2019 1:44 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Jan 25, 2005 7:01 pm
Posts: 460
Location: Canada
I get an array out of bound whenever I try the F5 terrain, and it's pretty impressive otherwise :3


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Wed Mar 06, 2019 5:54 pm 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 74
@ poshu :
replace line 369 by
Global Dim repartition.b(300,400,9)

or remove debug mode (it's much faster)


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Wed Mar 06, 2019 6:07 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2011 3:47 am
Posts: 2213
Location: Singapore
From what I'm able to see, it's simply fantastic. But the screen keeps going to black, then revealing the view again in an upward-curtain fashion.

Any idea what could be causing this?

_________________
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too!


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Wed Mar 06, 2019 6:57 pm 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 74
sorry, this demo don't work on TI99-4A :mrgreen:

try with openwindow instead openscreen:
line 617 - 618


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Wed Mar 06, 2019 7:05 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2011 3:47 am
Posts: 2213
Location: Singapore
pf shadoko wrote:
sorry, this demo don't work on TI99-4A :mrgreen:
Wouldn't it be something if it did?

It works with OpenWindowedScreen(), and I must say - Wow!

Thank you for sharing. :D

_________________
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too!


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Tue Mar 19, 2019 6:51 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Aug 19, 2013 3:28 pm
Posts: 256
Any way you could add multi-layered texture painting & splatmap where you can change the detail of each texture of the splatmap?

Thanks, & keep up the awesome work!


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Wed Mar 20, 2019 11:40 am 
Offline
Addict
Addict
User avatar

Joined: Mon Jun 06, 2005 2:35 pm
Posts: 1212
Location: germany
I tried with PB5.70 x64 on Windows 7 and get

[11:38:26] Waiting for executable to start...
[11:38:26] Executable type: Windows - x64 (64bit, Unicode)
[11:38:26] Executable started.
[11:38:27] [ERROR] Line: 590
[11:38:27] [ERROR] Invalid memory access. (read error at address 0)
[11:38:54] The Program was killed.

What's wrong?


Top
 Profile  
Reply with quote  
 Post subject: Re: Landscape v4
PostPosted: Wed Mar 20, 2019 12:03 pm 
Offline
Administrator
Administrator

Joined: Fri May 17, 2002 4:39 pm
Posts: 13612
Location: France
You can try with 'opengl' as subsystem


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 27 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  
cron

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye