Corrections et améliorations diverses

- amélioration du TGBEJoystick;
- les mouvements des TGBEClouds et TGBEPlaneExtend peuvent être réalisés via TTask;
- amélioration du TGBEPlayerPosition pour détection des collisions;
- modification uGBEUtils3D pour la détection des collisions et réactivité avec interaction composants 2D;
- adaptation de la démo JoystickPlayer.

Author: gbegreg

GBEClouds.pas

@@ -4,7 +4,7 @@ interface
 
 uses
   System.SysUtils, System.Classes, FMX.Types, FMX.Types3D, FMX.Controls3D, FMX.Objects3D, Generics.Collections,
-  System.Math.Vectors, FMX.MaterialSources;
+  System.Math.Vectors, FMX.MaterialSources, System.Threading;
 
 type
   TGBEClouds = class(TDummy)
@@ -13,7 +13,7 @@   TGBEClouds = class(TDummy)
     fListClouds : TList<TPlane>;
     fNbClouds, fLimits : integer;
     fWindSpeed : single;
-    fActiveWind : boolean;
+    fActiveWind, fUseTasks : boolean;
     fTexturesClouds: TList<TTextureMaterialSource>;
     function getNbClouds: integer;
     function getWindSpeed: single;
@@ -23,6 +23,7 @@   TGBEClouds = class(TDummy)
     procedure setLimits(const Value: integer);
     function getActiveWind: boolean;
     procedure setActiveWind(const Value: boolean);
+    procedure deplacementNuages;
   protected
     { Déclarations protégées }
   public
@@ -40,6 +41,7 @@   TGBEClouds = class(TDummy)
     property Limits : integer read getLimits write setLimits;
     property NbClouds : integer read getNbClouds write setNbClouds;
     property WindSpeed : single read getWindSpeed write setWindSpeed;
+    property UseTasks : boolean read fUseTasks write fUseTasks;
   end;
 
 procedure Register;
@@ -68,6 +70,7 @@ constructor TGBEClouds.Create(AOwner: TComponent);
   fActiveWind := false;
   fListClouds := TList<TPlane>.Create;
   fTexturesClouds := TList<TTextureMaterialSource>.create;
+  fUseTasks := true;
 end;
 
 procedure TGBEClouds.deleteTexturesClouds;
@@ -105,24 +108,39 @@ function TGBEClouds.getWindSpeed: single;
 end;
 
 procedure TGBEClouds.moveClouds;
+begin
+  if (fActiveWind) and (NbClouds > 0) then
+  begin
+    if fUseTasks then
+    begin
+      TTask.Create(procedure
+                  begin
+                    deplacementNuages;
+                  end).start;
+    end
+    else
+    begin
+      deplacementNuages;
+    end;
+  end;
+end;
+
+procedure TGBEClouds.deplacementNuages;
 var
   s:TPlane;
   P:TFmxObject;  // Va servir d'itérateur pour parcourir tous les objets enfants du dmyNuages
 begin
-  if fActiveWind then
+  for P in self.Children do // Parcours des objets enfants du dmyNuages
   begin
-    for P in self.Children do // Parcours des objets enfants du dmyNuages
+    if P is TPlane then // Si l'objet est un TPlane
     begin
-      if P is TPlane then // Si l'objet est un TPlane
+      s := TPlane(P);   // On va travailler sur ce TPlane
+      s.position.x := s.position.x + fWindSpeed / ( s.Position.z);
+      if (s.position.x > fLimits) or
+         (s.Position.X < -fLimits)   then      // Si la position en X du nuage > 1000, alors on repositionne le nuage à la position x = -1000 et Y et Z valeurs aléatoires
       begin
-        s := TPlane(P);   // On va travailler sur ce TPlane
-        s.position.x := s.position.x + fWindSpeed / ( s.Position.z);
-        if (s.position.x > fLimits) or
-           (s.Position.X < -fLimits)   then      // Si la position en X du nuage > 1000, alors on repositionne le nuage à la position x = -1000 et Y et Z valeurs aléatoires
-        begin
-          s.Position.point := Point3D(-fLimits, random-0.5, random*fLimits * (0.5-random));
-          s.Opacity := random;
-        end;
+        s.Position.point := Point3D(-fLimits, random-0.5, random*fLimits * (0.5-random));
+        s.Opacity := random;
       end;
     end;
   end;
@@ -184,6 +202,7 @@ procedure TGBEClouds.generateClouds;
     s.Opaque := false;
     s.ZWrite := false;     // pour éviter que le rectangle "cadre" du TPlane soit visible => mais du coup la profondeur n'est plus gérée : le Soleil passe devant les nuages...
     s.HitTest := false;    // pour ne pas pouvoir cliquer dessus
+    s.tag := self.Tag;
     s.Position.Point:=Point3D(random*fLimits * (0.5-random), random - 0.5, random*fLimits * (0.5-random));  // On positionne le nuage arbitrairement et aléatoirement partout au dessus de notre monde
     s.RotationAngle.Z := random * 360; // Orientation aléatoire du nuage
   end;

GBEJoystick.pas

@@ -4,7 +4,7 @@ interface
 
 uses
   System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts, GBEPlayerPosition, System.Math.Vectors, system.types,
-  FMX.Viewport3D, System.UITypes, FMX.Dialogs, FMX.Objects, FMX.Graphics, FMX.Ani;
+  FMX.Viewport3D, System.UITypes, FMX.Dialogs, FMX.Objects, FMX.Graphics, FMX.Ani, uGBEUtils3D;
 
 type
   TGBEJoystickType = (jtOrientation, jtDeplacement);
@@ -166,13 +166,17 @@ procedure TGBEJoystick.DoMouseLeave;
 procedure TGBEJoystick.MouseMove(Shift: TShiftState; X, Y: Single);
 begin
   inherited;
+
   if ssLeft in shift then
   begin
-    if fJoystickType = jtOrientation then angleDeVue := PointF(X,Y);
-    if fJoystickType = jtDeplacement then fPosDepartCurseur := PointF(X,Y);
+    if (Viewport3D <> nil) and (PlayerPosition <> nil) then
+    begin
+      if fJoystickType = jtOrientation then angleDeVue := PointF(X,Y);
 
-    fCircle2.Position.X := x - offset.x;
-    fCircle2.Position.y := Y - offset.y;
+      fCircle2.Position.X := x - offset.x;
+      fCircle2.Position.y := Y - offset.y;
+      interactionIHM(Viewport3D);
+    end;
   end;
 end;
 
@@ -191,8 +195,11 @@ procedure TGBEJoystick.Paint;
   begin
     if fJoystickType = jtDeplacement then
     begin
-      fAcceleration := ( fPosDepartCurseur.Y - self.height/2) / (sensitivity * 10000);
-      fPlayerPosition.RotationAngle.Y := fPlayerPosition.RotationAngle.Y + (fPosDepartCurseur.x - self.Width /2)/(sensitivity * 5);
+      if assigned(fPlayerPosition) then
+      begin
+        FAcceleration := FAcceleration + ((fCircle.Height - fCircle2.Height)*0.5 + fCircle2.position.Y) / Sensitivity;
+        fPlayerPosition.RotationAngle.Y := fPlayerPosition.RotationAngle.Y - ((fCircle.Width - fCircle2.Width)*0.5 - fCircle2.Position.X) / Sensitivity;
+      end;
     end;
   end;
 end;
@@ -202,8 +209,8 @@ procedure TGBEJoystick.Resize;
   inherited;
   fCircle2.width := fCircle.Width -20;
   fCircle2.height := fCircle.height -20;
-  fCircle2.position.X := (fCircle.Width - fCircle2.Width)/2 ;
-  fCircle2.position.Y := (fCircle.Height - fCircle2.Height)/2;
+  fCircle2.position.X := (fCircle.Width - fCircle2.Width)*0.5;
+  fCircle2.position.Y := (fCircle.Height - fCircle2.Height)*0.5;
 end;
 
 procedure TGBEJoystick.setJoystickType(const Value: TGBEJoystickType);

GBEPlaneExtend.pas

@@ -17,7 +17,7 @@   TGBEPlaneExtend = class(TPlane)
     fTime, fAmplitude, fLongueur, fVitesse : single;
     fOrigine, fCenter : TPoint3D;
     fNbMesh : integer;
-    fActiveWaves, fShowlines : boolean;
+    fActiveWaves, fShowlines, fUseTasks : boolean;
     fMaterialLignes: TColorMaterialSource;
     { Déclarations privées }
     procedure CalcWaves(D : TPoint3D);
@@ -36,6 +36,7 @@   TGBEPlaneExtend = class(TPlane)
     property Longueur : single read fLongueur write fLongueur;
     property Vitesse : single read fVitesse write fVitesse;
     property ShowLines: boolean read fShowlines write fShowLines;
+    property UseTasks : boolean read fUseTasks write fUseTasks;
     property MaterialLines : TColorMaterialSource read fMaterialLignes write fMaterialLignes;
   end;
 
@@ -97,6 +98,7 @@ constructor TGBEPlaneExtend.Create(AOwner: TComponent);
   fOrigine := Point3D(self.SubdivisionsWidth / self.Width, self.SubdivisionsHeight / self.Height, 2);
   fNbMesh:=(SubdivisionsWidth + 1) * (SubdivisionsHeight + 1);
   fCenter := Point3D(SubdivisionsWidth / self.Width, SubdivisionsHeight / self.Height, 0);
+  fUseTasks := true;
 end;
 
 destructor TGBEPlaneExtend.Destroy;
@@ -109,10 +111,17 @@ procedure TGBEPlaneExtend.Render;
   inherited;
   if fActiveWaves then
   begin
-    TTask.Create( procedure
-              begin
-                CalcWaves(Point3D(fAmplitude, fLongueur, fVitesse));
-              end).start;
+    if fUseTasks then
+    begin
+      TTask.Create( procedure
+                begin
+                  CalcWaves(Point3D(fAmplitude, fLongueur, fVitesse));
+                end).start;
+    end
+    else
+    begin
+      CalcWaves(Point3D(fAmplitude, fLongueur, fVitesse));
+    end;
   end;
   if ShowLines then
     Context.DrawLines(self.Data.VertexBuffer, self.Data.IndexBuffer, TMaterialSource.ValidMaterial(fMaterialLignes),1);

GBEPlayerPosition.pas

@@ -13,11 +13,17 @@   TGBEPlayerPosition = class(TDummy)
     fDummyOrientation, fNextPosition, fPositionDirection : TDummy;
     fCamera : TCamera;
     fTypePosition : TGBETypePosition;
+    fWidth: single;
+    fDepth: single;
+    fHeight: single;
     function getPositionCamera: TPoint3D;
     procedure setPositionCamera(const Value: TPoint3D);
     function getAngleOfView: single;
     procedure setAngleOfView(const Value: single);
     procedure setTypePosition(const Value: TGBETypePosition);
+    procedure setWidth(const Value: single);
+    procedure setDepth(const Value: single);
+    procedure setHeight(const Value: single);
   protected
     { Déclarations protégées }
   public
@@ -35,6 +41,9 @@   TGBEPlayerPosition = class(TDummy)
     property TypePosition : TGBETypePosition read fTypePosition write setTypePosition;
     property NextPosition : TDummy read fNextPosition write fNextPosition;
     property HitTest default False;
+    property Width : single read fWidth write setWidth;
+    property Height : single read fHeight write setHeight;
+    property Depth : single read fDepth write setDepth;
   end;
 
 procedure Register;
@@ -54,22 +63,31 @@ constructor TGBEPlayerPosition.Create(AOwner: TComponent);
   fDummyOrientation := TDummy.Create(self);
   fDummyOrientation.Locked := true;
   fDummyOrientation.Stored := false;
+  fDummyOrientation.Width := self.Width;
+  fDummyOrientation.height := self.height;
+  fDummyOrientation.Depth := self.Depth;
   AddObject(fDummyOrientation);
   fCamera := TCamera.Create(self);
   fCamera.Parent := fDummyOrientation;
 
   fNextPosition := TDummy.Create(self);
   fNextPosition.Locked := true;
   fNextPosition.Stored := false;
+  fNextPosition.Width := self.Width;
+  fNextPosition.height := self.height;
+  fNextPosition.Depth := self.Depth;
 
   fPositionDirection := TDummy.Create(self);
   fPositionDirection.Locked := true;
   fPositionDirection.Stored := false;
+  fPositionDirection.Width := self.Width;
+  fPositionDirection.height := self.height;
+  fPositionDirection.Depth := self.Depth;
   fPositionDirection.Parent := fDummyOrientation;
 
   fPositionDirection.position.X := 0;
   fPositionDirection.position.Y := 0;
-  fPositionDirection.position.Z := -0.1;
+  fPositionDirection.position.Z := -0.01;
 
   fTypePosition := TGBETypePosition.thirdPerson;
 end;
@@ -110,6 +128,22 @@ procedure TGBEPlayerPosition.setAngleOfView(const Value: single);
   fCamera.AngleOfView := value;
 end;
 
+procedure TGBEPlayerPosition.setDepth(const Value: single);
+begin
+  fDepth := Value;
+  fDummyOrientation.Depth := Value;
+  fNextPosition.Depth := Value;
+  fPositionDirection.Depth := Value;
+end;
+
+procedure TGBEPlayerPosition.setHeight(const Value: single);
+begin
+  fHeight := Value;
+  fDummyOrientation.Height := Value;
+  fNextPosition.Height := Value;
+  fPositionDirection.Height := Value;
+end;
+
 procedure TGBEPlayerPosition.setPositionCamera(const Value: TPoint3D);
 begin
   fCamera.Position.Point := value;
@@ -133,4 +167,12 @@ procedure TGBEPlayerPosition.setTypePosition(const Value: TGBETypePosition);
   end;
 end;
 
+procedure TGBEPlayerPosition.setWidth(const Value: single);
+begin
+  fWidth := Value;
+  fDummyOrientation.Width := Value;
+  fNextPosition.Width := Value;
+  fPositionDirection.Width := Value;
+end;
+
 end.

GBEViewport3D.pas

@@ -135,7 +135,7 @@ procedure TGBEViewport3D.Paint;
             begin
               for I := 0 to FMyRenderingList.Count -1 do
               begin
-                if FMyRenderingList[i].Visible or
+                if FMyRenderingList[i].Visible or (FMyRenderingList[i].Tag <> 2) or
                   (not FMyRenderingList[i].Visible and (csDesigning in ComponentState)
                    and not FMyRenderingList[i].Locked) then
                   begin
@@ -173,7 +173,10 @@ procedure TGBEViewport3D.RebuildRenderingList;
     FMyRenderingList.Clear;
     for i := 0 to Children.Count-1 do
     begin
-      if children[i] is TControl3D then FMyRenderingList.Add((children[i] as TControl3d));
+      if children[i] is TControl3D then
+      begin
+        FMyRenderingList.Add((children[i] as TControl3d));
+      end;
     end;
   end;
 end;

demos/Clouds/demo_clouds.res

@@ -204,7 +204,7 @@ object form1: Tform1
         JoystickType = jtDeplacement
         Viewport3D = GBEViewport
         ShowIntegrateJoystick = True
-        Sensitivity = 30
+        Sensitivity = 180
         object Image2: TImage
           MultiResBitmap = <
             item

demos/Cubemap/demo_cubemap.res

@@ -6,7 +6,7 @@ interface
   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
   System.Math.Vectors, FMX.Controls3D, FMX.Objects3D, FMX.Viewport3D,
-  GBEViewport3D, GBEHeightmap, uHeightmap, FMX.MaterialSources, FMX.Ani,
+  GBEViewport3D, GBEHeightmap, FMX.MaterialSources, FMX.Ani,
   GBEPlayerPosition, GBEJoystick, FMX.Layouts, FMX.Controls.Presentation,
   FMX.StdCtrls, uGBEUtils3D, FMX.ListBox, FMX.Objects, FMX.Types3D;
 
@@ -54,6 +54,7 @@   Tform1 = class(TForm)
 
 const
   tailleJoueur = 0.7;    // Taille du joueur pour la vue FirstPerson
+  vitesseMax = 0.1;    // Vitesse maxi de déplacement
 
 var
   form1: Tform1;
@@ -72,23 +73,26 @@ procedure Tform1.ComboBox1Change(Sender: TObject);
 
 procedure Tform1.FloatAnimation1Process(Sender: TObject);
 begin
-  vitesse := vitesse + GBEJoystick2.Acceleration;
-
-  GBEPlayerPosition1.NextPosition.Position.point := GBEPlayerPosition1.Position.Point - GBEJoystick2.direction * vitesse;
-  GBEPlayerPosition1.NextPosition.position.Y := GBEHeightmap1.GetHeight(GBEPlayerPosition1.Position.Point);
-
-  if GBEPlayerPosition1.TypePosition = TGBETypePosition.firstPerson then
-     GBEPlayerPosition1.NextPosition.position.Y := GBEPlayerPosition1.NextPosition.position.Y + tailleJoueur;
-
-  // On controle que la prochaine position est dans l'aire de jeu
-  if (GBEPlayerPosition1.NextPosition.position.Point.x < GBEHeightmap1.Depth*0.5) and
-     (GBEPlayerPosition1.NextPosition.position.Point.x > -GBEHeightmap1.Depth*0.5) and
-     (GBEPlayerPosition1.NextPosition.position.Point.z < GBEHeightmap1.width*0.5) and
-     (GBEPlayerPosition1.NextPosition.position.Point.z > -GBEHeightmap1.Depth*0.5) then
-  begin
-    GBEPlayerPosition1.Position.point := GBEPlayerPosition1.NextPosition.position.Point; // Si c'est le cas, on peut affecter la position à la procahine calculée
-  end
-  else vitesse := 0; // sinon on ne déplace pas le joueur et on réinitialise sa vitesse de déplacement
+  if GBEJoystick2.Acceleration = 0 then vitesse := 0
+  else begin
+    if abs(vitesse) <= vitesseMax then vitesse := vitesse + GBEJoystick2.Acceleration/5000;
+
+    GBEPlayerPosition1.NextPosition.Position.point := GBEPlayerPosition1.Position.Point - GBEJoystick2.direction * vitesse;
+    GBEPlayerPosition1.NextPosition.position.Y := GBEHeightmap1.GetHeight(GBEPlayerPosition1.Position.Point);
+
+    if GBEPlayerPosition1.TypePosition = TGBETypePosition.firstPerson then
+       GBEPlayerPosition1.NextPosition.position.Y := GBEPlayerPosition1.NextPosition.position.Y + tailleJoueur;
+
+    // On controle que la prochaine position est dans l'aire de jeu
+    if (GBEPlayerPosition1.NextPosition.position.Point.x < GBEHeightmap1.Depth*0.5) and
+       (GBEPlayerPosition1.NextPosition.position.Point.x > -GBEHeightmap1.Depth*0.5) and
+       (GBEPlayerPosition1.NextPosition.position.Point.z < GBEHeightmap1.width*0.5) and
+       (GBEPlayerPosition1.NextPosition.position.Point.z > -GBEHeightmap1.Depth*0.5) then
+    begin
+      GBEPlayerPosition1.Position.point := GBEPlayerPosition1.NextPosition.position.Point; // Si c'est le cas, on peut affecter la position à la procahine calculée
+    end
+    else vitesse := 0; // sinon on ne déplace pas le joueur et on réinitialise sa vitesse de déplacement
+  end;
 end;
 
 procedure Tform1.FormCreate(Sender: TObject);