; English forum: http://www.purebasic.fr/english/viewtopic.php?t=8367&postdays=0&postorder=asc&start=15
; Author: Comtois (updated for PB 4.00 by Andre)
; Date: 29. May 2004
; OS: Windows
; Demo: No


;Comtois le 29 mai 2004 
;Merci à François Weil pour l'optimisation du code :) 

;>> #PB_Material_Phong et #PB_Material_Flat sont inversés ? (Bug) 
;PB : 3.90 

;-Constantes 
#ScreenWidth = 1024 
#ScreenHeight = 768 
#ScreenDepth = 32 
#Img_SnapShot = 0 

;/SnapShot 
hBitmap = CreateImage(#Img_SnapShot, #ScreenWidth, #ScreenHeight) 
hdc = StartDrawing(ImageOutput(#Img_SnapShot)) 
SelectObject_(hdc, hBitmap) 
BitBlt_(hdc, 0, 0, #ScreenWidth, #ScreenHeight, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY) 
StopDrawing() 
DeleteDC_(hdc) 

;-Structures 
Structure Vecteur 
  x.f 
  y.f 
  Z.f 
EndStructure 
Structure Lumiere 
  Couleur.l 
  x.f 
  y.f 
  Z.f 
EndStructure  
Structure Matrice 
  Largeur.f 
  Profondeur.f 
  NbFacetteX.l      
  NbFacetteZ.l      
  FaceVisible.l      ; si = #True on double les triangles pour voir l'entité des deux côtés 
  NbPointX.l 
  NbPointZ.l 
  Nbtriangle.l 
  TailleFacetteX.f   ; Je ne sais pas si je vais garder cette méthode 
  TailleFacetteZ.f   ; Je ne sais pas si je vais garder cette méthode  
  PointIDMemory.l 
  TriangleIDMemory.l 
  TextureIDMemory.l 
  NormaleIDMemory.l 
EndStructure 
Structure Vague 
  decaleX.l 
  decaleZ.l 
  Hauteur.l 
  Angle.l 
  Vitesse.l 
EndStructure  
;-Variables 
Global Matrice.Matrice 
Global Lumiere.Lumiere 
Global Vague.Vague 
Global Mode.b ,ShadingMode.b,Animation.l,AfficheAide.l 

;-Declare 
Declare Matrice() 
Declare NormalesMatrice() 
Declare vagues() 
Declare GestionTouches() 
Declare GestionSouris() 
Declare AfficheAide() 
; 
;- Main starts here 
; 
If InitEngine3D() And InitSprite() And InitKeyboard() And InitMouse() And OpenScreen(#ScreenWidth, #ScreenHeight, #ScreenDepth, "FRW Matrice") 
  ;/Divers 
  Vague\Vitesse=3 
  Vague\Hauteur=20 
  Vague\decaleX=6 
  Vague\decaleZ=6 
  Animation = 1 
  AfficheAide = 1 
  
  ;/Paramètres de la matrice (à renseigner) 
  Matrice\Largeur    = 1000 
  Matrice\Profondeur = 1000 
  Matrice\NbFacetteX = 60 
  Matrice\NbFacetteZ = 60 
  Matrice\FaceVisible = #False ; #True double les triangles pour rendre visible l'autre face de la matrice 
  
  ;/Quelques informations complémentaires sur la matrice ( Calculées ) 
  If Matrice\FaceVisible 
    Matrice\Nbtriangle = 4 
  Else 
    Matrice\Nbtriangle = 2 
  EndIf  
  Matrice\NbPointX = Matrice\NbFacetteX + 1 
  Matrice\NbPointZ = Matrice\NbFacetteZ + 1 
  Matrice\TailleFacetteX = Matrice\Largeur / Matrice\NbFacetteX 
  Matrice\TailleFacetteZ = Matrice\Profondeur / Matrice\NbFacetteZ 
  Matrice\PointIDMemory    = AllocateMemory(12 * Matrice\NbPointX * Matrice\NbPointZ) 
  Matrice\TriangleIDMemory = AllocateMemory(12 * Matrice\NbFacetteX * Matrice\NbFacetteZ * Matrice\Nbtriangle) 
  Matrice\TextureIDMemory  = AllocateMemory(12 * Matrice\NbPointX * Matrice\NbPointZ)  
  Matrice\NormaleIDMemory  = AllocateMemory(12 * Matrice\NbPointX * Matrice\NbPointZ)  
  Global Dim Points.Vecteur(Matrice\NbPointX * Matrice\NbPointZ) 
  Matrice() 
  
  ;/Mesh 
  CreateMesh(0, 1000) 
  SetMeshData(0, 0, Matrice\PointIDMemory   , Matrice\NbPointX * Matrice\NbPointZ) 
  SetMeshData(0, 1, Matrice\TriangleIDMemory, Matrice\NbFacetteX * Matrice\NbFacetteZ * Matrice\Nbtriangle) 
  SetMeshData(0, 2, Matrice\TextureIDMemory , Matrice\NbPointX * Matrice\NbPointZ)  
  SetMeshData(0, 3, Matrice\NormaleIDMemory , Matrice\NbPointX * Matrice\NbPointZ)  
  
  ;/Texture 
  ;>>>>>>>>>>>    LoadTexture Here !!   <<<<<< 
  TextureXSize = 256 
  TextureYSize = 256 
  ;ResizeImage(#Img_SnapShot,TextureXSize,TextureYSize) 
  CreateTexture(0, TextureXSize, TextureYSize) 
  StartDrawing(TextureOutput(0)) 
  DrawImage(ImageID(#Img_SnapShot),0,0) 
  StopDrawing() 
  ;/Material 
  CreateMaterial(0, TextureID(0)) ; Material 
  MaterialShadingMode(0, #PB_Material_Gouraud) 
  MaterialBlendingMode(0, #PB_Material_AlphaBlend) 
  MaterialAmbientColor(0, RGB(255,55,55)) 
  MaterialDiffuseColor(0, RGB(255,255,128)) 
  MaterialSpecularColor(0,RGB(255,0,0)) 
  ;/Entity 
  CreateEntity(0, MeshID(0), MaterialID(0)) 
  ;/Caméra 
  CreateCamera(0, 0, 0, 100, 100) 
  CameraLocate(0, 0, 845, 915) 
  CameraLookAt(0, EntityX(0), EntityY(0) , EntityZ(0)) 
  ;/Lumière 
  AmbientColor(RGB(160,160,160)) 
  Lumiere\Couleur = RGB(255,255,128) 
  Lumiere\x = EntityX(0)/2 
  Lumiere\y = 930 
  Lumiere\Z = EntityZ(0)/2 
  CreateLight(0,Lumiere\Couleur)  
  LightLocate(0,Lumiere\x, Lumiere\y, Lumiere\Z) 
  Repeat 
    ;ClearScreen(0, 0, 0) 
    GestionSouris() 
    vagues() 
    NormalesMatrice()    
    RenderWorld() 
    GestionTouches() ; Placé après RenderWorld sinon le snapshot ne fonctionne pas ! 
    If AfficheAide : AfficheAide() : EndIf    
    FlipBuffers() 
  Until KeyboardPushed(#PB_Key_Escape) 
Else 
  MessageRequester("Error", "Something fails to initialize 3D engine", 0) 
EndIf 
End 

;/ 
;-Procedures 
;/ 
Procedure calculVecteurNorme(*v1.Vecteur,*v2.Vecteur,*n.Vecteur) 
  x.f = *v2\x - *v1\x 
  y.f = *v2\y - *v1\y 
  Z.f = *v2\Z - *v1\Z 
  d.f = Sqr(x * x + y * y + Z * Z) 
  *n\x =x / d 
  *n\y =y / d 
  *n\Z =Z / d 
EndProcedure 
Procedure produitVectoriel(*v1.Vecteur,*v2.Vecteur,*n.Vecteur) 
  *n\x = *v1\y * *v2\Z - *v1\Z * *v2\y 
  *n\y = *v1\Z * *v2\x - *v1\x * *v2\Z 
  *n\Z = *v1\x * *v2\y - *v1\y * *v2\x 
EndProcedure 
Procedure Matrice() 
  Adresse1 = Matrice\PointIDMemory    ; Adresse Points 
  Adresse2 = Matrice\TextureIDMemory  ; Adresse Texture 
  adresse3 = Matrice\TriangleIDMemory ; Adresse triangles 
  Index = 6 * Matrice\Nbtriangle 
  For b = 0 To Matrice\NbFacetteZ 
    bx = b * Matrice\NbPointX 
    bx1 = bx + Matrice\NbPointX 
    For a = 0 To Matrice\NbFacetteX 
      ;/Points 
      PokeF(Adresse1, (a - Matrice\NbFacetteX / 2) * Matrice\TailleFacetteX) 
      PokeF(Adresse1 + 4, 0) 
      PokeF(Adresse1 + 8, (b - Matrice\NbFacetteZ / 2) * Matrice\TailleFacetteZ) 
      Adresse1 + 12 
      ;/Texture 
      PokeF(Adresse2, a / Matrice\NbFacetteX) 
      PokeF(Adresse2 + 4, b / Matrice\NbFacetteZ) 
      Adresse2 + 8 
      ;/Triangles 
      If b < Matrice\NbFacetteZ And a < Matrice\NbFacetteX 
        P1 = a + bx 
        P2 = P1 + 1 
        P3 = a + bx1 
        P4 = P3 + 1 
        PokeL(adresse3, P4 << 16 + P1)          
        PokeL(adresse3 + 4, P1 << 16 + P2) 
        PokeL(adresse3 + 8, P4 << 16 + P3) 
        If Matrice\FaceVisible 
          PokeL(adresse3 + 12, P2 << 16 + P1) 
          PokeL(adresse3 + 16, P4 << 16 + P3) 
          PokeL(adresse3 + 20, P2 << 16 + P3) 
        EndIf 
        adresse3 + Index 
      EndIf  
    Next 
  Next 
EndProcedure 
Procedure NormalesMatrice() 
  Vecteur1.Vecteur 
  Vecteur2.Vecteur 
  
  P1.Vecteur ; Point 1 de la Facette 
  P2.Vecteur ; Point 2 de la Facette  
  P3.Vecteur ; Point 3 de la Facette 
  P4.Vecteur ; Point 4 de la Facette 
  
  Normale1.Vecteur ; Normale Triangle 1 de la Facette Points 1,2,3 
  Normale2.Vecteur ; Normale Triangle 2 de la Facette Points 2,4,3 
  
  adresse = Matrice\PointIDMemory + 4 
  AdrNormale = Matrice\NormaleIDMemory 
  
  For Z = 0 To Matrice\NbFacetteZ - 1 
    zx = Z * Matrice\NbPointX 
    zx1 = zx + Matrice\NbPointX 
    For x = 0 To Matrice\NbFacetteX - 1 
      
      NoPoint1 = x + zx 
      P1\x = x 
      P1\y = PeekF(adresse + NoPoint1 * 12) 
      P1\Z = Z 
      NoPoint2 = NoPoint1 + 1 
      P2\x = x + 1 
      P2\y = PeekF(adresse + NoPoint2 * 12) 
      P2\Z = Z 
      NoPoint3 = x + zx1 
      P3\x = x  
      P3\y = PeekF(adresse + NoPoint3 * 12) 
      P3\Z = Z + 1 
      NoPoint4 = NoPoint3 + 1 
      P4\x = x + 1 
      P4\y = PeekF(adresse + NoPoint4 * 12) 
      P4\Z = Z + 1 
      
      calculVecteurNorme(@P1,@P2,@Vecteur1) 
      calculVecteurNorme(@P1,@P3,@Vecteur2) 
      produitVectoriel(@Vecteur2,@Vecteur1,@Normale1) 
      calculVecteurNorme(@P2,@P4,@Vecteur1) 
      calculVecteurNorme(@P2,@P3,@Vecteur2) 
      produitVectoriel(@Vecteur2,@Vecteur1,@Normale2) 
      
      Points(NoPoint1)\x + Normale1\x 
      Points(NoPoint1)\y + Normale1\y 
      Points(NoPoint1)\Z + Normale1\Z 
      Points(NoPoint2)\x + Normale1\x + Normale2\x 
      Points(NoPoint2)\y + Normale1\y + Normale2\y 
      Points(NoPoint2)\Z + Normale1\Z + Normale2\Z 
      Points(NoPoint3)\x + Normale1\x + Normale2\x 
      Points(NoPoint3)\y + Normale1\y + Normale2\y 
      Points(NoPoint3)\Z + Normale1\Z + Normale2\Z 
      Points(NoPoint4)\x + Normale2\x 
      Points(NoPoint4)\y + Normale2\y 
      Points(NoPoint4)\Z + Normale2\Z 
      
    Next x 
  Next Z  
  
  For Z = 0 To Matrice\NbFacetteZ  
    For x = 0 To Matrice\NbFacetteX  
      Distance.f = Sqr(Points(No)\x * Points(No)\x + Points(No)\y * Points(No)\y + Points(No)\Z * Points(No)\Z) 
      Points(No)\x / Distance 
      Points(No)\y / Distance 
      Points(No)\Z / Distance 
      PokeF(AdrNormale    , Points(No)\x) 
      PokeF(AdrNormale + 4, Points(No)\y) 
      PokeF(AdrNormale + 8, Points(No)\Z) 
      No + 1 
      AdrNormale + 12 
    Next x 
  Next Z  
  SetMeshData(0, 3, Matrice\NormaleIDMemory , Matrice\NbPointX * Matrice\NbPointZ) 
EndProcedure 
Procedure vagues() 
  If Animation 
    Vague\Angle = (Vague\Angle + Vague\Vitesse) % 360 
  EndIf 
  adresse = Matrice\PointIDMemory + 4 
  For Z = 0 To Matrice\NbFacetteZ 
    For x = 0 To Matrice\NbFacetteX 
      Sommet.f = Sin(0.0174533 * (Vague\Angle + (x * Vague\decaleX) + (Z * Vague\decaleZ))) * Vague\Hauteur 
      PokeF(adresse, Sommet) 
      adresse + 12 
    Next x 
  Next Z 
  SetMeshData(0, 0, Matrice\PointIDMemory, Matrice\NbPointX * Matrice\NbPointZ) 
EndProcedure 
Procedure GestionTouches() 
  ExamineKeyboard() 
  If KeyboardReleased(#PB_Key_F1) 
    Mode = #PB_Camera_Wireframe - Mode 
    CameraRenderMode(0, Mode) 
  EndIf 
  If KeyboardReleased(#PB_Key_F2) 
    MaterialShadingMode(0, #PB_Material_Flat) 
  EndIf  
  If KeyboardReleased(#PB_Key_F3) 
    MaterialShadingMode(0, #PB_Material_Gouraud) 
  EndIf 
  If KeyboardReleased(#PB_Key_F4) 
    MaterialShadingMode(0, #PB_Material_Phong) 
  EndIf 
  If KeyboardReleased(#PB_Key_F5) 
    Animation = 1 - Animation 
  EndIf 
  If KeyboardReleased(#PB_Key_F10) 
    AfficheAide = 1 - AfficheAide 
  EndIf 
  Vague\decaleX - 1 * KeyboardPushed(#PB_Key_Left) / 128 
  Vague\decaleX + 1 * KeyboardPushed(#PB_Key_Right) / 128 
  Vague\Hauteur + 1 * KeyboardPushed(#PB_Key_PageUp) / 128 
  Vague\Hauteur - 1 * KeyboardPushed(#PB_Key_PageDown) / 128 
  Vague\decaleZ + 1 * KeyboardPushed(#PB_Key_Up) / 128 
  Vague\decaleZ - 1 * KeyboardPushed(#PB_Key_Down) / 128 
  
  ;SnapShot 
  If KeyboardReleased(#PB_Key_F12) 
    hBitmap = CreateImage(#Img_SnapShot, #ScreenWidth, #ScreenHeight) 
    hdc = StartDrawing(ImageOutput(#Img_SnapShot)) 
    SelectObject_(hdc, hBitmap) 
    BitBlt_(hdc, 0, 0, #ScreenWidth, #ScreenHeight, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY) 
    StopDrawing() 
    DeleteDC_(hdc) 
    SetClipboardImage(#Img_SnapShot) 
  EndIf 
EndProcedure 
Procedure GestionSouris() 
  ExamineMouse() 
  If MouseButton(1) 
    Lumiere\y + 2 
  EndIf 
  If MouseButton(2) 
    Lumiere\y - 2 
  EndIf  
  Lumiere\x + MouseDeltaX() 
  Lumiere\Z + MouseDeltaY() 
  LightLocate(0,Lumiere\x,Lumiere\y,Lumiere\Z) 
EndProcedure  
Procedure AfficheAide() 
  StartDrawing(ScreenOutput()) 
  DrawingMode(1) 
  FrontColor(RGB(255, 255, 255))
  DrawText(10, 10, "DecaleX = " + StrF(Vague\decaleX)) 
  DrawText(10, 30, "DecaleZ = " + StrF(Vague\decaleZ)) 
  DrawText(10, 50, "HauteurVague = " + StrF(Vague\Hauteur)) 
  DrawText(10, 70, "[F1] => Change Mode Caméra") 
  DrawText(10, 90, "[F2] => MaterialSharingMode=> Flat") 
  DrawText(10, 110, "[F3] => MaterialSharingMode=> Gouraud") 
  DrawText(10, 130, "[F4] => MaterialSharingMode=> Phong") 
  DrawText(10, 150, "[F5] => Marche/Arrêt Animation des vagues") 
  DrawText(10, 170, "Lumiere X => " + Str(Lumiere\x)) 
  DrawText(10, 190, "Lumiere Y (MouseClick) => " + Str(Lumiere\y)) 
  DrawText(10, 210, "Lumiere Z => " + Str(Lumiere\Z)) 
  DrawText(10, 230, "Image par seconde (Actuel) = " + Str(Engine3DFrameRate(#PB_Engine3D_Current))) 
  DrawText(10, 250, "Image par seconde (Moyenne) = " + Str(Engine3DFrameRate(#PB_Engine3D_Average))) 
  DrawText(10, 270, "Nombre de polygones (Triangles) = " + Str(CountRenderedTriangles())) 
  DrawText(10, 290, "Mémoire vidéo disponible = " + Str(AvailableScreenMemory())) 
  DrawText(10, 310, "[F10] Cache/Montre l'aide")  
  DrawText(10, 330, "[F12] SnapShot")    
  StopDrawing() 
EndProcedure  

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = --
; DisableDebugger