PureArea.net - Several News + (german) Showcase online

Post by **Andre** » Mon Nov 13, 2006 10:50 pm

Thanks!

Intrigued · Post by **Intrigued** » Tue Nov 14, 2006 4:49 am

Andre, thanks! I have not clicked on the link yet, but I appreciate your (and others) huge amount of patience and willingness to help the community via your expertise.

ps. The only reason I did not donate to PB's PayPal is the link leads to a page in French and I'm not sure what it says (though I am learning French on the side since about a couple weeks ago).

Thanks again

Post by **Andre** » Tue Nov 14, 2006 8:23 pm

@Intrigued: thanks for your kind words!

Can't say something about the paypal of PB, but also PureArea.net has one. You just must say me, who should get the billions of dollar...

@All: hopefully there are some people, which can do the converting of the last codes.

Comtois · Post by **Comtois** » Tue Nov 14, 2006 8:49 pm

Quick update for this one
http://www.purearea.net/pb/CodeArchiv/G ... ision3D.pb (Comtois)

And the last version for matrix can be found here

Code: Select all

; English forum: http://purebasic.myforums.net/viewtopic.php?t=8454&highlight=
; Author: Comtois
; Date: 22. November 2003

; http://perso.wanadoo.fr/comtois/codesforum/DemoCollisionV0.1.htm
; *******************************************
; * Comtois : 22/11/03 : DémoCollisionV0.1  *
; *******************************************

; [F1]/[F2]/[F3] => Changement Vue Caméra
; [F4] => Nombre d'images / seconde et positions du perso
; [PAgeUp]/[PageDown] => Lcve / Baisse la caméra
; [Fin] => Position par défaut de la caméra
; [Espace] => Saut du perso

;-Initialisation
#ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 16
If InitEngine3D() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll" , 0 )
   End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
   End
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "Démo PlateForme" ) = 0
   MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 )
   End
EndIf

;-Declare procedures
Declare MakeBoxCollision( No.l , X.f , Y.f , Z.f , Longueur.f , Hauteur.f , Largeur.f , AngleX.f , Type.l )
Declare.f WrapValue( Angle.f )

;-Structures
Structure BoxCollision
   No.l      ; Si le type est 1 alors ce Numéro correspond obligatoirement r l'entity , sinon c'est un numéro différent des entitys existantes
   X.f       ; Position en X de la Box
   Y.f       ; Position en Y de la Box
   Z.f       ; Position en Z de la Box
   AngleX.f  ; Angle de la Box sur le Plan XZ
   MinX.f    ; Dimension de la Box
   MinY.f    ; Dimension de la Box
   MinZ.f    ; Dimension de la Box
   MaxX.f    ; Dimension de la Box
   MaxY.f    ; Dimension de la Box
   MaxZ.f    ; Dimension de la Box
   Type.l    ; Type = 0 => Box Statique ; Type = 1 => Box Dynamique ( presque plus utile avec la nouvelle méthode )
EndStructure

Structure Camera
   AngleX.f
   AngleY.f
   CameraVue.l
   CameraDist.f
   CameraHaut.f
   LookAtY.f
EndStructure

Structure Parametres
   AngleX.f
   AngleY.f
   AngleZ.f
EndStructure

Global Dim entity.Parametres(100)

Global NewList BoxCollision.BoxCollision()
Global Camera.Camera
Camera\CameraVue = 1

;- Variables globales
Global GetCollisionX.f , GetCollisionY.f , GetCollisionZ.f
Global OldPosX.f , OldPosY.f , OldPosZ.f , Pas.f
Global PosX0.f , PosY0.f , PosZ0.f

;-Mesh
CreateMesh(0,100) ; Cube
SetMeshData(0, #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate, ?CubePoints       , 16)
SetMeshData(0, #PB_Mesh_Face, ?CubeTriangles    , 12)


;- Textures
CreateTexture(1,128,128)
StartDrawing(TextureOutput(1))
  Box(0,0,128,128,RGB(255,255,255))
  Box(2,2,124,124,RGB(200,0,0))
StopDrawing()

CreateTexture(2,128,128)
StartDrawing(TextureOutput(2))
  Box(0,0,128,128,RGB(255,255,255))
  Box(2,2,124,124,RGB(0,0,200))
StopDrawing()

CreateTexture(3,128,128)
StartDrawing(TextureOutput(3))
  Box(0,0,128,128,RGB(255,255,255))
  Box(2,2,124,124,RGB(0,200,0))
  For a = 0 To 128 Step 4
   For b = 0 To 128 Step 4
      Circle(a,b,2,RGB(10,150,10))
   Next b
Next a
StopDrawing()

;- Material
For a = 1 To 3
   CreateMaterial(a, TextureID( a ))
Next a

;-Entity
Restore Entitys
For a = 0 To 20
   If a < 5
      Read materialID.l : Read Type.l
      Read Longueur.f : Read Hauteur.f : Read Largeur.f
      Read X.f : Read Y.f : Read Z.f
      Read AngleX.f
   EndIf
   CreateEntity(a , MeshID(0) ,MaterialID(materialID))
   ScaleEntity(a , Longueur , Hauteur , Largeur )
   If a<5
      EntityLocate(a,X,Y,Z)
   Else
      EntityLocate(a,X + a * 40,Y + a * 20,Z)
   EndIf
   entity(a)\AngleX = AngleX
   RotateEntity(a,entity(a)\AngleX,0,0)
   MakeBoxCollision( a , EntityX(a) , EntityY(a) , EntityZ(a) , Longueur , Hauteur , Largeur , entity(a)\AngleX , Type )
Next a

;- Camera
CreateCamera(0, 0, 0 , 100 , 100)
CameraLocate(0,0,0,20)
AmbientColor(RGB(255,255,255))

;- Procédures
Procedure.f Cosd( Angle.f )
   ;calcule le cos d'un angle en degré
   a.f = Angle * 0.0174533
   ProcedureReturn Cos( a )
EndProcedure

Procedure.f Sind( Angle.f )
   ;calcule le sin d'un angle en degré
   a.f = Angle  * 0.0174533
   ProcedureReturn Sin( a )
EndProcedure

Procedure.f WrapValue( Angle.f )
   ;Permet de toujours avoir un angle compris entre 0° et 360°
   While Angle < 0
      Angle + 360
   Wend
   While Angle - 360 >= 0
      Angle - 360
   Wend
   ProcedureReturn Angle
EndProcedure

Procedure.f NewXValue( X.f , Angle.f , NbUnite.f )
   ;r utiliser conjointement avec NewZvalue pour calculer une position de <NbUnite> dans la direction <angle>
   Valeur.f = X + Cosd( Angle ) * NbUnite
   ProcedureReturn Valeur
EndProcedure

Procedure.f NewZValue( Z.f , Angle.f , NbUnite.f )
   ;r utiliser conjointement avec NewXvalue pour calculer une position de <NbUnite> dans la direction <angle>
   Valeur.f = Z - Sind( Angle ) * NbUnite
   ProcedureReturn Valeur
EndProcedure

Procedure.f EcartAngle( angle1.f , angle2.f )
   ; simplifier tout ça
   If angle1 > 180
      ecart2.f = 360 - angle1
   Else
      ecart2.f = angle1
   EndIf

   If angle2 > 180
      ecart1.f = 360 - angle2
   Else
      ecart1.f = angle2
   EndIf

   If Abs( WrapValue( angle2 ) - WrapValue( angle1 ) ) > 180
      If angle2 < angle1
         Delta.f = ( ecart1 + ecart2 )
      Else
         Delta.f = ( ecart1 + ecart2 ) * -1
      EndIf
   Else
      Delta.f = WrapValue( angle2 ) - WrapValue( angle1 )
   EndIf

   ProcedureReturn Delta

EndProcedure

Procedure.f CurveAngle( Actuelle.f , Cible.f , P.f )
   ;Calcule un angle progressif allant de la valeur actuelle r la valeur cible
   Delta.f = EcartAngle( Actuelle , Cible )
   If P > 1000 : P = 1000 : EndIf
   Valeur.f = Actuelle + ( Delta * P / 1000 )
   ProcedureReturn WrapValue( Valeur )
EndProcedure

Procedure.f CurveValue( Actuelle.f , Cible.f , P.f )
   ;Calcule une valeur progressive allant de la valeur actuelle r la valeur cible
   Delta.f = Cible - Actuelle
   If P > 1000 : P = 1000 : EndIf
   Valeur.f = Actuelle + ( Delta * P / 1000 )
   ProcedureReturn Valeur
EndProcedure

Procedure MakeBoxCollision( No.l , X.f , Y.f , Z.f , Longueur.f , Hauteur.f , Largeur.f , AngleX.f , Type.l )
   ; X , Y et Z => Coordonnées de la Box
   ; Longueur   => Longueur de la Box
   ; Hauteur    => Hauteur de la Box
   ; Largeur    => Largeur de la Box
   ; AngleX     => Angle de la Box sur le plan XZ ( je n'ai pas besoin des autres plans pour l'instant )
   ; Type = 0   => Box statique ( calculée une seule fois , exemple pour un mur , un décor quelconque )
   ; Type = 1   => Box dynamique ( calculée avant de tester une collision selon la position de l'entity )


   ; MinZ .........|..........
   ;      .        |         .
   ;      .        |         .
   ;    -----------0--------------
   ;      .        |         .
   ;      .        |         .
   ; MaxZ .........|..........
   ;
   ;    MinX               MaxX

   ; Les paramctres MinX.f , MinY.f , MinZ.f , MaxX.f , MaxY.f , MaxZ.f , correspondent aux dimensions de la box en prenant
   ; le centre de l'entity comme référence (0) .

   ; Exemple pour un mur de longueur x = 400 , hauteur y = 100 et largeur z = 30
   ; ensuite si on veut placer le mur r 45° r la position 1500,50,300
   ; EntityLocate(#Mur,1500,50,300)
   ; RotateEntity(#Mur,45,0,0)
   ; Entity(#Mur)\\AngleX = 45
   ; et on appelle la Procedure
   ; MakeBoxCollision( #Mur , EntityX(#Mur) , EntityY(#Mur) , EntityZ(#Mur) , 400 , 100 , 30 , Entity(#Mur)\\AngleX , 0 )

   ; Pour l'instant je considcre que la Box est centré sur l'entity , si ça devait par la suite se révéler trop contraignant
   ; il sera toujours possible de modifier légcrement cette procédure ainsi :
   ; Procedure MakeBoxCollision( No.l, X.f, Y.f, Z.f, MinX.f, MinY.f, MinZ.f, MaxX.f, MaxY.f, MaxZ.f, AngleX.f, Type.l )

   AddElement( BoxCollision() )
   BoxCollision()\No = No
   BoxCollision()\X = X
   BoxCollision()\Y = Y
   BoxCollision()\Z = Z
   BoxCollision()\MinX = -Longueur/2
   BoxCollision()\MinY = -Hauteur/2
   BoxCollision()\MinZ = -Largeur/2
   BoxCollision()\MaxX = Longueur/2
   BoxCollision()\MaxY = Hauteur/2
   BoxCollision()\MaxZ = Largeur/2
   BoxCollision()\AngleX = AngleX
   BoxCollision()\Type = Type

EndProcedure

Procedure.l EntityCollision( No1.l , No2.l )
   ; La procedure renvoit -1 en cas d'erreur de paramctres ( Box inexistante , Box 1 et 2 identiques )
   ; La procedure renvoit 0 si aucune Collision
   ; La procedure renvoit 1 si la Box No1 est en Collision avec la Box No2

   If No1 = No2 :  ProcedureReturn -1 : EndIf

   ;************************************** Cherche Box *******************************************

   Trouve = 0
   ResetList( BoxCollision() )
   While NextElement( BoxCollision() )
      If BoxCollision()\No = No1

         ; Mise r Jour des caractériques de la Box
         If BoxCollision()\Type = 1
            BoxCollision()\X = EntityX(No1)
            BoxCollision()\Y = EntityY(No1)
            BoxCollision()\Z = EntityZ(No1)
            BoxCollision()\AngleX = entity(No1)\AngleX
         EndIf

         ; On récupcre les caractéristiques de la Box No1
         PosX1.f = BoxCollision()\X
         PosY1.f = BoxCollision()\Y
         PosZ1.f = BoxCollision()\Z
         MinX1.f = BoxCollision()\MinX
         MinY1.f = BoxCollision()\MinY
         MinZ1.f = BoxCollision()\MinZ
         MaxX1.f = BoxCollision()\MaxX
         MaxY1.f = BoxCollision()\MaxY
         MaxZ1.f = BoxCollision()\MaxZ
         AngleX1.f = BoxCollision()\AngleX

         Trouve + 1

      ElseIf BoxCollision()\No = No2

         ; Mise r Jour des caractériques de la Box
         If BoxCollision()\Type = 1
            BoxCollision()\X = EntityX(No2)
            BoxCollision()\Y = EntityY(No2)
            BoxCollision()\Z = EntityZ(No2)
            BoxCollision()\AngleX = entity(No2)\AngleX
         EndIf

         ; On récupcre les caractéristiques de la Box No2
         PosX2.f = BoxCollision()\X
         PosY2.f = BoxCollision()\Y
         PosZ2.f = BoxCollision()\Z
         MinX2.f = BoxCollision()\MinX
         MinY2.f = BoxCollision()\MinY
         MinZ2.f = BoxCollision()\MinZ
         MaxX2.f = BoxCollision()\MaxX
         MaxY2.f = BoxCollision()\MaxY
         MaxZ2.f = BoxCollision()\MaxZ
         AngleX2.f = BoxCollision()\AngleX

         Trouve + 1

      EndIf

      If Trouve = 2 : Break : EndIf

   Wend

   ; Il manque au moins une box
   If Trouve < 2
      ProcedureReturn -1
   EndIf

   ;****************************** Changement de repcres ****************************************
   CosA1.f = Cosd( AngleX1 )
   SinA1.f = -Sind( AngleX1 )
   CosA2.f = Cosd( AngleX2 )
   SinA2.f = Sind( AngleX2 )
   PosX.f  = PosX1 - PosX2
   PosY.f  = PosY1 - PosY2
   PosZ.f  = PosZ1 - PosZ2
   A1.f    = (CosA1 * CosA2 - SinA1 * SinA2)
   A2.f    = (SinA1 * CosA2 + CosA1 * SinA2)
   A3.f    = (PosX * CosA2 - PosZ * SinA2)
   A4.f    = (PosX * SinA2 + PosZ * CosA2)

   ; Calcul les 4 coins de la Box sur le plan XZ en tenant compte du changement de repcre
   ;
   ; MinX1/MinZ1(0)  ______    MaxX1/MinZ1(1)
   ;                 \     \
   ;                  \     \
   ;                   \     \
   ; MinX1/MaxZ1(3)     \_____\ MaxX1/MaxZ1(2)
   ;

   ; Et ensuite on détermine une Box qui englobe le tout ( pas précis , mais plus simple )
   ; BoxMinX/BoxMinZ.............BoxMaxX/BoxMinZ
   ;                . ______    .
   ;                . \     \   .
   ;                .  \     \  .
   ;                .   \     \ .
   ;                .    \_____\.
   ; BoxMinX/BoxMaxZ.............BoxMaxX/BoxMaxZ
   ;
   ;MinX1/MinZ1
   X0.f = MinX1 * A1 - MinZ1 * A2 + A3
   Z0.f = MinX1 * A2 + MinZ1 * A1 + A4

   BoxMinX.f = X0
   BoxMinZ.f = Z0
   BoxMaxX.f = X0
   BoxMaxZ.f = Z0

   ;MaxX1/MinZ1
   X1.f = MaxX1 * A1 - MinZ1 * A2 + A3
   Z1.f = MaxX1 * A2 + MinZ1 * A1 + A4

   If X1 < BoxMinX
      BoxMinX = X1
   ElseIf  X1 > BoxMaxX
      BoxMaxX = X1
   EndIf
   If Z1 < BoxMinZ
      BoxMinZ = Z1
   ElseIf  Z1 > BoxMaxZ
      BoxMaxZ = Z1
   EndIf

   ;MaxX1/MaxZ1
   X2.f = MaxX1 * A1 - MaxZ1 * A2 + A3
   Z2.f = MaxX1 * A2 + MaxZ1 * A1 + A4

   If X2 < BoxMinX
      BoxMinX = X2
   ElseIf  X2 > BoxMaxX
      BoxMaxX = X2
   EndIf
   If Z2 < BoxMinZ
      BoxMinZ = Z2
   ElseIf  Z2 > BoxMaxZ
      BoxMaxZ = Z2
   EndIf

   ;MinX1/MaxZ1
   X3.f = MinX1 * A1 - MaxZ1 * A2 + A3
   Z3.f = MinX1 * A2 + MaxZ1 * A1 + A4

   If X3 < BoxMinX
      BoxMinX = X3
   ElseIf  X3 > BoxMaxX
      BoxMaxX = X3
   EndIf
   If Z3 < BoxMinZ
      BoxMinZ = Z3
   ElseIf  Z3 > BoxMaxZ
      BoxMaxZ = Z3
   EndIf
   BoxMinY.f = MinY1 + PosY
   BoxMaxY.f = MaxY1 + PosY

   ;**************************** Test si Collision *************************************************
   ; BoxMinX/BoxMinZ.............BoxMaxX/BoxMinZ    MinX2/MinZ2.............MaxX2/MaxZ2
   ;                . ______    .                              .           .
   ;                . \     \   .                              .           .
   ;                .  \     \  .                              .           .
   ;                .   \     \ .                              .           .
   ;                .    \_____\.                              .           .
   ; BoxMinX/BoxMaxZ.............BoxMaxX/BoxMaxZ    MinX2/MaxZ2.............MaxX2/MaxZ2

   ;Test Collision
   CondX = (BoxMaxX >= MinX2 And BoxMinX <= MaxX2)
   CondY = (BoxMaxY >= MinY2 And BoxMinY <= MaxY2)
   CondZ = (BoxMaxZ >= MinZ2 And BoxMinZ <= MaxZ2) 
   ;Utilisé pour les collisions glissantes
   GetCollisionX = 0
   GetCollisionY = 0
   GetCollisionZ = 0

   If CondY And CondX And CondZ
      ; il serait surement plus judicieux de ne faire ces calculs que s'ils sont demandés
      ; en effet , dans de nombreux cas , on a seulement besoin de savoir s'il y a une collision
      ; et pas forcément de calculer une collision glissante !
      ;Collision en X
      If BoxMinX < MaxX2 And BoxMinX > MinX2 And BoxMaxX > MaxX2
         GetCollisionXa.f =  BoxMinX - MaxX2
      ElseIf BoxMaxX < MaxX2 And BoxMaxX > MinX2 And BoxMinX < MinX2
         GetCollisionXa.f =  BoxMaxX - MinX2
      EndIf

      ; a voir pour traiter ça autrement ! > c'est pour éviter de tomber quand on s'approche trop du bord d'une box !
      If Abs(GetCollisionXa) > 3
         GetCollisionXa = 0
      EndIf

      ; Collision en Z
      If BoxMinZ < MaxZ2 And BoxMaxZ > MaxZ2 And BoxMaxZ > MaxZ2
         GetCollisionZa.f =  BoxMinZ - MaxZ2
      ElseIf BoxMaxZ < MaxZ2 And BoxMaxZ > MinZ2 And BoxMinZ < MinZ2
         GetCollisionZa.f =  BoxMaxZ - MinZ2
      EndIf

      ; A voir pour traiter ça autrement ! > c'est pour éviter de tomber quand on s'approche trop du bord d'une box !
      If Abs(GetCollisionZa) > 3
         GetCollisionZa = 0
      EndIf

      ;Collision en Y
      If BoxMinY < MaxY2 And BoxMinY > MinY2 And BoxMaxY > MaxY2 And GetCollisionXa = 0 And GetCollisionZa = 0
         GetCollisionY =  BoxMinY - MaxY2
      ElseIf BoxMaxY < MaxY2 And BoxMaxY> MinY2 And BoxMinY < MinY2 And OldPosY < PosY0
         GetCollisionY =  BoxMaxY - MinY2
      EndIf

      ;Changement de repcre des valeurs Collisions glissantes
      CosA2.f = Cosd( -AngleX2 )
      SinA2.f = Sind( -AngleX2 )
      GetCollisionX = GetCollisionXa * CosA2 - GetCollisionZa * SinA2
      GetCollisionZ = GetCollisionXa * SinA2 + GetCollisionZa * CosA2

      ProcedureReturn 1

   Else

      ProcedureReturn 0

   EndIf

EndProcedure

Procedure GestionCamera()

   ; Touches de la Caméra
   If KeyboardReleased(#PB_Key_F1) : Camera\CameraVue = 1 : EndIf
   If KeyboardReleased(#PB_Key_F2) : Camera\CameraVue = 2 : EndIf
   If KeyboardReleased(#PB_Key_F3) : Camera\CameraVue = 3 : EndIf

   If KeyboardPushed(#PB_Key_PageUp)
      Camera\AngleY + 0.1
   EndIf

   If KeyboardPushed(#PB_Key_PageDown)
      Camera\AngleY - 0.1
   EndIf

   If KeyboardPushed(#PB_Key_End)
      Camera\AngleY = CurveValue(Camera\AngleY,0,20)
   EndIf

   If Camera\CameraVue = 1

      Camera\CameraDist = CurveValue(Camera\CameraDist ,85 , 20)
      Camera\CameraHaut = CurveValue(Camera\CameraHaut ,25 , 20)
      Camera\LookAtY = CurveValue(Camera\LookAtY ,0 , 20)
      Camera\AngleX = CurveAngle(Camera\AngleX , entity(0)\AngleX , 20 )
      PosXCamera.f = CurveValue(CameraX(0) , NewXValue(EntityX(0) , Camera\AngleX + 180 , Camera\CameraDist) , 280)
      PosYCamera.f = CurveValue(CameraY(0) , EntityY(0) + Camera\CameraHaut , 30)
      PosZCamera.f = CurveValue(CameraZ(0) , NewZValue(EntityZ(0) , Camera\AngleX + 180 , Camera\CameraDist) , 280)
      CameraLocate(0 , PosXCamera , PosYCamera , PosZCamera)
      CameraLookAt(0 , EntityX(0), EntityY(0) + Camera\LookAtY + Camera\AngleY  ,EntityZ(0))

   ElseIf Camera\CameraVue = 2

      Camera\CameraDist = CurveValue(Camera\CameraDist ,45 , 20)
      Camera\CameraHaut = CurveValue(Camera\CameraHaut ,25 , 20)
      Camera\LookAtY = CurveValue(Camera\LookAtY , 8 , 20)
      Camera\AngleX = CurveAngle(Camera\AngleX , entity(0)\AngleX , 20 )
      PosXCamera.f = CurveValue(CameraX(0) , NewXValue(EntityX(0) , Camera\AngleX + 180 , Camera\CameraDist) , 280)
      PosYCamera.f = CurveValue(CameraY(0) , EntityY(0) + Camera\CameraHaut , 30)
      PosZCamera.f = CurveValue(CameraZ(0) , NewZValue(EntityZ(0) , Camera\AngleX + 180 , Camera\CameraDist) , 280)
      CameraLocate(0 , PosXCamera , PosYCamera , PosZCamera)
      CameraLookAt(0 , EntityX(0), EntityY(0) + Camera\LookAtY + Camera\AngleY  ,EntityZ(0))

   ElseIf Camera\CameraVue = 3

      Camera\CameraDist = CurveValue(Camera\CameraDist ,15 , 20)
      Camera\CameraHaut = CurveValue(Camera\CameraHaut ,95 , 20)
      Camera\LookAtY = CurveValue(Camera\LookAtY , 0 , 20)
      Camera\AngleX = CurveAngle(Camera\AngleX , entity(0)\AngleX , 20 )
      PosXCamera.f = CurveValue(CameraX(0) , NewXValue(EntityX(0) , Camera\AngleX + 180 , Camera\CameraDist) , 280)
      PosYCamera.f = CurveValue(CameraY(0) , EntityY(0) + Camera\CameraHaut , 30)
      PosZCamera.f = CurveValue(CameraZ(0) , NewZValue(EntityZ(0) , Camera\AngleX + 180 , Camera\CameraDist) , 280)
      CameraLocate(0 , PosXCamera , PosYCamera , PosZCamera)
      CameraLookAt(0 , EntityX(0) , EntityY(0) + Camera\LookAtY + Camera\AngleY  , EntityZ(0))

   EndIf

EndProcedure

Procedure AffAide()
   StartDrawing(ScreenOutput())
   DrawText(10, 10, "Nombre d'images Minimum = " + StrF(Engine3DFrameRate(#PB_Engine3D_Minimum )) + " / Nombre d'images Maximum = " + StrF(Engine3DFrameRate(#PB_Engine3D_Maximum)))
   DrawText(10, 30, "Nombre d'images par seconde = " + StrF(Engine3DFrameRate(#PB_Engine3D_Current)))
   DrawText(10, 50, StrF(EntityX(0)) + " / " + StrF(EntityY(0)) + " / " + StrF(EntityZ(0)))
   StopDrawing()
EndProcedure

;- Boucle principale

DecAttraction.f = 0.05
Attraction.f = 0
Pas.f = 0

Repeat

   ClearScreen(#Black)

   If ExamineKeyboard()

      ; Touches du joueur r mettre dans une procédure  et gérer un fichier préférence pour configurer les touches
      If KeyboardPushed(#PB_Key_Left)
         entity(0)\AngleX = WrapValue( entity(0)\AngleX + 1 )
      ElseIf KeyboardPushed(#PB_Key_Right)
         entity(0)\AngleX = WrapValue( entity(0)\AngleX - 1 )
      EndIf
      RotateEntity(0, entity(0)\AngleX , 0, 0 )

      If KeyboardPushed(#PB_Key_Up)
         Pas = CurveValue(Pas, 2 , 120)
      ElseIf KeyboardPushed(#PB_Key_Down)
         Pas = CurveValue(Pas, -2 , 120)
      Else
         Pas = CurveValue(Pas, 0 , 200)
      EndIf

      If KeyboardPushed(#PB_Key_Space) And Attraction = 0 And  AutoriseSaut
         Attraction = 1.6 : DecAttraction = 0.05
      EndIf

      If KeyboardReleased(#PB_Key_F4) : AfficheAide = 1 - AfficheAide : EndIf

   EndIf


   ; LE perso avant
   OldPosY = EntityY(0)
   OldPosX = EntityX(0)
   OldPosZ = EntityZ(0)

   ; LE perso pendant
   MoveEntity( 0 , Cosd( entity(0)\AngleX ) * Pas , Attraction, -Sind( entity(0)\AngleX ) * Pas )

   ; LE perso aprcs
   PosY0 = EntityY(0)
   PosX0 = EntityX(0)
   PosZ0 = EntityZ(0)

   ; Gestion de l'attraction
   Attraction - DecAttraction

   ; Test des collisions

   ResetList(BoxCollision())
   While NextElement(BoxCollision())

      NoBox = BoxCollision()\No
      IndexBoxCollision = ListIndex(BoxCollision())

      If EntityCollision( 0 , NoBox ) > 0

         ; Collision glissante
         PosY0 - GetCollisionY
         PosX0 - GetCollisionX
         PosZ0 - GetCollisionZ

         If GetCollisionY <> 0
            If OldPosY < PosY0 And GetCollisionY > 0; pour ne pas rester coller sous une dalle quand on saute !!
               Attraction = -0.1
               AutoriseSaut = 0
            Else
               Attraction = 0
               AutoriseSaut = 1
            EndIf
         EndIf

      EndIf

      SelectElement(BoxCollision(), IndexBoxCollision)

   Wend

   ; Repositionne le perso
   EntityLocate(0,PosX0 ,PosY0 ,PosZ0 )

   ; Gestion de la caméra
   GestionCamera()

   RenderWorld()
   If AfficheAide : AffAide(): EndIf
   FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)


;-Datas du Cube

DataSection
Entitys:
; le perso
Data.l 2,1 ; matérial
Data.f 6,6,6 ; Dimension longueur , hauteur , largeur
Data.f 200,30,200,0 ; positions X,Y,Z et angle
; le sol
Data.l 3,0 ; matérial
Data.f 1000,8,1000 ; Dimension longueur , hauteur , largeur
Data.f 500,0,500,0 ; positions X,Y,Z et angle
; Un mur
Data.l 1,0 ; matérial
Data.f 100,25,10 ; Dimension longueur , hauteur , largeur
Data.f 400,16,400,45 ; positions X,Y,Z et angle
; Un autre mur
Data.l 1,0 ; matérial
Data.f 100,25,10 ; Dimension longueur , hauteur , largeur
Data.f 600,16,600,0 ; positions X,Y,Z et angle
; et un escalier
Data.l 1,0 ; matérial
Data.f 35,5,35 ; Dimension longueur , hauteur , largeur
Data.f 200,-80,700,0 ; positions X,Y,Z et angle

CubePoints:
Data.f -0.5,-0.5,-0.5
Data.f -0.5,0,-0.5
Data.f 0,1
Data.f -0.5,-0.5,0.5
Data.f -0.5,0,0.5
Data.f 1,1
Data.f 0.5,-0.5,0.5
Data.f 0.5,0,0.5
Data.f 0,1
Data.f 0.5,-0.5,-0.5
Data.f 0.5,0,-0.5
Data.f 1,1
Data.f -0.5,0.5,-0.5
Data.f -0.5,0,-0.5
Data.f 0,0
Data.f -0.5,0.5,0.5
Data.f -0.5,0,0.5
Data.f 1,0
Data.f 0.5,0.5,0.5
Data.f 0.5,0,0.5
Data.f 0,0
Data.f 0.5,0.5,-0.5
Data.f 0.5,0,-0.5
Data.f 1,0
Data.f -0.5,-0.5,-0.5
Data.f 0,1,0
Data.f 0,0
Data.f -0.5,-0.5,0.5
Data.f 0,1,0
Data.f 1,0
Data.f 0.5,-0.5,0.5
Data.f 0,1,0
Data.f 1,1
Data.f 0.5,-0.5,-0.5
Data.f 0,1,0
Data.f 0,1
Data.f -0.5,0.5,-0.5
Data.f 0,-1,0
Data.f 0,0
Data.f -0.5,0.5,0.5
Data.f 0,-1,0
Data.f 1,0
Data.f 0.5,0.5,0.5
Data.f 0,-1,0
Data.f 1,1
Data.f 0.5,0.5,-0.5
Data.f 0,-1,0
Data.f 0,1

CubeTriangles:
Data.w 0,4,7
Data.w 0,7,3
Data.w 1,5,4
Data.w 1,4,0
Data.w 2,6,5
Data.w 2,5,1
Data.w 3,7,6
Data.w 3,6,2
Data.w 9,8,11
Data.w 9,11,10
Data.w 12,13,14
Data.w 12,14,15
EndDataSection

benny · Post by **benny** » Tue Nov 14, 2006 9:08 pm

Updated codes of the rest 3D-stuff (see list) sent to Andre.

http://www.purearea.net/pb/CodeArchiv/G ... Objects.pb (Franco)
http://www.purearea.net/pb/CodeArchiv/G ... Runtime.pb (Danilo)
http://www.purearea.net/pb/CodeArchiv/G ... -Editor.pb (LJ)

Post by **Andre** » Tue Nov 14, 2006 11:08 pm

@benny + @Comtois: thanks a lot for your contributions!

@Comtois: I've updated the Matrix2.pb code with the mentioned code on the linked thread. Can you convert also the "simple" Matrix1.pb code (see also first post in the thread) to PB v4? Thanks a lot.

Intrigued · Post by **Intrigued** » Wed Nov 15, 2006 2:15 am

Andre (sorry bit OFFT), same problem, but it's in German and my wife is not here to translate. Can you post an English PayPal version? I'll donate then.

TIA

Keep up the great work!

(Sorry back ONT)

Post by **Andre** » Wed Nov 22, 2006 3:47 pm

Post by **Andre** » Sat Nov 25, 2006 9:27 pm

I just want to tell, that I've now also converted all forum links to their new destinations (new domains, older codes from german forum now use their relating "..../archive/..." links)

Currently I'm converting CAV to PB v4, after that I will add new codes to the CodeArchive.

Would be nice, if someone can help to complete the converting of the old codes to PB v4 (see list above).

Thanks!

Flype · Post by **Flype** » Sun Nov 26, 2006 1:07 am

hi andre,

here is a little one :
http://www.purearea.net/pb/CodeArchiv/G ... haBlend.pb

but i don't know how to convert the ASM part.

Code: Select all

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=3268&start=10
; Author: Mischa
; Date: 30. December 2003

Import "Msimg32.lib"
  AlphaBlend(dc1, x1, y1, w1, h1, dc2, x2, y2, w2, h2, blend)
EndImport

Procedure.l DrawAlphaImage2(hdc, image, x, y, Alpha) 
  Protected tdc.l, object.l, w.l, h.l, blend.l, *blend.BLENDFUNCTION = @blend
  tdc = CreateCompatibleDC_(hdc) 
  If tdc
    object = SelectObject_(tdc, ImageID(image)) 
    If object
      w = ImageWidth(image)
      h = ImageHeight(image) 
      *blend\SourceConstantAlpha = Alpha
      AlphaBlend(hdc, x, y, w, h, tdc, 0, 0, w, h, blend) 
      DeleteObject_(object) 
    EndIf
    DeleteDC_(tdc) 
  EndIf
EndProcedure 

For i = 1 To 10 
  If CreateImage(i, Random(50)+50, Random(50)+50) 
    If StartDrawing(ImageOutput(i)) 
      Box(0, 0, ImageWidth(i), ImageHeight(i), RGB(Random(255), Random(255), Random(255))) 
      StopDrawing() 
    EndIf
  EndIf
Next i 

If OpenWindow(0, 0, 0, 400, 300, "AlphaBlend", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
  
  hdc = StartDrawing(WindowOutput(0)) 
  
  If hdc
    For i = 1 To 100 
      For j = 1 To 10 
        DrawAlphaImage2(hdc, j, Random(375), Random(275), i) 
      Next j 
      WindowEvent() 
      Delay(20) 
    Next i 
  EndIf
  
  StopDrawing() 

  Repeat
  Until WaitWindowEvent()=#PB_Event_CloseWindow 

EndIf

Comtois · Post by **Comtois** » Sun Nov 26, 2006 1:17 am

you can forget this one

http://www.purearea.net/pb/CodeArchiv/G ... Matrix1.pb (Comtois)

you have the same (matrix2) here

netmaestro · Post by **netmaestro** » Sun Nov 26, 2006 1:56 am

ListIcon_SortByColumn:

Code: Select all

; English forum:
; Author:
; Date:

Structure PB_ListIconItem 
  UserData.l 
EndStructure 

#LVM_SETEXTENDEDLISTVIEWSTYLE = #LVM_FIRST + 54
#LVM_GETEXTENDEDLISTVIEWSTYLE = #LVM_FIRST + 55
Global ListIconGadget.l, Buffer1.l, Buffer2.l, lvi.LV_ITEM, updown.l, lastcol.l
Buffer1 = AllocateMemory(128)
Buffer2 = AllocateMemory(128)

Procedure CompareFunc(*item1.PB_ListIconItem, *item2.PB_ListIconItem, lParamSort) 
  result = 0 
  lvi\iSubItem = lParamSort 
  lvi\pszText = Buffer1 
  lvi\cchTextMax = 512 
  lvi\Mask = #LVIF_TEXT 
  SendMessage_(ListIconGadget, #LVM_GETITEMTEXT, *item1\UserData, @lvi) 
  lvi\pszText = Buffer2 
  SendMessage_(ListIconGadget, #LVM_GETITEMTEXT, *item2\UserData, @lvi) 
  Seeker1 = Buffer1 
  Seeker2 = Buffer2 
  done = 0 
  While done=0 
    char1 = Asc(UCase(Chr(PeekB(Seeker1)))) 
    char2 = Asc(UCase(Chr(PeekB(Seeker2)))) 
    result = (char1-char2)*updown 
    If result<>0 Or (Seeker1-Buffer1)>511
      done = 1 
    EndIf 
    Seeker1+1 
    Seeker2+1 
  Wend 
  ProcedureReturn result 
EndProcedure 

Procedure UpdatelParam() 
  Protected i.l, lTmp.l, lRecs.l, lvi.LV_ITEM 
  lRecs = SendMessage_(ListIconGadget, #LVM_GETITEMCOUNT, 0, 0) 
  For i = 0 To lRecs - 1 
    SetGadgetItemData(GetDlgCtrlID_(ListIconGadget), i, i) 
  Next 
EndProcedure 


Procedure ColumnClickCallback(hwnd, uMsg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select uMsg 
    Case #WM_NOTIFY 
      *msg.NMHDR = lParam 
      If *msg\hwndFrom = ListIconGadget And *msg\code = #LVN_COLUMNCLICK 
        *pnmv.NM_LISTVIEW = lParam 
        If lastcol<>*pnmv\iSubItem 
          updown = 1 
        EndIf 
        SendMessage_(ListIconGadget, #LVM_SORTITEMS, *pnmv\iSubItem, @CompareFunc()) 
        UpdatelParam() 
        UpdateWindow_(ListIconGadget) 
        lastcol = *pnmv\iSubItem 
        updown = -updown 
      EndIf 
    Case #WM_SIZE 
      If hwnd = WindowID(0) And IsIconic_(hwnd)=0 
        WindowWidth = lParam & $FFFF 
        WindowHeight = lParam>>16 
        ResizeGadget(0, 0, 0, WindowWidth, WindowHeight) 
        result = 1 
      EndIf 
  EndSelect 

  ProcedureReturn result 
EndProcedure

If OpenWindow(0, 384, 288, 640, 480, "ListIconGadget sort example", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
  LVWidth = WindowWidth(0)
  LVCWidth = Int(LVWidth/4)-1
  If CreateGadgetList(WindowID(0))
    ListIconGadget = ListIconGadget(0, 0, 0, LVWidth, WindowHeight(0), "Column 0", LVCWidth, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
    AddGadgetColumn(0, 1, "Column 1", LVCWidth)
    AddGadgetColumn(0, 2, "Column 2", LVCWidth)
    AddGadgetColumn(0, 3, "Column 3", LVCWidth)
  EndIf
  AddGadgetItem(0, 0, "Aaa 1"+Chr(10)+"Bcc 3"+Chr(10)+"Cdd 2"+Chr(10)+"Eee 3"+Chr(10), 0)
  AddGadgetItem(0, 1, "Aab 2"+Chr(10)+"Bbc 2"+Chr(10)+"Ddd 3"+Chr(10)+"Dde 1"+Chr(10), 0)
  AddGadgetItem(0, 2, "Abb 3"+Chr(10)+"Baa 1"+Chr(10)+"Ccd 1"+Chr(10)+"Dee 2"+Chr(10), 0)
  updown = 1
  lastcol = 0
  UpdatelParam()
  SetWindowCallback(@ColumnClickCallback())

  Repeat
    EventID = WaitWindowEvent()
  Until EventID = #PB_Event_CloseWindow
EndIf

FreeMemory(Buffer1)
FreeMemory(Buffer2)
End
; ExecutableFormat=Windows
; FirstLine=1
; EnableXP
; DisableDebugger
; EOF

Post by **Andre** » Sun Nov 26, 2006 1:12 pm

@Flype + netmaestro: thanks for the updated codes, I've added them to the archive

@Comtois: about the Matrix1 code: can you please help finishing the following code? I really would like to have this "simpler" code with some different material/light settings in the archive.... (currently only the picture is missing and the keyboard settings aren't displayed - but they works)

Code: Select all

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=8367&highlight=
; Author: Comtois
; Date: 16. November 2003
; OS: Windows
; Demo: 

;******************************************* 
;** Comtois ** 15/11/03 ** Matrice / Vagues  ** 
;******************************************* 

;-Initialisation 
; #ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 32 
ExamineDesktops() 

If InitEngine3D()=0 
   MessageRequester("Erreur", "Impossible d'initialiser la 3D , Vérifiez la présence de la DLL Engine3D.dll", 0) 
   End 
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 
   MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0) 
   End 
ElseIf OpenScreen( DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "DemoMatrice" ) = 0 
   MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 ) 
   End 
EndIf 


;-Variables Globales 
Global AngleVague.f ,vitesse.f ,decaleX.f ,decaleZ.f ,hauteur.f 
AngleVague = Random(360) 
vitesse = 3.0 
decaleX = 23 
decaleZ = 0 
hauteur = 4 

;- Declaration des procédures 
Declare Matrice(NbpointsX.l,NbpointsZ.l) 

;-Constantes 
Global addpoint.l, addtriangle.l, addtexture.l

#NbX= 30 ; nombre de facettes 
#NbZ= 30 ; nombre de facettes 

;-Mémoires Mesh 
addpoint = AllocateMemory(12 * (#NbX + 1 )* (#NbZ + 1 )) 
addtriangle = AllocateMemory(12 * #NbX * #NbZ * 4) 
addtexture = AllocateMemory(12 * (#NbX + 1 )* (#NbZ + 1 )) 
Matrice(#NbX , #NbZ) 

;-Mesh 
CreateMesh(0, 100) 
SetMeshData(0, #PB_Mesh_Vertex      , addpoint    , (#NbX + 1 )* (#NbZ + 1 )) 
SetMeshData(0, #PB_Mesh_Face        , addtriangle , (#NbX ) * (#NbZ ) * 4) 
SetMeshData(0, #PB_Mesh_UVCoordinate, addtexture  , (#NbX + 1 )* (#NbZ + 1 )) 

;-Texture 
UsePNGImageDecoder() 
;LoadTexture(0,"purebasiclogoNew.png") ; <<< pourquoi ça plante quand je mets juste ça ? 
LoadImage(0,"..\gfx\purebasiclogoNew.png")    ; alors que l'image se charge ? Je verrai ça plus tard 
CreateTexture(0,256,256) 
StartDrawing(TextureOutput(0)) 
DrawImage(ImageID(0),0,0) 
DrawingMode(4) 
Box(1,1,254,254,RGB(255,255,255)) 
StopDrawing() 


;- MAterial 
CreateMaterial(0,TextureID(0)) 
MaterialFilteringMode(0 , #PB_Material_Trilinear ) 

;-Entity 
CreateEntity(0, MeshID(0), MaterialID(0)) 
RotateEntity(0,0,45,0) 
ScaleEntity(0, 10, 10, 10) 

;-Camera 
CreateCamera(0, 0, 0, 100, 100) 
CameraLocate(0,0,350,350) 
CameraLookAt(0,0,0,0) 
CameraRenderMode(0, #PB_Camera_Wireframe)    ; added by Andre to show different start settings than Matrix2 example

;-Procédures 
Procedure Matrice(FX.l,FZ.l) 
    
   adresse=addpoint
   For b=0 To FZ 
      For a=0 To FX 
         PokeF(adresse, a - FX/2) : PokeF(adresse + 4, 0 ) : PokeF(adresse + 8, b - FZ/2)  
         ;PokeF(adresse, a ) : PokeF(adresse + 4, 0 ) : PokeF(adresse + 8, b ) 
         adresse + 12 
      Next a 
   Next b 
    
   adresse=addtriangle 
   Nb = FX + 1 
   For b=0 To FZ - 1 
      For a=0 To FX - 1 
         P1 = a + (b * Nb) 
         P2 = a + 1 + (b * Nb) 
         P3 = a + ((b + 1) * Nb) 
         P4 = a + 1 + ((b + 1) * Nb) 
         PokeW(adresse     , P3) : PokeW(adresse +  2, P2) : PokeW(adresse +  4, P1) 
         PokeW(adresse +  6, P2) : PokeW(adresse +  8, P3) : PokeW(adresse + 10, P4)    
         PokeW(adresse + 12, P1) : PokeW(adresse + 14, P2) : PokeW(adresse + 16, P3) 
         PokeW(adresse + 18, P4) : PokeW(adresse + 20, P3) : PokeW(adresse + 22, P2)            
         adresse + 24 
      Next a 
   Next b 
    
   adresse=addtexture 
   For b=0 To FZ 
      For a=0 To FX 
         px.f = a/FX 
         pz.f = b/FZ 
         PokeF(adresse, px) : PokeF(adresse + 4, pz)    
         adresse + 8 
      Next a 
   Next b 
    
EndProcedure  

Procedure.f wrapvalue( angle.f ) 
   ;Permet de toujours avoir un angle compris entre 0° et 360° 
   While angle < 0 
      angle + 360 
   Wend 
   While angle - 360 >= 0 
      angle - 360 
   Wend 
   ProcedureReturn angle 
EndProcedure 

Procedure.f Cosd( angle.f ) 
   ;calcule le cos d'un angle en degré 
   a.f = angle * 0.0174533 
   ProcedureReturn Cos( a ) 
EndProcedure 

Procedure.f Sind( angle.f ) 
   ;calcule le sin d'un angle en degré 
   a.f = angle  * 0.0174533 
   ProcedureReturn Sin( a ) 
EndProcedure 

Procedure vagues() 
   ; Modification sur l'axe des Y 
   adresse = addpoint + 4 
   For z = 0 To #NbZ 
      For x = 0 To #NbX 
         Sommet.f = Sind(AngleVague + (x * decaleX) + (z * decaleZ)) * hauteur 
         PokeF(adresse, Sommet) 
         adresse + 12 
      Next x 
   Next z 
   SetMeshData(0, #PB_Mesh_Vertex, addpoint , (#NbX + 1 )* (#NbZ + 1 )) 
EndProcedure 

Procedure AffAide() 
   StartDrawing(ScreenOutput()) 
   DrawingMode(1) 
   FrontColor(RGB(255,255,255)) 
   DrawText(0, 0, "[F1] / [F2] => Change Mode affichage") 
   DrawText(0, 20, "[PageUp] / [PageDown] => Hauteur : " + StrF(hauteur)) 
   DrawText(0, 40, "[Flèche Haut] / [Flèche bas] => DecaleZ : " + Str(decaleZ)) 
   DrawText(0, 60, "[Flèche Gauche] / [Flèche droite] => DecaleX : " + Str(decaleX)) 
   StopDrawing() 
EndProcedure 

;-Boucle principale 

Repeat 
    
   ClearScreen(RGB(0, 0, 0))
   ExamineKeyboard() 
   AffAide() 
   If KeyboardReleased(#PB_Key_F1) :ClearScreen(RGB(0, 0, 0)): CameraRenderMode(0, #PB_Camera_Wireframe)  : EndIf 
   If KeyboardReleased(#PB_Key_F2) :ClearScreen(RGB(0, 0, 0)): CameraRenderMode(0, #PB_Camera_Textured)  : EndIf 
    
   If KeyboardReleased(#PB_Key_PageUp) : hauteur + 0.5  : EndIf 
   If KeyboardReleased(#PB_Key_PageDown) : hauteur - 0.5  : EndIf 
    
   If KeyboardReleased(#PB_Key_Up) : decaleZ + 1  : EndIf 
   If KeyboardReleased(#PB_Key_Down) : decaleZ - 1  : EndIf 
   If KeyboardReleased(#PB_Key_Left) : decaleX - 1  : EndIf 
   If KeyboardReleased(#PB_Key_Right) : decaleX + 1  : EndIf 
    
   AngleVague = wrapvalue(AngleVague + vitesse) 
   vagues() 
   RotateEntity(0,0,0,0.1) 
   RenderWorld() 
   FlipBuffers() 
    
Until KeyboardPushed(#PB_Key_Escape)

Thanks in advance!

Comtois · Post by **Comtois** » Sun Nov 26, 2006 4:48 pm

currently only the picture is missing :

Yes, UVCoordinates were wrong.

and the keyboard settings aren't displayed :

you have 2 solutions
- (a) - 3D on 2D -> add CameraBackColor(0,-1)
- (b) - 2D on 3D -> move AddAide() after RenderWorld()

Code: Select all

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=8367&highlight=
; Author: Comtois
; Date: 16. November 2003
; OS: Windows
; Demo:

;*******************************************
;** Comtois ** 15/11/03 ** Matrice / Vagues  **
;*******************************************

;-Initialisation
ExamineDesktops()

If InitEngine3D()=0
   MessageRequester("Erreur", "Impossible d'initialiser la 3D , Vérifiez la présence de la DLL Engine3D.dll", 0)
   End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0
   MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
   End
ElseIf OpenScreen( DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "DemoMatrice" ) = 0
   MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 )
   End
EndIf


;-Variables Globales
Global *addpoint, *addtriangle
Global AngleZ.f, AngleVague.f, vitesse.f, decaleX.f, decaleZ.f, hauteur.f

AngleVague = Random(360)
vitesse = 3.0
decaleX = 8
decaleZ = 8
hauteur = 3

;- Declaration des procédures
Declare Matrice(NbpointsX.l,NbpointsZ.l)

;-Constantes
#NbX= 30 ; nombre de facettes
#NbZ= 30 ; nombre de facettes
#Deg2Rad = #PI / 180.0

;-Mémoires Mesh
*addpoint = AllocateMemory(20 * (#NbX + 1 )* (#NbZ + 1 ))
*addtriangle = AllocateMemory(24 * #NbX * #NbZ * 4)
Matrice(#NbX , #NbZ)

;-Mesh
CreateMesh(0, 100)
SetMeshData(0, #PB_Mesh_Vertex | #PB_Mesh_UVCoordinate, *addpoint, (#NbX + 1) * (#NbZ + 1))
SetMeshData(0, #PB_Mesh_Face, *addtriangle, #NbX * #NbZ * 4)

;-Texture
UsePNGImageDecoder()
;LoadTexture(0,"purebasiclogoNew.png") ; <<< pourquoi ça plante quand je mets juste ça ?
LoadImage(0,"purebasiclogoNew.png")    ; alors que l'image se charge ? Je verrai ça plus tard
CreateTexture(0, 256, 256)
StartDrawing(TextureOutput(0))
DrawImage(ImageID(0), 0, 0)
DrawingMode(4)
Box(1, 1, 254, 254, #White)
StopDrawing()


;- MAterial
CreateMaterial(0,TextureID(0))

;-Entity
CreateEntity(0, MeshID(0), MaterialID(0))
RotateEntity(0, 0, 45,0)
ScaleEntity(0, 10, 10, 10)

;-Camera
CreateCamera(0, 0, 0, 100, 100)
CameraLocate(0,0,350,350)
CameraLookAt(0,0,0,0)
CameraRenderMode(0, #PB_Camera_Wireframe) ; added by Andre to show different start settings than Matrix2 example

;-Procédures
Procedure Matrice(FX.l,FZ.l)
   
   adresse=*addpoint
   For b=0 To FZ
      For a=0 To FX
         ;Position vertices
         PokeF(adresse, a - FX/2) : PokeF(adresse + 4, 0 ) : PokeF(adresse + 8, b - FZ/2) 
         ;UV coordinates (Texture)
         u.f = a/FX 
         v.f = b/FZ
         PokeF(adresse + 12, u) : PokeF(adresse + 16, v)   
         adresse + 20
      Next a
   Next b
   
   adresse=*addtriangle
   Nb = FX + 1
   For b=0 To FZ - 1
      For a=0 To FX - 1
         P1 = a + (b * Nb)
         P2 = P1 + 1
         P3 = a + ((b + 1) * Nb)
         P4 = P3 + 1
         ;Recto 
         PokeW(adresse     , P3) : PokeW(adresse +  2, P2) : PokeW(adresse +  4, P1)
         PokeW(adresse +  6, P2) : PokeW(adresse +  8, P3) : PokeW(adresse + 10, P4)   
         ;Verso
         PokeW(adresse + 12, P1) : PokeW(adresse + 14, P2) : PokeW(adresse + 16, P3)
         PokeW(adresse + 18, P4) : PokeW(adresse + 20, P3) : PokeW(adresse + 22, P2)           
         adresse + 24
      Next a
   Next b

EndProcedure 

Procedure.f WrapValue(angle.f); <- wraps a value into [0,360) fringe
  ;Psychophanta : http://purebasic.fr/english/viewtopic.php?t=18635 
  !fild dword[@f] ; <- now i have 360 into st0
  !fld dword[p.v_angle]
  !fprem
  !fadd st1,st0
  !fldz
  !fcomip st1
  !fcmovnbe st0,st1
  !fstp st1
  ProcedureReturn
  !@@:dd 360
EndProcedure

Macro Cosd(angle)
  (Cos((angle) * #Deg2Rad))
EndMacro

Macro Sind(angle)
  (Sin((angle) * #Deg2Rad))
EndMacro

Procedure vagues()
   ; Modification sur l'axe des Y
   adresse = *addpoint + 4
   For z = 0 To #NbZ
      For x = 0 To #NbX
         Sommet.f = Sind(AngleVague + (x * decaleX) + (z * decaleZ)) * hauteur
         PokeF(adresse, Sommet)
         adresse + 20
      Next x
   Next z
   SetMeshData(0, #PB_Mesh_Vertex | #PB_Mesh_UVCoordinate, *addpoint , (#NbX + 1) * (#NbZ + 1))
EndProcedure

Procedure AffAide()
   StartDrawing(ScreenOutput())
   DrawingMode(1)
   FrontColor(RGB(255,255,255))
   DrawText(0, 0, "[F1] / [F2] => Change Mode affichage")
   DrawText(0, 20, "[PageUp] / [PageDown] => Hauteur : " + StrF(hauteur))
   DrawText(0, 40, "[Flèche Haut] / [Flèche bas] => DecaleZ : " + Str(decaleZ))
   DrawText(0, 60, "[Flèche Gauche] / [Flèche droite] => DecaleX : " + Str(decaleX))
   StopDrawing()
EndProcedure

;-Boucle principale

Repeat
   
   ClearScreen(#Black)
   ExamineKeyboard()
   If KeyboardReleased(#PB_Key_F1) :ClearScreen(RGB(0, 0, 0)): CameraRenderMode(0, #PB_Camera_Wireframe)  : EndIf
   If KeyboardReleased(#PB_Key_F2) :ClearScreen(RGB(0, 0, 0)): CameraRenderMode(0, #PB_Camera_Textured)  : EndIf
   
   If KeyboardReleased(#PB_Key_PageUp) : hauteur + 0.5  : EndIf
   If KeyboardReleased(#PB_Key_PageDown) : hauteur - 0.5  : EndIf
   
   If KeyboardReleased(#PB_Key_Up) : decaleZ + 1  : EndIf
   If KeyboardReleased(#PB_Key_Down) : decaleZ - 1  : EndIf
   If KeyboardReleased(#PB_Key_Left) : decaleX - 1  : EndIf
   If KeyboardReleased(#PB_Key_Right) : decaleX + 1  : EndIf
   
   AngleVague = wrapvalue(AngleVague + vitesse)
   vagues()
   AngleZ + 0.5
   RotateEntity(0,0,0, AngleZ)
   RenderWorld()
   AffAide()
   FlipBuffers()
   
Until KeyboardPushed(#PB_Key_Escape)

Post by **Andre** » Sun Nov 26, 2006 4:52 pm

@Comtois: cool, thanks!