Paysage V2

[Guillot]

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()

[Mouillard]

Bonsoir à tous,
Alors là ...Je change de nom ...Je m'appelle ICARE ...Et je vole... .
C'est SUPER ... Merci de partager pf Shadoko

[Micoute]

Merci pour le partage et là je n'y comprends plus rien, car je pense qu'il a été conçu de la même façon que le premier, et là déroule devant mes yeux, on fabuleux paysage, comme si j'était superman survolant le monde à la recherche de sa Loïs. Merci encore tellement c'est beau et bien fait.

Réédition :

Dans Paysage V1, j'ai remplacé

Code : Tout sélectionner

OpenScreen(ex,ey,32,"")

par

Code : Tout sélectionner

OpenWindow(0,0,0,ex,ey,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0),WindowHeight(0))

et ça fonctionne, apparemment mon système n'aime pas OpenScreen(), je vais faire des essais pour voir.

Par contre, il n'y a rien d'écrit dans la petite fenêtre en haut à gauche.

[MLD]

Chapeau bas Monsieur
j'ai crus être dans un hélico militaire a la recherche de cibles

[Ar-S]

Merci, c'est chouette.
Par contre j'ai du micro lag lorsque je bouge ma souris, même en wireframe. (Encore une histoire de dpi souris ?) Parce que coté hardware je n'ai aucune raison de lagger avec une 1080...

[Kwai chang caine]

Moi super fluide comme l'autre paysage
Juste un gros carré blanc en haut à gauche avec des formes bizarres
On peut même ramper sur le sol comme un serpent, certes un peu rapide.. cool
N'y connaissant rien en graphisme, je ne sais pas si il faut remercier PB, OpenGL, ou GUILLOT, alors je remercie les trois pour faire des trucs de oufs comme ça avec si peu de lignes
Et encore une fois GUILLOT pour son partage

[Guillot]

j'ai réédité le code (il y avais 2 boulettes: dans le menu 'select terrain' ne fonctionne pas (c'est pour la v3) et j'ai mis le mode ecran (openscreen...), c'est plus fluide)

à Micoute:
bien vu
est ce que tu peux regarder si parmi les exemples PB concernant les sprites, t'aurai pas le même probleme, et dans ce cas faire un rapport de bug
t'as quoi comme version de PB ?

à Ar-S:
tu peux essayer avec ma réédition (openscreen), je pense que t'auras plus de lag
(avec wireframe, c'est toujours plus lent (je pense que c'est un mode non optimisé, c'est juste pour le debogage comme createline3d))

à KCC:
merci pour tes commentaires (toujours élogieux !)
toi aussi t'as un probleme avec les sprites, même question qu'à Micoute : t'as quoi comme version de PB ?

[Marc56]

C'est superbe

Un déplacement automatique aléatoire et ça ferait aussi un très bel écran de veille

[Ar-S]

Yop.
En openscreen le lag est toujours présent lorsque je fais par exemple des mouvements circulaires avec la souris.

[Micoute]

Bonjour professeur Shadoko et à tous les autres,

maintenant que j'ai changé les lignes sur ton Paysage V1, je n'ai aucun problème avec la 3D, même en OpenScreen(), sauf les très anciens qui fonctionnaient avec les Sprite3d() qui n'ont plus cours.

[djes]

J'ai eu le problème avec ta démo océan, alors que j'avais lancé fortnite pour le gamin... Ca a fonctionné avec le débogueur graphique autonome. Et en OpenGL, le sprite s'était mis à se déformer avec les mouvements de la souris ! Ca sent le bug PB.

[venom]

C'est reposant de se promener dans ces montagnes infini Merci pour le partage Guillot






@++

[Kwai chang caine]

à KCC:
merci pour tes commentaires (toujours élogieux !)

Comment ne pas l'être tu nous fait rêver, surtout moi pour qui le mot "SPRITE" n'évoque qu'une boisson gazeuse
Et encore, si je pouvais dire mieux, je le ferais, je suis en admiration, et toujours très pressé d'essayer une de tes nouvelles merveilles, et pour le coup jamais déçu
Avec toi, pour parler de ce que j'aime, c'est du Bocuse tous les jours...alors comment ne rien dire et ne pas essayer de te rendre un peu de reconnaissance au regard de tout ton immense talent et travail, partagé de surcroit

toi aussi t'as un probleme avec les sprites, même question qu'à Micoute : t'as quoi comme version de PB ?

Et ben je devais avoir W10 X64 / V5.70 X86 sur mon VIVO
Maintenant je suis sous W7 X86 / v5.70 X86 sur portable bureautique de m....et ça marche du tonnerre de dieu, comprend pas
Si j'y pense je réessaierais à nouveau ce week-end sur mon petit VIVO pour voir si j'ai de nouveau le carré blanc

[Ollivier]

Et ben je devais avoir W10 X64 / V5.70 X86 sur mon VIVO
Maintenant je suis sous W7 X86 / v5.70 X86 sur portable bureautique de m....et ça marche du tonnerre de dieu, comprend pas

Ah la pissée que j'ai prise en lisant ça !! Ah Microsoft... La tankulade du siècle...

@Guillot

Je vais essayer ton truc mais je n'ai pas la dernière version. Je suppose que tu utilises les dernières commandes...

[Kwai chang caine]

Ah Microsoft... La tankulade du siècle...

Mouai ..mais y'a que lui que je comprend
En fin de compte heureusement qu'il existe car si y'avait eu seulement le pingoin, peut être que je serais passé à coté de l'informatique de par sa complexité
Bien des fois je l'ai critiqué le bilou, mais je lui dois de le reconnaitre