Perlin et subdivisions, création de terrains

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Répondre
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Re: Perlin et subdivisions, création de terrains

Message par Huitbit »

Hello,

En effet, j'avais déjà testé :wink: .
D'ailleurs, les réglages 2D ne sont plus valables (voir le rivage !)
Idem, si je ne tiens pas compte de la pente, le lissage est de meilleure qualité.
Par contre, des infos sur le fichier Terrain_Detail.jpg de

Code : Tout sélectionner

AddMaterialLayer(0, LoadTexture(1, "Terrain_Detail.jpg"), #PB_Material_Add)
ça serait bien cool :P !


AVANT (sans pente mais réglages 2D pour le rivage)
Image

APRES (on s'y croirait non ? 8) )
Un week sur ce rivage offert par le forum pour l'anniversaire de Typhoon :lol: :lol:
Image

Pour ceux qui veulent tester avec l'exemple de pb :
niveaux de gris
http://hpics.li/329b636

texture
http://hpics.li/30595e9

Hasta la vista !
Elevé au MSX !
Haut
aleo
Messages : 22
Inscription : lun. 04/avr./2011 18:19

Re: Perlin et subdivisions, création de terrains

Message par aleo »

Tu fais don de rêve lol

C'est un très jolie rendu.

C'est quand que tu crée une planète entière ? ^^
Haut
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Perlin et subdivisions, création de terrains

Message par G-Rom »

petite modif en ajoutant normal map & lightmap :

Code : Tout sélectionner

;-@@@@@@@@@@@@@@@
;-Bruit de Perlin & Subdivisions
;Auteur Huitbit
;Avril 2011
;PureBasic 4.51 (Windows  -  x86)
;-@@@@@@@@@@@@@@@
;-Déclarations
Structure VECTOR3
  x.f :  y.f : z.f
EndStructure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro SetVector3(V,_x,_y,_z)
V\x=_x
V\y=_y
V\z=_z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro VectorLength(V)
(V\x*V\x + V\y*V\y + V\z*V\z)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro Normalize(V)
         l.f = VectorLength(V)
         If (l <> 0)
           l =  Sqr(l)
           V\x / l
           V\y / l
           V\z / l
         EndIf
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro DotProduct(A,B)
A\X * B\X + A\Y * B\Y + A\Z * B\Z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CrossProduct(A,B,C)
  C\x = (A\y * B\z) - (A\z * B\y)
  C\y = (A\z * B\x) - (A\x * B\z)
  C\z = (A\x * B\y) - (A\y * B\x)
EndMacro            
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Min(a.d,b.d)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Max(a.d,b.d)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
; ----------------------------------------------------------------------------------------------------------------
;-SOBEL FILTER DEF
; ----------------------------------------------------------------------------------------------------------------
Global *SobelX.b = AllocateMemory(9)
Global *SobelY.b = AllocateMemory(9)

PokeB(*SobelX  ,-1) : PokeB(*SobelX+1,-2) : PokeB(*SobelX+2,-1)
PokeB(*SobelX+3, 0) : PokeB(*SobelX+4, 0) : PokeB(*SobelX+5, 0)
PokeB(*SobelX+6, 1) : PokeB(*SobelX+7, 2) : PokeB(*SobelX+8, 1)

PokeB(*SobelY  ,-1) : PokeB(*SobelY+1, 0) : PokeB(*SobelY+2, 1)
PokeB(*SobelY+3,-2) : PokeB(*SobelY+4, 0) : PokeB(*SobelY+5, 2)
PokeB(*SobelY+6,-1) : PokeB(*SobelY+7, 0) : PokeB(*SobelY+8, 1)

; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i PutImageOnBuffer(ImageID)
*Memory.i = AllocateMemory(  ImageWidth(ImageID) * ImageHeight(ImageID) * 4 )
StartDrawing(ImageOutput(ImageID))
  For x = 0 To ImageWidth(ImageID)-1
    For y = 0 To ImageHeight(ImageID)-1
      Color = Point(x,y)  
      r=Red(Color)
      g=Green(Color)
      b=Blue(Color)
      gray = (r+b+g) / 3
      Color = RGB(gray,gray,gray)  
      PokeI(*Memory + (x*4) +  ImageWidth(ImageID) * (y*4),Color)
    Next 
  Next 
StopDrawing()
ProcedureReturn *Memory
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro GetPixelBuffer(Memory,w,x,y)
  PeekI(Memory + (x*4) + w * (y*4))
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro PutPixelBuffer(Memory,w,x,y,pixel)
  PokeI(Memory + (x*4) + w * (y*4),pixel)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CharToByte(Char)
Char/255.0
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro ByteToChar(Byte)
Byte*255
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i GetGrayLevel(*Buffer,w,x,y)
  Color = PeekI(*Buffer + (x*4) + w * (y*4))
  Red     = Color >> 0  & $000000FF
  Green   = Color >> 8  & $000000FF
  Blue    = Color >> 16 & $000000FF
  Gray = (Red+Green+Blue)/3
  ProcedureReturn Gray
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i Conv3x3(*Buffer.i,w.i,h.i,*Sobel.i,Threshold)
*Gradient.i = AllocateMemory(w*h*4)
If *Gradient
For y = 1 To w-2
   For x = 1 To h-2
           Gradient_Value.f = (CharToByte(GetGrayLevel(*Buffer,w,x-1,y-1) * PeekB(*Sobel  ))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y-1) * PeekB(*Sobel+1))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y-1) * PeekB(*Sobel+2))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y  ) * PeekB(*Sobel+3))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y  ) * PeekB(*Sobel+4))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y  ) * PeekB(*Sobel+5))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y+1) * PeekB(*Sobel+6))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y+1) * PeekB(*Sobel+7))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y+1) * PeekB(*Sobel+8))) 
           PokeF(*Gradient + (x*4) + w * (y*4),Gradient_Value*Threshold)
   Next 
Next 
EndIf 
ProcedureReturn *Gradient
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure Map0_to_255(*V.VECTOR3)
*V\x = max(-256,*V\x)
*V\y = max(-256,*V\y)
*V\z = max(-256,*V\z)
*V\x = min(256,*V\x)
*V\y = min(256,*V\y)
*V\z = min(256,*V\z)
*V\x =*V\x/2 + 127
*V\y =*V\y/2 + 127
*V\z =*V\z/2 + 127
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i CreateNormalMapFromImageID(ImageID,Threshold=5)
Protected *Buffer.i,*GradientX.i,*GradientY.i,NewImage.i

*Buffer     = PutImageOnBuffer(ImageID)
*GradientX  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelX,Threshold)
*GradientY  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelY,Threshold)


NewImage = CreateImage(#PB_Any,ImageWidth(ImageID),ImageHeight(ImageID))
StartDrawing(ImageOutput(NewImage))
For y = 0 To ImageHeight(NewImage)-1
   For x = 0 To ImageWidth(NewImage)-1

  V.VECTOR3
  GrdX.f = PeekF(*GradientX + (x*4) + ImageWidth(ImageID) * (y*4))
  GrdY.f = PeekF(*GradientY + (x*4) + ImageWidth(ImageID) * (y*4))
  SetVector3(V,GrdX,GrdY,0.1)
  Normalize(V)

  Color.VECTOR3
  SetVector3(Color,ByteToChar(V\x),ByteToChar(V\y),ByteToChar(V\z))
  Map0_to_255(Color)
  Plot(x,y,RGB(Color\x,Color\y,Color\z))

   Next
Next   
StopDrawing()


ProcedureReturn NewImage
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------

#PasInitial =128
#NbreInitialDePicsHorizontaux =6
#NbreInitialDePicsVerticaux =4
#OctaveMax = 5; de l'octave n°1 à #OctaveMax
#Persistance = 0.5
Octave.b
Persistance.f
FacteurNormalisation.f =(1 - Pow(#Persistance,#OctaveMax)) / (1 - #Persistance)
Composante.w
Pas.l
NbreDePicsHorizontaux.l
NbreDePicsVerticaux.l
NbreMaxDePicsHorizontaux.l = #NbreInitialDePicsHorizontaux * Pow(2 , #OctaveMax - 1)
NbreMaxDePicsVerticaux.l = #NbreInitialDePicsVerticaux * Pow(2 , #OctaveMax - 1)
PasMinimal.l = #PasInitial / Pow(2 , #OctaveMax - 1)
LargeurEcran.l = NbreMaxDePicsHorizontaux  * PasMinimal
HauteurEcran.l = NbreMaxDePicsVerticaux  * PasMinimal
#NbreDeSubdivisions = 3
RapportSubdv.f = 0.25
IndiceMaxDesPtsDeCtrlHorizontaux.l = (NbreMaxDePicsHorizontaux - 2) * Pow(2,#NbreDeSubdivisions) +1
IndiceMaxDesPtsDeCtrlVerticaux.l = (NbreMaxDePicsVerticaux - 2) * Pow(2,#NbreDeSubdivisions) + 1
IndiceDesPtsDeCtrlHorizontaux.l
IndiceDesPtsDeCtrlVerticaux.l

Structure PtDeCtrl
  x.l
  y.l ; y  =  a  *  x  + b
  z.l
  a.f ; pente
  b.f ; ordonnée à l'origine
EndStructure

Structure Carte
  z.w
EndStructure

Macro affine(a,b,uA,zA,uB,zB)
If (uB-uA)<>0
  a = (zB - zA) / (uB - uA)
  b = zB - a * uB
EndIf
EndMacro

;tableau des points de contrôle
Dim P.PtDeCtrl(LargeurEcran , IndiceMaxDesPtsDeCtrlVerticaux , #OctaveMax)

Dim carte.Carte(LargeurEcran,HauteurEcran,#OctaveMax)

;-Remplissage du tableau  de points de contrôle avec des pics de Perlin
For Octave = 1 To #OctaveMax
  Pas = #PasInitial / Pow(2 , Octave - 1)
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  Persistance =  Pow(#Persistance , Octave - 1)
  For i = 0 To NbreDePicsHorizontaux -1
    For j = 0 To NbreDePicsVerticaux -1
      P(i  , j , Octave)\x = i * Pas
      P(i  , j , Octave)\y = j * Pas
      P(i  , j , Octave)\z = Persistance * Random(255)
     
    Next j
  Next i
Next Octave

  ;-Subdivisions
For Octave = 1 To #OctaveMax
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  IndiceDesPtsDeCtrlHorizontaux = NbreDePicsHorizontaux - 1
  IndiceDesPtsDeCtrlVerticaux = NbreDePicsVerticaux - 1
  Pas = #PasInitial / Pow(2 , Octave - 1)
  ;- Création des lignes de contrôle horizontales pour chaque octave
  ;Utilisation du tableau P(i,j,Octave) pour i allant de i=0 à i=NbreDePicsHorizontauxProvisoire
  ;l'utilisation de i=x=0 à  i=x=LargeurEcran se fera dans la deuxième partie
  ;{
 
  For j = 0 To IndiceDesPtsDeCtrlVerticaux
   
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsHorizontaux - 2) * Pow(2,SubdivisionEnCours) +1
     
      For i = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If i = IndiceMaxProvisoire - 1
          P(2 * i + 1,j,Octave)\x = LargeurEcran
          P(2 * i + 1,j,Octave)\z = P(IndiceMaxProvisoire,j,Octave)\z
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
         
        Else
          P(2 * i + 1,j,Octave)\x = P(i,j,Octave)\x + (1 - RapportSubdv) * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i + 1,j,Octave)\z = P(i,j,Octave)\z + (1 - RapportSubdv) * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
        EndIf
       
      Next i
     
      P(1,j,Octave)\x = P(0,j,Octave)\x + (1 - RapportSubdv) * (P(1,j,Octave)\x - P(0,j,Octave)\x)
      P(1,j,Octave)\z = P(0,j,Octave)\z + (1 - RapportSubdv) * (P(1,j,Octave)\z - P(0,j,Octave)\z)
     
    Next SubdivisionEnCours
   
    ;-calculs des équations affines de chaque segment
    x=0
    For i = 0  To IndiceMaxDesPtsDeCtrlHorizontaux -1
      affine(P(i,j,Octave)\a,P(i,j,Octave)\b,P(i,j,Octave)\x,P(i,j,Octave)\z,P(i + 1,j,Octave)\x,P(i + 1,j,Octave)\z)
     
      ;-remplissage du tableau carte(x,y,Octave)
     
      While x<=P(i+1,j,Octave)\x
        carte(x,j*Pas,Octave)\z=P(i,j,Octave)\a * x  + P(i,j,Octave)\b
        x=x+1
      Wend
    Next i
   
  Next j
 
 
  ;}
  ;-subdivisions selon y, les points de contrôles sont issus des lignes de contrôle horizontales
  ;{
  For x=0 To LargeurEcran
    ;Chargement des points de contrôle d'abscisse x
    For j = 0 To IndiceDesPtsDeCtrlVerticaux
      P(x,j,Octave)\z= carte(x,j*Pas ,Octave)\z
      P(x,j,Octave)\y=j*Pas
    Next j
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsVerticaux - 2) * Pow(2,SubdivisionEnCours) +1
      For j = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If j = IndiceMaxProvisoire - 1
          P(x,2 * j + 1,Octave)\y = HauteurEcran
          P(x,2 * j + 1,Octave)\z = P(x,IndiceMaxProvisoire,Octave)\z
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
         
        Else
          P(x,2 * j + 1,Octave)\y = P(x,j,Octave)\y + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j + 1,Octave)\z = P(x,j,Octave)\z + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\z - P(x,j,Octave)\z)
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
         
        EndIf
       
      Next j
     
      P(x,1,Octave)\y = P(x,0,Octave)\y + (1 - RapportSubdv) * (P(x,1,Octave)\y - P(x,0,Octave)\y)
      P(x,1,Octave)\z = P(x,0,Octave)\z + (1 - RapportSubdv) * (P(x,1,Octave)\z - P(x,0,Octave)\z)
     
     
     
    Next SubdivisionEnCours
    ;-calculs des équations affines de chaque segment
   
    y=0
    For j = 0  To IndiceMaxDesPtsDeCtrlVerticaux -1
      affine(P(x,j,Octave)\a,P(x,j,Octave)\b,P(x,j,Octave)\y,P(x,j,Octave)\z,P(x ,j+1,Octave)\y,P(x,j+1,Octave)\z)
      ;-remplissage du tableau carte(x,y,Octave)
     
      While y<=P(x,j+1,Octave)\y
        carte(x,y,Octave)\z=P(x,j,Octave)\a * y  + P(x,j,Octave)\b
        y=y+1
      Wend
    Next j
   
  Next x
  ;}
Next Octave
;-*************************************************
;-PROGRAMME PRINCIPAL
;-
;-************************************************
InitSprite()
InitKeyboard()
info$=">>INFOS: Pics "+ Str(#NbreInitialDePicsHorizontaux)+" * "+Str(#NbreInitialDePicsVerticaux)+"   Oct="+Str(#OctaveMax)+"  Subdv="+Str(#NbreDeSubdivisions)
OpenWindow(0,0,0,LargeurEcran,HauteurEcran,"Test Perlin 2D"+info$,#PB_Window_ScreenCentered|#PB_Window_SystemMenu  )
; OpenWindowedScreen(WindowID(0),0,0,LargeurEcran,HauteurEcran,0,0,0)

;-dessin de la carte
DiffuseColor = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)
Dim DiffuseColor.i(LargeurEcran,HauteurEcran)
StartDrawing(ImageOutput(DiffuseColor))

If #OctaveMax>1
  For Octave = 2 To #OctaveMax
   
    For x=0 To LargeurEcran
      For y=0 To HauteurEcran
        carte(x,y,1)\z=carte(x,y,1)\z+carte(x,y,Octave)\z
      Next y
    Next x
   
  Next Octave
EndIf

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z/FacteurNormalisation
    ;-choix des couleurs en fonction de z
    Select Composante
      Case 0 To 85 ; eaux profondes
        Box(x,y,1,1,RGB(0,0,2*Composante))
        DiffuseColor(x,y )=RGB(0,0,2*Composante)
      Case 85 To 100 ; eaux peu profondes
        Box(x,y,1,1,RGB(0, Composante*0.4, 2*Composante))
        DiffuseColor(x,y )=RGB(0, Composante*0.4, 2*Composante)
      Case 100 To 104 ; plages
        Box(x,y,1,1,RGB(2*Composante+25,2*Composante+15,Composante))
         DiffuseColor(x,y )=RGB(2*Composante+25,2*Composante+15,Composante)
      Case 104 To 115 ;herbe
        Box(x,y,1,1,RGB(0, 2*Composante-Random(40),0))
        DiffuseColor(x,y )=RGB(0, 2*Composante-Random(40),0)
      Case 115 To 130;forêt
        Box(x,y,1,1,RGB(0,Composante-Random(20),0))
        DiffuseColor(x,y )=RGB(0,Composante-Random(20),0)
      Case 120 To 150;basse montagne
        Box(x,y,1,1,RGB(Composante, Composante*0.7, Random(80)))
        DiffuseColor(x,y )=RGB(Composante, Composante*0.7, Random(80))
      Case 150 To 170;haute montagne
        Box(x,y,1,1,RGB(Composante, Composante, 20+Random(80)))
        DiffuseColor(x,y )=RGB(Composante, Composante, 20+Random(80))
      Case 170 To 255;neige
        Box(x,y,1,1,RGB(Composante, Composante,Composante))
        DiffuseColor(x,y )=RGB(Composante, Composante,Composante)
    EndSelect
   
  Next y
Next x
StopDrawing()

HeightMap = CreateImage(#PB_Any,LargeurEcran,HauteurEcran,32)
StartDrawing(ImageOutput(HeightMap))

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z/FacteurNormalisation
    Plot(x,y,RGB(Composante,Composante,Composante))
  Next y
Next x
StopDrawing()

OldSizeX = LargeurEcran
OldSizeY = HauteurEcran
ResizeImage(HeightMap,512,512)
NormalMap = CreateNormalMapFromImageID(HeightMap)
ResizeImage(HeightMap,OldSizeX ,OldSizeY )
ResizeImage(NormalMap,OldSizeX ,OldSizeY )


; Calcul de la lightmap
  Dim Normal.VECTOR3(LargeurEcran,HauteurEcran)
  
  StartDrawing(ImageOutput(NormalMap))
    For y = 0 To ImageHeight(NormalMap) - 1 
      For x = 0 To ImageWidth(NormalMap) - 1
        Color = Point(x,y)
        Normal(x,y)\x=(Red(Color)/255)
        Normal(x,y)\y=(Green(Color)/255)
        Normal(x,y)\z=(Blue(Color)/255)
        normalize(Normal(x,y))
      Next 
    Next 
  StopDrawing()

  
  sunColor = $FFFFFF
  SunX=30000
  SunY=10000
  SunZ=30000
 lightmap = CreateImage(#PB_Any,ImageWidth(NormalMap), ImageHeight(NormalMap))
  StartDrawing(ImageOutput(lightmap))
  
 
  For z = 0 To ImageHeight(NormalMap) - 1
    For x = 0 To ImageWidth(NormalMap) - 1
      
      terrainHeight.f = carte(x,y,1)\z * 100
      
      terrainPixel.VECTOR3
      terrainPixel\x = x
      terrainPixel\y = terrainHeight
      terrainPixel\z = z
      
      SunDir.Vector3
      SunDir\x =  (sunX - terrainPixel\x)
      SunDir\y =  (sunY - terrainPixel\y)
      SunDir\z =  (sunZ - terrainPixel\z)
      Normalize(SunDir)

      
      tmp.f = DotProduct(SunDir,Normal(x,z))
        
      If tmp<0
        Col.f = -1 * tmp
      Else
        Col.f = tmp 
      EndIf 
      
       
      red   = Red(DiffuseColor(x,z))   * Col
      green = Green(DiffuseColor(x,z)) * Col
      blue  = Blue(DiffuseColor(x,z))  * Col
      
      
      If red>255  :red=255  :EndIf
      If green>255:green=255:EndIf
      If blue>255 :blue=255 :EndIf

      Plot(x,z,RGB(red,green,blue))
     
    Next
  Next
  
  StopDrawing()
  
  
Debug "!"

;-BOUCLE PRINCIPALE
Repeat
;   FlipBuffers()
  StartDrawing(WindowOutput(0))
    DrawImage(ImageID(lightmap),0,0)
  StopDrawing()
  Delay(10)
Until WindowEvent() = #PB_Event_CloseWindow
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Re: Perlin et subdivisions, création de terrains

Message par Huitbit »

Wahou 8O !
Saperlipopette !


De mon côté, j'ai avancé(problèmes avec les octaves et le nombre de subdivisions)
Avec le gradient de couleurs, ça va le faire !
Il y aura un code pour la 2D et pour la 3D
J'ai juste un petit problème pour l'image en niveaux de gris.
Impossible de faire la sauvegarde en 256 couleurs !

Hasta la vista !
Elevé au MSX !
Haut
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Perlin et subdivisions, création de terrains

Message par G-Rom »

Ca serait bien que tu sépares le perlin d'un coté , le remplissage de couleur d'un coté. et que tu fasse une fonction autonome , càd sans variable globale ou tout le chmillblick qui va avec...
Et le top du top , si tu pouvais ajouté des paramètres d'érosion , le type de terrain ( plaine (pente douce , peu/pas d'eau) , cayon ( pente brut , pas d'eau ) , iles , etc.... ) :mrgreen:
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Re: Perlin et subdivisions, création de terrains

Message par Huitbit »

Hello !

J'hallucine 8O
J'ai fait un copier-coller de la procédure pour les teintes, j'ai écrit

Code : Tout sélectionner

 
     Composante=carte(x,y,1)\z*10/FacteurNormalisation
    ;-choix des couleurs en fonction de z
      DiffuseColor(x,y )=couleur(composante)
à la place de ma sauce infame pour les couleurs, j'ai changé la position du Soleil

Code : Tout sélectionner

SunX=60000;30000
  SunY=20000;10000
  SunZ=60000;30000
Et voilà !

Là G-Rom, tu as fait fort ! Ton code assure 8) , sans même le regarder, j'ai pû l'utiliser :P
Le seul Sobel que je connaissais, c'était celui de la Easy Company de Band of Brothers :lol: :lol:

Maintenant, il ne me reste plus qu'à comprendre ton code :mrgreen:
J'ai la nette impression que ça vaut le coup !
D'ailleurs, je suis tombé sur une mine d'or :
http://libnoise.sourceforge.net/index.html

Mais tu dois connaître ça !

Image

A propos du rendu 3D(Ce n'était pas un objectif, mais comme ça marche plutôt bien ! D'ailleurs mon fils, joue à l'avion avec les touches du clavier(avec le bruitage), moi je contrôle la souris, et on traverse le mini-archipel Pureland à foOOOond :lol:)
Je n'arrive toujours pas à sauvegarder en niveaux de gris :?


Hasta la vista !

PS: le code provisoire pour ceux qui veulent tester (temps de compilation différent avec ou sans débuggeur)
Par rapport aux dimensions des cartes, j'ai l'impression que c'est plutôt rapide. Il faudrait l'avis de spécialistes !

Dans cette version, il ne faut pas dépasser 3 subdivisions ou 5 octaves (le problème est déjà réglé sur une autre version)

Code : Tout sélectionner

;-@@@@@@@@@@@@@@@
;-Bruit de Perlin & Subdivisions
;Auteur Huitbit
;Grosse contribution G-Rom
;Avril 2011
;PureBasic 4.51 (Windows  -  x86)
;-@@@@@@@@@@@@@@@

;gradient de teintes multicolores quelconques
;{
Enumeration
  #EauxProfondes
  #EauxPeuProfondes
  #Sable
  #Herbe
  #Foret
  #BasseMontagne
  #HauteMontagne
  #Neige
EndEnumeration
;-index des teintes
IndexMaxDesTeintes.l=2550
#IndexRelatifEauxProfondes=0
#IndexRelatifEauxPeuProfondes=0.42
#IndexRelatifSable=0.44
#IndexRelatifHerbe=0.45
#IndexRelatifForet=0.54
#IndexRelatifBasseMontagne=0.65
#IndexRelatifHauteMontagne=0.70
#IndexRelatifNeige=1

Global x.l
Structure Teinte
  Rouge.c
  Vert.c
  Bleu.c
  Index.l
EndStructure

Macro TeinteDeReference(TypeDeTerrain,r,v,b,id);id valeur comprise entre 0 et 1 (0% et 100%)
Teinte(TypeDeTerrain)\Rouge=r
Teinte(TypeDeTerrain)\Vert=v
Teinte(TypeDeTerrain)\Bleu=b
Teinte(TypeDeTerrain)\Index = id*IndexMaxDesTeintes
EndMacro

Macro  Composante(comp)
ValeurComposanteTeinte(x,Teinte(TypeDeTerrain)\Index ,Teinte(TypeDeTerrain)\comp,Teinte(TypeDeTerrain+1)\Index ,Teinte(TypeDeTerrain+1)\comp)
EndMacro

Procedure.f ValeurComposanteTeinte(x.l,xA.f,Ya.f,xB.f,YB.f)
  ProcedureReturn yA + (yB - yA)/(xB - xA) * (x - xA)
EndProcedure

Global Dim Teinte.Teinte(IndexMaxDesTeintes)
Dim couleur.l(2550)
TeinteDeReference(#EauxProfondes,0,0,32,#IndexRelatifEauxProfondes)
TeinteDeReference(#EauxPeuProfondes,0,128,192,#IndexRelatifEauxPeuProfondes)
TeinteDeReference(#Sable,224,224,128,#IndexRelatifSable)
TeinteDeReference(#Herbe,0,192,0,#IndexRelatifHerbe)
TeinteDeReference(#Foret,0,92,0,#IndexRelatifForet)
TeinteDeReference(#BasseMontagne,120,120,68,#IndexRelatifBasseMontagne)
TeinteDeReference(#HauteMontagne,200, 193, 178,#IndexRelatifHauteMontagne)
TeinteDeReference(#Neige,255,255,255,#IndexRelatifNeige)


For x=0 To IndexMaxDesTeintes
  
  Select x
    Case Teinte(#EauxProfondes)\Index
      TypeDeTerrain=#EauxProfondes
    Case Teinte(#EauxPeuProfondes)\Index
      TypeDeTerrain=#EauxPeuProfondes
    Case Teinte(#Sable)\Index
      TypeDeTerrain=#Sable
    Case Teinte(#Herbe)\Index
      TypeDeTerrain=#Herbe
    Case Teinte(#Foret)\Index
      TypeDeTerrain=#Foret
    Case Teinte(#BasseMontagne)\Index
      TypeDeTerrain=#BasseMontagne
    Case Teinte(#HauteMontagne)\Index
      TypeDeTerrain=#HauteMontagne
  EndSelect
  
  couleur(x)=RGB(Composante(Rouge),Composante(Vert),Composante(Bleu))
Next x
;}

;-Déclarations
Structure VECTOR3
  x.f :  y.f : z.f
EndStructure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro SetVector3(V,_x,_y,_z)
V\x=_x
V\y=_y
V\z=_z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro VectorLength(V)
(V\x*V\x + V\y*V\y + V\z*V\z)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro Normalize(V)
l.f = VectorLength(V)
If (l <> 0)
  l =  Sqr(l)
  V\x / l
  V\y / l
  V\z / l
EndIf
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro DotProduct(A,B)
A\X * B\X + A\Y * B\Y + A\Z * B\Z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CrossProduct(A,B,C)
C\x = (A\y * B\z) - (A\z * B\y)
C\y = (A\z * B\x) - (A\x * B\z)
C\z = (A\x * B\y) - (A\y * B\x)
EndMacro            
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Min(a.d,b.d)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Max(a.d,b.d)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
; ----------------------------------------------------------------------------------------------------------------
;-SOBEL FILTER DEF
; ----------------------------------------------------------------------------------------------------------------
Global *SobelX.b = AllocateMemory(9)
Global *SobelY.b = AllocateMemory(9)

PokeB(*SobelX  ,-1) : PokeB(*SobelX+1,-2) : PokeB(*SobelX+2,-1)
PokeB(*SobelX+3, 0) : PokeB(*SobelX+4, 0) : PokeB(*SobelX+5, 0)
PokeB(*SobelX+6, 1) : PokeB(*SobelX+7, 2) : PokeB(*SobelX+8, 1)

PokeB(*SobelY  ,-1) : PokeB(*SobelY+1, 0) : PokeB(*SobelY+2, 1)
PokeB(*SobelY+3,-2) : PokeB(*SobelY+4, 0) : PokeB(*SobelY+5, 2)
PokeB(*SobelY+6,-1) : PokeB(*SobelY+7, 0) : PokeB(*SobelY+8, 1)

; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i PutImageOnBuffer(ImageID)
  *Memory.i = AllocateMemory(  ImageWidth(ImageID) * ImageHeight(ImageID) * 4 )
  StartDrawing(ImageOutput(ImageID))
  For x = 0 To ImageWidth(ImageID)-1
    For y = 0 To ImageHeight(ImageID)-1
      Color = Point(x,y)  
      r=Red(Color)
      g=Green(Color)
      b=Blue(Color)
      gray = (r+b+g) / 3
      Color = RGB(gray,gray,gray)  
      PokeI(*Memory + (x*4) +  ImageWidth(ImageID) * (y*4),Color)
    Next 
  Next 
  StopDrawing()
  ProcedureReturn *Memory
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro GetPixelBuffer(Memory,w,x,y)
PeekI(Memory + (x*4) + w * (y*4))
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro PutPixelBuffer(Memory,w,x,y,pixel)
PokeI(Memory + (x*4) + w * (y*4),pixel)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CharToByte(Char)
Char/255.0
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro ByteToChar(Byte)
Byte*255
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i GetGrayLevel(*Buffer,w,x,y)
  Color = PeekI(*Buffer + (x*4) + w * (y*4))
  Red     = Color >> 0  & $000000FF
  Green   = Color >> 8  & $000000FF
  Blue    = Color >> 16 & $000000FF
  Gray = (Red+Green+Blue)/3
  ProcedureReturn Gray
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i Conv3x3(*Buffer.i,w.i,h.i,*Sobel.i,Threshold)
  *Gradient.i = AllocateMemory(w*h*4)
  If *Gradient
    For y = 1 To w-2
      For x = 1 To h-2
        Gradient_Value.f = (CharToByte(GetGrayLevel(*Buffer,w,x-1,y-1) * PeekB(*Sobel  ))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y-1) * PeekB(*Sobel+1))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y-1) * PeekB(*Sobel+2))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y  ) * PeekB(*Sobel+3))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y  ) * PeekB(*Sobel+4))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y  ) * PeekB(*Sobel+5))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y+1) * PeekB(*Sobel+6))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y+1) * PeekB(*Sobel+7))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y+1) * PeekB(*Sobel+8))) 
        PokeF(*Gradient + (x*4) + w * (y*4),Gradient_Value*Threshold)
      Next 
    Next 
  EndIf 
  ProcedureReturn *Gradient
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure Map0_to_255(*V.VECTOR3)
  *V\x = max(-256,*V\x)
  *V\y = max(-256,*V\y)
  *V\z = max(-256,*V\z)
  *V\x = min(256,*V\x)
  *V\y = min(256,*V\y)
  *V\z = min(256,*V\z)
  *V\x =*V\x/2 + 127
  *V\y =*V\y/2 + 127
  *V\z =*V\z/2 + 127
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i CreateNormalMapFromImageID(ImageID,Threshold=5)
  Protected *Buffer.i,*GradientX.i,*GradientY.i,NewImage.i
  
  *Buffer     = PutImageOnBuffer(ImageID)
  *GradientX  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelX,Threshold)
  *GradientY  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelY,Threshold)
  
  
  NewImage = CreateImage(#PB_Any,ImageWidth(ImageID),ImageHeight(ImageID))
  StartDrawing(ImageOutput(NewImage))
  For y = 0 To ImageHeight(NewImage)-1
    For x = 0 To ImageWidth(NewImage)-1
      
      V.VECTOR3
      GrdX.f = PeekF(*GradientX + (x*4) + ImageWidth(ImageID) * (y*4))
      GrdY.f = PeekF(*GradientY + (x*4) + ImageWidth(ImageID) * (y*4))
      SetVector3(V,GrdX,GrdY,0.1)
      Normalize(V)
      
      Color.VECTOR3
      SetVector3(Color,ByteToChar(V\x),ByteToChar(V\y),ByteToChar(V\z))
      Map0_to_255(Color)
      Plot(x,y,RGB(Color\x,Color\y,Color\z))
      
    Next
  Next   
  StopDrawing()
  
  
  ProcedureReturn NewImage
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------

#PasInitial =128
#NbreInitialDePicsHorizontaux =6
#NbreInitialDePicsVerticaux =6
#OctaveMax = 5; de l'octave n°1 à #OctaveMax
#Persistance = 0.55
Octave.b
Persistance.f
FacteurNormalisation.f =(1 - Pow(#Persistance,#OctaveMax)) / (1 - #Persistance)
Composante.w
Pas.l
NbreDePicsHorizontaux.l
NbreDePicsVerticaux.l
NbreMaxDePicsHorizontaux.l = #NbreInitialDePicsHorizontaux * Pow(2 , #OctaveMax - 1)
NbreMaxDePicsVerticaux.l = #NbreInitialDePicsVerticaux * Pow(2 , #OctaveMax - 1)
PasMinimal.l = #PasInitial / Pow(2 , #OctaveMax - 1)
LargeurEcran.l = NbreMaxDePicsHorizontaux  * PasMinimal
HauteurEcran.l = NbreMaxDePicsVerticaux  * PasMinimal
#NbreDeSubdivisions = 3
RapportSubdv.f = 0.25
IndiceMaxDesPtsDeCtrlHorizontaux.l = (NbreMaxDePicsHorizontaux - 2) * Pow(2,#NbreDeSubdivisions) +1
IndiceMaxDesPtsDeCtrlVerticaux.l = (NbreMaxDePicsVerticaux - 2) * Pow(2,#NbreDeSubdivisions) + 1
IndiceDesPtsDeCtrlHorizontaux.l
IndiceDesPtsDeCtrlVerticaux.l

Structure PtDeCtrl
  x.l
  y.l ; y  =  a  *  x  + b
  z.l
  a.f ; pente
  b.f ; ordonnée à l'origine
EndStructure

Structure Carte
  z.w
EndStructure

Macro affine(a,b,uA,zA,uB,zB)
If (uB-uA)<>0
  a = (zB - zA) / (uB - uA)
  b = zB - a * uB
EndIf
EndMacro

;tableau des points de contrôle
Dim P.PtDeCtrl(LargeurEcran , IndiceMaxDesPtsDeCtrlVerticaux , #OctaveMax)

Dim carte.Carte(LargeurEcran,HauteurEcran,#OctaveMax)

;-Remplissage du tableau  de points de contrôle avec des pics de Perlin
For Octave = 1 To #OctaveMax
  Pas = #PasInitial / Pow(2 , Octave - 1)
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  Persistance =  Pow(#Persistance , Octave - 1)
  For i = 0 To NbreDePicsHorizontaux -1
    For j = 0 To NbreDePicsVerticaux -1
      P(i  , j , Octave)\x = i * Pas
      P(i  , j , Octave)\y = j * Pas
      P(i  , j , Octave)\z = Persistance * Random(255)
      
    Next j
  Next i
Next Octave

  ;-Subdivisions
For Octave = 1 To #OctaveMax
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  IndiceDesPtsDeCtrlHorizontaux = NbreDePicsHorizontaux - 1
  IndiceDesPtsDeCtrlVerticaux = NbreDePicsVerticaux - 1
  Pas = #PasInitial / Pow(2 , Octave - 1)
  ;- Création des lignes de contrôle horizontales pour chaque octave
  ;Utilisation du tableau P(i,j,Octave) pour i allant de i=0 Ã  i=NbreDePicsHorizontauxProvisoire
  ;l'utilisation de i=x=0 à  i=x=LargeurEcran se fera dans la deuxième partie
  ;{
  
  For j = 0 To IndiceDesPtsDeCtrlVerticaux
    
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsHorizontaux - 2) * Pow(2,SubdivisionEnCours) +1
      
      For i = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If i = IndiceMaxProvisoire - 1
          P(2 * i + 1,j,Octave)\x = LargeurEcran
          P(2 * i + 1,j,Octave)\z = P(IndiceMaxProvisoire,j,Octave)\z
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          
        Else
          P(2 * i + 1,j,Octave)\x = P(i,j,Octave)\x + (1 - RapportSubdv) * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i + 1,j,Octave)\z = P(i,j,Octave)\z + (1 - RapportSubdv) * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
        EndIf
        
      Next i
      
      P(1,j,Octave)\x = P(0,j,Octave)\x + (1 - RapportSubdv) * (P(1,j,Octave)\x - P(0,j,Octave)\x)
      P(1,j,Octave)\z = P(0,j,Octave)\z + (1 - RapportSubdv) * (P(1,j,Octave)\z - P(0,j,Octave)\z)
      
    Next SubdivisionEnCours
    
    ;-calculs des équations affines de chaque segment
    x=0
    For i = 0  To IndiceMaxDesPtsDeCtrlHorizontaux -1
      affine(P(i,j,Octave)\a,P(i,j,Octave)\b,P(i,j,Octave)\x,P(i,j,Octave)\z,P(i + 1,j,Octave)\x,P(i + 1,j,Octave)\z)
      
      ;-remplissage du tableau carte(x,y,Octave)
      
      While x<=P(i+1,j,Octave)\x
        carte(x,j*Pas,Octave)\z=P(i,j,Octave)\a * x  + P(i,j,Octave)\b
        x=x+1
      Wend
    Next i
    
  Next j
  
  
  ;}
  ;-subdivisions selon y, les points de contrôles sont issus des lignes de contrôle horizontales
  ;{
  For x=0 To LargeurEcran
    ;Chargement des points de contrôle d'abscisse x
    For j = 0 To IndiceDesPtsDeCtrlVerticaux
      P(x,j,Octave)\z= carte(x,j*Pas ,Octave)\z
      P(x,j,Octave)\y=j*Pas
    Next j
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsVerticaux - 2) * Pow(2,SubdivisionEnCours) +1
      For j = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If j = IndiceMaxProvisoire - 1
          P(x,2 * j + 1,Octave)\y = HauteurEcran
          P(x,2 * j + 1,Octave)\z = P(x,IndiceMaxProvisoire,Octave)\z
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
          
        Else
          P(x,2 * j + 1,Octave)\y = P(x,j,Octave)\y + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j + 1,Octave)\z = P(x,j,Octave)\z + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\z - P(x,j,Octave)\z)
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
          
        EndIf
        
      Next j
      
      P(x,1,Octave)\y = P(x,0,Octave)\y + (1 - RapportSubdv) * (P(x,1,Octave)\y - P(x,0,Octave)\y)
      P(x,1,Octave)\z = P(x,0,Octave)\z + (1 - RapportSubdv) * (P(x,1,Octave)\z - P(x,0,Octave)\z)
      
      
      
    Next SubdivisionEnCours
    ;-calculs des équations affines de chaque segment
    
    y=0
    For j = 0  To IndiceMaxDesPtsDeCtrlVerticaux -1
      affine(P(x,j,Octave)\a,P(x,j,Octave)\b,P(x,j,Octave)\y,P(x,j,Octave)\z,P(x ,j+1,Octave)\y,P(x,j+1,Octave)\z)
      ;-remplissage du tableau carte(x,y,Octave)
      
      While y<=P(x,j+1,Octave)\y
        carte(x,y,Octave)\z=P(x,j,Octave)\a * y  + P(x,j,Octave)\b
        y=y+1
      Wend
    Next j
    
  Next x
  ;}
Next Octave
;-*************************************************
;-PROGRAMME PRINCIPAL
;-
;-************************************************
InitSprite()
InitKeyboard()
info$=">>INFOS: Pics "+ Str(#NbreInitialDePicsHorizontaux)+" * "+Str(#NbreInitialDePicsVerticaux)+"   Oct="+Str(#OctaveMax)+"  Subdv="+Str(#NbreDeSubdivisions)
OpenWindow(0,0,0,LargeurEcran,HauteurEcran,"Test Perlin 2D"+info$,#PB_Window_ScreenCentered|#PB_Window_SystemMenu  )
; OpenWindowedScreen(WindowID(0),0,0,LargeurEcran,HauteurEcran,0,0,0)

;-dessin de la carte
DiffuseColor = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)
Dim DiffuseColor.i(LargeurEcran,HauteurEcran)
StartDrawing(ImageOutput(DiffuseColor))

If #OctaveMax>1
  For Octave = 2 To #OctaveMax
    
    For x=0 To LargeurEcran
      For y=0 To HauteurEcran
        carte(x,y,1)\z=carte(x,y,1)\z+carte(x,y,Octave)\z
      Next y
    Next x
    
  Next Octave
EndIf

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z*10/FacteurNormalisation
    ;-choix des couleurs en fonction de z
    DiffuseColor(x,y )=couleur(composante)
    
    
  Next y
Next x
StopDrawing()

HeightMap = CreateImage(#PB_Any,LargeurEcran,HauteurEcran,32)
StartDrawing(ImageOutput(HeightMap))

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z/FacteurNormalisation
    Plot(x,y,RGB(Composante,Composante,Composante))
  Next y
Next x
StopDrawing()

OldSizeX = LargeurEcran
OldSizeY = HauteurEcran
ResizeImage(HeightMap,512,512)
NormalMap = CreateNormalMapFromImageID(HeightMap)
ResizeImage(HeightMap,OldSizeX ,OldSizeY )
ResizeImage(NormalMap,OldSizeX ,OldSizeY )


; Calcul de la lightmap
Dim Normal.VECTOR3(LargeurEcran,HauteurEcran)
  
StartDrawing(ImageOutput(NormalMap))
For y = 0 To ImageHeight(NormalMap) - 1 
  For x = 0 To ImageWidth(NormalMap) - 1
    Color = Point(x,y)
    Normal(x,y)\x=(Red(Color)/255)
    Normal(x,y)\y=(Green(Color)/255)
    Normal(x,y)\z=(Blue(Color)/255)
    normalize(Normal(x,y))
  Next 
Next 
StopDrawing()

  
sunColor = $FFFFFF
SunX=60000;30000
SunY=20000;10000
SunZ=60000;30000
lightmap = CreateImage(#PB_Any,ImageWidth(NormalMap), ImageHeight(NormalMap))
StartDrawing(ImageOutput(lightmap))
  

For z = 0 To ImageHeight(NormalMap) - 1
  For x = 0 To ImageWidth(NormalMap) - 1
    
    terrainHeight.f = carte(x,y,1)\z * 100
    
    terrainPixel.VECTOR3
    terrainPixel\x = x
    terrainPixel\y = terrainHeight
    terrainPixel\z = z
    
    SunDir.VECTOR3
    SunDir\x =  (SunX - terrainPixel\x)
    SunDir\y =  (SunY - terrainPixel\y)
    SunDir\z =  (SunZ - terrainPixel\z)
    Normalize(SunDir)
    
    
    tmp.f = DotProduct(SunDir,Normal(x,z))
    
    If tmp<0
      Col.f = -1 * tmp
    Else
      Col.f = tmp 
    EndIf 
    
    
    Red   = Red(DiffuseColor(x,z))   * Col
    Green = Green(DiffuseColor(x,z)) * Col
    Blue  = Blue(DiffuseColor(x,z))  * Col
    
    
    If Red>255  :Red=255  :EndIf
    If Green>255:Green=255:EndIf
    If Blue>255 :Blue=255 :EndIf
    
    Plot(x,z,RGB(Red,Green,Blue))
    
  Next
Next
  
StopDrawing()
  
  

;-BOUCLE PRINCIPALE
Repeat
   StartDrawing(WindowOutput(0))
  DrawImage(ImageID(lightmap),0,0)
  StopDrawing()
  Delay(10)
Until WindowEvent() = #PB_Event_CloseWindow
Elevé au MSX !
Haut
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Perlin et subdivisions, création de terrains

Message par G-Rom »

Je n'arrive toujours pas à sauvegarder en niveaux de gris
Ca ne marche pas non plus chez moi , tu n'as qu'a sauvegardé en RGB
puis à la lecture , tu additionnes toute les composantes que tu divises ensuite par 3 : Gris = ( R+G+B ) / 3

Prise en compte du niveau de la mer , ca pète un peu plus , reste plus que le shadow mapping ;)

Code : Tout sélectionner

;-@@@@@@@@@@@@@@@
;-Bruit de Perlin & Subdivisions
;Auteur Huitbit
;Grosse contribution G-Rom
;Avril 2011
;PureBasic 4.51 (Windows  -  x86)
;-@@@@@@@@@@@@@@@

;gradient de teintes multicolores quelconques
;{
Enumeration
  #EauxProfondes
  #EauxPeuProfondes
  #Sable
  #Herbe
  #Foret
  #BasseMontagne
  #HauteMontagne
  #Neige
EndEnumeration
;-index des teintes
IndexMaxDesTeintes.l=2550
#IndexRelatifEauxProfondes=0
#IndexRelatifEauxPeuProfondes=0.42
#IndexRelatifSable=0.44
#IndexRelatifHerbe=0.45
#IndexRelatifForet=0.54
#IndexRelatifBasseMontagne=0.65
#IndexRelatifHauteMontagne=0.70
#IndexRelatifNeige=1

Global x.l
Structure Teinte
  Rouge.c
  Vert.c
  Bleu.c
  Index.l
EndStructure

Macro TeinteDeReference(TypeDeTerrain,r,v,b,id);id valeur comprise entre 0 et 1 (0% et 100%)
Teinte(TypeDeTerrain)\Rouge=r
Teinte(TypeDeTerrain)\Vert=v
Teinte(TypeDeTerrain)\Bleu=b
Teinte(TypeDeTerrain)\Index = id*IndexMaxDesTeintes
EndMacro

Macro  Composante(comp)
ValeurComposanteTeinte(x,Teinte(TypeDeTerrain)\Index ,Teinte(TypeDeTerrain)\comp,Teinte(TypeDeTerrain+1)\Index ,Teinte(TypeDeTerrain+1)\comp)
EndMacro

Procedure.f ValeurComposanteTeinte(x.l,xA.f,Ya.f,xB.f,YB.f)
  ProcedureReturn yA + (yB - yA)/(xB - xA) * (x - xA)
EndProcedure

Global Dim Teinte.Teinte(IndexMaxDesTeintes)
Dim couleur.l(2550)
TeinteDeReference(#EauxProfondes,0,0,32,#IndexRelatifEauxProfondes)
TeinteDeReference(#EauxPeuProfondes,0,128,192,#IndexRelatifEauxPeuProfondes)
TeinteDeReference(#Sable,224,224,128,#IndexRelatifSable)
TeinteDeReference(#Herbe,0,192,0,#IndexRelatifHerbe)
TeinteDeReference(#Foret,0,92,0,#IndexRelatifForet)
TeinteDeReference(#BasseMontagne,120,120,68,#IndexRelatifBasseMontagne)
TeinteDeReference(#HauteMontagne,200, 193, 178,#IndexRelatifHauteMontagne)
TeinteDeReference(#Neige,255,255,255,#IndexRelatifNeige)


For x=0 To IndexMaxDesTeintes
 
  Select x
    Case Teinte(#EauxProfondes)\Index
      TypeDeTerrain=#EauxProfondes
    Case Teinte(#EauxPeuProfondes)\Index
      TypeDeTerrain=#EauxPeuProfondes
    Case Teinte(#Sable)\Index
      TypeDeTerrain=#Sable
    Case Teinte(#Herbe)\Index
      TypeDeTerrain=#Herbe
    Case Teinte(#Foret)\Index
      TypeDeTerrain=#Foret
    Case Teinte(#BasseMontagne)\Index
      TypeDeTerrain=#BasseMontagne
    Case Teinte(#HauteMontagne)\Index
      TypeDeTerrain=#HauteMontagne
  EndSelect
 
  couleur(x)=RGB(Composante(Rouge),Composante(Vert),Composante(Bleu))
Next x
;}

;-Déclarations
Structure VECTOR3
  x.f :  y.f : z.f
EndStructure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro SetVector3(V,_x,_y,_z)
V\x=_x
V\y=_y
V\z=_z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro VectorLength(V)
(V\x*V\x + V\y*V\y + V\z*V\z)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro Normalize(V)
l.f = VectorLength(V)
If (l <> 0)
  l =  Sqr(l)
  V\x / l
  V\y / l
  V\z / l
EndIf
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro DotProduct(A,B)
A\X * B\X + A\Y * B\Y + A\Z * B\Z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CrossProduct(A,B,C)
C\x = (A\y * B\z) - (A\z * B\y)
C\y = (A\z * B\x) - (A\x * B\z)
C\z = (A\x * B\y) - (A\y * B\x)
EndMacro           
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Min(a.d,b.d)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Max(a.d,b.d)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
; ----------------------------------------------------------------------------------------------------------------
;-SOBEL FILTER DEF
; ----------------------------------------------------------------------------------------------------------------
Global *SobelX.b = AllocateMemory(9)
Global *SobelY.b = AllocateMemory(9)

PokeB(*SobelX  ,-1) : PokeB(*SobelX+1,-2) : PokeB(*SobelX+2,-1)
PokeB(*SobelX+3, 0) : PokeB(*SobelX+4, 0) : PokeB(*SobelX+5, 0)
PokeB(*SobelX+6, 1) : PokeB(*SobelX+7, 2) : PokeB(*SobelX+8, 1)

PokeB(*SobelY  ,-1) : PokeB(*SobelY+1, 0) : PokeB(*SobelY+2, 1)
PokeB(*SobelY+3,-2) : PokeB(*SobelY+4, 0) : PokeB(*SobelY+5, 2)
PokeB(*SobelY+6,-1) : PokeB(*SobelY+7, 0) : PokeB(*SobelY+8, 1)

; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i PutImageOnBuffer(ImageID)
  *Memory.i = AllocateMemory(  ImageWidth(ImageID) * ImageHeight(ImageID) * 4 )
  StartDrawing(ImageOutput(ImageID))
  For x = 0 To ImageWidth(ImageID)-1
    For y = 0 To ImageHeight(ImageID)-1
      Color = Point(x,y) 
      r=Red(Color)
      g=Green(Color)
      b=Blue(Color)
      gray = (r+b+g) / 3
      Color = RGB(gray,gray,gray) 
      PokeI(*Memory + (x*4) +  ImageWidth(ImageID) * (y*4),Color)
    Next
  Next
  StopDrawing()
  ProcedureReturn *Memory
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro GetPixelBuffer(Memory,w,x,y)
PeekI(Memory + (x*4) + w * (y*4))
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro PutPixelBuffer(Memory,w,x,y,pixel)
PokeI(Memory + (x*4) + w * (y*4),pixel)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CharToByte(Char)
Char/255.0
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro ByteToChar(Byte)
Byte*255
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i GetGrayLevel(*Buffer,w,x,y)
  Color = PeekI(*Buffer + (x*4) + w * (y*4))
  Red     = Color >> 0  & $000000FF
  Green   = Color >> 8  & $000000FF
  Blue    = Color >> 16 & $000000FF
  Gray = (Red+Green+Blue)/3
  ProcedureReturn Gray
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i Conv3x3(*Buffer.i,w.i,h.i,*Sobel.i,Threshold)
  *Gradient.i = AllocateMemory(w*h*4)
  If *Gradient
    For y = 1 To w-2
      For x = 1 To h-2
        Gradient_Value.f = (CharToByte(GetGrayLevel(*Buffer,w,x-1,y-1) * PeekB(*Sobel  ))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y-1) * PeekB(*Sobel+1))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y-1) * PeekB(*Sobel+2))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y  ) * PeekB(*Sobel+3))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y  ) * PeekB(*Sobel+4))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y  ) * PeekB(*Sobel+5))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y+1) * PeekB(*Sobel+6))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y+1) * PeekB(*Sobel+7))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y+1) * PeekB(*Sobel+8)))
        PokeF(*Gradient + (x*4) + w * (y*4),Gradient_Value*Threshold)
      Next
    Next
  EndIf
  ProcedureReturn *Gradient
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure Map0_to_255(*V.VECTOR3)
  *V\x = max(-256,*V\x)
  *V\y = max(-256,*V\y)
  *V\z = max(-256,*V\z)
  *V\x = min(256,*V\x)
  *V\y = min(256,*V\y)
  *V\z = min(256,*V\z)
  *V\x =*V\x/2 + 127
  *V\y =*V\y/2 + 127
  *V\z =*V\z/2 + 127
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i CreateNormalMapFromImageID(ImageID,Threshold=5)
  Protected *Buffer.i,*GradientX.i,*GradientY.i,NewImage.i
 
  *Buffer     = PutImageOnBuffer(ImageID)
  *GradientX  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelX,Threshold)
  *GradientY  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelY,Threshold)
 
 
  NewImage = CreateImage(#PB_Any,ImageWidth(ImageID),ImageHeight(ImageID))
  StartDrawing(ImageOutput(NewImage))
  For y = 0 To ImageHeight(NewImage)-1
    For x = 0 To ImageWidth(NewImage)-1
     
      V.VECTOR3
      GrdX.f = PeekF(*GradientX + (x*4) + ImageWidth(ImageID) * (y*4))
      GrdY.f = PeekF(*GradientY + (x*4) + ImageWidth(ImageID) * (y*4))
      SetVector3(V,GrdX,GrdY,0.1)
      Normalize(V)
     
      Color.VECTOR3
      SetVector3(Color,ByteToChar(V\x),ByteToChar(V\y),ByteToChar(V\z))
      Map0_to_255(Color)
      Plot(x,y,RGB(Color\x,Color\y,Color\z))
     
    Next
  Next   
  StopDrawing()
 
 
  ProcedureReturn NewImage
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------

#PasInitial =128
#NbreInitialDePicsHorizontaux =6
#NbreInitialDePicsVerticaux =6
#OctaveMax = 5; de l'octave n°1 à #OctaveMax
#Persistance = 0.55
Octave.b
Persistance.f
FacteurNormalisation.f =(1 - Pow(#Persistance,#OctaveMax)) / (1 - #Persistance)
Composante.w
Pas.l
NbreDePicsHorizontaux.l
NbreDePicsVerticaux.l
NbreMaxDePicsHorizontaux.l = #NbreInitialDePicsHorizontaux * Pow(2 , #OctaveMax - 1)
NbreMaxDePicsVerticaux.l = #NbreInitialDePicsVerticaux * Pow(2 , #OctaveMax - 1)
PasMinimal.l = #PasInitial / Pow(2 , #OctaveMax - 1)
LargeurEcran.l = NbreMaxDePicsHorizontaux  * PasMinimal
HauteurEcran.l = NbreMaxDePicsVerticaux  * PasMinimal
#NbreDeSubdivisions = 3
RapportSubdv.f = 0.25
IndiceMaxDesPtsDeCtrlHorizontaux.l = (NbreMaxDePicsHorizontaux - 2) * Pow(2,#NbreDeSubdivisions) +1
IndiceMaxDesPtsDeCtrlVerticaux.l = (NbreMaxDePicsVerticaux - 2) * Pow(2,#NbreDeSubdivisions) + 1
IndiceDesPtsDeCtrlHorizontaux.l
IndiceDesPtsDeCtrlVerticaux.l

Structure PtDeCtrl
  x.l
  y.l ; y  =  a  *  x  + b
  z.l
  a.f ; pente
  b.f ; ordonnée à l'origine
EndStructure

Structure Carte
  z.w
EndStructure

Macro affine(a,b,uA,zA,uB,zB)
If (uB-uA)<>0
  a = (zB - zA) / (uB - uA)
  b = zB - a * uB
EndIf
EndMacro

;tableau des points de contrôle
Dim P.PtDeCtrl(LargeurEcran , IndiceMaxDesPtsDeCtrlVerticaux , #OctaveMax)

Dim carte.Carte(LargeurEcran,HauteurEcran,#OctaveMax)

;-Remplissage du tableau  de points de contrôle avec des pics de Perlin
For Octave = 1 To #OctaveMax
  Pas = #PasInitial / Pow(2 , Octave - 1)
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  Persistance =  Pow(#Persistance , Octave - 1)
  For i = 0 To NbreDePicsHorizontaux -1
    For j = 0 To NbreDePicsVerticaux -1
      P(i  , j , Octave)\x = i * Pas
      P(i  , j , Octave)\y = j * Pas
      P(i  , j , Octave)\z = Persistance * Random(255)
     
    Next j
  Next i
Next Octave

  ;-Subdivisions
For Octave = 1 To #OctaveMax
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  IndiceDesPtsDeCtrlHorizontaux = NbreDePicsHorizontaux - 1
  IndiceDesPtsDeCtrlVerticaux = NbreDePicsVerticaux - 1
  Pas = #PasInitial / Pow(2 , Octave - 1)
  ;- Création des lignes de contrôle horizontales pour chaque octave
  ;Utilisation du tableau P(i,j,Octave) pour i allant de i=0 Ã  i=NbreDePicsHorizontauxProvisoire
  ;l'utilisation de i=x=0 à  i=x=LargeurEcran se fera dans la deuxième partie
  ;{
 
  For j = 0 To IndiceDesPtsDeCtrlVerticaux
   
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsHorizontaux - 2) * Pow(2,SubdivisionEnCours) +1
     
      For i = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If i = IndiceMaxProvisoire - 1
          P(2 * i + 1,j,Octave)\x = LargeurEcran
          P(2 * i + 1,j,Octave)\z = P(IndiceMaxProvisoire,j,Octave)\z
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
         
        Else
          P(2 * i + 1,j,Octave)\x = P(i,j,Octave)\x + (1 - RapportSubdv) * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i + 1,j,Octave)\z = P(i,j,Octave)\z + (1 - RapportSubdv) * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
        EndIf
       
      Next i
     
      P(1,j,Octave)\x = P(0,j,Octave)\x + (1 - RapportSubdv) * (P(1,j,Octave)\x - P(0,j,Octave)\x)
      P(1,j,Octave)\z = P(0,j,Octave)\z + (1 - RapportSubdv) * (P(1,j,Octave)\z - P(0,j,Octave)\z)
     
    Next SubdivisionEnCours
   
    ;-calculs des équations affines de chaque segment
    x=0
    For i = 0  To IndiceMaxDesPtsDeCtrlHorizontaux -1
      affine(P(i,j,Octave)\a,P(i,j,Octave)\b,P(i,j,Octave)\x,P(i,j,Octave)\z,P(i + 1,j,Octave)\x,P(i + 1,j,Octave)\z)
     
      ;-remplissage du tableau carte(x,y,Octave)
     
      While x<=P(i+1,j,Octave)\x
        carte(x,j*Pas,Octave)\z=P(i,j,Octave)\a * x  + P(i,j,Octave)\b
        x=x+1
      Wend
    Next i
   
  Next j
 
 
  ;}
  ;-subdivisions selon y, les points de contrôles sont issus des lignes de contrôle horizontales
  ;{
  For x=0 To LargeurEcran
    ;Chargement des points de contrôle d'abscisse x
    For j = 0 To IndiceDesPtsDeCtrlVerticaux
      P(x,j,Octave)\z= carte(x,j*Pas ,Octave)\z
      P(x,j,Octave)\y=j*Pas
    Next j
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsVerticaux - 2) * Pow(2,SubdivisionEnCours) +1
      For j = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If j = IndiceMaxProvisoire - 1
          P(x,2 * j + 1,Octave)\y = HauteurEcran
          P(x,2 * j + 1,Octave)\z = P(x,IndiceMaxProvisoire,Octave)\z
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
         
        Else
          P(x,2 * j + 1,Octave)\y = P(x,j,Octave)\y + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j + 1,Octave)\z = P(x,j,Octave)\z + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\z - P(x,j,Octave)\z)
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
         
        EndIf
       
      Next j
     
      P(x,1,Octave)\y = P(x,0,Octave)\y + (1 - RapportSubdv) * (P(x,1,Octave)\y - P(x,0,Octave)\y)
      P(x,1,Octave)\z = P(x,0,Octave)\z + (1 - RapportSubdv) * (P(x,1,Octave)\z - P(x,0,Octave)\z)
     
     
     
    Next SubdivisionEnCours
    ;-calculs des équations affines de chaque segment
   
    y=0
    For j = 0  To IndiceMaxDesPtsDeCtrlVerticaux -1
      affine(P(x,j,Octave)\a,P(x,j,Octave)\b,P(x,j,Octave)\y,P(x,j,Octave)\z,P(x ,j+1,Octave)\y,P(x,j+1,Octave)\z)
      ;-remplissage du tableau carte(x,y,Octave)
     
      While y<=P(x,j+1,Octave)\y
        carte(x,y,Octave)\z=P(x,j,Octave)\a * y  + P(x,j,Octave)\b
        y=y+1
      Wend
    Next j
   
  Next x
  ;}
Next Octave

;-dessin de la carte
DiffuseColor = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)
Dim DiffuseColor.i(LargeurEcran,HauteurEcran)
StartDrawing(ImageOutput(DiffuseColor))

If #OctaveMax>1
  For Octave = 2 To #OctaveMax
   
    For x=0 To LargeurEcran
      For y=0 To HauteurEcran
        carte(x,y,1)\z=carte(x,y,1)\z+carte(x,y,Octave)\z
      Next y
    Next x
   
  Next Octave
EndIf

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z*10/FacteurNormalisation
    ;-choix des couleurs en fonction de z
    DiffuseColor(x,y )=couleur(composante)
   
   
  Next y
Next x
StopDrawing()

HeightMap = CreateImage(#PB_Any,LargeurEcran,HauteurEcran,32)
StartDrawing(ImageOutput(HeightMap))

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z/FacteurNormalisation
    If Composante < #IndexRelatifEauxPeuProfondes * 255
      Composante = #IndexRelatifEauxPeuProfondes * 255
    EndIf 
    Plot(x,y,RGB(Composante,Composante,Composante))
  Next y
Next x
StopDrawing()

OldSizeX = LargeurEcran
OldSizeY = HauteurEcran
ResizeImage(HeightMap,512,512)
NormalMap = CreateNormalMapFromImageID(HeightMap)
ResizeImage(HeightMap,OldSizeX ,OldSizeY )
ResizeImage(NormalMap,OldSizeX ,OldSizeY )


; Calcul de la lightmap
Dim Normal.VECTOR3(LargeurEcran,HauteurEcran)
 
StartDrawing(ImageOutput(NormalMap))
For y = 0 To ImageHeight(NormalMap) - 1
  For x = 0 To ImageWidth(NormalMap) - 1
    Color = Point(x,y)
    Normal(x,y)\x=(Red(Color)/255)
    Normal(x,y)\y=(Green(Color)/255)
    Normal(x,y)\z=(Blue(Color)/255)
    normalize(Normal(x,y))
  Next
Next
StopDrawing()

 
sunColor = $FFFFFF
SunX=60000;30000
SunY=20000;10000
SunZ=60000;30000
lightmap = CreateImage(#PB_Any,ImageWidth(NormalMap), ImageHeight(NormalMap))
StartDrawing(ImageOutput(lightmap))
 

For z = 0 To ImageHeight(NormalMap) - 1
  For x = 0 To ImageWidth(NormalMap) - 1
   
    terrainHeight.f = carte(x,y,1)\z * 100
   
    terrainPixel.VECTOR3
    terrainPixel\x = x
    terrainPixel\y = terrainHeight
    terrainPixel\z = z
   
    SunDir.VECTOR3
    SunDir\x =  (SunX - terrainPixel\x)
    SunDir\y =  (SunY - terrainPixel\y)
    SunDir\z =  (SunZ - terrainPixel\z)
    Normalize(SunDir)
   
   
    tmp.f = DotProduct(SunDir,Normal(x,z))
   
    If tmp<0
      Col.f = -1 * tmp
    Else
      Col.f = tmp
    EndIf
   
   
    Red   = Red(DiffuseColor(x,z))   * Col
    Green = Green(DiffuseColor(x,z)) * Col
    Blue  = Blue(DiffuseColor(x,z))  * Col
   
   
    If Red>255  :Red=255  :EndIf
    If Green>255:Green=255:EndIf
    If Blue>255 :Blue=255 :EndIf
   
    Plot(x,z,RGB(Red,Green,Blue))
   
  Next
Next
 
StopDrawing()


;-*************************************************
;-PROGRAMME PRINCIPAL
;-
;-************************************************
InitSprite()
InitKeyboard()
info$=">>INFOS: Pics "+ Str(#NbreInitialDePicsHorizontaux)+" * "+Str(#NbreInitialDePicsVerticaux)+"   Oct="+Str(#OctaveMax)+"  Subdv="+Str(#NbreDeSubdivisions)
OpenWindow(0,0,0,LargeurEcran,HauteurEcran,"Test Perlin 2D"+info$,#PB_Window_ScreenCentered|#PB_Window_SystemMenu  )
Panel = PanelGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran)
AddGadgetItem(Panel,-1,"Heightmap + DiffuseMap + LightMap")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(lightmap))
AddGadgetItem(Panel,-1,"heightmap")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(heightmap))
AddGadgetItem(Panel,-1,"normal map")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(NormalMap))



;-BOUCLE PRINCIPALE
Repeat
;    StartDrawing(WindowOutput(0))
;   DrawImage(ImageID(lightmap),0,0)
;   StopDrawing()
  Delay(10)
Until WindowEvent() = #PB_Event_CloseWindow
Haut
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Perlin et subdivisions, création de terrains

Message par G-Rom »

Petit bonus avant d'aller au dodo scié des bûches, le rendu isométrique :

Image

Code : Tout sélectionner

;-@@@@@@@@@@@@@@@
;-Bruit de Perlin & Subdivisions
;Auteur Huitbit
;Grosse contribution G-Rom
;Avril 2011
;PureBasic 4.51 (Windows  -  x86)
;-@@@@@@@@@@@@@@@

;gradient de teintes multicolores quelconques
;{
Enumeration
  #EauxProfondes
  #EauxPeuProfondes
  #Sable
  #Herbe
  #Foret
  #BasseMontagne
  #HauteMontagne
  #Neige
EndEnumeration
;-index des teintes
IndexMaxDesTeintes.l=2550
#IndexRelatifEauxProfondes=0
#IndexRelatifEauxPeuProfondes=0.42
#IndexRelatifSable=0.44
#IndexRelatifHerbe=0.45
#IndexRelatifForet=0.54
#IndexRelatifBasseMontagne=0.65
#IndexRelatifHauteMontagne=0.70
#IndexRelatifNeige=1

Global x.l
Structure Teinte
  Rouge.c
  Vert.c
  Bleu.c
  Index.l
EndStructure

Macro TeinteDeReference(TypeDeTerrain,r,v,b,id);id valeur comprise entre 0 et 1 (0% et 100%)
Teinte(TypeDeTerrain)\Rouge=r
Teinte(TypeDeTerrain)\Vert=v
Teinte(TypeDeTerrain)\Bleu=b
Teinte(TypeDeTerrain)\Index = id*IndexMaxDesTeintes
EndMacro

Macro  Composante(comp)
ValeurComposanteTeinte(x,Teinte(TypeDeTerrain)\Index ,Teinte(TypeDeTerrain)\comp,Teinte(TypeDeTerrain+1)\Index ,Teinte(TypeDeTerrain+1)\comp)
EndMacro

Procedure.f ValeurComposanteTeinte(x.l,xA.f,Ya.f,xB.f,YB.f)
  ProcedureReturn yA + (yB - yA)/(xB - xA) * (x - xA)
EndProcedure

Global Dim Teinte.Teinte(IndexMaxDesTeintes)
Dim couleur.l(2550)
TeinteDeReference(#EauxProfondes,0,0,32,#IndexRelatifEauxProfondes)
TeinteDeReference(#EauxPeuProfondes,0,128,192,#IndexRelatifEauxPeuProfondes)
TeinteDeReference(#Sable,224,224,128,#IndexRelatifSable)
TeinteDeReference(#Herbe,0,192,0,#IndexRelatifHerbe)
TeinteDeReference(#Foret,0,92,0,#IndexRelatifForet)
TeinteDeReference(#BasseMontagne,120,120,68,#IndexRelatifBasseMontagne)
TeinteDeReference(#HauteMontagne,200, 193, 178,#IndexRelatifHauteMontagne)
TeinteDeReference(#Neige,255,255,255,#IndexRelatifNeige)


For x=0 To IndexMaxDesTeintes

  Select x
    Case Teinte(#EauxProfondes)\Index
      TypeDeTerrain=#EauxProfondes
    Case Teinte(#EauxPeuProfondes)\Index
      TypeDeTerrain=#EauxPeuProfondes
    Case Teinte(#Sable)\Index
      TypeDeTerrain=#Sable
    Case Teinte(#Herbe)\Index
      TypeDeTerrain=#Herbe
    Case Teinte(#Foret)\Index
      TypeDeTerrain=#Foret
    Case Teinte(#BasseMontagne)\Index
      TypeDeTerrain=#BasseMontagne
    Case Teinte(#HauteMontagne)\Index
      TypeDeTerrain=#HauteMontagne
  EndSelect

  couleur(x)=RGB(Composante(Rouge),Composante(Vert),Composante(Bleu))
Next x
;}

;-Déclarations
Structure VECTOR3
  x.f :  y.f : z.f
EndStructure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro SetVector3(V,_x,_y,_z)
V\x=_x
V\y=_y
V\z=_z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro VectorLength(V)
(V\x*V\x + V\y*V\y + V\z*V\z)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro Normalize(V)
l.f = VectorLength(V)
If (l <> 0)
  l =  Sqr(l)
  V\x / l
  V\y / l
  V\z / l
EndIf
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro DotProduct(A,B)
A\X * B\X + A\Y * B\Y + A\Z * B\Z
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CrossProduct(A,B,C)
C\x = (A\y * B\z) - (A\z * B\y)
C\y = (A\z * B\x) - (A\x * B\z)
C\z = (A\x * B\y) - (A\y * B\x)
EndMacro           
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Min(a.d,b.d)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.d Max(a.d,b.d)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
; ----------------------------------------------------------------------------------------------------------------
;-SOBEL FILTER DEF
; ----------------------------------------------------------------------------------------------------------------
Global *SobelX.b = AllocateMemory(9)
Global *SobelY.b = AllocateMemory(9)

PokeB(*SobelX  ,-1) : PokeB(*SobelX+1,-2) : PokeB(*SobelX+2,-1)
PokeB(*SobelX+3, 0) : PokeB(*SobelX+4, 0) : PokeB(*SobelX+5, 0)
PokeB(*SobelX+6, 1) : PokeB(*SobelX+7, 2) : PokeB(*SobelX+8, 1)

PokeB(*SobelY  ,-1) : PokeB(*SobelY+1, 0) : PokeB(*SobelY+2, 1)
PokeB(*SobelY+3,-2) : PokeB(*SobelY+4, 0) : PokeB(*SobelY+5, 2)
PokeB(*SobelY+6,-1) : PokeB(*SobelY+7, 0) : PokeB(*SobelY+8, 1)

; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i PutImageOnBuffer(ImageID)
  *Memory.i = AllocateMemory(  ImageWidth(ImageID) * ImageHeight(ImageID) * 4 )
  StartDrawing(ImageOutput(ImageID))
  For x = 0 To ImageWidth(ImageID)-1
    For y = 0 To ImageHeight(ImageID)-1
      Color = Point(x,y)
      r=Red(Color)
      g=Green(Color)
      b=Blue(Color)
      gray = (r+b+g) / 3
      Color = RGB(gray,gray,gray)
      PokeI(*Memory + (x*4) +  ImageWidth(ImageID) * (y*4),Color)
    Next
  Next
  StopDrawing()
  ProcedureReturn *Memory
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro GetPixelBuffer(Memory,w,x,y)
PeekI(Memory + (x*4) + w * (y*4))
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro PutPixelBuffer(Memory,w,x,y,pixel)
PokeI(Memory + (x*4) + w * (y*4),pixel)
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro CharToByte(Char)
Char/255.0
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Macro ByteToChar(Byte)
Byte*255
EndMacro
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i GetGrayLevel(*Buffer,w,x,y)
  Color = PeekI(*Buffer + (x*4) + w * (y*4))
  Red     = Color >> 0  & $000000FF
  Green   = Color >> 8  & $000000FF
  Blue    = Color >> 16 & $000000FF
  Gray = (Red+Green+Blue)/3
  ProcedureReturn Gray
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i Conv3x3(*Buffer.i,w.i,h.i,*Sobel.i,Threshold)
  *Gradient.i = AllocateMemory(w*h*4)
  If *Gradient
    For y = 1 To w-2
      For x = 1 To h-2
        Gradient_Value.f = (CharToByte(GetGrayLevel(*Buffer,w,x-1,y-1) * PeekB(*Sobel  ))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y-1) * PeekB(*Sobel+1))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y-1) * PeekB(*Sobel+2))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y  ) * PeekB(*Sobel+3))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y  ) * PeekB(*Sobel+4))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y  ) * PeekB(*Sobel+5))) +  (CharToByte(GetGrayLevel(*Buffer,w,x-1,y+1) * PeekB(*Sobel+6))) +  (CharToByte(GetGrayLevel(*Buffer,w,x  ,y+1) * PeekB(*Sobel+7))) +  (CharToByte(GetGrayLevel(*Buffer,w,x+1,y+1) * PeekB(*Sobel+8)))
        PokeF(*Gradient + (x*4) + w * (y*4),Gradient_Value*Threshold)
      Next
    Next
  EndIf
  ProcedureReturn *Gradient
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure Map0_to_255(*V.VECTOR3)
  *V\x = max(-256,*V\x)
  *V\y = max(-256,*V\y)
  *V\z = max(-256,*V\z)
  *V\x = min(256,*V\x)
  *V\y = min(256,*V\y)
  *V\z = min(256,*V\z)
  *V\x =*V\x/2 + 127
  *V\y =*V\y/2 + 127
  *V\z =*V\z/2 + 127
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------
Procedure.i CreateNormalMapFromImageID(ImageID,Threshold=5)
  Protected *Buffer.i,*GradientX.i,*GradientY.i,NewImage.i

  *Buffer     = PutImageOnBuffer(ImageID)
  *GradientX  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelX,Threshold)
  *GradientY  = Conv3x3(*Buffer,ImageWidth(ImageID),ImageHeight(ImageID),*SobelY,Threshold)


  NewImage = CreateImage(#PB_Any,ImageWidth(ImageID),ImageHeight(ImageID))
  StartDrawing(ImageOutput(NewImage))
  For y = 0 To ImageHeight(NewImage)-1
    For x = 0 To ImageWidth(NewImage)-1
     
      V.VECTOR3
      GrdX.f = PeekF(*GradientX + (x*4) + ImageWidth(ImageID) * (y*4))
      GrdY.f = PeekF(*GradientY + (x*4) + ImageWidth(ImageID) * (y*4))
      SetVector3(V,GrdX,GrdY,0.1)
      Normalize(V)
     
      Color.VECTOR3
      SetVector3(Color,ByteToChar(V\x),ByteToChar(V\y),ByteToChar(V\z))
      Map0_to_255(Color)
      Plot(x,y,RGB(Color\x,Color\y,Color\z))
     
    Next
  Next   
  StopDrawing()


  ProcedureReturn NewImage
EndProcedure
; ----------------------------------------------------------------------------------------------------------------
;
; ----------------------------------------------------------------------------------------------------------------

#PasInitial =128
#NbreInitialDePicsHorizontaux =6
#NbreInitialDePicsVerticaux =6
#OctaveMax = 5; de l'octave n°1 à #OctaveMax
#Persistance = 0.55
Octave.b
Persistance.f
FacteurNormalisation.f =(1 - Pow(#Persistance,#OctaveMax)) / (1 - #Persistance)
Composante.w
Pas.l
NbreDePicsHorizontaux.l
NbreDePicsVerticaux.l
NbreMaxDePicsHorizontaux.l = #NbreInitialDePicsHorizontaux * Pow(2 , #OctaveMax - 1)
NbreMaxDePicsVerticaux.l = #NbreInitialDePicsVerticaux * Pow(2 , #OctaveMax - 1)
PasMinimal.l = #PasInitial / Pow(2 , #OctaveMax - 1)
LargeurEcran.l = NbreMaxDePicsHorizontaux  * PasMinimal
HauteurEcran.l = NbreMaxDePicsVerticaux  * PasMinimal
#NbreDeSubdivisions = 3
RapportSubdv.f = 0.25
IndiceMaxDesPtsDeCtrlHorizontaux.l = (NbreMaxDePicsHorizontaux - 2) * Pow(2,#NbreDeSubdivisions) +1
IndiceMaxDesPtsDeCtrlVerticaux.l = (NbreMaxDePicsVerticaux - 2) * Pow(2,#NbreDeSubdivisions) + 1
IndiceDesPtsDeCtrlHorizontaux.l
IndiceDesPtsDeCtrlVerticaux.l

Structure PtDeCtrl
  x.l
  y.l ; y  =  a  *  x  + b
  z.l
  a.f ; pente
  b.f ; ordonnée à l'origine
EndStructure

Structure Carte
  z.w
EndStructure

Macro affine(a,b,uA,zA,uB,zB)
If (uB-uA)<>0
  a = (zB - zA) / (uB - uA)
  b = zB - a * uB
EndIf
EndMacro

;tableau des points de contrôle
Dim P.PtDeCtrl(LargeurEcran , IndiceMaxDesPtsDeCtrlVerticaux , #OctaveMax)

Dim carte.Carte(LargeurEcran,HauteurEcran,#OctaveMax)

;-Remplissage du tableau  de points de contrôle avec des pics de Perlin
For Octave = 1 To #OctaveMax
  Pas = #PasInitial / Pow(2 , Octave - 1)
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  Persistance =  Pow(#Persistance , Octave - 1)
  For i = 0 To NbreDePicsHorizontaux -1
    For j = 0 To NbreDePicsVerticaux -1
      P(i  , j , Octave)\x = i * Pas
      P(i  , j , Octave)\y = j * Pas
      P(i  , j , Octave)\z = Persistance * Random(255)
     
    Next j
  Next i
Next Octave

  ;-Subdivisions
For Octave = 1 To #OctaveMax
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  IndiceDesPtsDeCtrlHorizontaux = NbreDePicsHorizontaux - 1
  IndiceDesPtsDeCtrlVerticaux = NbreDePicsVerticaux - 1
  Pas = #PasInitial / Pow(2 , Octave - 1)
  ;- Création des lignes de contrôle horizontales pour chaque octave
  ;Utilisation du tableau P(i,j,Octave) pour i allant de i=0 Ã  i=NbreDePicsHorizontauxProvisoire
  ;l'utilisation de i=x=0 à  i=x=LargeurEcran se fera dans la deuxième partie
  ;{

  For j = 0 To IndiceDesPtsDeCtrlVerticaux
   
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsHorizontaux - 2) * Pow(2,SubdivisionEnCours) +1
     
      For i = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If i = IndiceMaxProvisoire - 1
          P(2 * i + 1,j,Octave)\x = LargeurEcran
          P(2 * i + 1,j,Octave)\z = P(IndiceMaxProvisoire,j,Octave)\z
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
         
        Else
          P(2 * i + 1,j,Octave)\x = P(i,j,Octave)\x + (1 - RapportSubdv) * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i + 1,j,Octave)\z = P(i,j,Octave)\z + (1 - RapportSubdv) * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
        EndIf
       
      Next i
     
      P(1,j,Octave)\x = P(0,j,Octave)\x + (1 - RapportSubdv) * (P(1,j,Octave)\x - P(0,j,Octave)\x)
      P(1,j,Octave)\z = P(0,j,Octave)\z + (1 - RapportSubdv) * (P(1,j,Octave)\z - P(0,j,Octave)\z)
     
    Next SubdivisionEnCours
   
    ;-calculs des équations affines de chaque segment
    x=0
    For i = 0  To IndiceMaxDesPtsDeCtrlHorizontaux -1
      affine(P(i,j,Octave)\a,P(i,j,Octave)\b,P(i,j,Octave)\x,P(i,j,Octave)\z,P(i + 1,j,Octave)\x,P(i + 1,j,Octave)\z)
     
      ;-remplissage du tableau carte(x,y,Octave)
     
      While x<=P(i+1,j,Octave)\x
        carte(x,j*Pas,Octave)\z=P(i,j,Octave)\a * x  + P(i,j,Octave)\b
        x=x+1
      Wend
    Next i
   
  Next j


  ;}
  ;-subdivisions selon y, les points de contrôles sont issus des lignes de contrôle horizontales
  ;{
  For x=0 To LargeurEcran
    ;Chargement des points de contrôle d'abscisse x
    For j = 0 To IndiceDesPtsDeCtrlVerticaux
      P(x,j,Octave)\z= carte(x,j*Pas ,Octave)\z
      P(x,j,Octave)\y=j*Pas
    Next j
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsVerticaux - 2) * Pow(2,SubdivisionEnCours) +1
      For j = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If j = IndiceMaxProvisoire - 1
          P(x,2 * j + 1,Octave)\y = HauteurEcran
          P(x,2 * j + 1,Octave)\z = P(x,IndiceMaxProvisoire,Octave)\z
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
         
        Else
          P(x,2 * j + 1,Octave)\y = P(x,j,Octave)\y + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j + 1,Octave)\z = P(x,j,Octave)\z + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\z - P(x,j,Octave)\z)
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
         
        EndIf
       
      Next j
     
      P(x,1,Octave)\y = P(x,0,Octave)\y + (1 - RapportSubdv) * (P(x,1,Octave)\y - P(x,0,Octave)\y)
      P(x,1,Octave)\z = P(x,0,Octave)\z + (1 - RapportSubdv) * (P(x,1,Octave)\z - P(x,0,Octave)\z)
     
     
     
    Next SubdivisionEnCours
    ;-calculs des équations affines de chaque segment
   
    y=0
    For j = 0  To IndiceMaxDesPtsDeCtrlVerticaux -1
      affine(P(x,j,Octave)\a,P(x,j,Octave)\b,P(x,j,Octave)\y,P(x,j,Octave)\z,P(x ,j+1,Octave)\y,P(x,j+1,Octave)\z)
      ;-remplissage du tableau carte(x,y,Octave)
     
      While y<=P(x,j+1,Octave)\y
        carte(x,y,Octave)\z=P(x,j,Octave)\a * y  + P(x,j,Octave)\b
        y=y+1
      Wend
    Next j
   
  Next x
  ;}
Next Octave

;-dessin de la carte
DiffuseColor = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)
Dim DiffuseColor.i(LargeurEcran,HauteurEcran)
StartDrawing(ImageOutput(DiffuseColor))

If #OctaveMax>1
  For Octave = 2 To #OctaveMax
   
    For x=0 To LargeurEcran
      For y=0 To HauteurEcran
        carte(x,y,1)\z=carte(x,y,1)\z+carte(x,y,Octave)\z
      Next y
    Next x
   
  Next Octave
EndIf

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z*10/FacteurNormalisation
    ;-choix des couleurs en fonction de z
    DiffuseColor(x,y )=couleur(composante)
  Next y
Next x
StopDrawing()

HeightMap = CreateImage(#PB_Any,LargeurEcran,HauteurEcran,32)
Dim HeightMapColor(LargeurEcran,HauteurEcran)
StartDrawing(ImageOutput(HeightMap))

For x=0 To LargeurEcran-1
  For y=0 To HauteurEcran-1
    Composante=carte(x,y,1)\z/FacteurNormalisation
    If Composante < #IndexRelatifEauxPeuProfondes * 255
      Composante = #IndexRelatifEauxPeuProfondes * 255
    EndIf
    Plot(x,y,RGB(Composante,Composante,Composante))
    HeightMapColor(x,y) = RGB(Composante,Composante,Composante)
  Next y
Next x
StopDrawing()

OldSizeX = LargeurEcran
OldSizeY = HauteurEcran
ResizeImage(HeightMap,512,512)
NormalMap = CreateNormalMapFromImageID(HeightMap)
ResizeImage(HeightMap,OldSizeX ,OldSizeY )
ResizeImage(NormalMap,OldSizeX ,OldSizeY )


; Calcul de la lightmap
Dim Normal.VECTOR3(LargeurEcran,HauteurEcran)
Dim NormalColor(LargeurEcran,HauteurEcran)

StartDrawing(ImageOutput(NormalMap))
For y = 0 To ImageHeight(NormalMap) - 1
  For x = 0 To ImageWidth(NormalMap) - 1
    Color = Point(x,y)
    NormalColor(x,y) = Color
    Normal(x,y)\x=(Red(Color)/255)
    Normal(x,y)\y=(Green(Color)/255)
    Normal(x,y)\z=(Blue(Color)/255)
    normalize(Normal(x,y))
  Next
Next
StopDrawing()


sunColor = $FFFFFF
SunX=60000;30000
SunY=20000;10000
SunZ=60000;30000
lightmap = CreateImage(#PB_Any,ImageWidth(NormalMap), ImageHeight(NormalMap))
Dim LightMapColor(LargeurEcran,HauteurEcran)
StartDrawing(ImageOutput(lightmap))

For z = 0 To ImageHeight(NormalMap) - 1
  For x = 0 To ImageWidth(NormalMap) - 1
   
    terrainHeight.f = carte(x,y,1)\z * 100
   
    terrainPixel.VECTOR3
    terrainPixel\x = x
    terrainPixel\y = terrainHeight
    terrainPixel\z = z
   
    SunDir.VECTOR3
    SunDir\x =  (SunX - terrainPixel\x)
    SunDir\y =  (SunY - terrainPixel\y)
    SunDir\z =  (SunZ - terrainPixel\z)
    Normalize(SunDir)
   
   
    tmp.f = DotProduct(SunDir,Normal(x,z))
   
    If tmp<0
      Col.f = -1 * tmp
    Else
      Col.f = tmp
    EndIf
   
   
    Red   = Red(DiffuseColor(x,z))   * Col
    Green = Green(DiffuseColor(x,z)) * Col
    Blue  = Blue(DiffuseColor(x,z))  * Col
   
   
    If Red>255  :Red=255  :EndIf
    If Green>255:Green=255:EndIf
    If Blue>255 :Blue=255 :EndIf
   
    Plot(x,z,RGB(Red,Green,Blue))
    LightMapColor(x,z) = RGB(Red,Green,Blue)
   
  Next
Next

StopDrawing()


; Pour le fun , serie de map iso !!!!

IsoColor = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)

StartDrawing(ImageOutput(IsoColor))
For y = 0 To (ImageHeight(IsoColor)/2) - 1
  For x = 0 To (ImageWidth(IsoColor)/2) - 1
    
    Color  = LightMapColor(x*2,y*2)
    Height = carte(x*2,y*2,1)\z / 2
    
    Composante=carte(x*2,y*2,1)\z/FacteurNormalisation
    If Composante < (#IndexRelatifEauxPeuProfondes * 255)+8
      Height = (#IndexRelatifEauxPeuProfondes * 255)+8
    EndIf

    isoX = (x-y) + LargeurEcran/2
    isoY = (((x+y)/2) + HauteurEcran/3) - Height

    If x = (ImageWidth(IsoColor)/2) - 1
      Color = RGB(133, 76, 4)
    EndIf 
    
    If y = (ImageHeight(IsoColor)/2) - 1
      Color = RGB(66, 42, 11)
    EndIf
        
    Box(isoX,isoY,1,Height,Color)
  Next
Next
StopDrawing()



IsoNormal = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)

StartDrawing(ImageOutput(IsoNormal))
For y = 0 To (ImageHeight(IsoNormal)/2) - 1
  For x = 0 To (ImageWidth(IsoNormal)/2) - 1
    
    Color  = NormalColor(x*2,y*2)
    Height = carte(x*2,y*2,1)\z / 2
    
    Composante=carte(x*2,y*2,1)\z/FacteurNormalisation
    If Composante < (#IndexRelatifEauxPeuProfondes * 255)+8
      Height = (#IndexRelatifEauxPeuProfondes * 255)+8
    EndIf

    isoX = (x-y) + LargeurEcran/2
    isoY = (((x+y)/2) + HauteurEcran/3) - Height

    If x = (ImageWidth(IsoColor)/2) - 1
      Color = RGB(197, 93, 255)
    EndIf 
    
    If y = (ImageHeight(IsoColor)/2) - 1
      Color = RGB(181, 188, 243)
    EndIf
        
    Box(isoX,isoY,1,Height,Color)
  Next
Next
StopDrawing()

IsoHeight = CreateImage(#PB_Any,LargeurEcran,HauteurEcran)

StartDrawing(ImageOutput(IsoHeight))
For y = 0 To (ImageHeight(IsoHeight)/2) - 1
  For x = 0 To (ImageWidth(IsoHeight)/2) - 1
    
    Color  = HeightMapColor(x*2,y*2)
    Height = carte(x*2,y*2,1)\z / 2
    
    Composante=carte(x*2,y*2,1)\z/FacteurNormalisation
    If Composante < (#IndexRelatifEauxPeuProfondes * 255)+8
      Height = (#IndexRelatifEauxPeuProfondes * 255)+8
    EndIf

    isoX = (x-y) + LargeurEcran/2
    isoY = (((x+y)/2) + HauteurEcran/3) - Height

    If x = (ImageWidth(IsoColor)/2) - 1
      Color = $CACACA
    EndIf 
    
    If y = (ImageHeight(IsoColor)/2) - 1
      Color = $5A5A5A
    EndIf
        
    Box(isoX,isoY,1,Height,Color)
  Next
Next
StopDrawing()







;-*************************************************
;-PROGRAMME PRINCIPAL
;-
;-************************************************
InitSprite()
InitKeyboard()
info$=">>INFOS: Pics "+ Str(#NbreInitialDePicsHorizontaux)+" * "+Str(#NbreInitialDePicsVerticaux)+"   Oct="+Str(#OctaveMax)+"  Subdv="+Str(#NbreDeSubdivisions)
OpenWindow(0,0,0,LargeurEcran,HauteurEcran,"Test Perlin 2D"+info$,#PB_Window_ScreenCentered|#PB_Window_SystemMenu  )
Panel = PanelGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran)
AddGadgetItem(Panel,-1,"Diffuse")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(lightmap))
AddGadgetItem(Panel,-1,"Height")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(heightmap))
AddGadgetItem(Panel,-1,"Normal")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(NormalMap))
AddGadgetItem(Panel,-1,"Iso-Height")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(IsoHeight))
AddGadgetItem(Panel,-1,"Iso-Normal")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(IsoNormal))
AddGadgetItem(Panel,-1,"Iso-Diffuse")
ImageGadget(#PB_Any,0,0,LargeurEcran,HauteurEcran,ImageID(IsoColor))



;-BOUCLE PRINCIPALE
Repeat
  Delay(10)
Until WindowEvent() = #PB_Event_CloseWindow
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Re: Perlin et subdivisions, création de terrains

Message par Huitbit »

C'est beau comme un gâteau d'anniversaire :P !

Test rapide en perspective cavalière :
Image

Info : Petite semaine de vacances à Marie-Galante sans PC.
J'ai quand même imprimé le code, ça peut servir :lol:

Hasta la vista !
Elevé au MSX !
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Re: Perlin et subdivisions, création de terrains

Message par Huitbit »

Allez une petite dernière vue(perspective cavalière différente de la précedente) avant de prendre le bateau !

Image

A la semaine prochaine 8) !
Elevé au MSX !
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Re: Perlin et subdivisions, création de terrains

Message par Thyphoon »

dire que malgré mes recherches hier avec bruit de perlin j'étais passé a côté de ce sujet ! :oops:
Bravo c'est impressionnant ce qu'on peut faire un avec un peu de math, et Purebasic ! :mrgreen:
et surtout merci d'avoir partagé ! :D
Haut
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :
Contacter Le Soldat Inconnu

Re: Perlin et subdivisions, création de terrains

Message par Le Soldat Inconnu »

Trop fort :D
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Haut
Répondre

Revenir à « Débutants »