PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

[4.60] HuitBit & TerrainMesh

https://www.purebasic.fr/french/viewtopic.php?t=11797

Page 1 sur 1

[4.60] HuitBit & TerrainMesh

Publié : lun. 25/avr./2011 21:34
par G-Rom
Le code de huitbit a la sauce 3D :

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)
Global LargeurEcran.l = NbreMaxDePicsHorizontaux  * PasMinimal
Global 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)
Global 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)
Global 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,100)
ResizeImage(HeightMap,OldSizeX ,OldSizeY )
ResizeImage(NormalMap,OldSizeX ,OldSizeY )


; Calcul de la lightmap
Global Dim Normal.VECTOR3(LargeurEcran,HauteurEcran)
Global 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))
Global 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()

; SaveImage(NormalMap,"temp.bmp"); 
SaveImage(lightmap,"temp.bmp")


; 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 / FacteurNormalisation
    
    Composante=carte(x*2,y*2,1)\z/FacteurNormalisation
    If Composante < #IndexRelatifEauxPeuProfondes * 255
      Height = #IndexRelatifEauxPeuProfondes * 255
    EndIf
    
    Height / 4 

    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 / FacteurNormalisation
   
    Composante=carte(x*2,y*2,1)\z/FacteurNormalisation
    If Composante < #IndexRelatifEauxPeuProfondes * 255
      Height = #IndexRelatifEauxPeuProfondes * 255
    EndIf

    Height / 4
    
    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 / FacteurNormalisation
   
    Composante=carte(x*2,y*2,1)\z/FacteurNormalisation
    If Composante < #IndexRelatifEauxPeuProfondes * 255
      Height = #IndexRelatifEauxPeuProfondes * 255
    EndIf
    
    Height / 4
    
    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()


Procedure MakeTerrain(EdgeSize.i, ScaleFactor.i=100)
  Protected i.l, b.l, a.l, Nb.l
  Protected P1.l, P2.l, P3.l, P4.l
  
  Dim hsmooth.i(LargeurEcran,HauteurEcran)
  
;   For pass = 1 To 4
  
  ;Smooth heightvalue
  For i = 2 To HauteurEcran-2
    For j = 2 To LargeurEcran-2
      
      HeightSmooth.i = 0
      For a = -1 To 1
        For b = -1 To 1
          Col = HeightMapColor(i+a,j+b)
          gray = (Red(Col)+Green(Col)+Blue(Col))/3
          HeightSmooth + gray
        Next 
      Next 
      
      HeightSmooth/9
      hsmooth(i,j) = HeightSmooth
    Next
  Next 
  
  
;   Next 
  
  
  
  
  CreateMesh(0, 1000)
  
  Num = EdgeSize
  
  For b=0 To Num
    For a=0 To Num
      
      hy = (b * HauteurEcran)/num
      hx = (a * LargeurEcran)/num

      Gray = hsmooth(hx,hy)
      
      nn = AddMeshVertex(a - Num/2,Gray*20, b - Num/2) 
      MeshVertexNormal(0,1,0) 
      MeshVertexTextureCoordinate(a/Num, b/Num)
     Next a
  Next b

  i = 0
  Nb=Num+1
  For b=0 To Num-1
    For a=0 To Num-1
      P1=a+(b*Nb)
      P2=P1+1
      P3=a+(b+1)*Nb
      P4=P3+1
      AddMeshFace(P3, P2, P1)
      AddMeshFace(P2, P3, P4)
      i+1
    Next
  Next

  FinishMesh()
  NormalizeMesh(0)
  
  
  LoadTexture(0,"temp.bmp")
  CreateMaterial(0,TextureID(0))
  
  Terrain = CreateEntity(#PB_Any, MeshID(0),MaterialID(0))
  ScaleEntity(Terrain,ScaleFactor,1,ScaleFactor)
  
 
EndProcedure  
  

#PB_Engine_Space_Local=1
#PB_Engine_Space_Parent=2
#PB_Engine_Space_World=4
#PB_Engine_Absolute_Rotation=8
#PB_Engine_Relative_Rotation=16
#PB_Engine_Quaternion_Rotation=32
#PB_Engine_Euler_Rotation=64


InitSprite()
InitEngine3D()
InitKeyboard()
InitMouse()

;- Window
OpenWindow(0, 0, 0, 1024,768, "", #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
OpenWindowedScreen(WindowID(0), 0, 0, 1024,768, 0, 0, 0,#PB_Screen_SmartSynchronization)





Camera = CreateCamera(#PB_Any,0,0,1024,768)
CameraLocate(Camera,5000,5000,5000)
CameraLookAt(Camera,0,0,0)
CameraBackColor(Camera,RGB(64,128,255))
; CameraRenderMode(Camera,#PB_Camera_Wireframe)


Add3DArchive("./",#PB_3DArchive_FileSystem)


Light = CreateLight(#PB_Any,RGB(64,64,64),SunX,SunY,SunZ)

MakeTerrain(200,100)





KeyboardMode(#PB_Keyboard_International)
ReleaseMouse(0)

Repeat
  
  
  event = WindowEvent()
  ExamineMouse()
  ExamineKeyboard()
  ClearScreen(0)
 
  
   ;Camera Free Fly mode
      If KeyboardPushed(#PB_Key_RightShift)
        Boost.f = 10
      Else
        Boost = 1
      EndIf 
      
      If KeyboardPushed(#PB_Key_Up)         :   MoveCamera(Camera,0,0,-2*Boost)   : EndIf 
      If KeyboardPushed(#PB_Key_Down)       :   MoveCamera(Camera,0,0,2*Boost)    : EndIf 
      If KeyboardPushed( #PB_Key_Left)      :   MoveCamera(Camera,-2*Boost,0,0)   : EndIf 
      If KeyboardPushed(#PB_Key_Right)      :   MoveCamera(Camera,2*Boost,0,0)    : EndIf 
      
      
      
      Yaw.f = MouseDeltaX() / 10
      Pitch.f = MouseDeltaY() / 10
      
      RotateCamera(Camera, -Pitch, Yaw, 0, #PB_Engine_Relative_Rotation | #PB_Engine_Euler_Rotation)
  RenderWorld()
  FlipBuffers()
Until event = #PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)

Re: [4.60] HuitBit & TerrainMesh

Publié : lun. 25/avr./2011 21:43
par venom
Problème chez moi avec InitEngine3D() :?

PureBasic 4.60 Beta 2 (Windows - x86)







@++

Re: [4.60] HuitBit & TerrainMesh

Publié : mar. 26/avr./2011 10:02
par Cool Dji
Salut,

J'ai un Invalid Memory Access (read error at adress 1)
ligne 731
Gray = hsmooth(hx,hy)
et avec
AddMeshFace(P3, P2, P1)
AddMeshFace(P2, P3, P4)

J'ai essayé de cadrer la valeur de Num sans succès...

PureBasic 4.60 Beta 2 (Windows - x86)

Re: [4.60] HuitBit & TerrainMesh

Publié : mar. 26/avr./2011 16:58
par G-Rom
Le compilo sous windows doit être buggé , sous linux ca marche impec :/

Re: [4.60] HuitBit & TerrainMesh

Publié : mar. 26/avr./2011 20:52
par Atomo
J'ai le même problème que Cool Dji.

Re: [4.60] HuitBit & TerrainMesh

Publié : sam. 30/avr./2011 18:26
par blendman
même problème de cool Dji, sous windows xp.

Re: [4.60] HuitBit & TerrainMesh

Publié : mar. 23/août/2011 16:26
par Cool Dji
Hello,

J'ai testé avec la 4.6 beta 4 (windows x86):
CreateMesch (ligne 721) ne demande plus qu'un seul paramètre (j'ai enlevé la boite englobante) du coup plus rien de devient visible...
Mais ça plante pas :D

Re: [4.60] HuitBit & TerrainMesh

Publié : jeu. 25/août/2011 2:44
par Geo Trouvpatou
Salut.

Pareil que Cool Dji (Windowsx64).
Mais c'est vrai que la doc windows dit : Resultat = CreateMesh(#Mesh, RayonBoiteEnglobante)
Mais en cliquant sur la fonction dans l'IDE, la barre de status indique CreateMesh(#Mesh)

J'ai donc remplacé CreateMesh(0, 1000) par CreateMesh(0)
Avec cette modif et en virant le debugger ça fonctionne.

Par contre, j'ai mis :

Code : Tout sélectionner

      If KeyboardPushed(#PB_Key_Up)         :   MoveCamera(Camera,0,0,-200*Boost)   : EndIf
      If KeyboardPushed(#PB_Key_Down)       :   MoveCamera(Camera,0,0,200*Boost)    : EndIf
      If KeyboardPushed( #PB_Key_Left)      :   MoveCamera(Camera,-200*Boost,0,0)   : EndIf
      If KeyboardPushed(#PB_Key_Right)      :   MoveCamera(Camera,200*Boost,0,0)    : EndIf
Sinon il fallait 3 jours pour voir la scène entière.

Bravo à toi.

Re: [4.60] HuitBit & TerrainMesh

Publié : jeu. 25/août/2011 3:58
par Huitbit
Hello,

Idem que CoolD ji (PureBasic 4.60 Beta 4 (Windows - x86)).
Dommage.

Pour un programme 2D, j'ai dû retravailler avec les subdivisions(il manque encore un détail à régler avant de poster le bidule), je me suis aperçu d'une petite erreur dans les indices(car j'avais repris mon code tel quel fait 2 ans plus tôt).
Tout est rentré dans l'ordre, ça va mieux :P .
L'objectif est de faire une macro ou une procédure qui prenne en charge des points de contrôle (c'est à dire, subdivisions, coefficients directeurs des segments créés, normales,...etc)
Par exemple, pour ce programme, il y aurait un gros gain de temps si le nombre de subdivisions était lié à l'octave.


Hasta la vista !

PS: je me suis mis à la 3D avec PureBasic pour mon fils :mrgreen:
Cubes en bristol (6cm*6cm*6cm)
Images découpées avec Pb(j'ai découvert GrabImage() :D ).
Utilisation d'un utilitaire(Creative Tool) pour assembler les faces(j'aurais mieux fait de le faire moi-même car l'image affichée ne correspond pas à l'image imprimée, j'ai dû faire les zones de pliages au compas car le logiciel utilise un papier prédécoupé !)
Feuilles découpées et pliées par l'homme (ben ouais, Pb peut pas tout faire :lol: :lol: )
Cubes assemblés et photos prises par le pokémon
Image

Re: [4.60] HuitBit & TerrainMesh

Publié : mar. 13/sept./2011 23:55
par Huitbit
:D

Code testé avec la version PureBasic 4.60 RC 1 (Windows - x86)

A part la souris qui délire, cette fois-ci, CA MARCHE !

Bravo à l'équipe de PureBasic !

Hasta la vista !

Re: [4.60] HuitBit & TerrainMesh

Publié : mer. 14/sept./2011 11:38
par Geo Trouvpatou
Huitbit a écrit ::D

Code testé avec la version PureBasic 4.60 RC 1 (Windows - x86)

A part la souris qui délire, cette fois-ci, CA MARCHE !

Bravo à l'équipe de PureBasic !

Hasta la vista !
Ouais enfin j'avais donné la solution juste au dessus de ton post... Mais bon.

Re: [4.60] HuitBit & TerrainMesh

Publié : jeu. 15/sept./2011 2:16
par Huitbit
Ouais enfin j'avais donné la solution juste au dessus de ton post... Mais bon.
:mrgreen:

Avec la béta précédente, ta solution donnait, sur mon PC en carton, un bel écran figé tout gris.
Je ne poste pas souvent ces derniers temps :cry:, alors si j'ai pris la peine de le faire... :roll: .

:wink:


Hasta la vista !
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru