[PB 4.31] Dynamic planet mesh generation

[Kelebrindae]

Hi,

This code is the logical sequel of this post : once you've generated the map + heightmap of a terrain, why not generate the 3D mesh ?

Creating a terrain mesh should be relatively easy (affect each point of the heightmap to a point of the terrain matrix, then texture it with the map).
What's a little trickier is to create a planet mesh, because it's quite unpractical to try to wrap a square map on a spherical object...

So here's what I did:
- create a cube;
- subdivide each side of the cube as much as possible (to heighten level of detail)
- "spherify" the mesh, by normalizing the distance between the vertices and the mesh's center;
- generate 6 heightmaps (using a slightly modified version of the "random terrain" algorithm), one for each side of the cube, and apply them to the sides;
- cut out the sides to make them 6 different meshes;
- Generate 6 maps from the heightmaps and apply them as textures to these meshes;
Et voila !

Controls:
- Mouse: rotates the planet
- + / - / mouse wheel: zoom / unzoom
- F1 : switches between wireframe and normal mode
- Space : starts the next phase of the process

Notes:
- Set the #PLANETSEED constant to another value to generate a different planet
- Set the #RELIEFEXAGERATION constant to a lower value to get a less "cartoonish" result
- Set the #USEAPIDRAWING constant to #False if you compile with 4.40, Mac, or Linux

And don't forget to turn the Debugger Off, or else it will be really slow!

(oops, code's too big; I have to split it in two parts)
Part 1:

Code: Select all

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

; ---------------------------------------------------------------------------------------------------------------
; Purpose:
; ---------------------------------------------------------------------------------------------------------------
; - Starts from a cube
; - Subdivides each side of the cube to increase detail
; - "Spherify" the 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 cube 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!
;



;- Constants
#e = 2.718281828459045235
#SQRT03=0.577350269189625764
#MAXMESH=10
#PLANETSEED=4321 ; change this to create a different planet
#WATERLEVEL=127
#RELIEFEXAGERATION=0.2 ; Change this to increase/decrease relief height
#USEAPIDRAWING = #True  ; set this to false in 4.40, or to compile under Mac or Linux

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

;- Data structures
Structure VoronoiPoint2D ; used to create the 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

Structure geostat_struct ; used to store infos about terrains
  latitude.f
  slope.l
  temperature.f
  height.l
  probaterrain.f[10]
  isWater.b
  couleur.l
EndStructure

Structure terrain_struct ; used to store specifications for each terrain type
  name.s
  heightAv.f
  heightVt.f
  slopeAv.f
  slopeVt.f
  temperatureAv.f
  temperatureVt.f
  couleur.l
EndStructure

Structure myBITMAPINFO
  bmiHeader.BITMAPINFOHEADER
  bmiColors.RGBQUAD[1]
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)
Global Dim geostat.geostat_struct(6,maxgrid,maxgrid)
Global Dim terrain.terrain_struct(10)

; Tundra
terrain(1)\name = "Tundra"
terrain(1)\heightAv = 1
terrain(1)\heightVt = 4
terrain(1)\slopeAv = 0
terrain(1)\slopeVt = 2.5
terrain(1)\temperatureAv = 0
terrain(1)\temperatureVt = 1.5
terrain(1)\couleur = $79A700
; Herbe
terrain(2)\name = "Grass"
terrain(2)\heightAv = 1
terrain(2)\heightVt = 3
terrain(2)\slopeAv = 0
terrain(2)\slopeVt = 2
terrain(2)\temperatureAv = 18
terrain(2)\temperatureVt = 3.5
terrain(2)\couleur = $5AD00F
; Forêt
terrain(3)\name = "Forest"
terrain(3)\heightAv = 1.1
terrain(3)\heightVt = 3
terrain(3)\slopeAv = 5
terrain(3)\slopeVt = 3
terrain(3)\temperatureAv = 25
terrain(3)\temperatureVt = 2
terrain(3)\couleur = $3EA300
; Désert
terrain(4)\name = "Desert"
terrain(4)\heightAv = 1.3
terrain(4)\heightVt = 5
terrain(4)\slopeAv = 0
terrain(4)\slopeVt = 1.25
terrain(4)\temperatureAv = 50
terrain(4)\temperatureVt = 2
terrain(4)\couleur = $E5DFAD
; Montagne
terrain(5)\name = "Mountain"
terrain(5)\heightAv = 1.7
terrain(5)\heightVt = 2
terrain(5)\slopeAv = 20
terrain(5)\slopeVt = 3
terrain(5)\temperatureAv = 10
terrain(5)\temperatureVt = 2
terrain(5)\couleur = $BBBBBB

Global tpol.f = -15,teq.f = 50


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

;- --- 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 

;- --- 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=255.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=255.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: 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 or not
;   - use the Voronoi diagram or not 
; 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=#True And Diamond=#True 
        k1=(diamond(i,j) & 255)
        k2=(voronoi(i,j) & 255)
        temp(i,j) = k1*k2
      Else
        ; only diamond-square
        If Diamond=#True
          k1=(diamond(i,j) & 255)
          temp(i,j) = k1
        Else
          ; only Voronoi
          If Voronoi=#True
            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: 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

;************************************************************************************
; Name: ComputeGeoStats
; Purpose: Compute height, slope, temperature, ice/snow, terrain type and color for
;          each cell of an heightmap
; Parameters:
;   - number of the heightmap
;   - size of the array (a square of size x size)
;   - sea level (between 0-255)
;   - Temperature at poles (usually cold)
;   - Temperature at equator (usually hot)
;   - seed: albeit the map is random, a seed always produces the same result
; Return-value:  none, but the results are stored in the "geostat" array
;************************************************************************************
Procedure ComputeGeoStats(numHmap.b,maxgrid.l,waterLevel.l,tpol.f,teq.f,seed.l,side.b)

  Protected heightAboveWater.l
  Protected equivHeightToTemp.f = -0.4; temperature loss when you climb up 1 unit
  Protected i.l,j.l,k.l
  Protected x.l,y.l,newx.l,newy.l
  Protected p.l,h1.l,h2.l,maxp.l
  Protected red1.l,red2.l,green1.l,green2.l,blue1.l,blue2.l,red.f,green.f,blue.f
  Protected exp.f,cumul.f,icegradient.f,icecolor.l
  Protected vector3.Vector3
  
  RandomSeed(seed)
  
  maxgrid-1
  For i=0 To maxgrid
    For j = 0 To maxgrid
    
      ; Latitude
      If side=#TOPSIDE Or side=#BOTTOMSIDE
        vector3\x = i-(maxgrid/2)
        vector3\y = maxgrid/2
        vector3\z = j-(maxgrid/2)
    
        NormalizeVector(@vector3)
        
        vector3\x*maxgrid/2
        vector3\y*maxgrid/2
        vector3\z*maxgrid/2

        geostat(numHmap,i,j)\latitude = Cos(vector3\y/maxgrid *#PI)
      Else
        vector3\x = i-(maxgrid/2)
        vector3\y = j-(maxgrid/2)
        vector3\z = maxgrid/2
    
        NormalizeVector(@vector3)
        
        vector3\x*maxgrid/2
        vector3\y*maxgrid/2
        vector3\z*maxgrid/2

        geostat(numHmap,i,j)\latitude = Cos(vector3\y/maxgrid *#PI)
      EndIf
    
      ; Altitude
      geostat(numHmap,i,j)\height = heightmap(numHmap,i,j)&255
      
      ; Slope
      h1= geostat(numHmap,i,j)\height
      geostat(numHmap,i,j)\slope=0
      
      If i>0
        h2=heightmap(numHmap,i-1,j)&255
        p=Abs( h1 - h2 )
        If p>geostat(numHmap,i,j)\slope
          geostat(numHmap,i,j)\slope = p
        EndIf
      EndIf

      If i<maxgrid
        h2=heightmap(numHmap,i+1,j)&255
        p=Abs( h1 - h2 )
        If p>geostat(numHmap,i,j)\slope
          geostat(numHmap,i,j)\slope = p
        EndIf
      EndIf

      If j>0
        h2=heightmap(numHmap,i,j-1)&255
        p=Abs( h1 - h2 )
        If p>geostat(numHmap,i,j)\slope
          geostat(numHmap,i,j)\slope = p
        EndIf
      EndIf

      If j<maxgrid
        h2=heightmap(numHmap,i,j+1)&255
        p=Abs( h1 - h2 )
        If p>geostat(numHmap,i,j)\slope
          geostat(numHmap,i,j)\slope = p
        EndIf
      EndIf
      If geostat(numHmap,i,j)\slope > maxp
        maxp = geostat(numHmap,i,j)\slope
      EndIf

      ; Temperature
      heightAboveWater=geostat(numHmap,i,j)\height - waterlevel
      If heightAboveWater <0
        heightAboveWater = 0
      EndIf
      geostat(numHmap,i,j)\temperature = tpol + geostat(numHmap,i,j)\latitude*(teq-tpol) + equivHeightToTemp*heightAboveWater
      
      If geostat(numHmap,i,j)\height<waterlevel
        ; This point is under sea level
        geostat(numHmap,i,j)\isWater=2
      
        ; underwater points => shades of blue
        red1=0:green1=3:blue1=92
        red2=0:green2=130:blue2=220
        
        red=red1+(red2-red1)*(geostat(numHmap,i,j)\height/waterlevel)
        green=green1+(green2-green1)*(geostat(numHmap,i,j)\height/waterlevel)
        blue=blue1+(blue2-blue1)*(geostat(numHmap,i,j)\height/waterlevel)
      
        ; water depth causes temperature variation
        geostat(numHmap,i,j)\temperature-(geostat(numHmap,i,j)\height-waterlevel)*0.075
      Else       
        ; This point is above sea level
        geostat(numHmap,i,j)\isWater=0
        
        ; Probability computation for each terrain type
        cumul=0:red=0:green=0:blue=0
        For k=1 To 5
          exp = Abs(terrain(k)\temperatureAv - geostat(numHmap,i,j)\temperature)/terrain(k)\temperatureVt
          exp + Abs(terrain(k)\slopeAv - geostat(numHmap,i,j)\slope)/terrain(k)\slopeVt
          exp + Abs(terrain(k)\heightAv*waterLevel - geostat(numHmap,i,j)\height)/terrain(k)\heightVt
          geostat(numHmap,i,j)\probaterrain[k] = Pow(#e,-exp)
          
          cumul+geostat(numHmap,i,j)\probaterrain[k]
        Next k
        
        ; Mix terrains colors according to probability
        For k=1 To 5
          geostat(numHmap,i,j)\probaterrain[k]/cumul
          blue+Red(terrain(k)\couleur)*geostat(numHmap,i,j)\probaterrain[k]
          green+Green(terrain(k)\couleur)*geostat(numHmap,i,j)\probaterrain[k]
          red+Blue(terrain(k)\couleur)*geostat(numHmap,i,j)\probaterrain[k]
        Next k
                
      EndIf
  
      geostat(numHmap,i,j)\couleur = RGB(red,green,blue)
      
    Next j
  Next i
  
  ; Generate a few rivers
  j=0
  For i=1 To Random(6)
    Repeat
      x=Random(maxgrid)
      y=Random(maxgrid)
      j+1
    Until geostat(numHmap,x,y)\isWater<>2 Or j=1000
    
    Repeat
      geostat(numHmap,x,y)\couleur = RGB(0,130,220)
      geostat(numHmap,x,y)\isWater=1
      h1=999
      newx=0:newy=0
      If x>0
        If geostat(numHmap,x-1,y)\isWater <>1 And geostat(numHmap,x-1,y)\height < h1
          newx=x-1:newy=y
          h1=geostat(numHmap,newx,newy)\height
        EndIf 
      EndIf
      If x<maxgrid
        If geostat(numHmap,x+1,y)\isWater <>1 And geostat(numHmap,x+1,y)\height < h1
          newx=x+1:newy=y
          h1=geostat(numHmap,newx,newy)\height
        EndIf 
      EndIf
      If y>0
        If geostat(numHmap,x,y-1)\isWater <>1 And geostat(numHmap,x,y-1)\height < h1
          newx=x:newy=y-1
          h1=geostat(numHmap,newx,newy)\height
        EndIf 
      EndIf
      If y<maxgrid
        If geostat(numHmap,x,y+1)\isWater <>1 And geostat(numHmap,x,y+1)\height < h1
          newx=x:newy=y+1
          h1=geostat(numHmap,newx,newy)\height
        EndIf 
      EndIf
      x=newx:y=newy
      
    Until geostat(numHmap,x,y)\isWater=2 Or (newx=0 And newy=0)
    
  Next i

  ; Add ice/snow, slope marking
  For i=0 To maxgrid
    For j=0 To maxgrid
      red=Red(geostat(numHmap,i,j)\couleur)
      green=Green(geostat(numHmap,i,j)\couleur)
      blue=Blue(geostat(numHmap,i,j)\couleur)
    
      ; Ice / snow
      If geostat(numHmap,i,j)\temperature < 0
        If geostat(numHmap,i,j)\temperature < 0
          icegradient= -geostat(numHmap,i,j)\temperature / 5
        EndIf
        
        If icegradient>1
          icegradient=1
        EndIf         
        icecolor=247+Random(8)
        
        red=red*(1-icegradient) + icecolor*icegradient
        green=green*(1-icegradient) + icecolor*icegradient
        blue=blue*(1-icegradient) + icecolor*icegradient        
      EndIf 
      
      ; Slopes are darker
      If geostat(numHmap,i,j)\isWater<2    
        red-geostat(numHmap,i,j)\slope * 3
        green-geostat(numHmap,i,j)\slope * 3
        blue-geostat(numHmap,i,j)\slope * 3        
      EndIf     
        
      ; RGB must stay between 0-255
      If red<0 
        red=0
      Else
        If red>255
          red=255
        EndIf
      EndIf
      If green<0 
        green=0
      Else
        If green>255
          green=255
        EndIf
      EndIf
      If blue<0 
        blue=0
      Else
        If blue>255
          blue=255
        EndIf
      EndIf
        
      geostat(numHmap,i,j)\couleur = RGB(blue,green,red)

    Next j
  Next i

EndProcedure

;************************************************************************************
; Name: MakeTerrainImage
; Purpose: Draw the map
; Parameters:
;   - number of the image
;   - number of the heightmap / geostats array
;   - size of the array (a square of size x size)
;   - Type of map to draw: "terrain","altitude","slope", "temperature"
; Return-value:  none
;************************************************************************************
Procedure MakeTerrainImage(numImage.l,numHmap.b,maxgrid.l,imageType.s)

  Protected i.l,j.l,color.l,icecolor.l
  Protected red.f,green.f,blue.f,icegradient.f
  
  CompilerIf #USEAPIDRAWING = #True
    Protected hDC.l,hBmp.l,*mem.l,picl_X.l,picl_Y.l,picl_D.l
    Protected bmi.myBITMAPINFO,*pixel.LONG
  
    hDC=StartDrawing(ImageOutput(numImage))
    hBmp = ImageID(numImage)
    picl_X = ImageWidth(numImage)
    picl_Y = ImageHeight(numImage)+1
    picl_D = ImageDepth(numImage)  
    
    *mem = AllocateMemory(picl_X*picl_Y*4)
    bmi.myBITMAPINFO
    bmi\bmiHeader\biSize   = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth  = picl_X
    bmi\bmiHeader\biHeight = picl_Y
    bmi\bmiHeader\biPlanes = 1
    bmi\bmiHeader\biBitCount = 32
    bmi\bmiHeader\biCompression = #BI_RGB
    GetDIBits_(hDC,hBmp,1,picl_Y,*mem,bmi,#DIB_RGB_COLORS)
  
    *pixel = *mem
  CompilerElse
    StartDrawing(ImageOutput(numImage))
  CompilerEndIf
  
  For j=maxgrid-1 To 0 Step-1
    For i=0 To maxgrid-1
    
      Select imageType
      
        Case "altitude"
          red = geostat(numHmap,i,j)\height
          green = red:blue = Red ; (greyscale)

          
        Case "temperature"
          If i>1 And i<maxgrid-1 And j>1 And j<maxgrid-1 And geostat(numHmap,i,j)\isWater>0 And (geostat(numHmap,i-1,j)\isWater=0 Or geostat(numHmap,i+1,j)\isWater=0 Or geostat(numHmap,i,j-1)\isWater=0 Or geostat(numHmap,i,j+1)\isWater=0)
            color=0
          Else
            red = (geostat(numHmap,i,j)\temperature - tpol)*255/(teq-tpol)
            If red>255
              red=255
            EndIf
            If red<0
              red=0
            EndIf
            blue = 255-red
            green=blue/2
          EndIf
          
        Case "slope"
          red = geostat(numHmap,i,j)\slope*32
          If red > 255
            red = 255
          EndIf
          green = red:blue = Red ; (greyscale)
          
        Case "terrain"
          ; Add ice/snow, slope marking
            red=Red(geostat(numHmap,i,j)\couleur)
            green=Green(geostat(numHmap,i,j)\couleur)
            blue=Blue(geostat(numHmap,i,j)\couleur)
          
            ; Ice / snow
            If geostat(numHmap,i,j)\temperature < 0
              If geostat(numHmap,i,j)\temperature < 0
                icegradient= -geostat(numHmap,i,j)\temperature / 5
              EndIf
              
              If icegradient>1
                icegradient=1
              EndIf         
              icecolor=247+Random(8)
              
              red=red*(1-icegradient) + icecolor*icegradient
              green=green*(1-icegradient) + icecolor*icegradient
              blue=blue*(1-icegradient) + icecolor*icegradient        
            EndIf 
            
            ; Slopes are darker
            If geostat(numHmap,i,j)\isWater<2    
              red-geostat(numHmap,i,j)\slope * 4
              green-geostat(numHmap,i,j)\slope * 4
              blue-geostat(numHmap,i,j)\slope * 4        
            EndIf     
              
            ; RGB must stay between 0-255
            If red<0 
              red=0
            Else
              If red>255
                red=255
              EndIf
            EndIf
            If green<0 
              green=0
            Else
              If green>255
                green=255
              EndIf
            EndIf
            If blue<0 
              blue=0
            Else
              If blue>255
                blue=255
              EndIf
            EndIf
          
      EndSelect
      
      CompilerIf #USEAPIDRAWING = #True
        color=RGB(red,green,blue)
        *pixel\l=color
        *pixel + 4
      CompilerElse
        color=RGB(blue,green,red)
        Plot(i,j,color)
      CompilerEndIf
    Next i
  Next j
  
  CompilerIf #USEAPIDRAWING = #True
    SetDIBits_(hDC,hBmp,1,maxgrid+1,*mem,bmi,#DIB_RGB_COLORS)
  CompilerEndIf
  
  StopDrawing()
  
  CompilerIf #USEAPIDRAWING = #True
    FreeMemory(*mem)
  CompilerEndIf

EndProcedure

[Kelebrindae]

Part 2:

Code: Select all

;- --- Dynamic mesh generation ---

Procedure 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
;************************************************************************************
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 = couleur(side) ;*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 = couleur(side) ;*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 = couleur(side) ;*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 v3","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 
EndIf
If InitSprite() = 0 Or InitSprite3D() = 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 v3") 
Else 
  OpenWindow(0,0, 0, 800 , 600 ,"Telluric Planet Generator v3",#PB_Window_ScreenCentered) 
  OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0) 
EndIf 

;-Mesh 
planetMesh = CreateCube("NewWorld",36,1,1,1,0,0,1,1,$FFFFFF)

;-Texture
Add3DArchive(".",#PB_3DArchive_FileSystem)
CreateImage(0,128, 128) 
StartDrawing(ImageOutput(0)) 
  Box(0, 0, 128, 128, $FFFFFF)
StopDrawing()
SaveImage(0,"temp.bmp")
FreeImage(0)
LoadTexture(0,"temp.bmp")


;-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,3.5) 
CameraLookAt(0,EntityX(planetEntity),EntityY(planetEntity),EntityZ(planetEntity)) 

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


;- Main loop
Repeat 
   If fullscreen = 0 
      While WindowEvent() : Wend
   EndIf
   
  ; Rotate
  ExamineMouse()
  anglex+MouseDeltaX()
  angley+MouseDeltaY()
  movez = MouseWheel()
  If phase < 4
    RotateEntity(planetEntity, angley,anglex,0)
  Else
    For i=0 To 5
      RotateEntity(newEntity+i, angley,anglex,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)
    ElseIf KeyboardReleased(#PB_Key_Subtract)
      MoveCamera(0,0,0,0.25)
    ElseIf movez <> 0
      MoveCamera(0,0,0,movez/5)
    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.")
            t1=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) 
            findDuplicateVertices(planetMesh,0.01)
            t1=ElapsedMilliseconds()-t1      

            
          Case 2
            MessageRequester("Phase 2","Compute and apply heightmaps.")

            ; Prepare six heightmaps (one for each side)
            t0=ElapsedMilliseconds()
            dispersion=maxgrid
            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 #true as last parameter to use Voronoi
              makeHeightmap(i,maxgrid,#True,#True)
            Next i
            
            ; Blend seams between heightmaps of each side of the mesh
            eraseseam(#FRONTSIDE,"right",#LEFTSIDE,"left",maxgrid,25)
            eraseseam(#FRONTSIDE,"left",#RIGHTSIDE,"right",maxgrid,25)
            eraseseam(#BACKSIDE,"right",#RIGHTSIDE,"left",maxgrid,25)
            eraseseam(#BACKSIDE,"left",#LEFTSIDE,"right",maxgrid,25)
            
            eraseseam(#TOPSIDE,"bottom",#BACKSIDE,"top",maxgrid,25)
            eraseseam(#TOPSIDE,"left",#LEFTSIDE,"top",maxgrid,25) 
            eraseseam(#TOPSIDE,"top",#FRONTSIDE,"top",maxgrid,25)
            eraseseam(#TOPSIDE,"right",#RIGHTSIDE,"top",maxgrid,25)
            
            eraseseam(#BOTTOMSIDE,"top",#FRONTSIDE,"bottom",maxgrid,25)
            eraseseam(#BOTTOMSIDE,"right",#LEFTSIDE,"bottom",maxgrid,25)
            eraseseam(#BOTTOMSIDE,"bottom",#BACKSIDE,"bottom",maxgrid,25)
            eraseseam(#BOTTOMSIDE,"left",#RIGHTSIDE,"bottom",maxgrid,25)
            t0=ElapsedMilliseconds()-t0
            
            ; Apply heightmap to mesh
            t2=ElapsedMilliseconds()
            applyHeightmaps(planetMesh,maxgrid)
            t2=ElapsedMilliseconds()-t2
            
          Case 3
            MessageRequester("Phase 3","Compute mesh normals.")
            t3=ElapsedMilliseconds()
            normalizeMesh(planetMesh)
            t3=ElapsedMilliseconds()-t3
            
          Case 4
            MessageRequester("Phase 4","Cut out mesh into 6 sub-meshes.")
            t4=ElapsedMilliseconds()
            
            newMesh=cutOutSides(planetmesh)      
            newEntity=10
            For i=0 To 5         
              CreateEntity(newEntity+i,MeshID(dynMesh(newMesh + i)\numMesh),MaterialID(0))
            Next i
            FreeEntity(planetEntity)
            
            t4=ElapsedMilliseconds()-t4

            
          Case 5
            MessageRequester("Phase 5","Generate a texture for each side and apply it to sub-meshes.")
            t5=ElapsedMilliseconds()
            
            For i=0 To 5
              computeGeoStats(i,maxgrid,#WATERLEVEL,tpol,teq,#PLANETSEED,i)
              CreateImage(10+i,maxgrid,maxgrid,32)
              makeTerrainImage(10+i,i,maxgrid,"terrain")
              SaveImage(10+i,"temp"+Str(i)+".bmp")
              LoadTexture(10+i,"temp"+Str(i)+".bmp")
              FreeImage(10+i)
              DeleteFile("temp"+Str(i)+".bmp")
  
              CreateMaterial(10+i,TextureID(10+i))            
              MaterialFilteringMode(10+i, #PB_Material_None)
              EntityMaterial(newEntity+i,MaterialID(10+i))
            Next i
  
            t5=ElapsedMilliseconds()-t5
            MessageRequester("Done!","Inflate base mesh: "+Str(t1)+" ms."+Chr(13)+Chr(10)+"Create heightmaps: "+Str(t0)+" ms."+Chr(13)+Chr(10)+"Apply heightmaps: "+Str(t2)+" ms."+Chr(13)+Chr(10)+"Normalize mesh: "+Str(t3)+" ms."+Chr(13)+Chr(10)+"Subdividing base mesh into 6 'sides': "+Str(t4)+" ms."+Chr(13)+Chr(10)+"Generating textures: "+Str(t5)+" ms."+Chr(13)+Chr(10)+"----------------------"+Chr(13)+Chr(10)+"Total: "+Str(t0+t1+t2+t3+t4+t5)+" ms.")
          
        EndSelect

    EndIf

  EndIf 
   
  ; show it all
  RenderWorld() 
     
  ; Flip buffers to avoid tearing  
  FlipBuffers(#PB_Screen_SmartSynchronization)
Until KeyboardPushed(#PB_Key_Escape) 

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

[c4s]

I'm speechless of your codes..
Please make a neat game that shows the power of PureBasic - I think you have the talent!

[dige]

Amazing I ask my self who is that guru Kelebrindae????

[gnasen]

This is one of the most impressive things done with PB I've seen.
That nearly screams after a game in the space, where you can build colony on planets etc. Maybe something like Master of Orion?
Do you code this stuff as fast as it is published in the forums?

[Kelebrindae]

Do you code this stuff as fast as it is published in the forums?

I certainly wish I could!
No, look at the date in the code header: this one is more than a year old.
I'm just "mass-posting" all my old codes previously posted on the french forums before the 4.40 comes out and hurls them into obsolescence limbo.

And concerning a "Master of Orion"-like game... Well I don't have enough time for that, but I have something left in my archives that could help to make one.
I'll post it Monday. Until then, have a nice week-end! .

[Kelebrindae]

It's monday!
Here's the next episode, you wannabe spacers !

[Num3]

It's exactly like Spore planets

[Marco2007]

WTF!! This is great!!