Générateur de planètes

Généralités sur la programmation 3D
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Générateur de planètes

Message par kelebrindae »

Bonjour à tous,

Ceci fait suite à mes précédents posts sur la génération d'une sphère et le calcul des normales.

L'idée est la suivante:
- Je pars d'un mesh très simple doté de 6 côtés bien définis
- Je subdivise ce mesh pour obtenir une sphère dont chaque polygone a hérité de l'attribut "côté" de son polygone d'origine
- Je génère 6 heightmaps, une par côté, que j'applique à la sphère en fonction du côté de chaque polygone
- A partir des heightmaps, je génère 6 textures (toujours une par côté)
- Afin de pouvoir appliquer les textures à chaque côté, je découpe la sphère en 6 entités diférentes
- J'applique les textures à ces 6 entités

=> Et voilà, une zolie planète !

Bon, il faut que j'améliore la génération des textures (qui est un peu primitive) et que j'essaie d'augmenter le nombre de polygones du mesh final (en partant d'un mesh de base différent), mais pour une première version ça ne rend pas trop mal. :D

Problèmes:
- En full-screen, les "messageRequester" passent parfois derrière l'image et on est obligé de faire "ALT-TAB" pour les voir;
- Les jointures entre les 6 entités "côtés" sont visibles (problème de coordonnées UV ?).
Mais je ne vois pas comment appliquer les 6 textures différentes sans découper le mesh; je ne crois pas que PB sache faire ça (bien qu'il le fasse pour les skycubes). Quelqu'un a une idée ?

Bon test! (n'oubliez pas de décocher le debugger, sinon c'est long)

[EDIT]
$¤*#à@ ! Le code est trop long pour tenir dans un seul post!

Je le découpe et je le reposte...
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Message par kelebrindae »

Première partie:

Code : Tout sélectionner

; Author: Kelebrindae
; Date: july,9, 2008
; PB version: v4.10
; OS: Windows XP

; ---------------------------------------------------------------------------------------------------------------
; Purpose:
; ---------------------------------------------------------------------------------------------------------------
; - Starts from a simple, very low-poly base mesh and subdivides it to make something that looks like a geosphere.
;   (NB: the base mesh has 6 square sides, like a cube.)
; - Then, generates 6 heightmaps and apply them to each "side" of the sphere (the "side" attribute for each poly
;   of the mesh is inherited from the base mesh).
; - As PB can't texture each "side" with a different material, cut out the sphere into 6 sub-mesh (one per "side")
; - Generate 6 textures from the heightmaps, and apply them to the "sides" entities.
;
; Presto! Instant planet!
;
; ---------------------------------------------------------------------------------------------------------------
; Known Problems:
; ---------------------------------------------------------------------------------------------------------------
; - Seams between sides sub-meshes are visible (UV problem ?)
; - Texture generation is pathetically simple


;- Constants
#SQRT03=0.577350269189625764
#MAXMESH=10
#PLANETSEED=11 ; change this to create a different planet
#WATERLEVEL=127
#RELIEFEXAGERATION=0.25 ; Change this to increase/decrease relief height

Enumeration
  #TOPSIDE
  #BOTTOMSIDE
  #RIGHTSIDE
  #LEFTSIDE
  #FRONTSIDE
  #BACKSIDE
EndEnumeration

;- Data structures
Structure VoronoiPoint2D ; used to create Voronoi Diagram
  x.l
  y.l
  dist.f
EndStructure

Structure Vector3 ; used in vector maths (normalization)
  x.f
  y.f
  z.f
EndStructure

Structure Vertex ; used to generate meshes
  px.f 
  py.f 
  pz.f 
  nx.f 
  ny.f 
  nz.f 
  couleur.l 
  U.f 
  V.f 
EndStructure 

Structure Polygon ; used to generate meshes
  numVert1.w 
  numVert2.w 
  numVert3.w 
EndStructure

Structure duplicateVert ; used to store lists of vertices that are at the same position
  numVert.w
  nbDup.w
  *PtrListVert.w
  done.b
EndStructure

Structure dynMesh_struct ; used to store infos about dynamically generated meshes
  id.s
  numMesh.l
  sizeX.f
  sizeY.f
  sizeZ.f
  nbVert.l
  nbTri.l
  *vertexBuffer.Vertex
  *dupVert.duplicateVert
  *polygonBuffer.Polygon
  *faceSideBuffer.b ; 1=up, 2=bottom,3=left,4=right,5=front,6=back
EndStructure


;- Global definitions
Global Dim dynMesh.dynMesh_struct(#MAXMESH)

Global Dim couleur(6)
couleur(#TOPSIDE)=RGB(255,0,0)
couleur(#BOTTOMSIDE)=RGB(0,255,0)
couleur(#LEFTSIDE)=RGB(0,0,255)
couleur(#RIGHTSIDE)=RGB(255,255,0)
couleur(#FRONTSIDE)=RGB(255,0,255)
couleur(#BACKSIDE)=RGB(0,255,255)

Global CameraMode.b
Global planetMesh.l,planetEntity.l = 0,newMesh.l,newEntity.l=10
Global *ptrPoly.Polygon,*ptrVert.vertex,*ptrSide.b
Global anglex.f = 0:angley.f = 0
Global side.b,phase.b

Global maxgrid.l = 512 ; must be a power of 2
Global Dim diamond.b(maxgrid,maxgrid)
Global Dim voronoi.b(maxgrid,maxgrid)
Global Dim heightmap.b(6,maxgrid,maxgrid)


;- ---------- Procedures ----------
EnableExplicit

;- --- Heightmaps generation ---
;************************************************************************************
; Name: makeDiamondSquare
; Purpose: Creates an array of fractal noise (looks like Perlin) that can be used as
;          a heightmap
; Parameters:
;   - size of the array (a square of size x size)
;   - dispersion
;   - seed: albeit the noise is random, a seed always produces the same result
; Return-value: none, but the result is stored in the "diamond" array
;************************************************************************************
Procedure makeDiamondSquare(maxgrid.l,dispersion.f,seed.l)

  Protected gridstep.l,mid.l,n.l
  Protected i.l,i1.l,i2.l
  Protected j.l,j1.l,j2.l,js.l
  Protected u.f,average.f
  Protected dispStep.f,min.f=999999,max.f=-999999,ratio.f
  Protected Dim temp.f(maxgrid,maxgrid)
  
  RandomSeed(seed)

  gridstep=maxgrid
  dispStep=dispersion

  ; main loop
  While gridstep>1
    mid=gridstep/2

    ; Diamond step - calculates new diamond corners from squares
    i=mid
    i1=i-mid
    i2=i+mid
    
    While i<maxgrid
      j=mid
      j1=j-mid
      j2=j+mid
      
      While j<maxgrid
        ; Average of surrounding points
        average=(temp(i1,j1)+temp(i1,j2)+temp(i2,j1)+temp(i2,j2))/4
        
        ; calculate random values between -1 and 1
        u=Random(16384)/8192 - 1
        
        ; Diamond value
        temp(i,j)=average+u*dispStep
        j+gridstep
        j1+gridstep
        j2+gridstep
      Wend
      
      i+gridstep
      i1+gridstep
      i2+gridstep
    Wend

    ; square Step - calculates new square corners from diamonds
    i=0
    i1=i-mid
    i2=i+mid
    js=0
    
    While i<maxgrid
      js=mid-js ; toggle start values of j loop
      j=js
      j1=j-mid
      j2=j+mid
      
      While j<maxgrid;+1
        average=0
        If i1<0  ; check For need To wrap around i value
          average+temp(i2,j)+temp(i2,j)
        Else
          If i2>maxgrid
            average+temp(i1,j)+temp(i1,j)
          Else
            average+temp(i1,j)+temp(i2,j)
          EndIf
        EndIf
        
        If j1<0  ; check For need To wrap around j value
          average+temp(i,j2)+temp(i,j2)
        Else
          If j2>maxgrid
            average+temp(i,j1)+temp(i,j1)
          Else
            average+temp(i,j1)+temp(i,j2)
          EndIf
        EndIf     
        average=average/4
        
        ; calculate random value between -1 And 1
        u=Random(16384)/8192-1
        
        temp(i,j)=average+u*dispStep
        temp(maxgrid,j)=temp(0,j) ; copy opposite edge
        j+gridstep
        j1+gridstep
        j2+gridstep
        
      Wend
      If j=maxgrid
        temp(i,j)=temp(i,0) ; copy opposite edge
      EndIf
      i+mid
      i1+mid
      i2+mid
    Wend

    dispStep/2
    gridstep/2
  Wend

; Keep values in Byte range (between 0 and 255)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      ; Min /max values
      If temp(i,j)<min
        min=temp(i,j)
      Else
        If temp(i,j)>max
          max=temp(i,j)
        EndIf
      EndIf   
    Next j
  Next i
  
  ratio=256.0/(max-min)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      n=(temp(i,j)-min)*ratio
      If n<0
        diamond(i,j)=0
      Else
        If n>255
          diamond(i,j)=255
        Else
          diamond(i,j)=n
        EndIf
      EndIf
    Next j
  Next i

 
EndProcedure

;************************************************************************************
; Name: makeVoronoi
; Purpose: Creates a modified Voronoi diagram that can be used to simulate tectonic
;          plates
; Parameters:
;   - size of the array (a square of size x size)
;   - number of regions
;   - number of points in each region (a point is the "center" of a Voronoi plate)
;   - seed: albeit the diagram is random, a seed always produces the same result
; Return-value: none, but the result is stored in the "voronoi" array
;************************************************************************************
Procedure makeVoronoi(maxgrid.l,nbregion.l,nbpts.l,seed.l)

  Protected NewList ftpoint.VoronoiPoint2D()
  Protected Dim coef.f(nbregion*nbregion*nbpts)
  Protected i.l,j.l,k.l,n.l
  Protected min.f=999999,max.f=-999999,ratio.f
  Protected Dim temp.f(maxgrid,maxgrid)


  RandomSeed(seed)
  coef(0)=-1
  coef(1)=-2
  coef(2)=0.5

  ; In each region of the grid, place some points
  For i=0 To nbregion-1
    For j =0 To nbregion-1
      n=Random(nbpts)
      For k=1 To n
        AddElement(ftpoint())
        ftpoint()\x=i*(maxgrid/nbregion)+Random(maxgrid/nbregion)
        ftpoint()\y=j*(maxgrid/nbregion)+Random(maxgrid/nbregion)
        ;Debug StrF(ftpoint()\x)+","+StrF(ftpoint()\y)
      Next k
    Next j
  Next i
  
  ; For each cell of the grid, compute distance to each point, sort points according to distance.
  ; => value = coef * distance
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
    
      ForEach ftpoint()     
        ftpoint()\dist = Sqr((ftpoint()\x-i)*(ftpoint()\x-i)+(ftpoint()\y-j)*(ftpoint()\y-j))
      Next
      SortStructuredList(ftpoint(),0,OffsetOf(VoronoiPoint2D\dist),#PB_Sort_Float)
      
      k=0
      ForEach ftpoint()
        temp(i,j) + coef(k)*ftpoint()\dist
        k+1
      Next     
      
      ; Min /max values
      If temp(i,j)<min
        min=temp(i,j)
      Else
        If temp(i,j)>max
          max=temp(i,j)
        EndIf
      EndIf   
      
    Next j
  Next i

; Keep values in Byte range (between 0 and 255)
  ratio=256.0/(max-min)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      n=(temp(i,j)-min)*ratio
      If n<0
        voronoi(i,j)=0
      Else
        If n>255
          voronoi(i,j)=255
        Else
          voronoi(i,j)=n
        EndIf
      EndIf
    Next j
  Next i
  
EndProcedure

;************************************************************************************
; Name: getColor
; Purpose: From a point in a heightmap, compute the color of the same point in the
;          corresponding texture
; Parameters:
;   - number of the heightmap
;   - coords X,Y of the point
;   - sea level
; Return-value: RGB value
;************************************************************************************
Procedure.l getColor(numHmap.b,x.l,y.l,waterLevel.l)

  Protected height.l
  Protected rockratio.f,grassratio.f
  Protected red1.f,green1.f,blue1.f
  Protected red2.f,green2.f,blue2.f
  Protected red.l,green.l,blue.l
  
  height = heightmap(numHmap,x,y)&255
  
  ; underwater points => shades of blue
  If height<=#WATERLEVEL
    red1=0:green1=3:blue1=92
    red2=0:green2=130:blue2=220
    
    red=red1+(red2-red1)*(height/#WATERLEVEL)
    green=green1+(green2-green1)*(height/#WATERLEVEL)
    blue=blue1+(blue2-blue1)*(height/#WATERLEVEL)

    ProcedureReturn RGB(red,green,blue)
  EndIf
  
  ; Above water: mix of grass and rock/snow
  rockratio=((height-160)/95)
  If rockratio<0
    rockratio=0
  EndIf
  If rockratio>1
    rockratio=1
  EndIf
  grassratio=1-rockratio
  
  ProcedureReturn RGB((32+Random(32))*grassratio+(height*rockratio),(255-(height/1.5)+Random(16))*grassratio+(height*rockratio),(0)*grassratio+(height*rockratio) ) 
  
EndProcedure 

;************************************************************************************
; Name: MakeHeightmap
; Purpose: Mix a diamond-square array and a Voronoi diagram to obtain the final heightmap
; Parameters:
;   - number of the heightmap
;   - size of the array (a square of size x size); Diamond, Voronoi, and Heightmap must
;     have the same size
;   - use the diamond-square array (param = 1) or not (param = -1)
;   - use the Voronoi diagram (param = 1) or not (param = -1)
; Return-value:  none, but the result is stored in the "heightmap" array
;************************************************************************************
Procedure makeHeightmap(numHmap.b,maxgrid.l,Diamond.b,Voronoi.b)

  Protected i.l,j.l,k1.l,k2.l
  Protected min.f=999999,max.f=-999999,ratio.f,temp.f
  Protected Dim temp.f(maxgrid,maxgrid)

  ; for each point of the array:
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
    
      ; both arrays will be used
      If Voronoi>-1 And Diamond>-1 
        k1=(diamond(i,j) & 255)
        k2=(voronoi(i,j) & 255)
        temp(i,j) = k1*k2
      Else
        ; only diamond-square
        If Diamond>-1
          k1=(diamond(i,j) & 255)
          temp(i,j) = k1
        Else
          ; only Voronoi
          If Voronoi>-1
            k2=(voronoi(i,j) & 255)
            temp(i,j) = k2
          EndIf
        EndIf
      EndIf    
    
      ; Store Min / Max values
      If temp(i,j)<min
        min=temp(i,j)
      Else
        If temp(i,j)>max
          max=temp(i,j)
        EndIf
      EndIf
    
    Next j
  Next i
  
  ; The heightmap values must be between 0 and 255
  ratio = 255.0/(max-min)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      temp = (temp(i,j)-min)*ratio
      ;Debug temp
      If temp<0
        heightmap(numHmap,i,j)=0
      Else
        If temp>255
          heightmap(numHmap,i,j)=255
        Else
          heightmap(numHmap,i,j)=temp
        EndIf
      EndIf
    Next j
  Next i

EndProcedure

;************************************************************************************
; Name: MakeHeightmaptexture
; Purpose: Creates a color texture from a heightmap
; Parameters:
;   - number of the texture
;   - number of the heightmap
;   - size of the array (a square of size x size); Texture and Heightmap must
;     have the same size
; Return-value:  none
;************************************************************************************
Procedure makeHeightmapTexture(numTexture.l,numHmap.b,maxgrid.l)

  Protected i.l,j.l,color.l

  CreateTexture(numTexture,maxgrid,maxgrid)
  StartDrawing(TextureOutput(numTexture))
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      color = getColor(numHmap,i,j,127)
      
      ; Can't use plot (x,y,color) => it causes an "invalid memory access" crash!
      FrontColor(color)
      Plot(i,j)
    Next j
  Next i
  StopDrawing()

EndProcedure

;************************************************************************************
; Name: eraseSeam
; Purpose: Blends the seam between two heightmaps
; Parameters:
;   - number of the first heightmap
;   - side of the first heightmap to blend (top, bottom, left, or right)
;   - number of the second heightmap
;   - side of the second heightmap to blend (top, bottom, left, or right)
;   - size of the array (a square of size x size); both Heightmaps must
;     have the same size
;   - percentage of that size that will be blended
; Return-value:  none
;************************************************************************************
Procedure eraseSeam(numHmap1.l,side1.s,numHmap2.l,side2.s,maxgrid.l,percent.b)

  Protected i.l,j.l,width.l,seamwidth.l,color.l
  Protected x1.l,y1.l,x2.l,y2.l
  Protected h1.l,h2.l,h.l
  Protected ratio1.f,ratio2.f
  
  width = maxgrid-1
  seamwidth = ( width*percent/100 )/2
    
  For i=0 To seamwidth
  
    ratio1=(seamwidth-(i/2))/seamwidth
    ratio2=(i/2)/seamwidth
  
    For j=0 To maxgrid-1
    
      Select side1
        Case "top"
          x1 = j
          y1 = seamwidth-i
        Case "bottom"
          x1 = j
          y1 = width-seamwidth+i
        Case "left"
          x1 = seamwidth-i
          y1 = j
        Case "right"
          x1 = width-seamwidth+i
          y1 = j
      EndSelect
      
      Select side2
        Case "top"
          x2 = j
          y2 = seamwidth-i
          If side1 = "top" Or side1 = "right"
            x2=maxgrid-1-j
          EndIf         
        Case "bottom"
          x2 = j
          y2 = width-seamwidth+i
          If side1 = "bottom" Or side1 = "left"
            x2=maxgrid-1-j
          EndIf
        Case "left"
          x2 = seamwidth-i
          y2 = j
          If side1 = "bottom" Or side1 = "left"
            x2=maxgrid-1-j
          EndIf
        Case "right"
          x2 = width-seamwidth+i
          y2 = j
          If side1 = "top" Or side1 = "right"
            x2=maxgrid-1-j
          EndIf         
      EndSelect
    
      h1=heightmap(numHmap1,x1,y1) & 255
      h2=heightmap(numHmap2,x2,y2) & 255

      h=h1*ratio1 + h2*ratio2      
      heightmap(numHmap1,x1,y1)=h
      
      h=h2*ratio1 + h1*ratio2
      heightmap(numHmap2,x2,y2)=h      
    Next j
    
  Next i

EndProcedure

;- --- Vector procedures ---
;************************************************************************************
; Name: NormalizeVector
; Purpose: Normalizes a vector to the length 1 without changing its orientation.
; Parameters:
;   - vector to normalize
;************************************************************************************
Procedure.l NormalizeVector(*Vec1.Vector3)
  Protected length.f
 
  length.f = Sqr(*Vec1\x * *Vec1\x + *Vec1\y * *Vec1\y + *Vec1\z * *Vec1\z)

  *Vec1\x / length
  *Vec1\y / length
  *Vec1\z / length

EndProcedure

; Same thing, Macro version 
Macro NORME(V)
  (Sqr(V\x * V\x + V\y * V\y + V\z * V\z))
EndMacro 

;- --- Dynamic mesh generation ---
;************************************************************************************
; Name: CreateDynMesh
; Purpose: Creates a mesh, scaled and UV mapped dynamically, and stores vertices/faces
;          infos in the "dynMesh" array
; Parameters:
;   - id of the mesh (a sort of text label for the mesh, unused)
;   - X size
;   - Y size
;   - Z size
;   - origin of mapping coord U 
;   - origin of mapping coord V
;   - scale of mapping coord U 
;   - scale of mapping coord V
;   - Vertices color
; Return value: mesh indice in the "dynMesh" array, or -1 if an error occurs
;************************************************************************************
Procedure.l createDynMesh(id.s,sizeX.f,sizeY.f,sizeZ.f,Uorigin.f,Vorigin.f,Uscale.f,Vscale.f,color.l) 

  Protected x.f,y.f,z.f                     ; vertex position
  Protected nx.f,ny.f,nz.f                  ; vertex normals
  Protected u.f,v.f                         ; vertex UV coords (texture mapping)
  Protected v1.w,v2.w,v3.w                  ; vertices of a poly
  Protected *PtrV.Vertex                    ; vertices buffer in memory
  Protected *ptrP.Polygon                   ; Polys buffer in memory
  Protected *PtrS.b                         ; Polys location buffer in memory
  Protected num.l,i.l
  Protected side.b
  
  ; Restore meshdatas
  Restore pointyCube
  
  ; Find first free slot in dynMesh()
  While num<#MAXMESH And dynMesh(num)\nummesh>0
    num+1
  Wend

  ; Read number of vertices and triangles
  Read dynMesh(num)\nbVert
  Read dynMesh(num)\nbTri

  ; Allocate the needed memory for vertices
  dynMesh(num)\vertexBuffer = AllocateMemory(SizeOf(Vertex)*dynMesh(num)\nbVert) 
  *PtrV = dynMesh(num)\vertexBuffer 
  
  ; Allocate the needed memory for faces info
  dynMesh(num)\polygonBuffer=AllocateMemory(SizeOf(Polygon)*dynMesh(num)\nbTri) 
  *ptrP=dynMesh(num)\polygonBuffer
  
  ; Allocate the needed memory for faces location
  dynMesh(num)\faceSideBuffer=AllocateMemory(dynMesh(num)\nbTri)
  *PtrS=dynMesh(num)\faceSideBuffer
  
  ; Read and store vertices position, normals, uv coords
  For i = 1 To dynMesh(num)\nbVert
    Read x
    Read y
    Read z
    Read nx
    Read ny
    Read nz
    Read u
    Read v
   
    *PtrV\px = x * sizex
    *PtrV\py = y * sizey
    *PtrV\pz = z * sizez  
    *PtrV\nx = nx 
    *PtrV\ny = ny
    *PtrV\nz = nz 
    *PtrV\couleur = color
    *PtrV\u = uorigin + (u * uscale)
    *PtrV\v = vorigin + (v * vscale)
    *PtrV + SizeOf(Vertex) 
  Next i    

  ;Read and store faces infos
  For i=1 To dynMesh(num)\nbTri 
    Read v1
    Read v2
    Read v3
    Read side
     
    *ptrP\numVert1=v1  
    *ptrP\numVert2=v2 
    *ptrP\numVert3=v3 
    *ptrP + SizeOf(Polygon)
    
    PokeB(*PtrS,side)
    *PtrS+1 
  Next i 

  ; Create mesh from stored infos
  dynMesh(num)\numMesh = CreateMesh(#PB_Any,dynMesh(num)\nbVert)
  If IsMesh(dynMesh(num)\numMesh) 
    SetMeshData(dynMesh(num)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,dynMesh(num)\vertexBuffer,dynMesh(num)\nbVert) 
    SetMeshData(dynMesh(num)\numMesh,#PB_Mesh_Face,dynMesh(num)\polygonBuffer,dynMesh(num)\nbTri) 
    
    dynMesh(num)\id = id
    dynMesh(num)\sizeX = sizeX
    dynMesh(num)\sizeY = sizeY
    dynMesh(num)\sizeZ = sizeZ

    ProcedureReturn num 
  Else 
    ; free memory if "createMesh" has failed
    FreeMemory(dynMesh(num)\vertexBuffer)
    FreeMemory(dynMesh(num)\polygonBuffer)
    ProcedureReturn -1    
  EndIf 
    
EndProcedure    

;************************************************************************************
; Name: deleteDynMesh
; Purpose: deletes a mesh and all vertices/faces infos in the "dynMesh" array
; Parameters:
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure deleteDynMesh(num.l)

    If dynMesh(num)\numMesh=0
      ProcedureReturn -1
    EndIf

    FreeMesh(dynMesh(num)\numMesh)
    FreeMemory(dynMesh(num)\vertexBuffer)
    FreeMemory(dynMesh(num)\polygonBuffer)
    dynMesh(num)\numMesh=0
  
EndProcedure

;************************************************************************************
; Name: inflateMesh
; Purpose: Normalizes each vertex' position so they're at the same distance from the center
;          of the mesh => makes the mesh spheric
; Parameters:
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure inflateMesh(numMesh.l)
  Protected i.l
  Protected *ptrVert.Vertex
  Protected vector3.Vector3
  Protected NormeVecteur.f

  *ptrVert = dynMesh(numMesh)\vertexBuffer
  For i = 1 To dynmesh(numMesh)\nbVert

    vector3\x = *ptrVert\px
    vector3\y = *ptrVert\py
    vector3\z = *ptrVert\pz
    
    NormalizeVector(@vector3)
    
    ; Equivalent:
;     NormeVecteur = NORME(vector3)
;     If NormeVecteur <> 0.0
;       vector3\x / NormeVecteur
;       vector3\y / NormeVecteur
;       vector3\z / NormeVecteur
;     EndIf  
       
    *ptrVert\px = vector3\x * dynMesh(numMesh)\sizeX
    *ptrVert\py = vector3\y * dynMesh(numMesh)\sizeY
    *ptrVert\pz = vector3\z * dynMesh(numMesh)\sizeZ
    *ptrVert\nx = vector3\x 
    *ptrVert\ny = vector3\y 
    *ptrVert\nz = vector3\z

    *ptrVert+SizeOf(Vertex)
  Next i
  
EndProcedure

;************************************************************************************
; Name: subdivideTriangle
; Purpose: Subdivides a triangle of the mesh into 4 smaller triangles
;   - mesh indice in the "dynMesh" array
;   - triangle to subdivide
;************************************************************************************
Procedure subdivideTriangle(nummesh.l,numtri.l)

  Protected VertexA.Vertex
  Protected VertexB.Vertex
  Protected VertexC.Vertex
  Protected *PtrV0.Vertex,*PtrV1.Vertex,*PtrV2.Vertex
  Protected *PtrNewV.vertex,*PtrNewP.Polygon,*PtrNewS.b
  Protected oldNbVert.w,oldNbFace.l,newVertNum.w,temp.w
  Protected currentTriSide.b

;   Debug "Mesh n°" + Str(nummesh) + ", " + Str(dynmesh(nummesh)\nbvert) + " vertices, " + Str(dynmesh(nummesh)\nbtri) + " triangles"
;   Debug "Subdivision du triangle n°" + Str(numtri)
;   Debug "   ->Taille mémoire pour vertices/faces: " + Str(MemorySize(dynMesh(nummesh)\vertexBuffer)) + " / " + Str(MemorySize(dynMesh(nummesh)\polygonBuffer))
;   Debug "   ->Taille mémoire des structures vertices/faces: " + Str(SizeOf(Vertex)) + " / " + Str(SizeOf(Polygon))
 

  ; Store current end of vertices/faces datas
  oldNbVert = dynMesh(nummesh)\nbVert
  oldNbFace = dynMesh(nummesh)\nbTri
  newVertNum = oldNbVert
  currentTriSide = PeekB(dynMesh(nummesh)\faceSideBuffer+numtri)
   
  ; Extend allocated memory for new vertices and faces
  dynmesh(nummesh)\nbvert+9
  dynMesh(nummesh)\vertexBuffer = ReAllocateMemory(dynMesh(nummesh)\vertexBuffer,SizeOf(Vertex)*dynMesh(nummesh)\nbVert) 
  dynmesh(nummesh)\nbtri+3
  dynMesh(nummesh)\polygonBuffer = ReAllocateMemory(dynMesh(nummesh)\polygonBuffer,SizeOf(Polygon)*dynMesh(nummesh)\nbTri)
  dynMesh(nummesh)\faceSideBuffer = ReAllocateMemory(dynMesh(nummesh)\faceSideBuffer,dynMesh(nummesh)\nbTri)
  ; NB: only 3 triangles are added, because the reference triangle is re-used
  
  
;   Debug "   Augmentation nb vertices/faces à: " + Str(dynmesh(nummesh)\nbvert) + " / " + Str(dynmesh(nummesh)\nbtri)
;   Debug "   ->Taille mémoire demandée pour vertices/faces: " + Str(SizeOf(Vertex) * dynmesh(nummesh)\nbvert) + " / " + Str(SizeOf(Polygon) * dynmesh(nummesh)\nbtri)
;   Debug "   Resultat de ReAllocate: " + Str(dynMesh(nummesh)\vertexBuffer) + " / " + Str(dynMesh(nummesh)\polygonBuffer)
;   Debug "   ->Nouvelle taille mémoire: " + Str(MemorySize(dynMesh(nummesh)\vertexBuffer)) + " / " + Str(MemorySize(dynMesh(nummesh)\polygonBuffer))


  ; Reference triangle is subdivided in 4 smaller triangles
  ; Phase 1: Store reference triangle's vertices positions in memory
  *PtrV0 = dynMesh(nummesh)\vertexBuffer + (numtri * SizeOf(Vertex) * 3)
  *PtrV1 = dynMesh(nummesh)\vertexBuffer + (numtri * SizeOf(Vertex) * 3) + SizeOf(Vertex)
  *PtrV2 = dynMesh(nummesh)\vertexBuffer + (numtri * SizeOf(Vertex) * 3) + SizeOf(Vertex) * 2

;   Debug "      Vertex réf., n°" + Str((*PtrV0 - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrV0\px)+","+StrF(*PtrV0\py)+","+StrF(*PtrV0\pz)
;   Debug "      Vertex réf., n°" + Str((*PtrV1 - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrV1\px)+","+StrF(*PtrV1\py)+","+StrF(*PtrV1\pz)
;   Debug "      Vertex réf., n°" + Str((*PtrV2 - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrV2\px)+","+StrF(*PtrV2\py)+","+StrF(*PtrV2\pz)


  ; Phase 2: Compute new vertices' positions
  VertexA\px = (*PtrV0\px + *PtrV1\px) / 2.0
  VertexA\py = (*PtrV0\py + *PtrV1\py) / 2.0
  VertexA\pz = (*PtrV0\pz + *PtrV1\pz) / 2.0
  VertexA\nx = VertexA\px / dynMesh(nummesh)\sizex
  VertexA\ny = VertexA\py / dynMesh(nummesh)\sizey
  VertexA\nz = VertexA\pz / dynMesh(nummesh)\sizez
  VertexA\couleur = (*PtrV0\couleur + *PtrV1\couleur) / 2.0
  VertexA\U =  (*PtrV0\U + *PtrV1\U) / 2.0
  VertexA\V =  (*PtrV0\V + *PtrV1\V) / 2.0

  VertexB\px = (*PtrV0\px + *PtrV2\px) / 2.0
  VertexB\py = (*PtrV0\py + *PtrV2\py) / 2.0
  VertexB\pz = (*PtrV0\pz + *PtrV2\pz) / 2.0
  VertexB\nx = VertexB\px / dynMesh(nummesh)\sizex
  VertexB\ny = VertexB\py / dynMesh(nummesh)\sizey
  VertexB\nz = VertexB\pz / dynMesh(nummesh)\sizez 
  VertexB\couleur = (*PtrV0\couleur + *PtrV2\couleur) / 2.0
  VertexB\U =  (*PtrV0\U + *PtrV2\U) / 2.0
  VertexB\V =  (*PtrV0\V + *PtrV2\V) / 2.0

  VertexC\px = (*PtrV1\px + *PtrV2\px) / 2.0
  VertexC\py = (*PtrV1\py + *PtrV2\py) / 2.0
  VertexC\pz = (*PtrV1\pz + *PtrV2\pz) / 2.0
  VertexC\nx = VertexC\px / dynMesh(nummesh)\sizex
  VertexC\ny = VertexC\py / dynMesh(nummesh)\sizey
  VertexC\nz = VertexC\pz / dynMesh(nummesh)\sizez
  VertexC\couleur = (*PtrV1\couleur + *PtrV2\couleur) / 2.0
  VertexC\U =  (*PtrV1\U + *PtrV2\U) / 2.0
  VertexC\V =  (*PtrV1\V + *PtrV2\V) / 2.0

  ; This is where new vertices/polys/sides will be stored:
  *PtrNewV = dynMesh(nummesh)\vertexBuffer + (SizeOf(Vertex) * (oldNbVert) )
  *PtrNewP = dynMesh(nummesh)\polygonBuffer + (SizeOf(Polygon) * (oldNbFace) )  
  *PtrNewS = dynMesh(nummesh)\faceSideBuffer + oldNbFace  

  ; Add a new triangle...
  *PtrNewV\px = *PtrV1\px
  *PtrNewV\py = *PtrV1\py
  *PtrNewV\pz = *PtrV1\pz
  *PtrNewV\nx = *PtrV1\nx 
  *PtrNewV\ny = *PtrV1\ny
  *PtrNewV\nz = *PtrV1\nz 
  *PtrNewV\couleur = *PtrV1\couleur 
  *PtrNewV\u = *PtrV1\u
  *PtrNewV\v = *PtrV1\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)

  *PtrNewV\px = VertexC\px
  *PtrNewV\py = VertexC\py
  *PtrNewV\pz = VertexC\pz
  *PtrNewV\nx = VertexC\nx 
  *PtrNewV\ny = VertexC\ny
  *PtrNewV\nz = VertexC\nz 
  *PtrNewV\couleur = VertexC\couleur 
  *PtrNewV\u = VertexC\u
  *PtrNewV\v = VertexC\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)

  *PtrNewV\px = VertexA\px
  *PtrNewV\py = VertexA\py
  *PtrNewV\pz = VertexA\pz
  *PtrNewV\nx = VertexA\nx 
  *PtrNewV\ny = VertexA\ny
  *PtrNewV\nz = VertexA\nz 
  *PtrNewV\couleur = VertexA\couleur 
  *PtrNewV\u = VertexA\u
  *PtrNewV\v = VertexA\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)
  
  *PtrNewP\numVert1=newVertNum +1
  *PtrNewP\numVert2=newVertNum +2
  *PtrNewP\numVert3=newVertNum 
;   Debug "           => new triangle, n°" + Str((*PtrNewP - dynMesh(nummesh)\polygonBuffer)/SizeOf(Polygon)) + ": " + Str(*PtrNewP\numVert1)+","+Str(*PtrNewP\numVert2)+","+Str(*PtrNewP\numVert3)
  *PtrNewP + SizeOf(Polygon) 
  newVertNum+3
  PokeB(*PtrNewS,currentTriSide)
  *PtrNewS+1
   
  ; ...add another...
  *PtrNewV\px = *PtrV2\px
  *PtrNewV\py = *PtrV2\py
  *PtrNewV\pz = *PtrV2\pz
  *PtrNewV\nx = *PtrV2\nx 
  *PtrNewV\ny = *PtrV2\ny
  *PtrNewV\nz = *PtrV2\nz 
  *PtrNewV\couleur = *PtrV2\couleur 
  *PtrNewV\u = *PtrV2\u
  *PtrNewV\v = *PtrV2\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)
  
  *PtrNewV\px = VertexB\px
  *PtrNewV\py = VertexB\py
  *PtrNewV\pz = VertexB\pz
  *PtrNewV\nx = VertexB\nx 
  *PtrNewV\ny = VertexB\ny
  *PtrNewV\nz = VertexB\nz 
  *PtrNewV\couleur = VertexB\couleur 
  *PtrNewV\u = VertexB\u
  *PtrNewV\v = VertexB\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)

  *PtrNewV\px = VertexC\px
  *PtrNewV\py = VertexC\py
  *PtrNewV\pz = VertexC\pz
  *PtrNewV\nx = VertexC\nx 
  *PtrNewV\ny = VertexC\ny
  *PtrNewV\nz = VertexC\nz 
  *PtrNewV\couleur = VertexC\couleur 
  *PtrNewV\u = VertexC\u
  *PtrNewV\v = VertexC\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)
  
  *PtrNewP\numVert1=newVertNum +1
  *PtrNewP\numVert2=newVertNum +2
  *PtrNewP\numVert3=newVertNum 
;   Debug "           => new triangle, n°" + Str((*PtrNewP - dynMesh(nummesh)\polygonBuffer)/SizeOf(Polygon)) + ": " + Str(*PtrNewP\numVert1)+","+Str(*PtrNewP\numVert2)+","+Str(*PtrNewP\numVert3)
  *PtrNewP + SizeOf(Polygon) 
  newVertNum+3
  PokeB(*PtrNewS,currentTriSide)
  *PtrNewS+1


  ; ...and another...
  *PtrNewV\px = VertexA\px
  *PtrNewV\py = VertexA\py
  *PtrNewV\pz = VertexA\pz
  *PtrNewV\nx = VertexA\nx 
  *PtrNewV\ny = VertexA\ny
  *PtrNewV\nz = VertexA\nz 
  *PtrNewV\couleur = VertexA\couleur 
  *PtrNewV\u = VertexA\u
  *PtrNewV\v = VertexA\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)
  
  *PtrNewV\px = VertexC\px
  *PtrNewV\py = VertexC\py
  *PtrNewV\pz = VertexC\pz
  *PtrNewV\nx = VertexC\nx 
  *PtrNewV\ny = VertexC\ny
  *PtrNewV\nz = VertexC\nz 
  *PtrNewV\couleur = VertexC\couleur 
  *PtrNewV\u = VertexC\u
  *PtrNewV\v = VertexC\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)

  *PtrNewV\px = VertexB\px
  *PtrNewV\py = VertexB\py
  *PtrNewV\pz = VertexB\pz
  *PtrNewV\nx = VertexB\nx 
  *PtrNewV\ny = VertexB\ny
  *PtrNewV\nz = VertexB\nz 
  *PtrNewV\couleur = VertexB\couleur 
  *PtrNewV\u = VertexB\u
  *PtrNewV\v = VertexB\v
;   Debug "         New Vertex, n°" + Str((*PtrNewV - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrNewV\px)+","+StrF(*PtrNewV\py)+","+StrF(*PtrNewV\pz)
  *PtrNewV + SizeOf(Vertex)
  
  *PtrNewP\numVert1=newVertNum +1
  *PtrNewP\numVert2=newVertNum +2 
  *PtrNewP\numVert3=newVertNum 
;   Debug "           => new triangle, n°" + Str((*PtrNewP - dynMesh(nummesh)\polygonBuffer)/SizeOf(Polygon)) + ": " + Str(*PtrNewP\numVert1)+","+Str(*PtrNewP\numVert2)+","+Str(*PtrNewP\numVert3)
  *PtrNewP + SizeOf(Polygon) 
  newVertNum+3
  PokeB(*PtrNewS,currentTriSide)
  *PtrNewS+1

   
  ; ...then resize reference triangle.
  *PtrV1\px = VertexA\px
  *PtrV1\py = VertexA\py
  *PtrV1\pz = VertexA\pz
  *PtrV1\nx = VertexA\nx
  *PtrV1\ny = VertexA\ny
  *PtrV1\nz = VertexA\nz
  *PtrV1\couleur = VertexA\couleur
  *PtrV1\U  = VertexA\U
  *PtrV1\V  = VertexA\V
;   Debug "         Reposition Vertex, n°" + Str((*PtrV1 - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrV1\px)+","+StrF(*PtrV1\py)+","+StrF(*PtrV1\pz)

  *PtrV2\px = VertexB\px
  *PtrV2\py = VertexB\py
  *PtrV2\pz = VertexB\pz
  *PtrV2\nx = VertexB\nx
  *PtrV2\ny = VertexB\ny
  *PtrV2\nz = VertexB\nz
  *PtrV2\ couleur= VertexB\couleur
  *PtrV2\U  = VertexB\U
  *PtrV2\V  = VertexB\V
;   Debug "         Reposition Vertex, n°" + Str((*PtrV2 - dynMesh(nummesh)\vertexBuffer)/SizeOf(Vertex)) + ": " + StrF(*PtrV2\px)+","+StrF(*PtrV2\py)+","+StrF(*PtrV2\pz) 
     
;   Debug "---------------------------------------------------"
  
EndProcedure

;************************************************************************************
; Name: subdivideMesh
; Purpose: Subdivides each triangle of a mesh, then inflates the mesh to make it look spheric
;   - mesh indice in the "dynMesh" array
;   - how many times the process will be repeated
;************************************************************************************
Procedure subdivideMesh(nummesh.l,nbiteration.b)
   Protected i.l,j.l,top.l

   ; subdivision
   For j = 1 To nbiteration
      top =  dynMesh(nummesh)\nbTri - 1
      For i = 0 To top
         subdivideTriangle(nummesh,i)
      Next i
   Next j

   ; Spherify
   inflateMesh(nummesh)

   ; modify mesh infos
   SetMeshData(dynMesh(nummesh)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(nummesh)\vertexBuffer,dynMesh(nummesh)\nbVert) 
   SetMeshData(dynMesh(nummesh)\numMesh,#PB_Mesh_Face,dynMesh(nummesh)\polygonBuffer,dynMesh(nummesh)\nbTri) 

EndProcedure

;************************************************************************************
; Name: normalizeMesh
; Purpose: Computes the normals of each vertex of the mesh to give it a smooth look
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure normalizeMesh(nummesh.l)

  Protected *ptrVert.vertex,*PtrV0.vertex,*PtrV1.vertex,*PtrV2.vertex
  Protected *ptrPoly.Polygon
  Protected *PtrDupVert.duplicateVert
  Protected normVect1.Vector3,normVect2.Vector3,faceNormal.Vector3
  Protected i.l,j.l
  Protected numvert.w
  Protected length.f
    
 ; Initialize all vertices' normals to 0
  *ptrVert = dynMesh(numMesh)\vertexBuffer
  For i = 1 To dynmesh(numMesh)\nbVert
    *ptrVert\nx = 0
    *ptrVert\ny = 0
    *ptrVert\nz = 0

    *ptrVert+SizeOf(Vertex)
  Next i
  
  ; For each poly of the mesh:
  *ptrPoly = dynMesh(nummesh)\polygonBuffer
  For i = 1 To dynMesh(nummesh)\nbTri
  
    ; Get polygon normal
    *PtrV0 = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert1 * SizeOf(Vertex))
    *PtrV1 = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert2 * SizeOf(Vertex))
    *PtrV2 = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert3 * SizeOf(Vertex))
  
    normVect1\x = (*PtrV1\px - *PtrV0\px)
    normVect1\y = (*PtrV1\py - *PtrV0\py)
    normVect1\z = (*PtrV1\pz - *PtrV0\pz)
    
    normVect2\x = (*PtrV2\px - *PtrV0\px)
    normVect2\y = (*PtrV2\py - *PtrV0\py)
    normVect2\z = (*PtrV2\pz - *PtrV0\pz)
    
    faceNormal\x = ((normVect1\y * normVect2\z) - (normVect1\z * normVect2\y))
    faceNormal\y = ((normVect1\z * normVect2\x) - (normVect1\x * normVect2\z))
    faceNormal\z = ((normVect1\x * normVect2\y) - (normVect1\y * normVect2\x))
    
    Length = Sqr(faceNormal\x*faceNormal\x + faceNormal\y*faceNormal\y + faceNormal\z*faceNormal\z)
    faceNormal\x / Length
    faceNormal\y / Length
    faceNormal\z / Length   
    
    ; sum up poly normal value to each of its vertex
    ; First vertex
    *PtrDupVert = dynMesh(numMesh)\dupVert + *ptrPoly\numVert1*SizeOf(duplicateVert)
    For j=1 To *PtrDupVert\nbdup
      numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
      *ptrVert = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
      *ptrVert\nx + faceNormal\x
      *ptrVert\ny + faceNormal\y
      *ptrVert\nz + faceNormal\z   
    Next j
    ; Second vertex
    *PtrDupVert = dynMesh(numMesh)\dupVert + *ptrPoly\numVert2*SizeOf(duplicateVert)
    For j=1 To *PtrDupVert\nbdup
      numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
      *ptrVert = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
      *ptrVert\nx + faceNormal\x
      *ptrVert\ny + faceNormal\y
      *ptrVert\nz + faceNormal\z  
    Next j
    ; Third vertex
    *PtrDupVert = dynMesh(numMesh)\dupVert + *ptrPoly\numVert3*SizeOf(duplicateVert)
    For j=1 To *PtrDupVert\nbdup
      numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
      *ptrVert = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
      *ptrVert\nx + faceNormal\x
      *ptrVert\ny + faceNormal\y
      *ptrVert\nz + faceNormal\z   
    Next j
    
    *ptrPoly+SizeOf(Polygon)
  Next i
  
  ; Then, average (= normalize) all the vertices' normals
  *ptrVert = dynMesh(numMesh)\vertexBuffer
  For j = 1 To dynmesh(numMesh)\nbVert
    normVect1\x = *ptrVert\nx
    normVect1\y = *ptrVert\ny
    normVect1\z = *ptrVert\nz
    
    NormalizeVector(@normVect1)
    
    *ptrVert\nx = normVect1\x
    *ptrVert\ny = normVect1\y
    *ptrVert\nz = normVect1\z  
    
    *ptrVert+SizeOf(Vertex)
  Next j
  
  ; modify mesh infos
  SetMeshData(dynMesh(nummesh)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(nummesh)\vertexBuffer,dynMesh(nummesh)\nbVert) 

EndProcedure

;************************************************************************************
; Name: findDuplicateVertices
; Purpose: Look for duplicate vertices in the mesh (vertices that are at the same
;          position) => used to optimize normals smoothing.
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure findDuplicateVertices(nummesh.l)

  Protected i,l,j.l,nbDup.l
  Protected numvert.w
  Protected *ptrVert.vertex,*PtrVert0.vertex,*PtrDupVert.duplicateVert,*PtrDupVert0.duplicateVert
  
  ; If the duplicates list already exists, erase it
  If dynMesh(numMesh)\dupVert>0
    FreeMemory(dynMesh(numMesh)\dupVert)
  EndIf
  
  ; Allocate memory to store a "dupVert" structure for each vertex of the mesh
  dynMesh(numMesh)\dupVert=AllocateMemory(dynmesh(numMesh)\nbVert * SizeOf(duplicateVert))
  
  ; For each vertex of the mesh:
  *ptrVert0 = dynMesh(numMesh)\vertexBuffer
  *PtrDupVert = dynMesh(numMesh)\dupVert
  For i=1 To dynmesh(numMesh)\nbVert

    ; if the vertex has not been checked for duplicates yet
    If *PtrDupVert\done<>1
    
      ; Store vertex number in dupVert  
      *PtrDupVert\numVert=i-1
    
      ; If duplicates list already exists, erase it
      If *PtrDupVert\ptrListVert > 0
        FreeMemory(*PtrDupVert\ptrListVert)
      EndIf
      
      ; Allocate minimal memory for duplicates list (this list contains at least the current vertex)
      *PtrDupVert\ptrListVert=AllocateMemory(2)
      
      ; Look for vertices that are at the exact position of the current vertex
      nbDup=0
      *ptrVert = dynMesh(numMesh)\vertexBuffer
      For j = 1 To dynmesh(numMesh)\nbVert
        ; if position is the same
        If *ptrVert\px = *ptrVert0\px And *ptrVert\py = *ptrVert0\py And *ptrVert\pz = *ptrVert0\pz
          ; update duplicates counter
          nbdup+1
          
          ; reallocate memory to adapt to the new list size
          If nbdup>1
            *PtrDupVert\ptrListVert=ReAllocateMemory(*PtrDupVert\ptrListVert,nbDup*2)
          EndIf
          
          ; Store duplicate vertex number
          PokeW(*PtrDupVert\ptrListVert + (nbDup-1)*2,j-1)              
        EndIf
        *ptrVert+SizeOf(Vertex)
        
      Next j
      
      ; Store list size
      *PtrDupVert\nbDup=nbdup
      ; Check the current vertex as "done"
      *PtrDupVert\done=1
    
      ; For each duplicate found, copy the duplicates list (because it will be the same) => speed up process
      For j=1 To nbdup
        numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
        If numvert <> *PtrDupVert\numVert
          *PtrDupVert0 = dynMesh(numMesh)\dupVert + numvert*SizeOf(duplicateVert)
          *PtrDupVert0\numVert = numvert
          *PtrDupVert0\ptrListVert = AllocateMemory(nbDup*2)
          CopyMemory(*PtrDupVert\ptrListVert,*PtrDupVert0\ptrListVert,nbDup*2)
          *PtrDupVert0\done=*PtrDupVert\done
          *PtrDupVert0\nbdup=*PtrDupVert\nbdup
        EndIf
      Next 
      
    EndIf
    
    *ptrVert0+SizeOf(Vertex)
    *PtrDupVert+SizeOf(duplicateVert)
  Next i
  
EndProcedure

;************************************************************************************
; Name: levelDuplicateVertices
; Purpose: Ensure that all duplicate vertices of the mesh stay at the exact same 
;          position => avoid "cracks" in the mesh after applying heightmaps
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure levelDuplicateVertices(nummesh.l)

  Protected i,l,j.l
  Protected numVert.w
  Protected *ptrVert.vertex,*PtrVert0.vertex,*PtrDupVert.duplicateVert,*PtrDupVert0.duplicateVert
  Protected xmean.f,ymean.f,zmean.f

  ; For each vertex of the mesh
  *ptrVert = dynMesh(numMesh)\vertexBuffer
  *PtrDupVert = dynMesh(numMesh)\dupVert   
  For i=1 To dynmesh(numMesh)\nbVert
    
    ; if the current vertex has not been leveled yet
    If *PtrDupVert\done <> 2
    
      ; Compute average positon for all duplicates of the current vertex
      xmean=0:ymean=0:zmean=0
      For j=1 To *PtrDupVert\nbDup
        numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
        *ptrVert0 = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
        
        xmean+ *ptrVert0\px
        ymean+ *ptrVert0\py
        zmean+ *ptrVert0\pz
      Next j         
      xmean / *PtrDupVert\nbDup
      ymean / *PtrDupVert\nbDup
      zmean / *PtrDupVert\nbDup
      
      ; Then move all the duplicates (including the current vertex) to this average position
      For j=1 To *PtrDupVert\nbDup
        numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
        *ptrVert0 = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
        
        *ptrVert0\px = xmean
        *ptrVert0\py = ymean
        *ptrVert0\pz = zmean
        
        *PtrDupVert0 = dynMesh(numMesh)\dupVert + numvert*SizeOf(duplicateVert)
        *PtrDupVert0\done=2
      Next j

    EndIf
    
    *ptrVert+SizeOf(Vertex)
    *PtrDupVert+SizeOf(duplicateVert)
  Next i

EndProcedure

;************************************************************************************
; Name: applyHeightmaps
; Purpose: Apply heightmaps 0 -> 5 to sides 0 -> 5 of the mesh
;   - mesh indice in the "dynMesh" array
;   - size of the array (a square of size x size)
;************************************************************************************
Procedure applyHeightmaps(nummesh.l,maxgrid.l)

  Protected i.l,j.l
  Protected *ptrPoly.Polygon,*ptrVert.vertex,*ptrSide.b
  Protected side.b
  Protected h.l,hu.l,hv.l
  Protected hr.f

  *ptrPoly = dynMesh(nummesh)\polygonBuffer
  *ptrSide = dynMesh(nummesh)\faceSideBuffer
  For i = 1 To dynMesh(nummesh)\nbTri
    side = PeekB(*ptrSide)
    
    *ptrVert = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert1 * SizeOf(Vertex))
    hu=Int(*ptrVert\u * (maxgrid-1))
    hv=Int(*ptrVert\v * (maxgrid-1))
    h=heightmap(side,hu,hv)&255
    hr=1+((h-#WATERLEVEL)/255)*#RELIEFEXAGERATION
    If hr<1
      hr = 1
    EndIf
    *ptrVert\px * hr
    *ptrVert\py * hr
    *ptrVert\pz * hr
    ;*ptrVert\couleur=getColor(side,hu,hv,127)
    
    *ptrVert = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert2 * SizeOf(Vertex))
    hu=Int(*ptrVert\u * (maxgrid-1))
    hv=Int(*ptrVert\v * (maxgrid-1))
    h=heightmap(side,hu,hv)&255
    hr=1+((h-#WATERLEVEL)/255)*#RELIEFEXAGERATION
    If hr<1
      hr = 1
    EndIf
    *ptrVert\px * hr
    *ptrVert\py * hr
    *ptrVert\pz * hr
    ;*ptrVert\couleur=getColor(side,hu,hv,127)
    
    *ptrVert = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert3 * SizeOf(Vertex))
    hu=Int(*ptrVert\u * (maxgrid-1))
    hv=Int(*ptrVert\v * (maxgrid-1))
    h=heightmap(side,hu,hv)&255
    hr=1+((h-#WATERLEVEL)/255)*#RELIEFEXAGERATION
    If hr<1
      hr = 1
    EndIf
    *ptrVert\px * hr
    *ptrVert\py * hr
    *ptrVert\pz * hr
    ;*ptrVert\couleur=getColor(side,hu,hv,127)
    
    *ptrPoly+SizeOf(Polygon)
    *ptrSide+1
  Next i
  
  ; Ensure that the vertices at the seams between sides stay at the same position
  levelDuplicateVertices(nummesh)
  
  SetMeshData(dynMesh(nummesh)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(nummesh)\vertexBuffer,dynMesh(nummesh)\nbVert) 

EndProcedure

;************************************************************************************
; Name: cutOutSides
; Purpose: From a given mesh, creates six new "sub-mesh" (one by side -> Top, bottom,
;          left, right, front, back). These six meshes will be consecutive in the
;          "dynmesh" array
;   - mesh indice in the "dynMesh" array
; Return-value : indice of the first sub-mesh in the "dynMesh" array
;************************************************************************************
Procedure.l cutOutSides(nummesh.l)

  Protected i.l,j.l,num.l
  Protected resultMesh.l
  Protected numvert1.w,numvert2.w,numvert3.w,side.b
  Protected *ptrVert.vertex,*ptrPoly.Polygon,*ptrSide.b
  Protected Dim *ptrV.vertex(6)
  Protected Dim *ptrP.Polygon(6)
  Protected Dim *ptrS.b(6)
  Protected Dim nbVert.w(6)
  Protected ok.b
  

  ; Find six consecutive free dyn meshes
  While num<#MAXMESH And dynMesh(num)\nummesh>0 Or dynMesh(num+1)\nummesh>0 Or dynMesh(num+2)\nummesh>0 Or dynMesh(num+3)\nummesh=0 Or dynMesh(num+4)\nummesh>0 Or dynMesh(num+5)\nummesh>0
    num+1
  Wend
  resultMesh = num
  
  ; count vertices and polygons for each side of the reference mesh
  *ptrSide = dynmesh(nummesh)\FaceSideBuffer
  For j=1 To dynMesh(nummesh)\nbTri
    side = PeekB(*ptrSide)
    dynMesh(resultMesh+side)\nbTri+1
    dynMesh(resultMesh+side)\nbVert+3

    *ptrSide+1
  Next j
  
  ; Allocate memory for each side
  For j=0 To 5
    ; Allocate the needed memory for vertices
    dynMesh(resultMesh+j)\vertexBuffer = AllocateMemory(SizeOf(Vertex)*dynMesh(resultMesh+j)\nbVert)
    *ptrV(j) = dynMesh(resultMesh+j)\vertexBuffer
        
    ; Allocate the needed memory for faces info
    dynMesh(resultMesh+j)\polygonBuffer=AllocateMemory(SizeOf(Polygon)*dynMesh(resultMesh+j)\nbTri) 
    *ptrP(j) = dynMesh(resultMesh+j)\polygonBuffer
    
    ; Allocate the needed memory for faces location
    dynMesh(resultMesh+j)\faceSideBuffer=AllocateMemory(dynMesh(resultMesh+j)\nbTri)
    *ptrS(j) = dynMesh(resultMesh+j)\faceSideBuffer
    
  Next j
  
  ; Cut out reference mesh and build sub-meshes
  *ptrPoly = dynmesh(nummesh)\polygonBuffer
  *ptrSide = dynmesh(nummesh)\FaceSideBuffer
  For j=1 To dynMesh(nummesh)\nbTri
    side = PeekB(*ptrSide)
    
    *ptrVert=dynmesh(nummesh)\vertexBuffer + *ptrPoly\numvert1*SizeOf(vertex)
    *PtrV(side)\px = *ptrVert\px
    *PtrV(side)\py = *ptrVert\py
    *PtrV(side)\pz = *ptrVert\pz  
    *PtrV(side)\nx = *ptrVert\nx 
    *PtrV(side)\ny = *ptrVert\ny
    *PtrV(side)\nz = *ptrVert\nz 
    *PtrV(side)\couleur = *ptrVert\couleur
    *PtrV(side)\u = *ptrVert\u
    *PtrV(side)\v = *ptrVert\v
    *PtrV(side)+SizeOf(vertex)
    
    *ptrVert=dynmesh(nummesh)\vertexBuffer + *ptrPoly\numvert2*SizeOf(vertex)
    *PtrV(side)\px = *ptrVert\px
    *PtrV(side)\py = *ptrVert\py
    *PtrV(side)\pz = *ptrVert\pz  
    *PtrV(side)\nx = *ptrVert\nx 
    *PtrV(side)\ny = *ptrVert\ny
    *PtrV(side)\nz = *ptrVert\nz 
    *PtrV(side)\couleur = *ptrVert\couleur
    *PtrV(side)\u = *ptrVert\u
    *PtrV(side)\v = *ptrVert\v
    *PtrV(side)+SizeOf(vertex)
    
    *ptrVert=dynmesh(nummesh)\vertexBuffer + *ptrPoly\numvert3*SizeOf(vertex)
    *PtrV(side)\px = *ptrVert\px
    *PtrV(side)\py = *ptrVert\py
    *PtrV(side)\pz = *ptrVert\pz  
    *PtrV(side)\nx = *ptrVert\nx 
    *PtrV(side)\ny = *ptrVert\ny
    *PtrV(side)\nz = *ptrVert\nz 
    *PtrV(side)\couleur = *ptrVert\couleur
    *PtrV(side)\u = *ptrVert\u
    *PtrV(side)\v = *ptrVert\v
    *PtrV(side)+SizeOf(vertex)
    
    *ptrP(side)\numvert1 = nbVert(side)
    *ptrP(side)\numvert2 = nbVert(side)+1
    *ptrP(side)\numvert3 = nbVert(side)+2
    *ptrP(side)+SizeOf(Polygon)
    nbVert(side)+3
    
    PokeB(*ptrS(side),side)
    *ptrS(side)+1
    
    *ptrPoly+SizeOf(Polygon)
    *ptrSide+1
  Next j
  
  ; Create then six sub-meshes from stored infos
  For i=0 To 5
    dynMesh(resultMesh+i)\numMesh = CreateMesh(#PB_Any,dynMesh(resultMesh+i)\nbVert)
    If IsMesh(dynMesh(resultMesh+i)\numMesh) 
      SetMeshData(dynMesh(resultMesh+i)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,dynMesh(resultMesh+i)\vertexBuffer,dynMesh(resultMesh+i)\nbVert) 
      SetMeshData(dynMesh(resultMesh+i)\numMesh,#PB_Mesh_Face,dynMesh(resultMesh+i)\polygonBuffer,dynMesh(resultMesh+i)\nbTri) 
      
      dynMesh(resultMesh+i)\id = dynMesh(nummesh)\id + Chr(1) + "Face "+Str(i)
      dynMesh(resultMesh+i)\sizeX = dynMesh(nummesh)\sizeX
      dynMesh(resultMesh+i)\sizeY = dynMesh(nummesh)\sizeY
      dynMesh(resultMesh+i)\sizeZ = dynMesh(nummesh)\sizeZ
    Else 
      ok=-1    
    EndIf
  Next i
  
  ; If something has gone wrong, free memory and return -1
  If ok=-1
    For i=0 To 5
      FreeMemory(dynMesh(resultMesh+i)\vertexBuffer)
      FreeMemory(dynMesh(resultMesh+i)\polygonBuffer)
      If IsMesh(dynMesh(resultMesh+i)\numMesh)
        FreeMesh(dynMesh(resultMesh+i)\numMesh)
      EndIf
      dynMesh(resultMesh+i)\numMesh = 0
    Next i
    ProcedureReturn -1    
  EndIf
  
  ; else, return number of the first mesh
  ProcedureReturn resultMesh

EndProcedure

DisableExplicit
;************************************************************************************
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Message par kelebrindae »

Seconde partie, à coller après celle ci-dessus:

Code : Tout sélectionner

;- ---------- Main program ----------
;- Screen initialisation 
Resultat = MessageRequester("Telluric planet generation","Full Screen ?",#PB_MessageRequester_YesNo) 
If Resultat = 6      
  FullScreen=1 
Else            
  FullScreen=0 
EndIf 

If InitEngine3D() = 0 
   MessageRequester( "Error" , "Can't initialize 3D, check if engine3D.dll is available" , 0 ) 
   End 
ElseIf InitSprite() = 0 Or InitKeyboard() = 0  Or InitMouse() = 0 
   MessageRequester( "Error" , "Can't find DirectX 7.0 or above" , 0 ) 
   End 
EndIf 

If Fullscreen  
  OpenScreen(1024,768,32,"Telluric Planet Generator") 
Else 
  OpenWindow(0,0, 0, 800 , 600 ,"Telluric Planet Generator",#PB_Window_ScreenCentered) 
  OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0) 
EndIf 

StartDrawing(ScreenOutput())
DrawText(0,0,"Generating base mesh and heightmaps, please wait...", $00FFFF, $BB0000)
StopDrawing() 
FlipBuffers()

;-Mesh 
planetMesh = CreateDynMesh("NewWorld",1,1,1,0,0,1,1,RGB(0,127,200)) 

;-Texture 
CreateTexture(0,128, 128) 
StartDrawing(TextureOutput(0)) 
  Box(0, 0, 128, 128, $FFFFFF)
StopDrawing()  

;-Material
CreateMaterial(0,TextureID(0))
MaterialAmbientColor(0,#PB_Material_AmbientColors)

;-Entity 
CreateEntity(planetEntity,MeshID(dynMesh(planetMesh)\numMesh),MaterialID(0))


;-Camera 
CreateCamera(0, 0, 0 , 100 , 100) 
MoveCamera(0,0,0,5) 
CameraLookAt(0,EntityX(planetEntity),EntityY(planetEntity),EntityZ(planetEntity)) 

;-Light 
AmbientColor(RGB(63,63,63)) 
CreateLight(0,RGB(255,255,255),300,300,300) 


;- Heightmaps
; Prepare six heightmaps (one for each side)


dispersion=512
For i=0 To 5
  makeDiamondSquare(maxgrid,dispersion,#PLANETSEED+i)
  
  ; Voronoi can add a nice "fractured" touch to heightmaps, but can be long to generate
  ;makeVoronoi(maxgrid,3,3,#PLANETSEED+i)
  
  ; Pass 1 as last parameter to use Voronoi
  makeHeightmap(i,maxgrid,1,-1)
Next i

; Blend seams between heightmaps of each side of the mesh
eraseseam(#FRONTSIDE,"right",#LEFTSIDE,"left",512,25)
eraseseam(#FRONTSIDE,"left",#RIGHTSIDE,"right",512,25)
eraseseam(#BACKSIDE,"right",#RIGHTSIDE,"left",512,25)
eraseseam(#BACKSIDE,"left",#LEFTSIDE,"right",512,25)

eraseseam(#TOPSIDE,"bottom",#BACKSIDE,"top",512,25)
eraseseam(#TOPSIDE,"left",#LEFTSIDE,"top",512,25) 
eraseseam(#TOPSIDE,"top",#FRONTSIDE,"top",512,25)
eraseseam(#TOPSIDE,"right",#RIGHTSIDE,"top",512,25)

eraseseam(#BOTTOMSIDE,"top",#FRONTSIDE,"bottom",512,25)
eraseseam(#BOTTOMSIDE,"right",#LEFTSIDE,"bottom",512,25)
eraseseam(#BOTTOMSIDE,"bottom",#BACKSIDE,"bottom",512,25)
eraseseam(#BOTTOMSIDE,"left",#RIGHTSIDE,"bottom",512,25)


;- Main loop
Repeat 
   If fullscreen = 0 
      While WindowEvent() : Wend
   EndIf
   
  ; Rotate
  ExamineMouse()
  anglex+MouseDeltaX()
  angley+MouseDeltaY()
  If phase < 4
    RotateEntity(planetEntity, anglex,angley,0)
  Else
    For i=0 To 5
      RotateEntity(newEntity+i, anglex,angley,0)
    Next i    
  EndIf
   
  If ExamineKeyboard() 
    
    ; Wireframe view 
    If KeyboardReleased(#PB_Key_F1) 
      CameraMode=1-CameraMode 
      CameraRenderMode(0,CameraMode) 
      AmbientColor(RGB(63+cameramode*150,63+cameramode*150,63+cameramode*150)) 
    EndIf
    
    ; Zoom / unzoom     
    If KeyboardReleased(#PB_Key_Add)
      MoveCamera(0,0,0,-0.25)
    EndIf
    If KeyboardReleased(#PB_Key_Subtract)
      MoveCamera(0,0,0,0.25)
    EndIf
     
    ; Change phase
    If KeyboardReleased(#PB_Key_Space) And phase <5
      phase + 1
      Select phase
        Case 1
          MessageRequester("Phase 1","Subdivide base mesh into something more spheric.")
          t=ElapsedMilliseconds()
          subdivideMesh(planetMesh,4)
          findDuplicateVertices(planetMesh)
          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 1","Phase 1 complete in " + Str(t) + " ms.")
          
        Case 2
          MessageRequester("Phase 2","Apply heightmaps.")
          t=ElapsedMilliseconds()
          applyHeightmaps(planetMesh,maxgrid)
          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 2","Phase 2 complete in " + Str(t) + " ms.")
          
        Case 3
          MessageRequester("Phase 3","Smooth mesh normals.")
          t=ElapsedMilliseconds()
          normalizeMesh(planetMesh)
          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 3","Phase 3 complete in " + Str(t) + " ms.")
          
        Case 4
          MessageRequester("Phase 4","Cut out mesh into 6 sub-meshes")
          t=ElapsedMilliseconds()
          
          newMesh=cutOutSides(planetmesh)      
          newEntity=10
          For i=0 To 5         
            CreateEntity(newEntity+i,MeshID(dynMesh(newMesh + i)\numMesh),MaterialID(0))
          Next i
          HideEntity(planetEntity,1)

          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 4","Phase 4 complete in " + Str(t) + " ms.")
          
          ; Color sides, so they're easier to see
          For i=0 To 5         
            *ptrPoly = dynMesh(newMesh+i)\polygonBuffer
            *ptrSide = dynMesh(newMesh+i)\faceSideBuffer
            For j = 1 To dynMesh(newMesh+i)\nbTri
               side = PeekB(*ptrSide)
               
               *ptrVert = dynMesh(newMesh+i)\vertexBuffer + (*ptrPoly\numVert1 * SizeOf(Vertex))
               *ptrVert\couleur = couleur(side)
               *ptrVert = dynMesh(newMesh+i)\vertexBuffer + (*ptrPoly\numVert2 * SizeOf(Vertex))
               *ptrVert\couleur = couleur(side)
               *ptrVert = dynMesh(newMesh+i)\vertexBuffer + (*ptrPoly\numVert3 * SizeOf(Vertex))
               *ptrVert\couleur = couleur(side)
               
               *ptrPoly+SizeOf(Polygon)
               *ptrSide+1
            Next j
            SetMeshData(dynMesh(newMesh+i)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(newMesh+i)\vertexBuffer,dynMesh(newMesh+i)\nbVert) 
          Next i
          
        Case 5
          MessageRequester("Phase 5","Generate a texture for each side and apply it to sub-meshes")
          t=ElapsedMilliseconds()
          
          For i=0 To 5         
            makeHeightmapTexture(10+i,i,maxgrid)
            CreateMaterial(10+i,TextureID(10+i))
            EntityMaterial(newEntity+i,MaterialID(10+i))
          Next i

          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 5","Phase 5 complete in " + Str(t) + " ms.")        
          
      EndSelect
    EndIf

  EndIf 
   
  ; show it all
  RenderWorld() 
   
  ; A little help
  StartDrawing(ScreenOutput())
  DrawText(0,0,"[F1] to change RenderMode, [Space] to go to next phase", $00FFFF, $BB0000)
  DrawText(0,15,"[+] to zoom, [-] to unzoom, [MOUSE] to rotate entity", $00FFFF, $BB0000)
  DrawText(0,30,Str(dynMesh(planetMesh)\nbVert) + " vertices, " + Str(dynMesh(planetMesh)\nbTri) + " polygons", $00FFFF, $BB0000)
  StopDrawing() 
  
  ; Flip buffers to avoid tearing  
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) 

; Delete dynamic meshes
For i=0 To #MAXMESH
  If dynmesh(i)\numMesh > 0
    deleteDynMesh(i)
  EndIf
Next i


;- Mesh Datas
DataSection:
PointyCube:
; Nb sommets / Nb faces
Data.l 72,24

; Vertices: pos / uv
; Up
Data.f 0,1,0
Data.f 0,1,0
Data.f 0.5,0.5
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f 0,1
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f 1,1
Data.f 0,1,0
Data.f 0,1,0
Data.f 0.5,0.5
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f 1,1
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f 1,0
Data.f 0,1,0
Data.f 0,1,0
Data.f 0.5,0.5
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f 1,0
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f 0,0
Data.f 0,1,0
Data.f 0,1,0
Data.f 0.5,0.5
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f 0,0
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f 0,1

; Bottom
Data.f 0,-1,0
Data.f 0,-1,0
Data.f 0.5,0.5
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f 0,1
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f 1,1
Data.f 0,-1,0
Data.f 0,-1,0
Data.f 0.5,0.5
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f 0,0
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f 0,1
Data.f 0,-1,0
Data.f 0,-1,0
Data.f 0.5,0.5
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f 1,0
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f 0,0
Data.f 0,-1,0
Data.f 0,-1,0
Data.f 0.5,0.5
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f 1,1
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f 1,0

; Left
Data.f -1,0,0
Data.f -1,0,0
Data.f 0.5,0.5
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f 1,0
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f 0,0
Data.f -1,0,0
Data.f -1,0,0
Data.f 0.5,0.5
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f 1,1
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f 1,0
Data.f -1,0,0
Data.f -1,0,0
Data.f 0.5,0.5
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f 0,1
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f 1,1
Data.f -1,0,0
Data.f -1,0,0
Data.f 0.5,0.5
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f 0,0
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f 0,1

; Right
Data.f 1,0,0
Data.f 1,0,0
Data.f 0.5,0.5
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f 1,0
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f 0,0
Data.f 1,0,0
Data.f 1,0,0
Data.f 0.5,0.5
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f 0,0
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f 0,1
Data.f 1,0,0
Data.f 1,0,0
Data.f 0.5,0.5
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f 0,1
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f 1,1
Data.f 1,0,0
Data.f 1,0,0
Data.f 0.5,0.5
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f 1,1
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f 1,0


; Front
Data.f 0,0,-1
Data.f 0,0,-1
Data.f 0.5,0.5
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f 1,0
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f 0,0
Data.f 0,0,-1
Data.f 0,0,-1
Data.f 0.5,0.5
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f #SQRT03,#SQRT03,-#SQRT03
Data.f 0,0
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f 0,1
Data.f 0,0,-1
Data.f 0,0,-1
Data.f 0.5,0.5
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f #SQRT03,-#SQRT03,-#SQRT03
Data.f 0,1
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f 1,1
Data.f 0,0,-1
Data.f 0,0,-1
Data.f 0.5,0.5
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f -#SQRT03,-#SQRT03,-#SQRT03
Data.f 1,1
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f -#SQRT03,#SQRT03,-#SQRT03
Data.f 1,0

; Back
Data.f 0,0,1
Data.f 0,0,1
Data.f 0.5,0.5
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f 1,0
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f 0,0
Data.f 0,0,1
Data.f 0,0,1
Data.f 0.5,0.5
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f 1,1
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f #SQRT03,#SQRT03,#SQRT03
Data.f 1,0
Data.f 0,0,1
Data.f 0,0,1
Data.f 0.5,0.5
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f 0,1
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f #SQRT03,-#SQRT03,#SQRT03
Data.f 1,1
Data.f 0,0,1
Data.f 0,0,1
Data.f 0.5,0.5
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f -#SQRT03,#SQRT03,#SQRT03
Data.f 0,0
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f -#SQRT03,-#SQRT03,#SQRT03
Data.f 0,1

; Faces
Data.w 0,1,2
Data.b #TOPSIDE
Data.w 3,4,5
Data.b #TOPSIDE
Data.w 6,7,8
Data.b #TOPSIDE
Data.w 9,10,11
Data.b #TOPSIDE

Data.w 12,13,14
Data.b #BOTTOMSIDE
Data.w 15,16,17
Data.b #BOTTOMSIDE
Data.w 18,19,20
Data.b #BOTTOMSIDE
Data.w 21,22,23
Data.b #BOTTOMSIDE

Data.w 24,25,26
Data.b #LEFTSIDE
Data.w 27,28,29
Data.b #LEFTSIDE
Data.w 30,31,32
Data.b #LEFTSIDE
Data.w 33,34,35
Data.b #LEFTSIDE

Data.w 36,37,38
Data.b #RIGHTSIDE
Data.w 39,40,41
Data.b #RIGHTSIDE
Data.w 42,43,44
Data.b #RIGHTSIDE
Data.w 45,46,47
Data.b #RIGHTSIDE

Data.w 48,49,50
Data.b #FRONTSIDE
Data.w 51,52,53
Data.b #FRONTSIDE
Data.w 54,55,56
Data.b #FRONTSIDE
Data.w 57,58,59
Data.b #FRONTSIDE

Data.w 60,61,62
Data.b #BACKSIDE
Data.w 63,64,65
Data.b #BACKSIDE
Data.w 66,67,68
Data.b #BACKSIDE
Data.w 69,70,71
Data.b #BACKSIDE



EndDataSection
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

je pensai naïvement qu'une sphere n'avait qu'un coté !! 8O

et qu'une seule texture pouvait la recouvrir !!

exactement comme les carte des atlas , ou la, la carte est "deroulé" d'ou les deformations en 2D :)

enfin sur 3dSmax , on a une primitive Sphere, et on aplique une seule texture .... 8O
Anonyme

Message par Anonyme »

Super , par contre on voit les jointures des textures , faudrait voir pour "clampé" la texture , je ne sais pas si en l'état c'est faisable par contre

Image
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Message par kelebrindae »

@Dobro:
Oui, habituellement les sphères n'ont qu'une seule texture mappée selon une projection de Mercator (comme une planisphère standard), ce qui cause de grosses distorsions autour des pôles.
C'est pour cela que j'utilise 6 textures: ma sphère est "cube-mappée".

Pour reprendre ton analogie avec 3DSmax: créé une sphère, utilise le Modifier "UVWmap", sélectionne "box", et ça te donnera un résultat sensiblement identique.
=> la distorsion des textures existe toujours, mais elle est moins visible.

De plus, comme mon mesh de base contient 6 côtés bien carrés et clairement délimités, les textures sont faciles à appliquer (mis à part ce petit problème de jointures visibles).
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Message par Ar-S »

Je n'ai pas testé ton code mais pour ton histoire de MessageRequester qui apparait parfois derrière, tu pourrais les remplacer par une fenêtre contenant un EditorGadget et tu appliquerais simplement un StickyWindow à cette même fenêtre.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

kelebrindae a écrit :@Dobro:
Oui, habituellement les sphères n'ont qu'une seule texture mappée selon une projection de Mercator (comme une planisphère standard), ce qui cause de grosses distorsions autour des pôles.
C'est pour cela que j'utilise 6 textures: ma sphère est "cube-mappée".

Pour reprendre ton analogie avec 3DSmax: créé une sphère, utilise le Modifier "UVWmap", sélectionne "box", et ça te donnera un résultat sensiblement identique.
=> la distorsion des textures existe toujours, mais elle est moins visible.

De plus, comme mon mesh de base contient 6 côtés bien carrés et clairement délimités, les textures sont faciles à appliquer (mis à part ce petit problème de jointures visibles).
Les textures sont modifiées pour corriger l'effet aux pôles. En tous cas t'aimes bien te casser la tête! :)
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Message par kelebrindae »

@Djes:
djes a écrit :Les textures sont modifiées pour corriger l'effet aux pôles.
Oui, mais cette correction interdit d'avoir des détails aux alentours du pôles (c'est tout flouté).

@Cpl_Bator:
Cpl.Bator a écrit :faudrait voir pour "clampé" la texture
J'ai un peu cherché, mais je n'ai pas trop compris en quoi ça consistait. Il s'agit de désactiver le filtering sur les bords de la texture pour éviter l'interpolation avec le bord opposé ?
Si oui, effectivement, je ne vois pas trop comment le faire en PB...

[EDIT]
Le problème vient bien du filtering: je viens d'essayer de mettre "MaterialFilteringMode(..., #PB_Material_None)" pour les textures de chaque côté, et le problème disparaît...
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

kelebrindae a écrit :@Djes:
djes a écrit :Les textures sont modifiées pour corriger l'effet aux pôles.
Oui, mais cette correction interdit d'avoir des détails aux alentours du pôles (c'est tout flouté).
C'est plutôt l'inverse, les pôles sont bien trop définis par rapport au reste, c'est du gâchis de texture; mais sinon ça marche bien et la plupart des textures que tu trouveras seront à ce format. Faut juste avoir un bon UV. Voir là : http://www.bfi.org/our_programs/bfi_com ... re_mapping
Et là ;) http://earthobservatory.nasa.gov/Newsro ... hlies.html
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Message par kelebrindae »

Et là aussi:
http://www.celestiamotherlode.net/catalog/earth.php

Mais mon but était justement d'éviter le "gâchis de texture"; et puis pour appliquer les heightmaps, c'est plus facile comme ça.
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Message par kelebrindae »

Nouvelle version, partant d'un mesh différent (un rubix cube de 36x36).
Avantages:
- plus de polygones, donc relief plus fin;
- comme les faces sont composées de carrés, on pourrait les "detail-mapper" facilement;
- plus de datas! (coucou Ollivier :wink: )
Inconvénient:
- comme le mesh de base est un cube "gonflé", il y a de la distorsion près du centre des faces (cf. vue Wireframe pour mieux s'en rendre compte.

Code : Tout sélectionner

; Author: Kelebrindae
; Date: july,11, 2008
; PB version: v4.10
; OS: Windows XP
; ---------------------------------------------------------------------------------------------------------------
; Purpose:
; ---------------------------------------------------------------------------------------------------------------
; - Starts from a hi-poly cube and "inflate" it to make a sphere
; - Then, generates 6 heightmaps and apply them to each "side" of the sphere (the "side" attribute for each poly
;   of the mesh is inherited from the base cube).
; - As PB can't texture each "side" with a different material, cut out the sphere into 6 sub-mesh (one per side)
; - Generate 6 textures from the heightmaps, and apply them to the "sides" entities.
;
; Presto! Instant planet!
;
;---------------------------------------------------------------------------------------------------------------
; Known Problems:
; ---------------------------------------------------------------------------------------------------------------
; - To avoid seams between sides, texture filtering is desactivated
; - Texture generation is pathetically simple


;- Constants
#MAXMESH=10
#PLANETSEED=11 ; change this to create a different planet
#WATERLEVEL=127
#RELIEFEXAGERATION=0.25 ; Change this to increase/decrease relief height

Enumeration
  #TOPSIDE
  #BOTTOMSIDE
  #RIGHTSIDE
  #LEFTSIDE
  #FRONTSIDE
  #BACKSIDE
EndEnumeration

;- Data structures
Structure VoronoiPoint2D ; used to create Voronoi Diagram
  x.l
  y.l
  dist.f
EndStructure

Structure Vector3 ; used in vector maths (normalization)
  x.f
  y.f
  z.f
EndStructure

Structure Vertex ; used to generate meshes
  px.f 
  py.f 
  pz.f 
  nx.f 
  ny.f 
  nz.f 
  couleur.l 
  U.f 
  V.f 
EndStructure 

Structure Polygon ; used to generate meshes
  numVert1.w 
  numVert2.w 
  numVert3.w 
EndStructure

Structure duplicateVert ; used to store lists of vertices that are at the same position
  numVert.w
  nbDup.w
  *PtrListVert.w
  done.b
EndStructure

Structure dynMesh_struct ; used to store infos about dynamically generated meshes
  id.s
  numMesh.l
  sizeX.f
  sizeY.f
  sizeZ.f
  nbVert.l
  nbTri.l
  *vertexBuffer.Vertex
  *dupVert.duplicateVert
  *polygonBuffer.Polygon
  *faceSideBuffer.b ; 1=up, 2=bottom,3=left,4=right,5=front,6=back
EndStructure


;- Global definitions
Global Dim dynMesh.dynMesh_struct(#MAXMESH)

Global Dim couleur(6)
couleur(#TOPSIDE)=RGB(255,0,0)
couleur(#BOTTOMSIDE)=RGB(0,255,0)
couleur(#LEFTSIDE)=RGB(0,0,255)
couleur(#RIGHTSIDE)=RGB(255,255,0)
couleur(#FRONTSIDE)=RGB(255,0,255)
couleur(#BACKSIDE)=RGB(0,255,255)

Global CameraMode.b
Global planetMesh.l,planetEntity.l = 0,newMesh.l,newEntity.l=10
Global *ptrPoly.Polygon,*ptrVert.vertex,*ptrSide.b
Global anglex.f = 0:angley.f = 0
Global side.b,phase.b

Global maxgrid.l = 512 ; must be a power of 2
Global Dim diamond.b(maxgrid,maxgrid)
Global Dim voronoi.b(maxgrid,maxgrid)
Global Dim heightmap.b(6,maxgrid,maxgrid)


;- ---------- Procedures ----------
EnableExplicit

;- --- Heightmaps generation ---
;************************************************************************************
; Name: makeDiamondSquare
; Purpose: Creates an array of fractal noise (looks like Perlin) that can be used as
;          a heightmap
; Parameters:
;   - size of the array (a square of size x size)
;   - dispersion
;   - seed: albeit the noise is random, a seed always produces the same result
; Return-value: none, but the result is stored in the "diamond" array
;************************************************************************************
Procedure makeDiamondSquare(maxgrid.l,dispersion.f,seed.l)

  Protected gridstep.l,mid.l,n.l
  Protected i.l,i1.l,i2.l
  Protected j.l,j1.l,j2.l,js.l
  Protected u.f,average.f
  Protected dispStep.f,min.f=999999,max.f=-999999,ratio.f
  Protected Dim temp.f(maxgrid,maxgrid)
  
  RandomSeed(seed)

  gridstep=maxgrid
  dispStep=dispersion

  ; main loop
  While gridstep>1
    mid=gridstep/2

    ; Diamond step - calculates new diamond corners from squares
    i=mid
    i1=i-mid
    i2=i+mid
    
    While i<maxgrid
      j=mid
      j1=j-mid
      j2=j+mid
      
      While j<maxgrid
        ; Average of surrounding points
        average=(temp(i1,j1)+temp(i1,j2)+temp(i2,j1)+temp(i2,j2))/4
        
        ; calculate random values between -1 and 1
        u=Random(16384)/8192 - 1
        
        ; Diamond value
        temp(i,j)=average+u*dispStep
        j+gridstep
        j1+gridstep
        j2+gridstep
      Wend
      
      i+gridstep
      i1+gridstep
      i2+gridstep
    Wend

    ; square Step - calculates new square corners from diamonds
    i=0
    i1=i-mid
    i2=i+mid
    js=0
    
    While i<maxgrid
      js=mid-js ; toggle start values of j loop
      j=js
      j1=j-mid
      j2=j+mid
      
      While j<maxgrid;+1
        average=0
        If i1<0  ; check For need To wrap around i value
          average+temp(i2,j)+temp(i2,j)
        Else
          If i2>maxgrid
            average+temp(i1,j)+temp(i1,j)
          Else
            average+temp(i1,j)+temp(i2,j)
          EndIf
        EndIf
        
        If j1<0  ; check For need To wrap around j value
          average+temp(i,j2)+temp(i,j2)
        Else
          If j2>maxgrid
            average+temp(i,j1)+temp(i,j1)
          Else
            average+temp(i,j1)+temp(i,j2)
          EndIf
        EndIf     
        average=average/4
        
        ; calculate random value between -1 And 1
        u=Random(16384)/8192-1
        
        temp(i,j)=average+u*dispStep
        temp(maxgrid,j)=temp(0,j) ; copy opposite edge
        j+gridstep
        j1+gridstep
        j2+gridstep
        
      Wend
      If j=maxgrid
        temp(i,j)=temp(i,0) ; copy opposite edge
      EndIf
      i+mid
      i1+mid
      i2+mid
    Wend

    dispStep/2
    gridstep/2
  Wend

; Keep values in Byte range (between 0 and 255)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      ; Min /max values
      If temp(i,j)<min
        min=temp(i,j)
      Else
        If temp(i,j)>max
          max=temp(i,j)
        EndIf
      EndIf   
    Next j
  Next i
  
  ratio=256.0/(max-min)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      n=(temp(i,j)-min)*ratio
      If n<0
        diamond(i,j)=0
      Else
        If n>255
          diamond(i,j)=255
        Else
          diamond(i,j)=n
        EndIf
      EndIf
    Next j
  Next i

 
EndProcedure

;************************************************************************************
; Name: makeVoronoi
; Purpose: Creates a modified Voronoi diagram that can be used to simulate tectonic
;          plates
; Parameters:
;   - size of the array (a square of size x size)
;   - number of regions
;   - number of points in each region (a point is the "center" of a Voronoi plate)
;   - seed: albeit the diagram is random, a seed always produces the same result
; Return-value: none, but the result is stored in the "voronoi" array
;************************************************************************************
Procedure makeVoronoi(maxgrid.l,nbregion.l,nbpts.l,seed.l)

  Protected NewList ftpoint.VoronoiPoint2D()
  Protected Dim coef.f(nbregion*nbregion*nbpts)
  Protected i.l,j.l,k.l,n.l
  Protected min.f=999999,max.f=-999999,ratio.f
  Protected Dim temp.f(maxgrid,maxgrid)


  RandomSeed(seed)
  coef(0)=-1
  coef(1)=-2
  coef(2)=0.5

  ; In each region of the grid, place some points
  For i=0 To nbregion-1
    For j =0 To nbregion-1
      n=Random(nbpts)
      For k=1 To n
        AddElement(ftpoint())
        ftpoint()\x=i*(maxgrid/nbregion)+Random(maxgrid/nbregion)
        ftpoint()\y=j*(maxgrid/nbregion)+Random(maxgrid/nbregion)
        ;Debug StrF(ftpoint()\x)+","+StrF(ftpoint()\y)
      Next k
    Next j
  Next i
  
  ; For each cell of the grid, compute distance to each point, sort points according to distance.
  ; => value = coef * distance
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
    
      ForEach ftpoint()     
        ftpoint()\dist = Sqr((ftpoint()\x-i)*(ftpoint()\x-i)+(ftpoint()\y-j)*(ftpoint()\y-j))
      Next
      SortStructuredList(ftpoint(),0,OffsetOf(VoronoiPoint2D\dist),#PB_Sort_Float)
      
      k=0
      ForEach ftpoint()
        temp(i,j) + coef(k)*ftpoint()\dist
        k+1
      Next     
      
      ; Min /max values
      If temp(i,j)<min
        min=temp(i,j)
      Else
        If temp(i,j)>max
          max=temp(i,j)
        EndIf
      EndIf   
      
    Next j
  Next i

; Keep values in Byte range (between 0 and 255)
  ratio=256.0/(max-min)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      n=(temp(i,j)-min)*ratio
      If n<0
        voronoi(i,j)=0
      Else
        If n>255
          voronoi(i,j)=255
        Else
          voronoi(i,j)=n
        EndIf
      EndIf
    Next j
  Next i
  
EndProcedure

;************************************************************************************
; Name: getColor
; Purpose: From a point in a heightmap, compute the color of the same point in the
;          corresponding texture
; Parameters:
;   - number of the heightmap
;   - coords X,Y of the point
;   - sea level
; Return-value: RGB value
;************************************************************************************
Procedure.l getColor(numHmap.b,x.l,y.l,waterLevel.l)

  Protected height.l
  Protected rockratio.f,grassratio.f
  Protected red1.f,green1.f,blue1.f
  Protected red2.f,green2.f,blue2.f
  Protected red.l,green.l,blue.l
  
  height = heightmap(numHmap,x,y)&255
  
  ; underwater points => shades of blue
  If height<=#WATERLEVEL
    red1=0:green1=3:blue1=92
    red2=0:green2=130:blue2=220
    
    red=red1+(red2-red1)*(height/#WATERLEVEL)
    green=green1+(green2-green1)*(height/#WATERLEVEL)
    blue=blue1+(blue2-blue1)*(height/#WATERLEVEL)

    ProcedureReturn RGB(red,green,blue)
  EndIf
  
  ; Above water: mix of grass and rock/snow
  rockratio=((height-160)/95)
  If rockratio<0
    rockratio=0
  EndIf
  If rockratio>1
    rockratio=1
  EndIf
  grassratio=1-rockratio
  
  ProcedureReturn RGB((32+Random(32))*grassratio+(height*rockratio),(255-(height/1.5)+Random(16))*grassratio+(height*rockratio),(0)*grassratio+(height*rockratio) ) 
  
EndProcedure 

;************************************************************************************
; Name: MakeHeightmap
; Purpose: Mix a diamond-square array and a Voronoi diagram to obtain the final heightmap
; Parameters:
;   - number of the heightmap
;   - size of the array (a square of size x size); Diamond, Voronoi, and Heightmap must
;     have the same size
;   - use the diamond-square array (param = 1) or not (param = -1)
;   - use the Voronoi diagram (param = 1) or not (param = -1)
; Return-value:  none, but the result is stored in the "heightmap" array
;************************************************************************************
Procedure makeHeightmap(numHmap.b,maxgrid.l,Diamond.b,Voronoi.b)

  Protected i.l,j.l,k1.l,k2.l
  Protected min.f=999999,max.f=-999999,ratio.f,temp.f
  Protected Dim temp.f(maxgrid,maxgrid)

  ; for each point of the array:
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
    
      ; both arrays will be used
      If Voronoi>-1 And Diamond>-1 
        k1=(diamond(i,j) & 255)
        k2=(voronoi(i,j) & 255)
        temp(i,j) = k1*k2
      Else
        ; only diamond-square
        If Diamond>-1
          k1=(diamond(i,j) & 255)
          temp(i,j) = k1
        Else
          ; only Voronoi
          If Voronoi>-1
            k2=(voronoi(i,j) & 255)
            temp(i,j) = k2
          EndIf
        EndIf
      EndIf    
    
      ; Store Min / Max values
      If temp(i,j)<min
        min=temp(i,j)
      Else
        If temp(i,j)>max
          max=temp(i,j)
        EndIf
      EndIf
    
    Next j
  Next i
  
  ; The heightmap values must be between 0 and 255
  ratio = 255.0/(max-min)
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      temp = (temp(i,j)-min)*ratio
      ;Debug temp
      If temp<0
        heightmap(numHmap,i,j)=0
      Else
        If temp>255
          heightmap(numHmap,i,j)=255
        Else
          heightmap(numHmap,i,j)=temp
        EndIf
      EndIf
    Next j
  Next i

EndProcedure

;************************************************************************************
; Name: MakeHeightmaptexture
; Purpose: Creates a color texture from a heightmap
; Parameters:
;   - number of the texture
;   - number of the heightmap
;   - size of the array (a square of size x size); Texture and Heightmap must
;     have the same size
; Return-value:  none
;************************************************************************************
Procedure makeHeightmapTexture(numTexture.l,numHmap.b,maxgrid.l)

  Protected i.l,j.l,color.l,numimage.l

  numimage = CreateImage(#PB_Any,maxgrid,maxgrid)
  StartDrawing(ImageOutput(numImage))
  For i=0 To maxgrid-1
    For j=0 To maxgrid-1
      color = getColor(numHmap,i,j,127)     
      ; Can't use plot (x,y,color) => it causes an "invalid memory access" crash!
      FrontColor(color)
      Plot(i,j)
    Next j
  Next i
  StopDrawing()

  CreateTexture(numTexture,maxgrid,maxgrid)
  StartDrawing(TextureOutput(numTexture))
    DrawImage(ImageID(numimage),0,0)
  StopDrawing()
  
  FreeImage(numimage)

EndProcedure

;************************************************************************************
; Name: eraseSeam
; Purpose: Blends the seam between two heightmaps
; Parameters:
;   - number of the first heightmap
;   - side of the first heightmap to blend (top, bottom, left, or right)
;   - number of the second heightmap
;   - side of the second heightmap to blend (top, bottom, left, or right)
;   - size of the array (a square of size x size); both Heightmaps must
;     have the same size
;   - percentage of that size that will be blended
; Return-value:  none
;************************************************************************************
Procedure eraseSeam(numHmap1.l,side1.s,numHmap2.l,side2.s,maxgrid.l,percent.b)

  Protected i.l,j.l,width.l,seamwidth.l,color.l
  Protected x1.l,y1.l,x2.l,y2.l
  Protected h1.l,h2.l,h.l
  Protected ratio1.f,ratio2.f
  
  width = maxgrid-1
  seamwidth = ( width*percent/100 )/2
    
  For i=0 To seamwidth
  
    ratio1=(seamwidth-(i/2))/seamwidth
    ratio2=(i/2)/seamwidth
  
    For j=0 To maxgrid-1
    
      Select side1
        Case "top"
          x1 = j
          y1 = seamwidth-i
        Case "bottom"
          x1 = j
          y1 = width-seamwidth+i
        Case "left"
          x1 = seamwidth-i
          y1 = j
        Case "right"
          x1 = width-seamwidth+i
          y1 = j
      EndSelect
      
      Select side2
        Case "top"
          x2 = j
          y2 = seamwidth-i
          If side1 = "top" Or side1 = "right"
            x2=maxgrid-1-j
          EndIf         
        Case "bottom"
          x2 = j
          y2 = width-seamwidth+i
          If side1 = "bottom" Or side1 = "left"
            x2=maxgrid-1-j
          EndIf
        Case "left"
          x2 = seamwidth-i
          y2 = j
          If side1 = "bottom" Or side1 = "left"
            x2=maxgrid-1-j
          EndIf
        Case "right"
          x2 = width-seamwidth+i
          y2 = j
          If side1 = "top" Or side1 = "right"
            x2=maxgrid-1-j
          EndIf         
      EndSelect
    
      h1=heightmap(numHmap1,x1,y1) & 255
      h2=heightmap(numHmap2,x2,y2) & 255

      h=h1*ratio1 + h2*ratio2      
      heightmap(numHmap1,x1,y1)=h
      
      h=h2*ratio1 + h1*ratio2
      heightmap(numHmap2,x2,y2)=h      
    Next j
    
  Next i

EndProcedure

;- --- Vector procedures ---
;************************************************************************************
; Name: NormalizeVector
; Purpose: Normalizes a vector to the length 1 without changing its orientation.
; Parameters:
;   - vector to normalize
;************************************************************************************
Procedure.l NormalizeVector(*Vec1.Vector3)
  Protected length.f
 
  length.f = Sqr(*Vec1\x * *Vec1\x + *Vec1\y * *Vec1\y + *Vec1\z * *Vec1\z)

  *Vec1\x / length
  *Vec1\y / length
  *Vec1\z / length

EndProcedure

; Same thing, Macro version 
Macro NORME(V)
  (Sqr(V\x * V\x + V\y * V\y + V\z * V\z))
EndMacro 

;- --- Dynamic mesh generation ---
;************************************************************************************
; Name: CreateCube
; Purpose: Creates a cube, scaled and UV mapped dynamically, and stores vertices/faces
;          infos in the "dynMesh" array
; Parameters:
;   - id of the mesh (a sort of text label for the mesh, unused)
;   - Nb subdivisions in each face
;   - X size
;   - Y size
;   - Z size
;   - origin of mapping coord U 
;   - origin of mapping coord V
;   - scale of mapping coord U 
;   - scale of mapping coord V
;   - Vertices color
; Return value: mesh indice in the "dynMesh" array, or -1 if an error occurs
;************************************************************************************
Procedure.l createCube(id.s,nbdiv.w,sizeX.f,sizeY.f,sizeZ.f,Uorigin.f,Vorigin.f,Uscale.f,Vscale.f,color.l)

  Protected sizediv.f
  Protected x1.f,y1.f,z1.f                     ; vertex position
  Protected x2.f,y2.f,z2.f                     ; vertex position
  Protected x3.f,y3.f,z3.f                     ; vertex position
  Protected x4.f,y4.f,z4.f                     ; vertex position
  Protected nx.f,ny.f,nz.f                  ; vertex normals
  Protected u.f,v.f                         ; vertex UV coords (texture mapping)
  Protected numvert.w,numvert0.w            ; vertices of a poly
  Protected *PtrV.Vertex,*PtrV0.Vertex      ; vertices buffer in memory
  Protected *ptrP.Polygon,*ptrP0.Polygon    ; Polys buffer in memory
  Protected *PtrS.b
  Protected num.l,i.l,j.l

  ; Find first free slot in dynMesh()
  While num<#MAXMESH And dynMesh(num)\nummesh>0
    num+1
  Wend

  dynmesh(num)\nbtri  = 6 * (nbDiv * nbDiv * 2) ; 6 sides * nb divisions * nb divisions * 2 triangles per division
  dynmesh(num)\nbvert = 6 * (nbDiv * nbDiv * 4) ; 6 sides * nb divisions * nb divisions * 4 vertices per division
  
  ; Allocate the needed memory for vertices
  dynMesh(num)\vertexBuffer = AllocateMemory(SizeOf(Vertex)*dynMesh(num)\nbVert) 
  *PtrV = dynMesh(num)\vertexBuffer 
  
  ; Allocate the needed memory for faces info
  dynMesh(num)\polygonBuffer=AllocateMemory(SizeOf(Polygon)*dynMesh(num)\nbTri) 
  *ptrP=dynMesh(num)\polygonBuffer
  
  ; Allocate the needed memory for faces location
  dynMesh(num)\faceSideBuffer=AllocateMemory(dynMesh(num)\nbTri)
  *PtrS=dynMesh(num)\faceSideBuffer

  sizeDiv = 1/nbDiv
  ; Top
  x1=-0.5:y1=0.5:z1=-0.5
  x2=-0.5+sizeDiv:y2=0.5:z2 = z1
  x3=x2:y3=0.5:z3=-0.5+sizeDiv
  x4=x1:y4=0.5:z4=z3
  
  For i=1 To nbDiv
    For j=1 To nbDiv
      
      ; 1 square = 4 vertices
      *PtrV\px = x1
      *PtrV\py = y1
      *PtrV\pz = z1
      *PtrV\nx = *PtrV\px 
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
      *PtrV + SizeOf(Vertex) 

      *PtrV\px = x2
      *PtrV\py = y2
      *PtrV\pz = z2  
      *PtrV\nx = *PtrV\px 
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
      *PtrV + SizeOf(Vertex) 

      *PtrV\px = x3 
      *PtrV\py = y3
      *PtrV\pz = z3  
      *PtrV\nx = *PtrV\px 
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
      *PtrV + SizeOf(Vertex) 
      
      *PtrV\px = x4 
      *PtrV\py = y4
      *PtrV\pz = z4 
      *PtrV\nx = *PtrV\px 
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
      *PtrV + SizeOf(Vertex) 

      ; 1 square = 2 triangles
      *ptrP\numVert1=numvert+3  
      *ptrP\numVert2=numvert+2
      *ptrP\numVert3=numvert 
      *ptrP + SizeOf(Polygon)
      PokeB(*PtrS,#TOPSIDE)
      *PtrS+1 
      
      *ptrP\numVert1=numvert  
      *ptrP\numVert2=numvert+2
      *ptrP\numVert3=numvert+1
      *ptrP + SizeOf(Polygon)
      PokeB(*PtrS,#TOPSIDE)
      *PtrS+1 
      
      numvert+4     

      z1=z4
      z2=z3
      z3+sizeDiv
      z4=z3

    Next j
    
    x1=x2
    x4=x3
    x2+sizeDiv
    x3=x2
    z1=-0.5
    z2=z1
    z3=-0.5+sizeDiv
    z4=z3
     
  Next i
  numvert0=numvert
  
  ; Bottom
  *PtrV0 = dynMesh(num)\vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\px
    *PtrV\py = -*PtrV0\py
    *PtrV\pz = *PtrV0\pz  
    *PtrV\nx = *PtrV\px 
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = *PtrV0\u
    *PtrV\v = *PtrV0\v
    
    *PtrV + SizeOf(Vertex) 
    *PtrV0 + SizeOf(Vertex) 
    numvert+1
    
    If i%4=0
      *ptrP\numVert1=numvert - 2 
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 4 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#BOTTOMSIDE)
      *PtrS+1 
    
      *ptrP\numVert1=numvert - 4 
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 2 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#BOTTOMSIDE)
      *PtrS+1   
    EndIf
    
  Next i

  ; Right
  *PtrV0 = dynMesh(num)\vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = *PtrV0\py
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = *PtrV0\pz  
    *PtrV\nx = *PtrV\px 
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = 1-*PtrV0\v
    *PtrV\v = *PtrV0\u
    
    *PtrV + SizeOf(Vertex) 
    *PtrV0 + SizeOf(Vertex) 
    numvert+1
    
    If i%4=0
      *ptrP\numVert1=numvert - 2 
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 4 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#RIGHTSIDE)
      *PtrS+1 
    
      *ptrP\numVert1=numvert - 4 
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 2 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#RIGHTSIDE)
      *PtrS+1   
    EndIf
    
  Next i

  ; Left
  *PtrV0 = dynMesh(num)\vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\py
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = *PtrV0\pz  
    *PtrV\nx = *PtrV\px 
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = *PtrV0\v
    *PtrV\v = *PtrV0\u
    
    *PtrV + SizeOf(Vertex) 
    *PtrV0 + SizeOf(Vertex) 
    numvert+1
    
    If i%4=0
      *ptrP\numVert1=numvert - 4 
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 2 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#LEFTSIDE)
      *PtrS+1 
    
      *ptrP\numVert1=numvert - 2 
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 4 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#LEFTSIDE)
      *PtrS+1   
    EndIf
    
  Next i

  ; Front
  *PtrV0 = dynMesh(num)\vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\pz
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = -*PtrV0\py  
    *PtrV\nx = *PtrV\px 
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = *PtrV0\v
    *PtrV\v = *PtrV0\u
    
    *PtrV + SizeOf(Vertex) 
    *PtrV0 + SizeOf(Vertex) 
    numvert+1
    
    If i%4=0
      *ptrP\numVert1=numvert - 4 
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 2 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#FRONTSIDE)
      *PtrS+1 
    
      *ptrP\numVert1=numvert - 2 
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 4 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#FRONTSIDE)
      *PtrS+1   
    EndIf
    
  Next i
  
  ; Back
  *PtrV0 = dynMesh(num)\vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\pz
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = *PtrV0\py  
    *PtrV\nx = *PtrV\px 
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = 1-*PtrV0\v
    *PtrV\v = *PtrV0\u
    
    *PtrV + SizeOf(Vertex) 
    *PtrV0 + SizeOf(Vertex) 
    numvert+1
    
    If i%4=0
      *ptrP\numVert1=numvert - 2 
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 4 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#BACKSIDE)
      *PtrS+1 
    
      *ptrP\numVert1=numvert - 4 
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 2 
      *ptrP + SizeOf(Polygon)  
      
      PokeB(*PtrS,#BACKSIDE)
      *PtrS+1   
    EndIf
    
  Next i

  ; Resize
  If sizeX<>1 Or sizeY<>1 Or sizeZ<>1
    *ptrV = dynMesh(num)\vertexBuffer
    For i=1 To dynmesh(num)\nbVert
      *PtrV\px*sizeX
      *PtrV\py*sizeY
      *PtrV\pz*sizeZ
      
      *PtrV+SizeOf(vertex)
    Next i  
  EndIf

  ; Create mesh from stored infos
  dynMesh(num)\numMesh = CreateMesh(#PB_Any,dynMesh(num)\nbVert)
  If IsMesh(dynMesh(num)\numMesh) 
    SetMeshData(dynMesh(num)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,dynMesh(num)\vertexBuffer,dynMesh(num)\nbVert) 
    SetMeshData(dynMesh(num)\numMesh,#PB_Mesh_Face,dynMesh(num)\polygonBuffer,dynMesh(num)\nbTri) 
    
    dynMesh(num)\id = id
    dynMesh(num)\sizeX = sizeX
    dynMesh(num)\sizeY = sizeY
    dynMesh(num)\sizeZ = sizeZ

    ProcedureReturn num 
  Else 
    ; free memory if "createMesh" has failed
    FreeMemory(dynMesh(num)\vertexBuffer)
    FreeMemory(dynMesh(num)\polygonBuffer)
    ProcedureReturn -1    
  EndIf 

EndProcedure

;************************************************************************************
; Name: deleteDynMesh
; Purpose: deletes a mesh and all vertices/faces infos in the "dynMesh" array
; Parameters:
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure deleteDynMesh(num.l)

    If dynMesh(num)\numMesh=0
      ProcedureReturn -1
    EndIf

    FreeMesh(dynMesh(num)\numMesh)
    FreeMemory(dynMesh(num)\vertexBuffer)
    FreeMemory(dynMesh(num)\polygonBuffer)
    dynMesh(num)\numMesh=0
  
EndProcedure

;************************************************************************************
; Name: inflateMesh
; Purpose: Normalizes each vertex' position so they're at the same distance from the center
;          of the mesh => makes the mesh spheric
; Parameters:
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure inflateMesh(numMesh.l)
  Protected i.l
  Protected *ptrVert.Vertex
  Protected vector3.Vector3
  Protected NormeVecteur.f

  *ptrVert = dynMesh(numMesh)\vertexBuffer
  For i = 1 To dynmesh(numMesh)\nbVert

    vector3\x = *ptrVert\px
    vector3\y = *ptrVert\py
    vector3\z = *ptrVert\pz
    
    NormalizeVector(@vector3)
    
    ; Equivalent:
;     NormeVecteur = NORME(vector3)
;     If NormeVecteur <> 0.0
;       vector3\x / NormeVecteur
;       vector3\y / NormeVecteur
;       vector3\z / NormeVecteur
;     EndIf  
       
    *ptrVert\px = vector3\x * dynMesh(numMesh)\sizeX
    *ptrVert\py = vector3\y * dynMesh(numMesh)\sizeY
    *ptrVert\pz = vector3\z * dynMesh(numMesh)\sizeZ
    *ptrVert\nx = vector3\x 
    *ptrVert\ny = vector3\y 
    *ptrVert\nz = vector3\z

    *ptrVert+SizeOf(Vertex)
  Next i
  
EndProcedure

;************************************************************************************
; Name: normalizeMesh
; Purpose: Computes the normals of each vertex of the mesh to give it a smooth look
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure normalizeMesh(nummesh.l)

  Protected *ptrVert.vertex,*PtrV0.vertex,*PtrV1.vertex,*PtrV2.vertex
  Protected *ptrPoly.Polygon
  Protected *PtrDupVert.duplicateVert
  Protected normVect1.Vector3,normVect2.Vector3,faceNormal.Vector3
  Protected i.l,j.l
  Protected numvert.w
  Protected length.f
    
 ; Initialize all vertices' normals to 0
  *ptrVert = dynMesh(numMesh)\vertexBuffer
  For i = 1 To dynmesh(numMesh)\nbVert
    *ptrVert\nx = 0
    *ptrVert\ny = 0
    *ptrVert\nz = 0

    *ptrVert+SizeOf(Vertex)
  Next i
  
  ; For each poly of the mesh:
  *ptrPoly = dynMesh(nummesh)\polygonBuffer
  For i = 1 To dynMesh(nummesh)\nbTri
  
    ; Get polygon normal
    *PtrV0 = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert1 * SizeOf(Vertex))
    *PtrV1 = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert2 * SizeOf(Vertex))
    *PtrV2 = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert3 * SizeOf(Vertex))
  
    normVect1\x = (*PtrV1\px - *PtrV0\px)
    normVect1\y = (*PtrV1\py - *PtrV0\py)
    normVect1\z = (*PtrV1\pz - *PtrV0\pz)
    
    normVect2\x = (*PtrV2\px - *PtrV0\px)
    normVect2\y = (*PtrV2\py - *PtrV0\py)
    normVect2\z = (*PtrV2\pz - *PtrV0\pz)
    
    faceNormal\x = ((normVect1\y * normVect2\z) - (normVect1\z * normVect2\y))
    faceNormal\y = ((normVect1\z * normVect2\x) - (normVect1\x * normVect2\z))
    faceNormal\z = ((normVect1\x * normVect2\y) - (normVect1\y * normVect2\x))
    
    Length = Sqr(faceNormal\x*faceNormal\x + faceNormal\y*faceNormal\y + faceNormal\z*faceNormal\z)
    faceNormal\x / Length
    faceNormal\y / Length
    faceNormal\z / Length   
    
    ; sum up poly normal value to each of its vertex
    ; First vertex
    *PtrDupVert = dynMesh(numMesh)\dupVert + *ptrPoly\numVert1*SizeOf(duplicateVert)
    For j=1 To *PtrDupVert\nbdup
      numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
      *ptrVert = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
      *ptrVert\nx + faceNormal\x
      *ptrVert\ny + faceNormal\y
      *ptrVert\nz + faceNormal\z   
    Next j
    ; Second vertex
    *PtrDupVert = dynMesh(numMesh)\dupVert + *ptrPoly\numVert2*SizeOf(duplicateVert)
    For j=1 To *PtrDupVert\nbdup
      numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
      *ptrVert = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
      *ptrVert\nx + faceNormal\x
      *ptrVert\ny + faceNormal\y
      *ptrVert\nz + faceNormal\z  
    Next j
    ; Third vertex
    *PtrDupVert = dynMesh(numMesh)\dupVert + *ptrPoly\numVert3*SizeOf(duplicateVert)
    For j=1 To *PtrDupVert\nbdup
      numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
      *ptrVert = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
      *ptrVert\nx + faceNormal\x
      *ptrVert\ny + faceNormal\y
      *ptrVert\nz + faceNormal\z   
    Next j
    
    *ptrPoly+SizeOf(Polygon)
  Next i
  
  ; Then, average (= normalize) all the vertices' normals
  *ptrVert = dynMesh(numMesh)\vertexBuffer
  For j = 1 To dynmesh(numMesh)\nbVert
    normVect1\x = *ptrVert\nx
    normVect1\y = *ptrVert\ny
    normVect1\z = *ptrVert\nz
    
    NormalizeVector(@normVect1)
    
    *ptrVert\nx = normVect1\x
    *ptrVert\ny = normVect1\y
    *ptrVert\nz = normVect1\z  
    
    *ptrVert+SizeOf(Vertex)
  Next j
  
  ; modify mesh infos
  SetMeshData(dynMesh(nummesh)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(nummesh)\vertexBuffer,dynMesh(nummesh)\nbVert) 

EndProcedure

;************************************************************************************
; Name: findDuplicateVertices
; Purpose: Look for duplicate vertices in the mesh (vertices that are at the same
;          position) => used to optimize normals smoothing.
;   - mesh indice in the "dynMesh" array
;   - margin in duplicate vertices detection
;************************************************************************************
Procedure findDuplicateVertices(nummesh.l,threshold.f)

  Protected i,l,j.l,nbDup.l
  Protected numvert.w
  Protected *ptrVert.vertex,*PtrVert0.vertex,*PtrDupVert.duplicateVert,*PtrDupVert0.duplicateVert
  
  ; If the duplicates list already exists, erase it
  If dynMesh(numMesh)\dupVert>0
    FreeMemory(dynMesh(numMesh)\dupVert)
  EndIf
  
  ; Allocate memory to store a "dupVert" structure for each vertex of the mesh
  dynMesh(numMesh)\dupVert=AllocateMemory(dynmesh(numMesh)\nbVert * SizeOf(duplicateVert))
  
  ; For each vertex of the mesh:
  *ptrVert0 = dynMesh(numMesh)\vertexBuffer
  *PtrDupVert = dynMesh(numMesh)\dupVert
  For i=1 To dynmesh(numMesh)\nbVert

    ; if the vertex has not been checked for duplicates yet
    If *PtrDupVert\done<>1
    
      ; Store vertex number in dupVert  
      *PtrDupVert\numVert=i-1
    
      ; If duplicates list already exists, erase it
      If *PtrDupVert\ptrListVert > 0
        FreeMemory(*PtrDupVert\ptrListVert)
      EndIf
      
      ; Allocate minimal memory for duplicates list (this list contains at least the current vertex)
      *PtrDupVert\ptrListVert=AllocateMemory(2)
      
      ; Look for vertices that are at the exact position of the current vertex
      nbDup=0
      *ptrVert = dynMesh(numMesh)\vertexBuffer
      For j = 1 To dynmesh(numMesh)\nbVert
        ; if position is the same
        If Abs(*ptrVert\px - *ptrVert0\px)<=threshold And Abs(*ptrVert\py - *ptrVert0\py)<=threshold And Abs(*ptrVert\pz - *ptrVert0\pz)<=threshold
          ; update duplicates counter
          nbdup+1
          
          ; reallocate memory to adapt to the new list size
          If nbdup>1
            *PtrDupVert\ptrListVert=ReAllocateMemory(*PtrDupVert\ptrListVert,nbDup*2)
          EndIf
          
          ; Store duplicate vertex number
          PokeW(*PtrDupVert\ptrListVert + (nbDup-1)*2,j-1)              
        EndIf
        *ptrVert+SizeOf(Vertex)
        
      Next j
      
      ; Store list size
      *PtrDupVert\nbDup=nbdup
      ; Check the current vertex as "done"
      *PtrDupVert\done=1
    
      ; For each duplicate found, copy the duplicates list (because it will be the same) => speed up process
      For j=1 To nbdup
        numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
        If numvert <> *PtrDupVert\numVert
          *PtrDupVert0 = dynMesh(numMesh)\dupVert + numvert*SizeOf(duplicateVert)
          *PtrDupVert0\numVert = numvert
          *PtrDupVert0\ptrListVert = AllocateMemory(nbDup*2)
          CopyMemory(*PtrDupVert\ptrListVert,*PtrDupVert0\ptrListVert,nbDup*2)
          *PtrDupVert0\done=*PtrDupVert\done
          *PtrDupVert0\nbdup=*PtrDupVert\nbdup
        EndIf
      Next 
      
    EndIf
    
    *ptrVert0+SizeOf(Vertex)
    *PtrDupVert+SizeOf(duplicateVert)
  Next i
  
EndProcedure

;************************************************************************************
; Name: levelDuplicateVertices
; Purpose: Ensure that all duplicate vertices of the mesh stay at the exact same 
;          position => avoid "cracks" in the mesh after applying heightmaps
;   - mesh indice in the "dynMesh" array
;************************************************************************************
Procedure levelDuplicateVertices(nummesh.l)

  Protected i,l,j.l
  Protected numVert.w
  Protected *ptrVert.vertex,*PtrVert0.vertex,*PtrDupVert.duplicateVert,*PtrDupVert0.duplicateVert
  Protected xmean.f,ymean.f,zmean.f

  ; For each vertex of the mesh
  *ptrVert = dynMesh(numMesh)\vertexBuffer
  *PtrDupVert = dynMesh(numMesh)\dupVert   
  For i=1 To dynmesh(numMesh)\nbVert
    
    ; if the current vertex has not been leveled yet
    If *PtrDupVert\done <> 2
    
      ; Compute average positon for all duplicates of the current vertex
      xmean=0:ymean=0:zmean=0
      For j=1 To *PtrDupVert\nbDup
        numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
        *ptrVert0 = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
        
        xmean+ *ptrVert0\px
        ymean+ *ptrVert0\py
        zmean+ *ptrVert0\pz
      Next j         
      xmean / *PtrDupVert\nbDup
      ymean / *PtrDupVert\nbDup
      zmean / *PtrDupVert\nbDup
      
      ; Then move all the duplicates (including the current vertex) to this average position
      For j=1 To *PtrDupVert\nbDup
        numvert = PeekW(*PtrDupVert\ptrListVert + (j-1)*2)
        *ptrVert0 = dynMesh(numMesh)\vertexBuffer + numvert*SizeOf(vertex)
        
        *ptrVert0\px = xmean
        *ptrVert0\py = ymean
        *ptrVert0\pz = zmean
        
        *PtrDupVert0 = dynMesh(numMesh)\dupVert + numvert*SizeOf(duplicateVert)
        *PtrDupVert0\done=2
      Next j

    EndIf
    
    *ptrVert+SizeOf(Vertex)
    *PtrDupVert+SizeOf(duplicateVert)
  Next i

EndProcedure

;************************************************************************************
; Name: applyHeightmaps
; Purpose: Apply heightmaps 0 -> 5 to sides 0 -> 5 of the mesh
;   - mesh indice in the "dynMesh" array
;   - size of the array (a square of size x size)
;************************************************************************************
Procedure applyHeightmaps(nummesh.l,maxgrid.l)

  Protected i.l,j.l
  Protected *ptrPoly.Polygon,*ptrVert.vertex,*ptrSide.b
  Protected side.b
  Protected h.l,hu.l,hv.l
  Protected hr.f

  *ptrPoly = dynMesh(nummesh)\polygonBuffer
  *ptrSide = dynMesh(nummesh)\faceSideBuffer
  For i = 1 To dynMesh(nummesh)\nbTri
    side = PeekB(*ptrSide)
    
    *ptrVert = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert1 * SizeOf(Vertex))
    hu=Int(*ptrVert\u * (maxgrid-1))
    hv=Int(*ptrVert\v * (maxgrid-1))
    h=heightmap(side,hu,hv)&255
    hr=1+((h-#WATERLEVEL)/255)*#RELIEFEXAGERATION
    If hr<1
      hr = 1
    EndIf
    *ptrVert\px * hr
    *ptrVert\py * hr
    *ptrVert\pz * hr
    ;*ptrVert\couleur=getColor(side,hu,hv,127)

    
    *ptrVert = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert2 * SizeOf(Vertex))
    hu=Int(*ptrVert\u * (maxgrid-1))
    hv=Int(*ptrVert\v * (maxgrid-1))
    h=heightmap(side,hu,hv)&255
    hr=1+((h-#WATERLEVEL)/255)*#RELIEFEXAGERATION
    If hr<1
      hr = 1
    EndIf
    *ptrVert\px * hr
    *ptrVert\py * hr
    *ptrVert\pz * hr
    ;*ptrVert\couleur=getColor(side,hu,hv,127)
    
    *ptrVert = dynMesh(nummesh)\vertexBuffer + (*ptrPoly\numVert3 * SizeOf(Vertex))
    hu=Int(*ptrVert\u * (maxgrid-1))
    hv=Int(*ptrVert\v * (maxgrid-1))
    h=heightmap(side,hu,hv)&255
    hr=1+((h-#WATERLEVEL)/255)*#RELIEFEXAGERATION
    If hr<1
      hr = 1
    EndIf
    *ptrVert\px * hr
    *ptrVert\py * hr
    *ptrVert\pz * hr
    ;*ptrVert\couleur=getColor(side,hu,hv,127)
    
    *ptrPoly+SizeOf(Polygon)
    *ptrSide+1
  Next i
  
  ; Ensure that the vertices at the seams between sides stay at the same position
  levelDuplicateVertices(nummesh)
  
  SetMeshData(dynMesh(nummesh)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(nummesh)\vertexBuffer,dynMesh(nummesh)\nbVert) 

EndProcedure

;************************************************************************************
; Name: cutOutSides
; Purpose: From a given mesh, creates six new "sub-mesh" (one by side -> Top, bottom,
;          left, right, front, back). These six meshes will be consecutive in the
;          "dynmesh" array
;   - mesh indice in the "dynMesh" array
; Return-value : indice of the first sub-mesh in the "dynMesh" array
;************************************************************************************
Procedure.l cutOutSides(nummesh.l)

  Protected i.l,j.l,num.l
  Protected resultMesh.l
  Protected numvert1.w,numvert2.w,numvert3.w,side.b
  Protected *ptrVert.vertex,*ptrPoly.Polygon,*ptrSide.b
  Protected Dim *ptrV.vertex(6)
  Protected Dim *ptrP.Polygon(6)
  Protected Dim *ptrS.b(6)
  Protected Dim nbVert.w(6)
  Protected ok.b
  

  ; Find six consecutive free dyn meshes
  While num<#MAXMESH And dynMesh(num)\nummesh>0 Or dynMesh(num+1)\nummesh>0 Or dynMesh(num+2)\nummesh>0 Or dynMesh(num+3)\nummesh=0 Or dynMesh(num+4)\nummesh>0 Or dynMesh(num+5)\nummesh>0
    num+1
  Wend
  resultMesh = num
  
  ; count vertices and polygons for each side of the reference mesh
  *ptrSide = dynmesh(nummesh)\FaceSideBuffer
  For j=1 To dynMesh(nummesh)\nbTri
    side = PeekB(*ptrSide)
    dynMesh(resultMesh+side)\nbTri+1
    dynMesh(resultMesh+side)\nbVert+3

    *ptrSide+1
  Next j
  
  ; Allocate memory for each side
  For j=0 To 5
    ; Allocate the needed memory for vertices
    dynMesh(resultMesh+j)\vertexBuffer = AllocateMemory(SizeOf(Vertex)*dynMesh(resultMesh+j)\nbVert)
    *ptrV(j) = dynMesh(resultMesh+j)\vertexBuffer
        
    ; Allocate the needed memory for faces info
    dynMesh(resultMesh+j)\polygonBuffer=AllocateMemory(SizeOf(Polygon)*dynMesh(resultMesh+j)\nbTri) 
    *ptrP(j) = dynMesh(resultMesh+j)\polygonBuffer
    
    ; Allocate the needed memory for faces location
    dynMesh(resultMesh+j)\faceSideBuffer=AllocateMemory(dynMesh(resultMesh+j)\nbTri)
    *ptrS(j) = dynMesh(resultMesh+j)\faceSideBuffer
    
  Next j
  
  ; Cut out reference mesh and build sub-meshes
  *ptrPoly = dynmesh(nummesh)\polygonBuffer
  *ptrSide = dynmesh(nummesh)\FaceSideBuffer
  For j=1 To dynMesh(nummesh)\nbTri
    side = PeekB(*ptrSide)
    
    *ptrVert=dynmesh(nummesh)\vertexBuffer + *ptrPoly\numvert1*SizeOf(vertex)
    *PtrV(side)\px = *ptrVert\px
    *PtrV(side)\py = *ptrVert\py
    *PtrV(side)\pz = *ptrVert\pz  
    *PtrV(side)\nx = *ptrVert\nx 
    *PtrV(side)\ny = *ptrVert\ny
    *PtrV(side)\nz = *ptrVert\nz 
    *PtrV(side)\couleur = *ptrVert\couleur
    *PtrV(side)\u = *ptrVert\u
    *PtrV(side)\v = *ptrVert\v
    *PtrV(side)+SizeOf(vertex)
    
    *ptrVert=dynmesh(nummesh)\vertexBuffer + *ptrPoly\numvert2*SizeOf(vertex)
    *PtrV(side)\px = *ptrVert\px
    *PtrV(side)\py = *ptrVert\py
    *PtrV(side)\pz = *ptrVert\pz  
    *PtrV(side)\nx = *ptrVert\nx 
    *PtrV(side)\ny = *ptrVert\ny
    *PtrV(side)\nz = *ptrVert\nz 
    *PtrV(side)\couleur = *ptrVert\couleur
    *PtrV(side)\u = *ptrVert\u
    *PtrV(side)\v = *ptrVert\v
    *PtrV(side)+SizeOf(vertex)
    
    *ptrVert=dynmesh(nummesh)\vertexBuffer + *ptrPoly\numvert3*SizeOf(vertex)
    *PtrV(side)\px = *ptrVert\px
    *PtrV(side)\py = *ptrVert\py
    *PtrV(side)\pz = *ptrVert\pz  
    *PtrV(side)\nx = *ptrVert\nx 
    *PtrV(side)\ny = *ptrVert\ny
    *PtrV(side)\nz = *ptrVert\nz 
    *PtrV(side)\couleur = *ptrVert\couleur
    *PtrV(side)\u = *ptrVert\u
    *PtrV(side)\v = *ptrVert\v
    *PtrV(side)+SizeOf(vertex)
    
    *ptrP(side)\numvert1 = nbVert(side)
    *ptrP(side)\numvert2 = nbVert(side)+1
    *ptrP(side)\numvert3 = nbVert(side)+2
    *ptrP(side)+SizeOf(Polygon)
    nbVert(side)+3
    
    PokeB(*ptrS(side),side)
    *ptrS(side)+1
    
    *ptrPoly+SizeOf(Polygon)
    *ptrSide+1
  Next j
  
  ; Create then six sub-meshes from stored infos
  For i=0 To 5
    dynMesh(resultMesh+i)\numMesh = CreateMesh(#PB_Any,dynMesh(resultMesh+i)\nbVert)
    If IsMesh(dynMesh(resultMesh+i)\numMesh) 
      SetMeshData(dynMesh(resultMesh+i)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,dynMesh(resultMesh+i)\vertexBuffer,dynMesh(resultMesh+i)\nbVert) 
      SetMeshData(dynMesh(resultMesh+i)\numMesh,#PB_Mesh_Face,dynMesh(resultMesh+i)\polygonBuffer,dynMesh(resultMesh+i)\nbTri) 
      
      dynMesh(resultMesh+i)\id = dynMesh(nummesh)\id + Chr(1) + "Face "+Str(i)
      dynMesh(resultMesh+i)\sizeX = dynMesh(nummesh)\sizeX
      dynMesh(resultMesh+i)\sizeY = dynMesh(nummesh)\sizeY
      dynMesh(resultMesh+i)\sizeZ = dynMesh(nummesh)\sizeZ
    Else 
      ok=-1    
    EndIf
  Next i
  
  ; If something has gone wrong, free memory and return -1
  If ok=-1
    For i=0 To 5
      FreeMemory(dynMesh(resultMesh+i)\vertexBuffer)
      FreeMemory(dynMesh(resultMesh+i)\polygonBuffer)
      If IsMesh(dynMesh(resultMesh+i)\numMesh)
        FreeMesh(dynMesh(resultMesh+i)\numMesh)
      EndIf
      dynMesh(resultMesh+i)\numMesh = 0
    Next i
    ProcedureReturn -1    
  EndIf
  
  ; else, return number of the first mesh
  ProcedureReturn resultMesh

EndProcedure

DisableExplicit
;************************************************************************************

;- ---------- Main program ----------
;- Screen initialisation 
Resultat = MessageRequester("Telluric planet generation v2","Full Screen ?",#PB_MessageRequester_YesNo) 
If Resultat = 6      
  FullScreen=1 
Else            
  FullScreen=0 
EndIf 

If InitEngine3D() = 0 
   MessageRequester( "Error" , "Can't initialize 3D, check if engine3D.dll is available" , 0 ) 
   End 
ElseIf InitSprite() = 0 Or InitKeyboard() = 0  Or InitMouse() = 0 
   MessageRequester( "Error" , "Can't find DirectX 7.0 or above" , 0 ) 
   End 
EndIf 

If Fullscreen  
  OpenScreen(1024,768,32,"Telluric Planet Generator v2") 
Else 
  OpenWindow(0,0, 0, 800 , 600 ,"Telluric Planet Generator",#PB_Window_ScreenCentered) 
  OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0) 
EndIf 

StartDrawing(ScreenOutput())
DrawText(0,0,"Generating base mesh and heightmaps, please wait...", $00FFFF, $BB0000)
StopDrawing() 
FlipBuffers()

;-Mesh 
planetMesh = CreateCube("NewWorld",36,1,1,1,0,0,1,1,RGB(0,127,200))
findDuplicateVertices(planetMesh,0.01)

;-Texture 
CreateTexture(0,128, 128) 
StartDrawing(TextureOutput(0)) 
  Box(0, 0, 128, 128, $FFFFFF)
StopDrawing()  

;-Material
CreateMaterial(0,TextureID(0))
MaterialAmbientColor(0,#PB_Material_AmbientColors)

;-Entity 
CreateEntity(planetEntity,MeshID(dynMesh(planetMesh)\numMesh),MaterialID(0))


;-Camera 
CreateCamera(0, 0, 0 , 100 , 100) 
MoveCamera(0,0,0,5) 
CameraLookAt(0,EntityX(planetEntity),EntityY(planetEntity),EntityZ(planetEntity)) 

;-Light 
AmbientColor(RGB(63,63,63)) 
CreateLight(0,RGB(255,255,255),300,300,300) 


;- Heightmaps
; Prepare six heightmaps (one for each side)
dispersion=512
For i=0 To 5
  makeDiamondSquare(maxgrid,dispersion,#PLANETSEED+i)
  
  ; Voronoi can add a nice "fractured" touch to heightmaps, but can be long to generate
  ;makeVoronoi(maxgrid,3,3,#PLANETSEED+i)
  
  ; Pass 1 as last parameter to use Voronoi
  makeHeightmap(i,maxgrid,1,-1)
Next i

; Blend seams between heightmaps of each side of the mesh
eraseseam(#FRONTSIDE,"right",#LEFTSIDE,"left",512,25)
eraseseam(#FRONTSIDE,"left",#RIGHTSIDE,"right",512,25)
eraseseam(#BACKSIDE,"right",#RIGHTSIDE,"left",512,25)
eraseseam(#BACKSIDE,"left",#LEFTSIDE,"right",512,25)

eraseseam(#TOPSIDE,"bottom",#BACKSIDE,"top",512,25)
eraseseam(#TOPSIDE,"left",#LEFTSIDE,"top",512,25) 
eraseseam(#TOPSIDE,"top",#FRONTSIDE,"top",512,25)
eraseseam(#TOPSIDE,"right",#RIGHTSIDE,"top",512,25)

eraseseam(#BOTTOMSIDE,"top",#FRONTSIDE,"bottom",512,25)
eraseseam(#BOTTOMSIDE,"right",#LEFTSIDE,"bottom",512,25)
eraseseam(#BOTTOMSIDE,"bottom",#BACKSIDE,"bottom",512,25)
eraseseam(#BOTTOMSIDE,"left",#RIGHTSIDE,"bottom",512,25)


;- Main loop
Repeat 
   If fullscreen = 0 
      While WindowEvent() : Wend
   EndIf
   
  ; Rotate
  ExamineMouse()
  anglex+MouseDeltaX()
  angley+MouseDeltaY()
  If phase < 4
    RotateEntity(planetEntity, anglex,angley,0)
  Else
    For i=0 To 5
      RotateEntity(newEntity+i, anglex,angley,0)
    Next i    
  EndIf
   
  If ExamineKeyboard() 
    
    ; Wireframe view 
    If KeyboardReleased(#PB_Key_F1) 
      CameraMode=1-CameraMode 
      CameraRenderMode(0,CameraMode) 
      AmbientColor(RGB(63+cameramode*150,63+cameramode*150,63+cameramode*150)) 
    EndIf
    
    ; Zoom / unzoom     
    If KeyboardReleased(#PB_Key_Add)
      MoveCamera(0,0,0,-0.25)
    EndIf
    If KeyboardReleased(#PB_Key_Subtract)
      MoveCamera(0,0,0,0.25)
    EndIf
     
    ; Change phase
    If KeyboardReleased(#PB_Key_Space) And phase <5
      phase + 1
      Select phase
        Case 1
          MessageRequester("Phase 1","Inflate base mesh into something more spheric.")
          t=ElapsedMilliseconds()
          inflateMesh(planetMesh)
          SetMeshData(dynMesh(planetMesh)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(planetMesh)\vertexBuffer,dynMesh(planetMesh)\nbVert) 
          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 1","Phase 1 complete in " + Str(t) + " ms.")
          
        Case 2
          MessageRequester("Phase 2","Apply heightmaps.")
          t=ElapsedMilliseconds()
          applyHeightmaps(planetMesh,maxgrid)
          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 2","Phase 2 complete in " + Str(t) + " ms.")
          
        Case 3
          MessageRequester("Phase 3","Smooth mesh normals.")
          t=ElapsedMilliseconds()
          normalizeMesh(planetMesh)
          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 3","Phase 3 complete in " + Str(t) + " ms.")
          
        Case 4
          MessageRequester("Phase 4","Cut out mesh into 6 sub-meshes")
          t=ElapsedMilliseconds()
          
          newMesh=cutOutSides(planetmesh)      
          newEntity=10
          For i=0 To 5         
            CreateEntity(newEntity+i,MeshID(dynMesh(newMesh + i)\numMesh),MaterialID(0))
          Next i
          HideEntity(planetEntity,1)

          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 4","Phase 4 complete in " + Str(t) + " ms.")
          
          ; Color sides, so they're easier to see
          For i=0 To 5         
            *ptrPoly = dynMesh(newMesh+i)\polygonBuffer
            *ptrSide = dynMesh(newMesh+i)\faceSideBuffer
            For j = 1 To dynMesh(newMesh+i)\nbTri
               side = PeekB(*ptrSide)
               
               *ptrVert = dynMesh(newMesh+i)\vertexBuffer + (*ptrPoly\numVert1 * SizeOf(Vertex))
               *ptrVert\couleur = couleur(side)
               *ptrVert = dynMesh(newMesh+i)\vertexBuffer + (*ptrPoly\numVert2 * SizeOf(Vertex))
               *ptrVert\couleur = couleur(side)
               *ptrVert = dynMesh(newMesh+i)\vertexBuffer + (*ptrPoly\numVert3 * SizeOf(Vertex))
               *ptrVert\couleur = couleur(side)
               
               *ptrPoly+SizeOf(Polygon)
               *ptrSide+1
            Next j
            SetMeshData(dynMesh(newMesh+i)\numMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate,dynMesh(newMesh+i)\vertexBuffer,dynMesh(newMesh+i)\nbVert) 
          Next i
          
        Case 5
          MessageRequester("Phase 5","Generate a texture for each side and apply it to sub-meshes")
          t=ElapsedMilliseconds()
          
          For i=0 To 5                   
            makeHeightmapTexture(10+i,i,maxgrid)
            CreateMaterial(10+i,TextureID(10+i))
            MaterialFilteringMode(10+i, #PB_Material_None)
            EntityMaterial(newEntity+i,MaterialID(10+i))
          Next i

          t=ElapsedMilliseconds()-t
          MessageRequester("Phase 5","Phase 5 complete in " + Str(t) + " ms.")        
          
      EndSelect
    EndIf

  EndIf 
   
  ; show it all
  RenderWorld() 
   
  ; A little help
  StartDrawing(ScreenOutput())
  DrawText(0,0,"[F1] to change RenderMode, [Space] to go to next phase", $00FFFF, $BB0000)
  DrawText(0,15,"[+] to zoom, [-] to unzoom, [MOUSE] to rotate entity", $00FFFF, $BB0000)
  DrawText(0,30,Str(dynMesh(planetMesh)\nbVert) + " vertices, " + Str(dynMesh(planetMesh)\nbTri) + " polygons", $00FFFF, $BB0000)
  StopDrawing() 
  
  ; Flip buffers to avoid tearing  
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) 

; Delete dynamic meshes
For i=0 To #MAXMESH
  If dynmesh(i)\numMesh > 0
    deleteDynMesh(i)
  EndIf
Next i

beauregard
Messages : 1307
Inscription : dim. 08/juil./2007 18:32
Localisation : Toulouse

Message par beauregard »

kelebrindae a écrit :Nouvelle version, partant d'un mesh différent (un rubix cube de 36x36).
Avantages:
- plus de polygones, donc relief plus fin;
- comme les faces sont composées de carrés, on pourrait les "detail-mapper" facilement;
- plus de datas! (coucou Ollivier :wink: )
Inconvénient:
- comme le mesh de base est un cube "gonflé", il y a de la distorsion près du centre des faces (cf. vue Wireframe pour mieux s'en rendre compte.
c'est encore mieux :), effectivement... çà fait un peu rêver( jeu Elite)...
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

C'est super impressionnant! On dirait un jeu bullfrog! Félicitations! :D
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Fantastique !
Tu t'amuses comme un fou :)
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.
Répondre