un début de code que j'ai la flemme de continuer :)

Partagez votre expérience de PureBasic avec les autres utilisateurs.
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

un début de code que j'ai la flemme de continuer :)

Message par comtois »

Je voulais le simplifier avant de le poster , mais ça fait deux week-end que je remets .Alors plutôt que de le laisser dormir sur mon disque dur , autant le mettre ici .
Si j'ai du courage , je le reprendrai pour le commenter et le simplifier.Et surtout améliorer l'affichage pour que ça ne rame pas quand il y a bcp de segments ( en clair éviter d'afficher tous les segments à chaque fois , seulement ceux qui sont utiles )
L'objectif c'était de me faire un petit éditeur pour différentes choses :
par exemple pour tracer des plans d'un batiment , et ensuite calculer les objets pour construire ce batiment en 3D. ( Je l'ai déjà fait dans un autre langage ( l'éditeur était différent , mais le principe de la construction 3D sera la même ), donc c'est possible , faut juste que je m'y mette :)

Et puis cet éditeur me permet de tracer des chemins sur une map , en construisant un maillage , j'ai déjà fait l'algo de recherche du chemin le plus court sur un maillage .Je ferai une démo à l'occasion ( elle est presque faite , manque plus qu'un truc qui se balade d'un point à un autre , pour l'instant je trace les segments du chemin le plus court en rouge pour le visualiser ).

L'éditeur peut aussi servir à tracer le chemin d'une voiture sur un circuit , etc ...


Les touches
[F1] Sans/Avec l'affichage des points
[F5] Sauvegarde le tracé en cours
[F6] Charge le dernier tracé

[Suppr] Supprime le point sélectionné ( en rouge )

Clic droit de la souris = annule le dernier tracé
Clic droit de la souris maintenu pour déplacer un point
Clic gauche de la souris pour ajouter un point

Code : Tout sélectionner

;- variables globales
Global NbSommet.b
Global Mode.b
Global SommetMove.l
Global MemMouse.b
Global Affpoint.b
NbSommet = 0
; Mode = 0 > Tracé , Mode = 1 > Sélection
Mode = 0
Affpoint = 1 
SommetMove = -1
MemMouse = 0
Dim SommetEnCours(2)

;- Les constantes
#ScreenWidth = 800
#ScreenHeight = 600
#ScreenDepth = 32
#Rayon = 3
#RayonSelect = 7

;/Sprites
#Souris = 0
#Fond = 1

;- Les structures
Structure Sommet
  No.l
  x.l
  y.l
EndStructure  
;Je pourrais me contenter du No des sommets et chercher les valeurs x et y dans la liste sommet
Structure Segment
  Sommet1.l
  X1.l
  Y1.l
  Sommet2.l
  X2.l
  Y2.l
  Long.l  ; Longueur d'un segment ( pour le calcul du chemin le plus court d'un sommet à un autre )
EndStructure
NewList Sommet.Sommet()
NewList Segment.Segment()


;-Fonts


;-Declare procédures


;-Initialisation 
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0 Or InitSprite3D() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
   End
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "PureSokoban3D" ) = 0
  MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 )
  End
EndIf

;/Les formes de la souris 
;Fleche
CreateSprite(0,32,32)
StartDrawing(SpriteOutput(0))
  Box(0,0,5,5,RGB(255,255,255))
  LineXY(0,0,SpriteWidth(0),SpriteHeight(0),RGB(255,255,255))
StopDrawing()
 

;-Procedures
Procedure.l Distance(x.l,y.l)
  Sommet.l = -1
  ForEach Sommet()
    Distance.l = Sqr(Pow(x-Sommet()\x,2)+Pow(y-Sommet()\y,2)) 
    ; #Rayon * 2 pour une sélection plus aisée d'un sommet
    If Distance <= #Rayon * 2 
      Sommet = Sommet()\No
      Break
    EndIf  
  Next 
  ProcedureReturn Sommet
EndProcedure

Procedure AddSommet(x.l,y.l)
  AddElement(Sommet())
  ; No unique selon la position sur l'écran 
  Sommet()\No = x + #ScreenWidth * y
  Sommet()\x = x
  Sommet()\y = y  
EndProcedure

Procedure AddSegment()
  AddElement(Segment())
  Segment()\Sommet1 = SommetEnCours(1)
  Segment()\Sommet2 = SommetEnCours(2)   
  ForEach Sommet()
    If Sommet()\No = SommetEnCours(1)
      Segment()\X1 = Sommet()\x
      Segment()\Y1 = Sommet()\y
      Trouve + 1
    EndIf
    If Sommet()\No = SommetEnCours(2)
      Segment()\X2 = Sommet()\x
      Segment()\Y2 = Sommet()\y
      Trouve + 1
    EndIf
    If Trouve = 2
      Break
    EndIf  
  Next
EndProcedure

Procedure TestSommet()
  Sommet = Distance(MouseX(),MouseY())
  If Sommet < 0
    If SegmentEnCours = #True 
      AddSegment()
    EndIf  
    AddSommet(MouseX(),MouseY())
  Else
    SegmentEnCours = #True 
    SommetEnCours = Sommet
  EndIf  
EndProcedure

Procedure AffSommet()
  ForEach Sommet()
    StartDrawing(ScreenOutput())
      Circle(Sommet()\x,Sommet()\y,#Rayon,RGB(255,255,55))
    StopDrawing()
  Next
EndProcedure

Procedure AffSegment()
  ForEach Segment()
    StartDrawing(ScreenOutput())
      LineXY(Segment()\X1,Segment()\Y1,Segment()\X2,Segment()\Y2,RGB(255,255,255))
    StopDrawing()
  Next
EndProcedure

Procedure AffSegmentEnCours()
  ForEach Sommet()
    If Sommet()\No = SommetEnCours(NbSommet)
      x = Sommet()\x
      y = Sommet()\y
      Break
    EndIf
  Next
  StartDrawing(ScreenOutput())
    LineXY(x,y,MouseX(),MouseY(),RGB(255,255,255))
  StopDrawing()
EndProcedure

Procedure Sauvegarde()
  CreateFile(0,"Sommets.hd")
  ForEach Sommet()
    WriteLong(Sommet()\No)
    WriteLong(Sommet()\x)
    WriteLong(Sommet()\y)    
  Next
  CloseFile(0)
  CreateFile(0,"Segment.hd")
  ForEach Segment()
    WriteLong(Segment()\Sommet1)
    WriteLong(Segment()\X1)
    WriteLong(Segment()\Y1)        
    WriteLong(Segment()\Sommet2)
    WriteLong(Segment()\X2)
    WriteLong(Segment()\Y2)  
    ;WriteLong(Segment()\Long)
  Next
  CloseFile(0)
   ForEach Segment()
    Debug Segment()\Sommet1
    Debug Segment()\Sommet2
  Next

EndProcedure

Procedure Charge()
  If OpenFile(0,"Sommets.hd")
    ClearList(Sommet())
    While Eof(0)=0
      AddElement(Sommet())
      Sommet()\No = ReadLong()
      Sommet()\x = ReadLong()
      Sommet()\y = ReadLong()    
    Wend
    CloseFile(0)
    If OpenFile(0,"Segment.hd")
      ClearList(Segment())
      While Eof(0)=0
        AddElement(Segment())
        Segment()\Sommet1 = ReadLong()
        Segment()\X1 = ReadLong()
        Segment()\Y1 = ReadLong() 
        Segment()\Sommet2 = ReadLong()
        Segment()\X2 = ReadLong()
        Segment()\Y2 = ReadLong()    
        ;Segment()\Long = ReadLong()
      Wend
      CloseFile(0)
    EndIf
  EndIf    
EndProcedure

;/
;-Boucle principale
;/
Repeat
  ClearScreen(0,0,0)
  ExamineMouse()
  ExamineKeyboard()
  ;/Affiche le dessin
  If Affpoint
    AffSommet()
  EndIf  
  AffSegment()

  ;/Affiche Sans/Avec Points
  If KeyboardReleased(#PB_Key_F1)
    Affpoint = 1 - Affpoint
  EndIf
 
  ;/Sauvegarde
  If KeyboardReleased(#PB_Key_F5)
    Sauvegarde()
  EndIf 
  
  ;/Charge
  If KeyboardReleased(#PB_Key_F6)
    Charge()
  EndIf 

  
  ;/Ajoute un sommet
  If MouseButton(1) And Mode = 0 And MemMouse = 0
    Sommet = Distance(MouseX(),MouseY())
    If Sommet < 0
      AddSommet(MouseX(),MouseY())
      Sommet = Sommet()\No
    EndIf 

    NbSommet + 1
    SommetEnCours(NbSommet) = Sommet
    If NbSommet = 2
      AddSegment()
      NbSommet = 1
      SommetEnCours(NbSommet) = Sommet 
    EndIf 
    MemMouse = 1  
  EndIf  
  
  If MouseButton(1) = 0
    MemMouse = 0
  EndIf
  
  ;Affiche le sommet sélectionné
  If CountList(Sommet())>0
    SommetSelect = -1
    SommetSelect = Distance(MouseX(),MouseY())
    If SommetSelect >=0
      StartDrawing(ScreenOutput())
        DrawingMode(4)
        Circle(Sommet()\x,Sommet()\y,#RayonSelect,RGB(255,55,55))
      StopDrawing()
      ;/Change mode
      If MouseButton(2) 
        Mode = 1 
      Else
        Mode = 0
      EndIf  
      ;/Supprime le sommet 
      If KeyboardReleased(#PB_Key_Delete)
        ForEach Segment()
          If Segment()\Sommet1 = SommetSelect Or Segment()\Sommet2 = SommetSelect
            DeleteElement(Segment())
          EndIf  
        Next
        ForEach Sommet()
          If Sommet()\No = SommetSelect
            DeleteElement(Sommet())
            Break
          EndIf
        Next  
    EndIf
   EndIf 
  EndIf 
  
  ;/Déplace un sommet
  If MouseButton(2) And Mode = 1
    If SommetMove = -1
      SommetMove = Distance(MouseX(),MouseY())
      If SommetMove >= 0
        ForEach Segment()
          If Sommet()\No = SommetMove
            SommetMove = ListIndex(Sommet())
            Break
          EndIf  
        Next    
      EndIf
    EndIf 
    If SommetMove>=0
      SelectElement(Sommet(),SommetMove)
      Sommet()\x = MouseX()
      Sommet()\y = MouseY()
      ForEach Segment()
        If Segment()\Sommet1 = Sommet()\No 
          Segment()\X1 = Sommet()\x
          Segment()\Y1 = Sommet()\y
        EndIf
        If Segment()\Sommet2 = Sommet()\No 
          Segment()\X2 = Sommet()\x
          Segment()\Y2 = Sommet()\y
        EndIf
      Next
    EndIf  
  Else
    SommetMove = -1
  EndIf  
  
  ;/Supprime un sommet
  If MouseButton(2)
    If NbSommet = 1
      NbSommet = 0
      ;Cherche si sommet en cours 
      Trouve = #False
      ForEach Segment()
        If Segment()\Sommet1 = SommetEnCours(1) Or Segment()\Sommet2 = SommetEnCours(1)
          Trouve = #True
          Break
        EndIf  
      Next
      If Trouve = #False
        ForEach Sommet()
          If Sommet()\No = SommetEnCours(1)
            DeleteElement(Sommet())
            Break
          EndIf
        Next  
      EndIf  
    EndIf
  EndIf 
  
  
  ;/Segment en cours
  If NbSommet
    AffSegmentEnCours()
  EndIf  
  
  ;/Souris
  DisplayTransparentSprite(#Souris,MouseX(),MouseY())
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

1 : copiez ce code dans le même répertoire que le code précédent
2 : Utilisez le code précédent pour tracer quelques murs (vue de dessus)
3 : Faites [F5] pour sauvegarder
4 : Ensuite lancez le code ci-dessous
5 : Et si tout va bien , vous devez pouvoir déplacer un cube dans le décor
que vous avez créez précédemment.

Bon c'est du vite fait, je voulais voir ce que ça pouvait donner .
Premier constat , va falloir améliorer les collisions avec les angles .
Sinon ça pourrait être le début d'un FPS à bon marché non ? :)

ou alors en mettant #Hauteur à 1 ou 2 , ça peut faire le tracé d'un circuit voiture , avec bcp d'imagination bien sûr :)

Par contre , va falloir que j'améliore les collisions .

Code : Tout sélectionner

;Comtois 07/02/04 
; V0.1 
;Bon c'est du vite fait , je vois que ça tremble sur les angles , va falloir que je regarde comment modifier les collisions
;[F1]/[F2]/[F3] => Camera
;[PAgeUp]/[PageDown] => Lève/Baisse la camera
;[Fin] => position par defaut de la camera


;-Initialisation 
#ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 32 
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 , "Demo PlateForme" ) = 0 
  MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 ) 
  End 
EndIf 
SetFrameRate(60) 

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

;-Variables Globales
Global Joueur.l
Global GetCollisionX.f , GetCollisionY.f , GetCollisionZ.f 
Global OldPosX.f , OldPosY.f , OldPosZ.f ,IndexBoxCollision.l 
Global PosX0.f , PosY0.f , PosZ0.f 

;- Constantes
#Hauteur.f = 20 ; Pas trop haut pour vérifier comment ça se passe , par la suite, la hauteur pourra être parametrable pour chaque segment
#Largeur.f = 5  ; Attention pour l'instant largeur doit être supérieure à la vitesse de déplacement du perso ( j'ai pas encore modifié la gestion des collisions )
#Echelle.f = 1  ; Echelle de la map
#Taille.f = 10  ; Taille du perso
#TypeMesh = 0 ; Sélectionne 0 = box ; 1 = Plain pour la construction des murs

;- Les structures
Structure Camera 
   AngleX.f 
   AngleY.f    
   CameraVue.l 
   CameraDist.f  
   CameraHaut.f  
   LookAtY.f 
EndStructure 

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

Structure Sommet
  No.l
  X.l
  Y.l
EndStructure  

;Je pourrais me contenter du No des sommets et chercher les valeurs x et y dans la liste sommet
Structure Segment
  Sommet1.l
  x1.l
  Y1.l
  Sommet2.l
  x2.l
  Y2.l
  Long.l  ; Longueur d'un segment ( pour le calcul du chemin le plus court d'un sommet à un autre )
EndStructure

Structure BoxCollision 
   No.l      ; Si le type est 1 alors ce Numéro correspond obligatoirement à l'entity , sinon ça peut être 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 ( ça devrait être Y , j'ai encore rien compris à ça :) 
   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  
EndStructure 
NewList Sommet.Sommet()
NewList Segment.Segment()
NewList BoxCollision.BoxCollision() 
Global Camera.Camera 
Camera\CameraVue = 1

;-Mesh 
CreateMesh(0) ; Cube 
SetMeshData(0, 0, ?CubePoints       , 16) 
SetMeshData(0, 1, ?CubeTriangles    , 12) 
SetMeshData(0, 2, ?CubeTextures     , 16) 
SetMeshData(0, 3, ?CubeNormales     , 16) 

CreateMesh(1) ; Plain 
SetMeshData(1, 0, ?PlainPoints      , 4) 
SetMeshData(1, 1, ?PlainTriangles   , 4) 
SetMeshData(1, 2, ?PlainTextures    , 4) 

;- Textures 
For a = 0 To 1 
  CreateTexture(a,128,128) 
  StartDrawing(TextureOutput(a)) 
     Box(0,0,128,128,RGB(255,255,255)) 
     Box(1,1,126,126,RGB(255-a*100,55+a*100,a*255)) 
  StopDrawing() 
Next a 

;- Material 
For a = 0 To 1 
  CreateMaterial(a, TextureID( a )) 
  MaterialFilteringMode( a , #PB_Material_Trilinear )  
Next a 

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

;-Les procédures
Procedure Renum()
  ForEach Sommet()
    No = Sommet()\No
    Sommet()\No = ListIndex(Sommet())
    ForEach Segment()
      If Segment()\Sommet1 = No
        Segment()\Sommet1 = Sommet()\No
      ElseIf Segment()\Sommet2 = No
        Segment()\Sommet2 = Sommet()\No
      EndIf
    Next
  Next
EndProcedure

Procedure Charge()
  If ReadFile(0,"Sommets.hd")=0 : End : EndIf
  ClearList(Sommet())
  While Eof(0)=0
    AddElement(Sommet())
    Sommet()\No = ReadLong()
    Sommet()\X = ReadLong()
    Sommet()\Y = ReadLong()    
  Wend
  CloseFile(0)
  ReadFile(0,"Segment.hd")
  ClearList(Segment())
  While Eof(0)=0
    AddElement(Segment())
    Segment()\Sommet1 = ReadLong()
    Segment()\x1 = ReadLong()
    Segment()\Y1 = ReadLong() 
    Segment()\Sommet2 = ReadLong()
    Segment()\x2 = ReadLong()
    Segment()\Y2 = ReadLong()  
    x1 = Segment()\x1
    Y1 = Segment()\Y1
    x2 = Segment()\x2
    Y2 = Segment()\Y2
    Segment()\Long = Sqr(Pow(x1-x2,2)+Pow(Y1-Y2,2)) 
  Wend
  CloseFile(0)
  Renum()
  
EndProcedure

Procedure MakeEntity()
  Dim entity.Parametres(CountList(Segment())+1)
  ForEach Segment()
    No = ListIndex(Segment())
    Adjacent.f = (Segment()\x1 - Segment()\x2)
    Oppose.f = (Segment()\Y1 - Segment()\Y2)
    Hypothenuse.f = Sqr(Pow(Adjacent,2)+Pow(Oppose,2)) 
    Angle.f = ACos(Adjacent/Hypothenuse)/0.0174533  
    If Segment()\Y1 > Segment()\Y2 
      Angle = 360 - Angle 
    EndIf 
    CreateEntity(No,MeshID(#TypeMesh),MaterialID(0)) 
    SX.f = (Segment()\Long + #Largeur/2) * #Echelle
    SY.f = #Hauteur
    SZ.f = #Largeur
    PX.f = (Segment()\x1 + Segment()\x2)/2
    PZ.f = (Segment()\Y1 + Segment()\Y2)/2  
    EntityLocate(No , PX * #Echelle , #Hauteur/2 , PZ * #Echelle) 
    If #TypeMesh
      ScaleEntity(No ,SX , SZ , SY )  
      RotateEntity(No , Angle , 90 , 0 ) 
    Else
      ScaleEntity(No ,SX , SY , SZ )  
      RotateEntity(No , Angle , 0 , 0 )   
    EndIf  
    MakeBoxCollision( No , EntityX(No) , EntityY(No) , EntityZ(No) , SX , SY , SZ , Angle , 0 ) 
  Next
  Joueur = No + 1
  CreateEntity(Joueur,MeshID(0),MaterialID(1)) 
  ScaleEntity(Joueur , #Taille, #Taille , #Taille )  
  EntityLocate(Joueur , PX * #Echelle , #Taille / 2 , PZ * #Echelle) 
  MakeBoxCollision( Joueur , EntityX(Joueur) , EntityY(Joueur) , EntityZ(Joueur) , #Taille , #Taille , #Taille , 0 , 1 ) 
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.f NewXValue( X.f , Angle.f , NbUnite.f ) 
    ;à 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 ) 
   ;à 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 à 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 à 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 paramètres 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 à 45° à 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 considère 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égèrement 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 paramètres ( 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 à 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écupère 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 à 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écupère 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 repères **************************************** 
   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 repère 
   ;      
   ; 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 

   ; J'en ai peut-être trop fait là ?  => A voir si ça peut se simplifier 
   CondX = (BoxMinX >= MinX2 And BoxMinX <= MaxX2) Or (BoxMaxX >= MinX2 And BoxMaxX <= MaxX2) Or (BoxMinX < MinX2 And BoxMaxX >= MinX2 ) Or (BoxMinX <= MaxX2 And BoxMaxX > MaxX2 ) 
   CondY = (BoxMinY >= MinY2 And BoxMinY <= MaxY2) Or (BoxMaxY >= MinY2 And BoxMaxY <= MaxY2) Or (BoxMinY < MinY2 And BoxMaxY >= MinY2 ) Or (BoxMinY <= MaxY2 And BoxMaxY > MaxY2 ) 
   CondZ = (BoxMinZ >= MinZ2 And BoxMinZ <= MaxZ2) Or (BoxMaxZ >= MinZ2 And BoxMaxZ <= MaxZ2) Or (BoxMinZ < MinZ2 And BoxMaxZ >= MinZ2 ) Or (BoxMinZ <= MaxZ2 And BoxMaxZ > MaxZ2 ) 

   ;Utilisé pour les collisions glissantes 
   GetCollisionX = 0 
   GetCollisionY = 0 
   GetCollisionZ = 0 
  
   If CondY And CondX And CondZ 
    
      ;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 repère 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(Joueur)\AngleX , 20 ) 
      
   ElseIf Camera\CameraVue = 2  
      
      Camera\CameraDist = CurveValue(Camera\CameraDist ,45 , 20) - Abs(Attraction)
      Camera\CameraHaut = CurveValue(Camera\CameraHaut ,25 , 20) + Abs(Attraction*2)
      Camera\LookAtY = CurveValue(Camera\LookAtY , 8 , 20)      
      Camera\AngleX = CurveAngle(Camera\AngleX , entity(Joueur)\AngleX , 20 ) 
      
   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(Joueur)\AngleX , 20 ) 
    
   EndIf  
    
   PosXCamera.f = CurveValue(CameraX(0) , NewXValue(EntityX(Joueur) , Camera\AngleX + 180 , Camera\CameraDist) , 280) 
   PosYCamera.f = CurveValue(CameraY(0) , EntityY(Joueur) + Camera\CameraHaut , 30) 
   PosZCamera.f = CurveValue(CameraZ(0) , NewZValue(EntityZ(Joueur) , Camera\AngleX + 180 , Camera\CameraDist) , 280) 
   CameraLocate(0 , PosXCamera , PosYCamera , PosZCamera) 
   CameraLookAt(0 , EntityX(Joueur) , EntityY(Joueur) + Camera\LookAtY + Camera\AngleY  , EntityZ(Joueur))    
    
EndProcedure 

;/
;-La boucle principale
;/
Charge()
MakeEntity()
Pas.f = 0

Repeat 
  ClearScreen(0, 0, 0) 

   If ExamineKeyboard() 
   ; Touches du joueur 
      If KeyboardPushed(#PB_Key_Left) 
         entity(Joueur)\AngleX = WrapValue( entity(Joueur)\AngleX + 1 ) 
         RotateEntity(Joueur,1 , 0, 0 ) 
      ElseIf KeyboardPushed(#PB_Key_Right) 
         entity(Joueur)\AngleX = WrapValue( entity(Joueur)\AngleX - 1 ) 
         RotateEntity(Joueur, -1 , 0, 0 ) 
      EndIf 
  
      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 
   EndIf  
   
      ; LE perso avant 
   OldPosY = EntityY(Joueur) 
   OldPosX = EntityX(Joueur) 
   OldPosZ = EntityZ(Joueur) 
    
   ; LE perso pendant 
   
   MoveEntity( Joueur , Cosd( entity(Joueur)\AngleX ) * Pas , 0 , -Sind( entity(Joueur)\AngleX ) * Pas ) 
   
   ; LE perso après    
   PosY0 = EntityY(Joueur) 
   PosX0 = EntityX(Joueur) 
   PosZ0 = EntityZ(Joueur) 
 
 ; Test des collisions 

   ForEach BoxCollision() 
      NoBox = BoxCollision()\No    
      IndexBoxCollision = ListIndex(BoxCollision()) 
      If EntityCollision( Joueur , NoBox ) > 0 
   
         ; Collision glissante 
         PosY0 - GetCollisionY 
         PosX0 - GetCollisionX  
         PosZ0 - GetCollisionZ  

      EndIf 
   SelectElement(BoxCollision(), IndexBoxCollision)  
   Next  
    
   ; Repositionne le perso 
   EntityLocate(Joueur,PosX0 ,PosY0 ,PosZ0 ) 

   ;Gestion de la camera
   GestionCamera()    
   RenderWorld() 
   FlipBuffers() 
Until KeyboardPushed(#PB_Key_Escape) 


;-Datas du Cube et du Plain 

DataSection 
CubePoints: 
Data.f -0.5,-0.5,-0.5 
Data.f -0.5,-0.5,0.5 
Data.f 0.5,-0.5,0.5 
Data.f 0.5,-0.5,-0.5 

Data.f -0.5,0.5,-0.5 
Data.f -0.5,0.5,0.5 
Data.f 0.5,0.5,0.5 
Data.f 0.5,0.5,-0.5 

Data.f -0.5,-0.5,-0.5 
Data.f -0.5,-0.5,0.5 
Data.f 0.5,-0.5,0.5 
Data.f 0.5,-0.5,-0.5 

Data.f -0.5,0.5,-0.5 
Data.f -0.5,0.5,0.5 
Data.f 0.5,0.5,0.5 
Data.f 0.5,0.5,-0.5 

CubeNormales: 
Data.f -0.5,0,-0.5 
Data.f -0.5,0,0.5 
Data.f 0.5,0,0.5 
Data.f 0.5,0,-0.5 
Data.f -0.5,0,-0.5 
Data.f -0.5,0,0.5 
Data.f 0.5,0,0.5 
Data.f 0.5,0,-0.5 
Data.f 0,-1,0 
Data.f 0,-1,0 
Data.f 0,-1,0 
Data.f 0,-1,0 
Data.f 0,1,0 
Data.f 0,1,0 
Data.f 0,1,0 
Data.f 0,1,0 
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 

CubeTextures: 
;original 
Data.f 0,1 
Data.f 1,1 
Data.f 0,1 
Data.f 1,1 

Data.f 0,0 
Data.f 1,0 
Data.f 0,0 
Data.f 1,0 

Data.f 0,0 
Data.f 1,0 
Data.f 1,1 
Data.f 0,1 

Data.f 0,0 
Data.f 1,0 
Data.f 1,1 
Data.f 0,1 

PlainPoints: 
Data.f -0.5, 0, -0.5 
Data.f 0.5 , 0, -0.5 
Data.f 0.5 , 0, 0.5 
Data.f -0.5, 0, 0.5 

PlainTriangles: 
Data.w 0, 1, 2 
Data.w 0, 2, 3 
Data.w 2, 1, 0 
Data.w 3, 2, 0 

PlainTextures: 
Data.f 0, 0 
Data.f 1, 0 
Data.f 1, 1    
Data.f 0, 1    

EndDataSection
Répondre