PureBasic

Salut à tous,
Comme je ne suis pas un expert en 3D, je pose la question...
Comment réaliser un Mouse Pick sur une Entity ?
En fait cela revient à identifier les entity qui se trouve sous le pointeur.

il y a un exemple sur le site d'Ogre, ça serait bien qu'il soit adapté pour PureBasic, mais en attendant faut qu'on se débrouille comme on peut.

Jusqu'à présent je ne m'étais pas cassé la tête, je prenais le centre de l'écran comme pointeur, ça correspond à la position de la caméra, et je n'ai plus qu'à faire un lancer de rayon pour trouver l'entity en collision.

Le principe est sensiblement le même avec la souris, la difficulté c'est de trouver le point 3D correspond avant de lancer un rayon.Pour l'instant je ne sais pas comment calculer le point 3D...

Alors j'ai fait le contraire, je calcule les points 2D en partant des entitys.
c'est pas terrible parce que je ne prends pas en compte les angles de la caméra. C'est un début, après faut adapter selon le besoin.

http://perso.wanadoo.fr/comtois/sources/Picking.zip

Dans l'exemple tu as un cube que tu déplaces avec les flèches, la caméra se déplace en plaçant la souris sur les bords de l'écran.

Je calcule la projection des points qui enveloppent le cube, je les dessine à l'écran ,et si je connais les points 2D qui enveloppent mon entity ,je peux aussi dire si la souris est dessus ou non. Clique avec la souris sur l'entity pour la faire tourner.

Salut Comtois,
Alors toujours aussi rapide dans tes réponses sur le Forum

Le Speedy Gonzales de PureBasic

Merci pour ton approche, c'est déja un bon début.
( Avec tous tes codes, il fallu que je crée un repertoire Comtois

)

Le mieux serait bien-sur à terme d'avoir une commande genre "PickEntity"...
Fred si tu nous entends

Drac avait déjà bossé sur le sujet et il a été beaucoup plus loin que moi , il prend en compte l'angle de la caméra

http://purebasic.hmt-forum.com/viewtopic.php?t=4305

Merci, c'est cool.

une petite mise à jour du code, cette fois ci le calcul de l'angle fonctionne, et prend en compte la résolution de l'écran et la focale de la caméra, je m'étais planté je prenais la largeur au lieu de la hauteur de l'écran

Code : Tout sélectionner

;Comtois le 25/06/06
;Cette fois ci le calcul tient compte de la résolution de l'écran et de la focale de la caméra.

;Evidemment cet exemple ne fonctionne plus si un angle de la caméra change.
;Malgré tout ça peut répondre à certains besoins.

#CameraSpeed = 10
#Focale = 60

Structure Screen 
  Width.l 
  Height.l
  Width_2.l 
  Height_2.l
  d.f
EndStructure

Structure Cube
   P1.POINT
   P2.POINT
   P3.POINT
   P4.POINT
   P5.POINT
   P6.POINT   
   P7.POINT
   P8.POINT
   Width.f
   Height.f
   Depth.f
   Width_2.f
   Height_2.f
   Depth_2.f
EndStructure

Global Screen.Screen 
Screen\Width = 800
Screen\Width_2 = Screen\Width  / 2
Screen\Height = 600
Screen\Height_2 = Screen\Height / 2
;Calcul de l'angle pour les projections
Angle.f = (#Focale * 0.0174533) / 2.0 
Screen\d = (Screen\Height / (2 * Tan(Angle)))

Declare Erreur(Message.s, Quit.l)

If InitEngine3D() = 0
   Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll" , #True)
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0
   Erreur("Impossible d'initialiser DirectX 7 Ou plus" , #True)
ElseIf OpenScreen(Screen\Width, Screen\Height, 32, "3D") = 0
   Erreur("Impossible d'ouvrir l'écran ", #True)
EndIf
UsePNGImageDecoder()

Define.f KeyX, KeyY, MouseX, MouseY
Global Cube.Cube
Cube\Width = 200
Cube\Width_2 = Cube\Width / 2
Cube\Height = 200
Cube\Height_2 = Cube\Height / 2
Cube\Depth = 200
Cube\Depth_2 = Cube\Depth / 2

Add3DArchive("Data\", #PB_3DArchive_FileSystem)

;-Sprite
#Souris = 0
LoadSprite(#SOuris,"Data\Souris.PNG")

;-Mesh
Enumeration 
   #Plan 
   #Cube 
EndEnumeration

LoadMesh   (#plan, "plan.mesh")
LoadMesh   (#cube, "cube.mesh")


;-Textures
LoadTexture(#Plan, "wood02.jpg")
LoadTexture(#Cube, "wall12.jpg")

;-Material
CreateMaterial(#Plan,TextureID(#Plan))
CreateMaterial(#Cube,TextureID(#Cube))

;-Entity
CreateEntity (#Plan, MeshID(#Plan), MaterialID(#Plan))
CreateEntity (#cube, MeshID(#Cube), MaterialID(#Cube),600,100,200)

ScaleEntity(#Plan, 10, 1, 10)
ScaleEntity(#Cube, 2, 2, 2)

;-Light
AmbientColor(RGB(128,128,128))
CreateLight(0, RGB(255,255,255))

;-Camera
CreateCamera(0, 0, 0, 100, 100)
CameraLocate(0, 1000, 500, 1000) 
CameraFOV(0, #Focale * 0.0174533)

;-Procedures
Procedure Erreur(Message.s, Quit.l)
   MessageRequester("Erreur", Message, #PB_MessageRequester_Ok)
   If Quit
      End
   EndIf
EndProcedure

Procedure P3D_P2D(X.f, Y.f, Z.f, *P2D.POINT)
   Define.f X1, Y1, Z1
   X1 = CameraX(0) - X
   Y1 = Y - CameraY(0)
   Z1 = Z - CameraZ(0)
   *P2D\x = (X1 / Z1 * Screen\d) + Screen\Width_2 
   *P2D\y = (Y1 / Z1 * Screen\d) + Screen\Height_2
EndProcedure
   
Procedure Cube3D_Cube2D(X.f, Y.f, Z.f)
   Define.f d, Angle, X1, Y1, Z1

   ;Point 1
   P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, @Cube\P1)
   
   ;Point 2
   P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, @Cube\P2)

   ;Point 3
   P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, @Cube\P3)
   
   ;Point 4
   P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, @Cube\P4)
   
   ;Point 5   
   P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, @Cube\P5)                        
      
   ;Point 6  
   P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, @Cube\P6)                       
   
   ;Point 7    
   P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, @Cube\P7)                   
   
   ;Point 8   
   P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, @Cube\P8)                   

EndProcedure

Macro Infos
   StartDrawing(ScreenOutput())
      ;Pour vérifiez que les calculs 3D -> 2D sont corrects (A remplacer par un tableau, idem dans la structure)
      Ct1 = (Cube\P1\x>-1 And Cube\P1\x<Screen\Width And Cube\P1\y>-1 And Cube\P1\y<Screen\Height)
      Ct2 = (Cube\P2\x>-1 And Cube\P2\x<Screen\Width And Cube\P2\y>-1 And Cube\P2\y<Screen\Height)
      Ct3 = (Cube\P3\x>-1 And Cube\P3\x<Screen\Width And Cube\P3\y>-1 And Cube\P3\y<Screen\Height)
      Ct4 = (Cube\P4\x>-1 And Cube\P4\x<Screen\Width And Cube\P4\y>-1 And Cube\P4\y<Screen\Height)
      Ct5 = (Cube\P5\x>-1 And Cube\P5\x<Screen\Width And Cube\P5\y>-1 And Cube\P5\y<Screen\Height)
      Ct6 = (Cube\P6\x>-1 And Cube\P6\x<Screen\Width And Cube\P6\y>-1 And Cube\P6\y<Screen\Height)
      Ct7 = (Cube\P7\x>-1 And Cube\P7\x<Screen\Width And Cube\P7\y>-1 And Cube\P7\y<Screen\Height)
      Ct8 = (Cube\P8\x>-1 And Cube\P8\x<Screen\Width And Cube\P8\y>-1 And Cube\P8\y<Screen\Height)
      If (Ct1 And ct2) : LineXY(Cube\P1\x, Cube\P1\y, Cube\P2\x, Cube\P2\y, $FF) : EndIf
      If (Ct3 And ct4) : LineXY(Cube\P3\x, Cube\P3\y, Cube\P4\x, Cube\P4\y, $FF) : EndIf
      If (Ct1 And ct3) : LineXY(Cube\P1\x, Cube\P1\y, Cube\P3\x, Cube\P3\y, $FF) : EndIf
      If (Ct2 And ct4) : LineXY(Cube\P2\x, Cube\P2\y, Cube\P4\x, Cube\P4\y, $FF) : EndIf
      If (Ct1 And ct5) : LineXY(Cube\P1\x, Cube\P1\y, Cube\P5\x, Cube\P5\y, $FF) : EndIf
      If (Ct2 And ct6) : LineXY(Cube\P2\x, Cube\P2\y, Cube\P6\x, Cube\P6\y, $FF) : EndIf
      If (Ct5 And ct6) : LineXY(Cube\P5\x, Cube\P5\y, Cube\P6\x, Cube\P6\y, $FF) : EndIf
      If (Ct3 And ct7) : LineXY(Cube\P3\x, Cube\P3\y, Cube\P7\x, Cube\P7\y, $FF) : EndIf
      If (Ct4 And ct8) : LineXY(Cube\P4\x, Cube\P4\y, Cube\P8\x, Cube\P8\y, $FF) : EndIf
      If (Ct5 And ct7) : LineXY(Cube\P5\x, Cube\P5\y, Cube\P7\x, Cube\P7\y, $FF) : EndIf
      If (Ct6 And ct8) : LineXY(Cube\P6\x, Cube\P6\y, Cube\P8\x, Cube\P8\y, $FF) : EndIf
      If (Ct7 And ct8) : LineXY(Cube\P7\x, Cube\P7\y, Cube\P8\x, Cube\P8\y, $FF) : EndIf
      ;L'entity n'est plus affichée à l'écran
      If (ct1 Or ct2 Or ct3 Or ct4 Or ct5 Or ct6 Or ct7 Or ct8) 
         DrawText(0,20,"Le cube est visible",$00FF00,0)
      Else
         DrawText(0,20,"Le cube n'est plus visible",$FF,0)
      EndIf
   StopDrawing()
EndMacro

MouseLocate(400,300)

Repeat

   ClearScreen(0)
     
   If ExamineKeyboard()
    
     If KeyboardPushed(#PB_Key_Up)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube), EntityZ(#Cube)-#CameraSpeed)
     ElseIf KeyboardPushed(#PB_Key_Down)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube), EntityZ(#Cube)+#CameraSpeed)
     EndIf
     If KeyboardPushed(#PB_Key_Left)
       EntityLocate(#Cube, EntityX(#Cube)-#CameraSpeed, EntityY(#Cube), EntityZ(#Cube))
     ElseIf KeyboardPushed(#PB_Key_Right)
       EntityLocate(#Cube, EntityX(#Cube)+#CameraSpeed, EntityY(#Cube), EntityZ(#Cube))
     EndIf    

   EndIf

   If ExamineMouse()
      If MouseX() = 0 
         CameraLocate(0,CameraX(0)-#CameraSpeed, CameraY(0), CameraZ(0))
      ElseIf MouseX() = Screen\Width-1
         CameraLocate(0,CameraX(0)+#CameraSpeed, CameraY(0), CameraZ(0))   
      EndIf   
      If MouseY() = 0
         CameraLocate(0,CameraX(0), CameraY(0), CameraZ(0)-#CameraSpeed)   
      ElseIf MouseY() = Screen\Height-1
         CameraLocate(0,CameraX(0), CameraY(0), CameraZ(0)+#CameraSpeed)  
      EndIf    
      
      If MouseButton(1)
         If MouseX()>Cube\P1\x And MouseX() < Cube\P2\x 
            If MouseY()>Cube\P1\y And MouseY() < Cube\P4\y 
               Angle + 1 
               RotateEntity(#Cube,Angle, 0 , 0)
            EndIf
         EndIf
      Else
        RotateEntity(#Cube, 0 , 0 , 0)
        Angle = 0
      EndIf         
   EndIf
        
   RenderWorld()     
   DisplayTransparentSprite(#SOuris,MouseX(),MouseY())   
 
   Cube3D_Cube2D(EntityX(#cube), EntityY(#cube), EntityZ(#cube))
   Infos  
   FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Je viens de tester...C'est bizarre je n'arrive pas à faire tourner le cube si je selectionne une autre partie que la face de devant.
Un shot est plus parlant :

http://perso.orange.fr/sehka/PureBasic/ ... ng_Bug.jpg

Ben c'est normal, pour faire simple je ne testais que la face avant

dans ce code , je cherche le polygone convexe qui encadre le cube, ensuite il suffit d'appliquer les algos de test d'un point dans un polygone pour tester la souris sur le cube.

A l'occasion j'ajouterai peut-être l'algo permettant de tester si un point se trouve dans un polygone convexe , tiens d'ailleurs je viens de me souvenir qu'il y avait eu un post à ce sujet et quelqu'un avait proposé un truc avec l'API , faudrait faire une petite recherche sur le mot region.

Code : Tout sélectionner

;Comtois le 25/06/06
;Cette fois ci le calcul tient compte de la résolution de l'écran et de la focale de la caméra.

;Evidemment cet exemple ne fonctionne plus si un angle de la caméra change.
;Malgré tout ça peut répondre à certains besoins.

#CameraSpeed = 10
#Focale = 65

Structure Screen 
  Width.l 
  Height.l
  Width_2.l 
  Height_2.l
  d.f
EndStructure

Structure Cube
   Width.f
   Height.f
   Depth.f
   Width_2.f
   Height_2.f
   Depth_2.f
EndStructure

Global Screen.Screen 
Screen\Width = 800
Screen\Width_2 = Screen\Width  / 2
Screen\Height = 600
Screen\Height_2 = Screen\Height / 2
;Calcul de l'angle pour les projections
Angle.f = (#Focale * 0.0174533) / 2.0 
Screen\d = (Screen\Height / (2 * Tan(Angle)))

Declare Erreur(Message.s, Quit.l)

If InitEngine3D() = 0
   Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll" , #True)
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0
   Erreur("Impossible d'initialiser DirectX 7 Ou plus" , #True)
ElseIf OpenScreen(Screen\Width, Screen\Height, 32, "3D") = 0
   Erreur("Impossible d'ouvrir l'écran ", #True)
EndIf
UsePNGImageDecoder()

Define.f KeyX, KeyY, MouseX, MouseY
Global Dim Polygone.Point(8)
Global Dim Ct(7)
Global NewList PolygoneConvexe.Point()
Global Cube.Cube
Cube\Width = 200
Cube\Width_2 = Cube\Width / 2
Cube\Height = 200
Cube\Height_2 = Cube\Height / 2
Cube\Depth = 200
Cube\Depth_2 = Cube\Depth / 2

Add3DArchive("Data\", #PB_3DArchive_FileSystem)

;-Sprite
#Souris = 0
LoadSprite(#SOuris,"Data\Souris.PNG")

;-Mesh
Enumeration 
   #Plan 
   #Cube 
EndEnumeration

LoadMesh   (#plan, "plan.mesh")
LoadMesh   (#cube, "cube.mesh")


;-Textures
LoadTexture(#Plan, "wood02.jpg")
LoadTexture(#Cube, "wall12.jpg")

;-Material
CreateMaterial(#Plan,TextureID(#Plan))
CreateMaterial(#Cube,TextureID(#Cube))

;-Entity
CreateEntity (#Plan, MeshID(#Plan), MaterialID(#Plan))
CreateEntity (#cube, MeshID(#Cube), MaterialID(#Cube),600,100,200)

ScaleEntity(#Plan, 10, 1, 10)
ScaleEntity(#Cube, 2, 2, 2)

;-Light
AmbientColor(RGB(128,128,128))
CreateLight(0, RGB(255,255,255))

;-Camera
CreateCamera(0, 0, 0, 100, 100)
CameraLocate(0, 1000, 500, 1000) 
CameraFOV(0, #Focale * 0.0174533)

;-Procedures
Procedure Erreur(Message.s, Quit.l)
   MessageRequester("Erreur", Message, #PB_MessageRequester_Ok)
   If Quit
      End
   EndIf
EndProcedure

Procedure CherchePolygoneConvexe()
  ;Initialise
  *Min.Point = #Null
  *p0.Point  = #Null
  *pi.Point  = #Null
  *pc.Point  = #Null
  ;Trouve le point le plus bas dans la liste des points
  *Min = @Polygone(0)
  For i = 0 To 7
    *p0 = @Polygone(i)
    ;Mémorise le point le plus bas , ou le plus à gauche s'il y a égalité
    If (*p0\y < *Min\y) Or ((*p0\y = *Min\y) And (*p0\x < *Min\x))
      *Min = *p0
    EndIf
  Next 
  ;Initialise la liste pour le contour convexe
  ClearList(PolygoneConvexe())
  ;Effectue la progression de Jarvis pour calculer le contour
  *p0 = *Min
  Repeat
    ;Insertion du nouveau p0 dans le contour convexe
    If AddElement(PolygoneConvexe()) = 0
      Erreur("plus de mémoire pour ajouter un élément dans polygone",1)
    Else 
      PolygoneConvexe()\x = *p0\x
      PolygoneConvexe()\y = *p0\y
    EndIf
    ;Trouve le point pc dans le sens des aiguilles d'une montre
    *pc = #Null
    For i = 0 To 7
      *pi = @Polygone(i)
      ;Saute p0
      If *pi = *p0
        Continue
      EndIf
      ;Sélectionne le premier point
      If *pc = #Null
        *pc = @Polygone(i)
        Continue
      EndIf
      ;Teste si pi est dans le sens des aiguilles d'une montre par rapport à pc
      z=(((*pi\x - *p0\x) * (*pc\y - *p0\y)) - ((*pi\y - *p0\y) * (*pc\x - *p0\x)))
      If z > 0
        ;pi est dans le sens des aiguilles d'une montre par rapport à pc
        *pc = *pi
      ElseIf z = 0
        ;Si pi et pc sont colinéaires , on choisit le plus éloigné de p0
        longueurpi = Pow(*pi\x - *p0\x, 2.0) + Pow(*pi\y - *p0\y, 2.0)
        longueurpc = Pow(*pc\x - *p0\x, 2.0) + Pow(*pc\y - *p0\y, 2.0)
        If longueurpi > longueurpc
          *pc = *pi
        EndIf
      EndIf 
    Next
    ;Cherche le point suivant
    *p0 = *pc
  Until *p0 = *Min
EndProcedure

Procedure P3D_P2D(X.f, Y.f, Z.f, *P2D.POINT)
   Define.f X1, Y1, Z1
   X1 = CameraX(0) - X
   Y1 = Y - CameraY(0)
   Z1 = Z - CameraZ(0)
   *P2D\x = (X1 / Z1 * Screen\d) + Screen\Width_2 
   *P2D\y = (Y1 / Z1 * Screen\d) + Screen\Height_2
EndProcedure
   
Procedure Cube3D_Cube2D(X.f, Y.f, Z.f)
   Define.f d, Angle, X1, Y1, Z1

   ;Point 0
   P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, @Polygone(0))
   
   ;Point 1
   P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, @Polygone(1))

   ;Point 2
   P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, @Polygone(2))
   
   ;Point 3
   P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, @Polygone(3))
   
   ;Point 4   
   P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, @Polygone(4))                        
      
   ;Point 5  
   P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, @Polygone(5))                       
   
   ;Point 6    
   P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, @Polygone(6))                   
   
   ;Point 7   
   P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, @Polygone(7))  
     
   ;Point 8   
   P3D_P2D(X, Y, Z, @Polygone(8))     
EndProcedure

Macro Infos
   Hdc = StartDrawing(ScreenOutput())
      ;Pour vérifiez que les calculs 3D -> 2D sont corrects (A remplacer par un tableau, idem dans la structure)
      For i = 0 To 7
        Ct(i) = (Polygone(i)\x>-1 And Polygone(i)\x<Screen\Width And Polygone(i)\y>-1 And Polygone(i)\y<Screen\Height)
      Next i

      SelectElement(PolygoneConvexe(), 0)
      *mem0.Point = PolygoneConvexe()
      *mem.Point  = PolygoneConvexe()
      While NextElement(PolygoneConvexe())
        LineXY(*mem\x, *mem\y, PolygoneConvexe()\x, PolygoneConvexe()\y, $FF)
        *mem = PolygoneConvexe()
      Wend 
      LineXY(*mem0\x, *mem0\y, *mem\x, *mem\y, $FF)

      ;L'entity n'est plus affichée à l'écran
      If (ct(0) Or ct(1) Or ct(2) Or ct(3) Or ct(4) Or ct(5) Or ct(6) Or ct(7)) 
         DrawText(0,20,"Le cube est visible",$00FF00,0)
      Else
         DrawText(0,20,"Le cube n'est plus visible",$FF,0)
      EndIf
      
   StopDrawing()
EndMacro

MouseLocate(400,300)

Repeat

   ClearScreen(0)
     
   If ExamineKeyboard()
    
     If KeyboardPushed(#PB_Key_Up)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube), EntityZ(#Cube)-#CameraSpeed)
     ElseIf KeyboardPushed(#PB_Key_Down)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube), EntityZ(#Cube)+#CameraSpeed)
     EndIf
     If KeyboardPushed(#PB_Key_Left)
       EntityLocate(#Cube, EntityX(#Cube)-#CameraSpeed, EntityY(#Cube), EntityZ(#Cube))
     ElseIf KeyboardPushed(#PB_Key_Right)
       EntityLocate(#Cube, EntityX(#Cube)+#CameraSpeed, EntityY(#Cube), EntityZ(#Cube))
     EndIf    

   EndIf

   If ExamineMouse()
      If MouseX() = 0 
         CameraLocate(0,CameraX(0)-#CameraSpeed, CameraY(0), CameraZ(0))
      ElseIf MouseX() = Screen\Width-1
         CameraLocate(0,CameraX(0)+#CameraSpeed, CameraY(0), CameraZ(0))   
      EndIf   
      If MouseY() = 0
         CameraLocate(0,CameraX(0), CameraY(0), CameraZ(0)-#CameraSpeed)   
      ElseIf MouseY() = Screen\Height-1
         CameraLocate(0,CameraX(0), CameraY(0), CameraZ(0)+#CameraSpeed)  
      EndIf    
      
      If MouseButton(1)
         If MouseX()>Polygone(0)\x And MouseX() < Polygone(1)\x 
            If MouseY()>Polygone(1)\y And MouseY() < Polygone(3)\y 
               Angle + 1 
               RotateEntity(#Cube,Angle, 0 , 0)
            EndIf
         EndIf
      Else
        RotateEntity(#Cube, 0 , 0 , 0)
        Angle = 0
      EndIf         
   EndIf
      
   RenderWorld()     
   DisplayTransparentSprite(#SOuris,MouseX(),MouseY())   
 
   Cube3D_Cube2D(EntityX(#cube), EntityY(#cube), EntityZ(#cube))
   CherchePolygoneConvexe()
   Infos 
   FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

ok voila une version avec la gestion d'une région
Cette fois ci tu vas me dire que le polygone rouge ne tourne pas en même temps que le cube ?

Faudrait appliquer une matrice de rotation aux points 3D avant de calculer la projection ...

[EDIT]
J'ai supprimé la rotation, désormais le polygone n'est tracé que si la souris se trouve sur le cube.

Code : Tout sélectionner

;Comtois le 25/06/06
;Cette fois ci le calcul tient compte de la résolution de l'écran et de la focale de la caméra.

;Evidemment cet exemple ne fonctionne plus si un angle de la caméra change.
;Malgré tout ça peut répondre à certains besoins.

#CameraSpeed = 10
#Focale = 65

Structure Screen 
  Width.l 
  Height.l
  Width_2.l 
  Height_2.l
  d.f
EndStructure

Structure Cube
   Width.f
   Height.f
   Depth.f
   Width_2.f
   Height_2.f
   Depth_2.f
EndStructure

Global Screen.Screen 
Screen\Width = 800
Screen\Width_2 = Screen\Width  / 2
Screen\Height = 600
Screen\Height_2 = Screen\Height / 2
;Calcul de l'angle pour les projections
Angle.f = (#Focale * 0.0174533) / 2.0 
Screen\d = (Screen\Height / (2 * Tan(Angle)))

Declare Erreur(Message.s, Quit.l)

If InitEngine3D() = 0
   Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll" , #True)
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0
   Erreur("Impossible d'initialiser DirectX 7 Ou plus" , #True)
ElseIf OpenScreen(Screen\Width, Screen\Height, 32, "3D") = 0
   Erreur("Impossible d'ouvrir l'écran ", #True)
EndIf
UsePNGImageDecoder()

Define.f KeyX, KeyY, MouseX, MouseY
Global NbVertex, CouleurRegion
Global Dim Region.Point(7)
Global Dim Polygone.Point(7)
Global Dim Ct(7)
Global NewList PolygoneConvexe.Point()
Global Cube.Cube
Cube\Width = 200
Cube\Width_2 = Cube\Width / 2
Cube\Height = 200
Cube\Height_2 = Cube\Height / 2
Cube\Depth = 200
Cube\Depth_2 = Cube\Depth / 2

Add3DArchive("Data\", #PB_3DArchive_FileSystem)

;-Sprite
#Souris = 0
LoadSprite(#SOuris,"Data\Souris.PNG")

;-Mesh
Enumeration 
   #Plan 
   #Cube 
EndEnumeration

LoadMesh   (#plan, "plan.mesh")
LoadMesh   (#cube, "cube.mesh")


;-Textures
LoadTexture(#Plan, "wood02.jpg")
LoadTexture(#Cube, "wall12.jpg")

;-Material
CreateMaterial(#Plan,TextureID(#Plan))
CreateMaterial(#Cube,TextureID(#Cube))

;-Entity
CreateEntity (#Plan, MeshID(#Plan), MaterialID(#Plan))
CreateEntity (#cube, MeshID(#Cube), MaterialID(#Cube),600,100,200)

ScaleEntity(#Plan, 10, 1, 10)
ScaleEntity(#Cube, 2, 2, 2)

;-Light
AmbientColor(RGB(128,128,128))
CreateLight(0, RGB(255,255,255))

;-Camera
CreateCamera(0, 0, 0, 100, 100)
CameraLocate(0, 1000, 500, 1000) 
CameraFOV(0, #Focale * 0.0174533)

;-Procedures
Procedure Erreur(Message.s, Quit.l)
   MessageRequester("Erreur", Message, #PB_MessageRequester_Ok)
   If Quit
      End
   EndIf
EndProcedure

Procedure CherchePolygoneConvexe()
  ;Initialise
  *Min.Point = #Null
  *p0.Point  = #Null
  *pi.Point  = #Null
  *pc.Point  = #Null
  ;Trouve le point le plus bas dans la liste des points
  *Min = @Polygone(0)
  For i = 0 To 7
    *p0 = @Polygone(i)
    ;Mémorise le point le plus bas , ou le plus à gauche s'il y a égalité
    If (*p0\y < *Min\y) Or ((*p0\y = *Min\y) And (*p0\x < *Min\x))
      *Min = *p0
    EndIf
  Next 
  ;Initialise la liste pour le contour convexe
  NbVertex = -1
  ;Effectue la progression de Jarvis pour calculer le contour
  *p0 = *Min
  Repeat
    ;Insertion du nouveau p0 dans le contour convexe
    
    NbVertex + 1
    Region(NbVertex)\x = *p0\x
    Region(NbVertex)\y = *p0\y

    ;Trouve le point pc dans le sens des aiguilles d'une montre
    *pc = #Null
    For i = 0 To 7
      *pi = @Polygone(i)
      ;Saute p0
      If *pi = *p0
        Continue
      EndIf
      ;Sélectionne le premier point
      If *pc = #Null
        *pc = @Polygone(i)
        Continue
      EndIf
      ;Teste si pi est dans le sens des aiguilles d'une montre par rapport à pc
      z=(((*pi\x - *p0\x) * (*pc\y - *p0\y)) - ((*pi\y - *p0\y) * (*pc\x - *p0\x)))
      If z > 0
        ;pi est dans le sens des aiguilles d'une montre par rapport à pc
        *pc = *pi
      ElseIf z = 0
        ;Si pi et pc sont colinéaires , on choisit le plus éloigné de p0
        longueurpi = Pow(*pi\x - *p0\x, 2.0) + Pow(*pi\y - *p0\y, 2.0)
        longueurpc = Pow(*pc\x - *p0\x, 2.0) + Pow(*pc\y - *p0\y, 2.0)
        If longueurpi > longueurpc
          *pc = *pi
        EndIf
      EndIf 
    Next
    ;Cherche le point suivant
    *p0 = *pc
  Until *p0 = *Min
EndProcedure

Procedure P3D_P2D(X.f, Y.f, Z.f, *P2D.POINT)
   Define.f X1, Y1, Z1
   X1 = CameraX(0) - X
   Y1 = Y - CameraY(0)
   Z1 = Z - CameraZ(0)
   *P2D\x = (X1 / Z1 * Screen\d) + Screen\Width_2 
   *P2D\y = (Y1 / Z1 * Screen\d) + Screen\Height_2
EndProcedure
   
Procedure Cube3D_Cube2D(X.f, Y.f, Z.f)
   Define.f d, Angle, X1, Y1, Z1

   ;Point 0
   P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, @Polygone(0))
   
   ;Point 1
   P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, @Polygone(1))

   ;Point 2
   P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, @Polygone(2))
   
   ;Point 3
   P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, @Polygone(3))
   
   ;Point 4   
   P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, @Polygone(4))                        
      
   ;Point 5  
   P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, @Polygone(5))                       
   
   ;Point 6    
   P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, @Polygone(6))                   
   
   ;Point 7   
   P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, @Polygone(7))  
   
EndProcedure

Macro Infos
   Hdc = StartDrawing(ScreenOutput())
      ;Pour vérifiez que les calculs 3D -> 2D sont corrects (A remplacer par un tableau, idem dans la structure)
      For i = 0 To 7
        Ct(i) = (Polygone(i)\x>-1 And Polygone(i)\x<Screen\Width And Polygone(i)\y>-1 And Polygone(i)\y<Screen\Height)
      Next i

      If CouleurRegion
        For i = 1 To NbVertex
          LineXY(Region(i-1)\x, Region(i-1)\y, Region(i)\x, Region(i)\y, CouleurRegion)
        Next i
        LineXY(Region(0)\x, Region(0)\y, Region(i-1)\x, Region(i-1)\y, CouleurRegion)
      EndIf
      
      ;L'entity n'est plus affichée à l'écran
      If (ct(0) Or ct(1) Or ct(2) Or ct(3) Or ct(4) Or ct(5) Or ct(6) Or ct(7)) 
         DrawText(0,20,"Le cube est visible",$00FF00,0)
      Else
         DrawText(0,20,"Le cube n'est plus visible",$FF,0)
      EndIf
      
   StopDrawing()
EndMacro

MouseLocate(400,300)

Repeat

   ClearScreen(0)
     
   If ExamineKeyboard()
    
     If KeyboardPushed(#PB_Key_Up)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube), EntityZ(#Cube)-#CameraSpeed)
     ElseIf KeyboardPushed(#PB_Key_Down)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube), EntityZ(#Cube)+#CameraSpeed)
     EndIf
     If KeyboardPushed(#PB_Key_Left)
       EntityLocate(#Cube, EntityX(#Cube)-#CameraSpeed, EntityY(#Cube), EntityZ(#Cube))
     ElseIf KeyboardPushed(#PB_Key_Right)
       EntityLocate(#Cube, EntityX(#Cube)+#CameraSpeed, EntityY(#Cube), EntityZ(#Cube))
     EndIf    

   EndIf

   Cube3D_Cube2D(EntityX(#cube), EntityY(#cube), EntityZ(#cube))
   CherchePolygoneConvexe()
   
   If ExamineMouse()
      If MouseX() = 0 
         CameraLocate(0,CameraX(0)-#CameraSpeed, CameraY(0), CameraZ(0))
      ElseIf MouseX() = Screen\Width-1
         CameraLocate(0,CameraX(0)+#CameraSpeed, CameraY(0), CameraZ(0))   
      EndIf   
      If MouseY() = 0
         CameraLocate(0,CameraX(0), CameraY(0), CameraZ(0)-#CameraSpeed)   
      ElseIf MouseY() = Screen\Height-1
         CameraLocate(0,CameraX(0), CameraY(0), CameraZ(0)+#CameraSpeed)  
      EndIf    

      ;Teste la souris sur le cube  
      Hrgn = CreatePolygonRgn_(@Region(), NbVertex + 1, #WINDING)
      
      If PtInRegion_(Hrgn,MouseX(), MouseY())
        CouleurRegion = $00FF00
      Else
        CouleurRegion = 0  
      EndIf
      
      DeleteObject_(Hrgn)

   EndIf
      
   RenderWorld()     
   DisplayTransparentSprite(#SOuris,MouseX(),MouseY())   
 
   Infos 
   FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Nickel

Dans cette version les angles de la caméra peuvent changer , pour en faire la démontration , la caméra suit un petit cube , et on peut l'élever ou le baisser avec les touches pageUp ou PageDown, la caméra change d'angle pour suivre le cube , et il est toujours possible de sélectionner un autre cube rester au sol. Autrement dit , les projections 3D--> tiennent compte de l'angle de la caméra et de sa position. Bon il me reste à faire le contraire , la projection de la souris dans la scène 3D.

Flèches gauche et droite pour tourner le petit cube
Flèches haut et bas pour avancer ou reculer le petit cube
Flèches pageUp et PageDown pour élever ou baisser le petit cube

Placez la souris sur le gros cube pour vérifier le calcul de la projection 3D-->2D.

Le code est en chantier...

Code : Tout sélectionner

;Comtois le 25/06/06
;Cette fois ci le calcul tient compte de la résolution de l'écran et de la focale de la caméra.

;Evidemment cet exemple ne fonctionne plus si un angle de la caméra change.
;Malgré tout ça peut répondre à certains besoins.

#Souris = 0
#CameraSpeed = 10
#Focale = 50

;-Mesh
Enumeration 
   #Plan 
   #Cube 
   #Caisse
EndEnumeration

Macro NORME(V)
   (Sqr(V\x * V\x + V\y * V\y + V\z * V\z)) 
EndMacro

Macro PRODUIT_VECTORIEL(N, V1, V2)
  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))
EndMacro

Macro NEW_X(x, Angle, Distance) 
  ((x) + Cos((Angle) * 0.0174533) * (Distance))
EndMacro

Macro NEW_Z(z, Angle, Distance)
  ((z) - Sin((Angle) * 0.0174533) * (Distance))
EndMacro

Structure Screen 
  Width.l 
  Height.l
  Width_2.l 
  Height_2.l
  d.f
EndStructure

Structure Cube
   Width.f
   Height.f
   Depth.f
   Width_2.f
   Height_2.f
   Depth_2.f
EndStructure

Structure s_Vecteur
  x.f
  y.f
  z.f
EndStructure

Global Screen.Screen 
Screen\Width = 800
Screen\Width_2 = Screen\Width  / 2
Screen\Height = 600
Screen\Height_2 = Screen\Height / 2
;Calcul de l'angle pour les projections
Angle.f = (#Focale * 0.0174533) / 2.0 
Screen\d = (Screen\Height / (2 * Tan(Angle)))

Declare Erreur(Message.s, Quit.l)
Declare CalculMatriceCamera(No.l)

If InitEngine3D() = 0
   Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll" , #True)
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0
   Erreur("Impossible d'initialiser DirectX 7 Ou plus" , #True)
ElseIf OpenScreen(Screen\Width, Screen\Height, 32, "3D") = 0
   Erreur("Impossible d'ouvrir l'écran ", #True)
EndIf
UsePNGImageDecoder()

Define.f KeyX, KeyY, MouseX, MouseY
Global NbVertex, CouleurRegion
Global EAngleX.f
Global Dim Region.Point(7)
Dim VerticesCube.Point(7)
Global Dim MatriceCamera.f(2, 2)
Global Dim Ct(7)
Global NewList PolygoneConvexe.Point()
Global Cube.Cube
Cube\Width = 300
Cube\Width_2 = Cube\Width / 2
Cube\Height = 200
Cube\Height_2 = Cube\Height / 2
Cube\Depth = 300
Cube\Depth_2 = Cube\Depth / 2

Add3DArchive("Data\", #PB_3DArchive_FileSystem)

;-Sprite
LoadSprite(#SOuris,"Data\Souris.PNG")


LoadMesh   (#plan, "plan.mesh")
LoadMesh   (#cube, "cube.mesh")


;-Textures
LoadTexture(#Plan, "wood02.jpg")
LoadTexture(#Cube, "wall12.jpg")

;-Material
CreateMaterial(#Plan,TextureID(#Plan))
CreateMaterial(#Cube,TextureID(#Cube))

;-Entity
CreateEntity (#Plan, MeshID(#Plan), MaterialID(#Plan))
CreateEntity (#cube, MeshID(#Cube), MaterialID(#Cube),600, 50, 200)
CreateEntity (#caisse, MeshID(#Cube), MaterialID(#Cube),300, Cube\Height_2, 300)
ScaleEntity(#Plan, 10, 1, 10)
;ScaleEntity(#Cube, 2, 4, 2)
ScaleEntity(#Caisse, 3, 2, 3)
;-Light
AmbientColor(RGB(128,128,128))
CreateLight(0, RGB(255,255,255))

;-Camera
CreateCamera(0, 0, 0, 100, 100)
CameraLocate(0, 1000, 1700, 1000) 
CameraFOV(0, #Focale * 0.0174533)

;-Procedures
Procedure Erreur(Message.s, Quit.l)
   MessageRequester("Erreur", Message, #PB_MessageRequester_Ok)
   If Quit
      End
   EndIf
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 

Procedure.f EcartAngle(Angle1.f, Angle2.f) 
	Define.f Delta
	
	Delta=Angle2-Angle1 
  	If Delta>180 
    	ProcedureReturn Delta-360 
  	ElseIf Delta<=-180 
    	ProcedureReturn Delta+360 
  	Else 
    	ProcedureReturn Delta 
  	EndIf    
EndProcedure 

Procedure.f  CurveValue(actuelle.f, Cible.f, P.f) 
  Define.f Delta, Valeur
  
  Delta = Cible - actuelle 
  If P > 1000 : P = 1000 : EndIf 
  Valeur = actuelle + ( Delta * P / 1000) 
  ProcedureReturn Valeur 
EndProcedure

Procedure GestionCamera()
  Define.f d
  d = 700
 
  PosXCamera.f = CurveValue(CameraX(0) , NEW_X(EntityX(#Cube) , EAngleX + 180 , d) , 280)
  ;PosYCamera.f = CurveValue(CameraY(0) , EntityY(#Cube) + Camera\CameraHaut , 30)
  PosYCamera.f = 550
  PosZCamera.f = CurveValue(CameraZ(0) , NEW_Z(EntityZ(#Cube) , EAngleX + 180 , d) , 280)
  CameraLocate(0 , PosXCamera , PosYCamera , PosZCamera)
  CameraLookAt(0 , EntityX(#Cube) , EntityY(#Cube), EntityZ(#Cube))   
 
EndProcedure 

Procedure CherchePolygoneConvexe(ListePoints.Point(1))
  Define.POINT *Min, *p0, *pi, *pc
  
  ;Trouve le point le plus bas dans la liste des points
  *Min = @ListePoints(0)
  For i = 0 To 7
    *p0 = @ListePoints(i)
    ;Mémorise le point le plus bas , ou le plus à gauche s'il y a égalité
    If (*p0\y < *Min\y) Or ((*p0\y = *Min\y) And (*p0\x < *Min\x))
      *Min = *p0
    EndIf
  Next 
  ;Initialise la liste pour le contour convexe
  NbVertex = -1
  ;Effectue la progression de Jarvis pour calculer le contour
  *p0 = *Min
  Repeat
    ;Insertion du nouveau p0 dans le contour convexe
    
    NbVertex + 1
    Region(NbVertex)\x = *p0\x
    Region(NbVertex)\y = *p0\y

    ;Trouve le point pc dans le sens des aiguilles d'une montre
    *pc = #Null
    For i = 0 To 7
      *pi = @ListePoints(i)
      ;Saute p0
      If *pi = *p0
        Continue
      EndIf
      ;Sélectionne le premier point
      If *pc = #Null
        *pc = @ListePoints(i)
        Continue
      EndIf
      ;Teste si pi est dans le sens des aiguilles d'une montre par rapport à pc
      z=(((*pi\x - *p0\x) * (*pc\y - *p0\y)) - ((*pi\y - *p0\y) * (*pc\x - *p0\x)))
      If z > 0
        ;pi est dans le sens des aiguilles d'une montre par rapport à pc
        *pc = *pi
      ElseIf z = 0
        ;Si pi et pc sont colinéaires , on choisit le plus éloigné de p0
        longueurpi = (*pi\x - *p0\x)*(*pi\x - *p0\x) + (*pi\y - *p0\y)*(*pi\y - *p0\y)
        longueurpc = (*pc\x - *p0\x)*(*pc\x - *p0\x) + (*pc\y - *p0\y)*(*pc\y - *p0\y)
        If longueurpi > longueurpc
          *pc = *pi
        EndIf
      EndIf 
    Next
    ;Cherche le point suivant
    *p0 = *pc
  Until *p0 = *Min Or NbVertex > 6
EndProcedure

Procedure P3D_P2D(X.f, Y.f, Z.f, *P2D.POINT)
  Define.s_Vecteur p
  Define.f X1,Y1,Z1
  ;Position du point dans le repère de la caméra
  p\x = X - CameraX(0)
  p\y = Y - CameraY(0)
  p\z = Z - CameraZ(0) 
  X1 = (MatriceCamera(0,0) * p\x) + (MatriceCamera(0,1) * p\y) + (MatriceCamera(0,2) * p\z)
  Y1 = (MatriceCamera(1,0) * p\x) + (MatriceCamera(1,1) * p\y) + (MatriceCamera(1,2) * p\z)
  Z1 = (MatriceCamera(2,0) * p\x) + (MatriceCamera(2,1) * p\y) + (MatriceCamera(2,2) * p\z)
  
  ; Transformation 3D --> 2D

  *P2D\x = (X1 / Z1 * Screen\d) + Screen\Width_2 
  *P2D\y = (Y1 / Z1 * Screen\d) + Screen\Height_2 
  
EndProcedure  
 
Procedure Normalise(*N.s_Vecteur)
   Define.f NormeVecteur
   
   NormeVecteur = NORME(*N)
   If NormeVecteur <> 0.0
    	*N\x / NormeVecteur
      *N\y / NormeVecteur
      *N\z / NormeVecteur
   EndIf   
EndProcedure
Procedure CalculMatriceCamera(No.l)
  Define.s_Vecteur x, y, z, p, SceneY

  SceneY\x = 0
  SceneY\y = 1
  SceneY\z = 0
  
  ;La camera est toujours orientée ver l'entity #Cube 
  ;il est aussi possible de lancer un rayon sur un plan imaginaire pour 
  ;déterminer un point de la scène se trouvant dans la direction de la caméra, pour cela
  ;il faudrait avoir un retour sur les angles de la caméra ou les gérer soi même :(

  ;Calcule l'axe z de la caméra ( la caméra pointe vers l'entity)
  z\x = EntityX(No) - CameraX(0)
  z\y = EntityY(No) - CameraY(0)
  z\z = EntityZ(No) - CameraZ(0)
  Normalise(@z) 

  ;Calcul l'axe x de la caméra de façon à ce qu'il soit perpendulaire aux axes z et Y de la Scène
  PRODUIT_VECTORIEL(x, z, SceneY)
  Normalise(@x)
 
  ;Calcule l'axe Y de la caméra de façon à ce qu'il soit perpendiculaire aux axes z et x 
  PRODUIT_VECTORIEL(y, z, x)
  Normalise(@y)
  
  ;Ligne Colonne
  MatriceCamera(0,0) = x\x
  MatriceCamera(0,1) = x\y
  MatriceCamera(0,2) = x\z  
  
  MatriceCamera(1,0) = y\x
  MatriceCamera(1,1) = y\y
  MatriceCamera(1,2) = y\z  
  
  MatriceCamera(2,0) = z\x
  MatriceCamera(2,1) = z\y
  MatriceCamera(2,2) = z\z  
EndProcedure
Procedure Cube3D_Cube2D(X.f, Y.f, Z.f, ListeVertices.Point(1))
  CalculMatriceCamera(#Cube)
  P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, ListeVertices(0))
  P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z + Cube\Depth_2, ListeVertices(1))
  P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, ListeVertices(2))
  P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z + Cube\Depth_2, ListeVertices(3))
  P3D_P2D(X - Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, ListeVertices(4))                        
  P3D_P2D(X + Cube\Width_2, Y + Cube\Height_2, Z - Cube\Depth_2, ListeVertices(5))                       
  P3D_P2D(X - Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, ListeVertices(6))                   
  P3D_P2D(X + Cube\Width_2, Y - Cube\Height_2, Z - Cube\Depth_2, ListeVertices(7))  
EndProcedure

Macro INFOS
   StartDrawing(ScreenOutput())
      For i = 0 To 7
        Ct(i) = (VerticesCube(i)\x>-1 And VerticesCube(i)\x<Screen\Width And VerticesCube(i)\y>-1 And VerticesCube(i)\y<Screen\Height)
      Next i
      
      If (ct(0) Or ct(1) Or ct(2) Or ct(3) Or ct(4) Or ct(5) Or ct(6) Or ct(7)) 
         DrawText(0,20,"Le cube est visible", $00FF00,0)
         If CouleurRegion
          For i = 1 To NbVertex
            LineXY(Region(i-1)\x, Region(i-1)\y, Region(i)\x, Region(i)\y, CouleurRegion)
          Next i
          LineXY(Region(0)\x, Region(0)\y, Region(i-1)\x, Region(i-1)\y, CouleurRegion)
        EndIf
      Else
         DrawText(0,20,"Le cube n'est plus visible",$FF,0)
      EndIf
      
   StopDrawing()
EndMacro

MouseLocate(400,300)
V = 6
Repeat

   ClearScreen(0)
     
   If ExamineKeyboard()
     If KeyboardPushed(#PB_Key_PageUp)
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube) + 3, EntityZ(#Cube))
     ElseIf KeyboardPushed(#PB_Key_PageDown) And EntityY(#Cube)> 50
       EntityLocate(#Cube, EntityX(#Cube), EntityY(#Cube) - 3, EntityZ(#Cube))
     EndIf      
    
     If KeyboardPushed(#PB_Key_Up)
       EntityLocate(#Cube, NEW_X(EntityX(#Cube),EAngleX, V), EntityY(#Cube), NEW_Z(EntityZ(#Cube),EAngleX, V))
     ElseIf KeyboardPushed(#PB_Key_Down)
       EntityLocate(#Cube, NEW_X(EntityX(#Cube),EAngleX, -V), EntityY(#Cube), NEW_Z(EntityZ(#Cube),EAngleX, -V))
     EndIf
     If KeyboardPushed(#PB_Key_Left)
        EAngleX + 1
        RotateEntity(#Cube, EAngleX, 0,0)
     ElseIf KeyboardPushed(#PB_Key_Right)
        EAngleX - 1
        RotateEntity(#Cube, EAngleX, 0,0)
     EndIf    

   EndIf
   GestionCamera()
   Cube3D_Cube2D(EntityX(#caisse), EntityY(#caisse), EntityZ(#caisse), VerticesCube())
  
   CherchePolygoneConvexe(VerticesCube())
   
   If ExamineMouse()
      ;Teste la souris sur le cube  
      Hrgn = CreatePolygonRgn_(@Region(), NbVertex + 1, #WINDING)
      
      If PtInRegion_(Hrgn,MouseX(), MouseY())
        CouleurRegion = $00FF00
      Else
        CouleurRegion = 0  
      EndIf
      
      DeleteObject_(Hrgn)

   EndIf
      
   RenderWorld()     
   DisplayTransparentSprite(#SOuris,MouseX(),MouseY())   
   INFOS 
   FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

de mieux en mieux