GLScene/Sourcex/uGBEUtils3D.pas

unit uGBEUtils3D;

interface

uses
  System.Math.Vectors,
  System.Types,
  System.Classes,
  FMX.Objects3D,
  System.Math,
  FMX.Controls3D,
  FMX.Graphics,
  FMX.Types3D,
  System.UITypes,
  FMX.Effects,
  System.UIConsts,
  System.SysUtils,
  System.RTLConsts,
  FMX.Types,
  FMX.Ani,
  FMX.Viewport3D;

type
  TCustomMeshHelper = class(TCustomMesh);

  TGBECollisionRetour = record
    bool: boolean;
    objet: TControl3D;
  end;

function Barycentre(p1, p2, p3: TPoint3D; p4: TPointF): single;
function CalculateHeight(Mesh: TMesh; P: TPoint3D; miseAEchelle: single;
  subDivX, subDivZ: integer): single;
function SizeOf3D(const unObjet3D: TControl3D): TPoint3D;
function DetectionCollisionObstacle(Mesh: TMesh; objet: TControl3D)
  : TGBECollisionRetour;
procedure InteractionIHM(viewport: TViewport3D);
function CollisionDummyChilds(aDummy: TDummy; objet3D: TControl3D)
  : TGBECollisionRetour;
function CollisionEntre2Objets(objet1, objet2: TControl3D): TGBECollisionRetour;

implementation // -------------------------------------------------------------

function Barycentre(p1, p2, p3: TPoint3D; p4: TPointF): single;
var
  det, l1, l2, l3, d1, d2, d3, t1, t2: single;
begin
  d1 := (p2.z - p3.z);
  // Small optimizations to only do intermediate calculations once in each iteration
  d2 := (p3.x - p2.x);
  d3 := (p1.x - p3.x);
  det := 1 / ((d1 * d3) + (d2 * (p1.z - p3.z)));
  // Inverse, allows to replace greedy divisions by a multiplication
  // (thus, we only do the division once instead of twice at each iteration)
  t1 := (p4.x - p3.x);
  t2 := (p4.y - p3.z);
  l1 := ((d1 * t1) + (d2 * t2)) * det;
  l2 := ((p3.z - p1.z) * (t1 + (d3 * t2))) * det;
  l3 := 1 - l1 - l2;
  Result := l1 * p1.y + l2 * p2.y + l3 * p3.y;
end;

// ------------------------------------------------------------------------------------------
function CalculateHeight(Mesh: TMesh; P: TPoint3D; miseAEchelle: single;
  subDivX, subDivZ: integer): single;
var
  grilleX, grilleZ, indiceMaille: integer;
  xCoord, zCoord, hauteurCalculee, demiDepth, demiWidth, subWidth,
    subDepth: single;
begin
  if (subDivX = 0) or (subDivZ = 0) then
  begin
    Result := 0;
    Exit;
  end;

  demiWidth := Mesh.width * 0.5;
  demiDepth := Mesh.Depth * 0.5;
  subWidth := Mesh.width / subDivX;
  subDepth := Mesh.Depth / subDivZ;

  // Determination of the indices allowing access to the mesh according to the position of the player
  grilleX := trunc((P.x + demiWidth) / subWidth);
  grilleZ := trunc((P.z + demiDepth) / subDepth);

  // If we are outside the mesh, we force (arbitrarily) the height
  if (grilleX >= subDivX) or (grilleZ >= subDivZ) or (grilleX < 0) or
    (grilleZ < 0) then
    Result := 0
  else
  begin
    xCoord := Frac((P.x + demiWidth) / subWidth);
    // X position in the current mesh
    zCoord := Frac((P.z + demiDepth) / subDepth);
    // Y position in the current mesh

    // The height is calculated based on the 3 vertices of the triangle in which the player is located.
    // We determine which triangle we are in
    indiceMaille := (grilleZ * subDivZ * 4) + grilleX * 4;
    if xCoord <= (1 - zCoord) then
    begin
      hauteurCalculee :=
        Barycentre(TPoint3D.Create(0, Mesh.data.VertexBuffer.Vertices
        [indiceMaille].y, 0), TPoint3D.Create(1, Mesh.data.VertexBuffer.Vertices
        [indiceMaille + 1].y, 0), TPoint3D.Create(0,
        Mesh.data.VertexBuffer.Vertices[indiceMaille + 3].y, 1),
        TPointF.Create(xCoord, zCoord));
    end
    else
    begin
      hauteurCalculee :=
        Barycentre(TPoint3D.Create(1, Mesh.data.VertexBuffer.Vertices
        [indiceMaille + 1].y, 0), TPoint3D.Create(1,
        Mesh.data.VertexBuffer.Vertices[indiceMaille + 2].y, 1),
        TPoint3D.Create(0, Mesh.data.VertexBuffer.Vertices[indiceMaille + 3].y,
        1), TPointF.Create(xCoord, zCoord));
    end;
    Result := hauteurCalculee * miseAEchelle; // - demiHeight ; //- mesh.Height;
  end;
end;

// Returns the dimensions of the 3D object
function SizeOf3D(const unObjet3D: TControl3D): TPoint3D;
begin
  Result := NullPoint3D;
  if unObjet3D <> nil then
    Result := Point3D(unObjet3D.width, unObjet3D.Height, unObjet3D.Depth);
end;

// ------------------------------------------------------------------------------------------
// "Bounding Box" collision detection between the mesh
// (TGBEHeightmap and its child objects which have their tag at 1) and an object
function DetectionCollisionObstacle(Mesh: TMesh; objet: TControl3D)
  : TGBECollisionRetour;
var
  unObjet3D: TControl3D; // the object being rendered
  i, j: integer;
  resultat: TGBECollisionRetour;
begin
  resultat.bool := false;
  resultat.objet := nil;
  // Collision test with direct children of mSol
  for i := 0 to Mesh.ChildrenCount - 1 do
  begin
    if Mesh.Children[i].Tag = 1 then
    // The TMesh child must have his tag at 1
    begin
      for j := 0 to Mesh.Children[i].ChildrenCount - 1 do
      begin
        // We are working on the object that is being calculated
        unObjet3D := TControl3D(Mesh.Children[i].Children[j]);

        if collisionEntre2Objets(unObjet3D, objet).bool then
        begin
          resultat.bool := true;
          resultat.objet := unObjet3D;
          Break;
        end;
      end;
    end;
  end;
  Result := resultat;
end;

// ------------------------------------------------------------------------------------------

procedure InteractionIHM(viewport: TViewport3D);
var
  obj: TFmxObject;
begin
  for obj in Viewport.Children do
  begin
    if obj is TAnimation then
      TAnimation(obj).ProcessTick(0, 0);
  end;
end;

// ------------------------------------------------------------------------------------------
function CollisionDummyChilds(aDummy: TDummy; objet3D: TControl3D)
  : TGBECollisionRetour;
var
  obj: TFmxObject;
  resultat: TGBECollisionRetour;
begin
  resultat.bool := false;
  resultat.objet := nil;
  for obj in aDummy.Children do
  begin
    if (obj as TControl3D).visible then
    begin
      resultat := collisionEntre2Objets(objet3D, (obj as TControl3D));
      if resultat.bool then
        Break;
    end;
  end;
  Result := resultat;
end;

function CollisionEntre2Objets(objet1, objet2: TControl3D): TGBECollisionRetour;
var
  DistanceEntreObjets, distanceMinimum: TPoint3D;
begin
  result.objet := nil;
  result.bool := false;

  DistanceEntreObjets := objet1.Position.Point - objet2.Position.Point;
  distanceMinimum := (SizeOf3D(objet1) + SizeOf3D(objet2)) * 0.5;

  if ((Abs(DistanceEntreObjets.x) < distanceMinimum.x) and
    (Abs(DistanceEntreObjets.y) < distanceMinimum.y) and
    (Abs(DistanceEntreObjets.z) < distanceMinimum.z)) then
  begin
    result.bool := True;
    result.objet := objet2;
  end;
end;

end.