GLScene/Examples/Demos/collisions/BoxSphere/fBoxSphereD.pas

unit fBoxSphereD;

interface

uses
  Winapi.Windows,
  Winapi.OpenGL,
  System.SysUtils,
  System.Classes,
  System.Math,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ExtCtrls,
  Vcl.ComCtrls,
  Vcl.StdCtrls,
  Vcl.Samples.Spin,

  
  GLS.Scene,
  GLS.PersistentClasses,
  GLS.VectorTypes,
  GLS.Objects,
  GLS.Cadencer,
  GLS.VectorFileObjects,
  GLS.SceneViewer,
  GLS.VectorGeometry,
  GLS.Graph,
  GLS.GeomObjects,
 
  GLS.Coordinates,
  GLS.BaseClasses;

type
  TFormBoxSphere = class(TForm)
    Viewer: TGLSceneViewer;
    GLScene: TGLScene;
    GLCadencer: TGLCadencer;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLLightSource2: TGLLightSource;
    DCCamTarget: TGLDummyCube;
    Panel2: TPanel;
    GLCube1: TGLCube;
    GLXYZGrid1: TGLXYZGrid;
    GLLines1: TGLLines;
    CheckBox06: TCheckBox;
    CheckBox04: TCheckBox;
    CheckBox05: TCheckBox;
    GLSphere1: TGLSphere;
    DCCube1: TGLDummyCube;
    CheckBox07: TCheckBox;
    Label5: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    UpDown3: TUpDown;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    UpDown4: TUpDown;
    UpDown5: TUpDown;
    UpDown6: TUpDown;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    UpDown7: TUpDown;
    UpDown8: TUpDown;
    UpDown9: TUpDown;
    Label1: TLabel;
    Edit10: TEdit;
    UpDown10: TUpDown;
    Label7: TLabel;
    Button3: TButton;
    Button4: TButton;
    GLLines3: TGLLines;
    GLSphere2: TGLSphere;
    procedure GLCadencerProgress(Sender: TObject; const DeltaTime, newTime: Double);
    procedure FormCreate(Sender: TObject);
    procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormResize(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure CheckBox04Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure ViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    mdx, mdy: Integer;
    intersPoint, ResNormal, BoxScale, SpherePos: TAffineVector;
    BoxMatrix: TGLMatrix;
    SphereRadius: Single;
  end;

// Generates random rotation for matrix. It remains a scale.
function RandomRotation(const aMatrix: TGLMatrix): TGLMatrix;

var
  FormBoxSphere: TFormBoxSphere;

implementation

{$R *.DFM}

procedure TFormBoxSphere.FormCreate(Sender: TObject);
begin
  Randomize;
  BoxScale := XYZVector;
  SphereRadius := 1;
  BoxMatrix := IdentityHmgMatrix;
end;

procedure TFormBoxSphere.CheckBox04Click(Sender: TObject);
begin
  GLCube1.Visible := CheckBox04.Checked;
  GLLines1.Visible := CheckBox05.Checked;
  GLXYZGrid1.Visible := CheckBox06.Checked;
  GLSphere1.Visible := CheckBox07.Checked;
end;

procedure TFormBoxSphere.Edit1Change(Sender: TObject);
const
  EditorsScale = 0.1;
var
  Res1: Boolean;
begin
  if not FormBoxSphere.Visible then
    Exit;
  GLLines3.Nodes.Clear;

  // Calc data.
  BoxMatrix.W.X := UpDown1.Position * EditorsScale;
  BoxMatrix.W.Y := UpDown2.Position * EditorsScale;
  BoxMatrix.W.Z := UpDown3.Position * EditorsScale;
  BoxMatrix.W.W := 1;

  BoxScale.X := UpDown4.Position * EditorsScale;
  BoxScale.Y := UpDown5.Position * EditorsScale;
  BoxScale.Z := UpDown6.Position * EditorsScale;

  SpherePos.X := UpDown7.Position * EditorsScale;
  SpherePos.Y := UpDown8.Position * EditorsScale;
  SpherePos.Z := UpDown9.Position * EditorsScale;

  SphereRadius := UpDown10.Position * EditorsScale;


  // dCollideSphereBox function !
  Res1 := IntersectSphereBox(VectorMake(SpherePos, 1), SphereRadius, BoxMatrix,
    BoxScale, @intersPoint, @ResNormal);

  if Res1 then
  begin
    // Intersected.
    Label1.Caption := 'Intersected';
    DCCamTarget.Position.SetPoint(intersPoint);

    // Draw normal
    GLLines3.Nodes.AddNode(intersPoint);
    GLLines3.Nodes.AddNode(VectorAdd(intersPoint, VectorScale(
      ResNormal, SphereRadius * 3)));
  end
  else
  begin
    // Not intersected.
    beep;
    Label1.Caption := '';

  end;
  DCCamTarget.Visible := Res1;

  // Draw GLCube1 and GLSphere1.
  GLCube1.SetMatrix(BoxMatrix);
  GLCube1.CubeWidth := BoxScale.X;
  GLCube1.CubeHeight := BoxScale.Y;
  GLCube1.CubeDepth := BoxScale.Z;
  DCCube1.SetMatrix(GLCube1.Matrix^);
  DCCube1.Scale.SetVector(BoxScale);
  GLSphere1.Position.SetPoint(SpherePos);
  GLSphere1.Radius := SphereRadius;
  GLSphere2.Position.SetPoint(SpherePos);
  GLSphere2.Radius := SphereRadius;
end;

// Recalc.
procedure TFormBoxSphere.Button3Click(Sender: TObject);
begin
  Edit1Change(Self);
end;

// Generates random rotation for matrix. It remains a scale.
function RandomRotation(const aMatrix: TGLMatrix): TGLMatrix;
var
  aScale: TAffineVector;
  I:      Integer;
begin
  // Save scale.
  for I := 0 to 2 do
    aScale.V[I] := VectorLength(aMatrix.V[I]);
  // Generate two not equal random vectors.
  Result.W := aMatrix.W;
  repeat
    repeat
      Result.X := VectorMake(Random * 2 - 1, Random * 2 - 1, Random * 2 - 1);
    until VectorNorm(Result.X) > 10e-6;
    repeat
      Result.Y := VectorMake(Random * 2 - 1, Random * 2 - 1, Random * 2 - 1);
    until VectorNorm(Result.Y) > 10e-6;
  until VectorNorm(VectorSubtract(Result.X, Result.Y)) > 10e-6;
  // Calculate two perpendicular vectors.
  Result.Z := VectorCrossProduct(Result.X, Result.Y);
  Result.Y := VectorCrossProduct(Result.X, Result.Z);
  // Restore scale.
  for I := 0 to 2 do
  begin
    NormalizeVector(Result.V[I]);
    ScaleVector(Result.V[I], aScale.V[I]);
  end;
end;

// Random matrix.
procedure TFormBoxSphere.Button4Click(Sender: TObject);
begin
  BoxMatrix := RandomRotation(BoxMatrix);
  Edit1Change(Self);
end;

procedure TFormBoxSphere.ViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Viewer.SetFocus;
end;

procedure TFormBoxSphere.GLCadencerProgress(Sender: TObject; const DeltaTime, newTime: Double);
begin
  if FormBoxSphere.Active then
    Viewer.Invalidate;
end;

procedure TFormBoxSphere.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Shift = [ssLeft] then
    GLCamera1.MoveAroundTarget(mdy - Y, mdx - X);
  mdx := X;
  mdy := Y;
end;

procedure TFormBoxSphere.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if Viewer.Focused then
    GLCamera1.AdjustDistanceToTarget(Power(1.02, WheelDelta / 120));
end;

procedure TFormBoxSphere.FormResize(Sender: TObject);
begin
  GLCamera1.FocalLength := MinInteger(Height, Width) / 10;
end;

procedure TFormBoxSphere.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #27 then
    Close;
end;

end.