GLScene/Source/GLS.Gizmo.pas

//
// The graphics engine GLXEngine. The unit of GLScene for Delphi
//
unit GLS.Gizmo;

(*
  Invisible component for helping to Move, Rotate and Scale an Object
  under GLScene (usefull for an Editor).
*)
// ------------------------------------------------------------------------------
// Description :
// Invisible component for helping to Move, Rotate and Scale an Object
// under GLScene (usefull for an Editor)
// ------------------------------------------------------------------------------
// Features :
// - Interaction When All Gizmo parts are Invisible
// - Add "gpMoveGizmo and  gpRotateGizmo" operations and use Like a "Pivot"
// or use RootGizmo As "Pivot"
// - Add Interactive Camera Movements
// - Adding Extended Controls with Keys
// - Maybe An Undo Function
// ------------------------------------------------------------------------------
// Bugs Known :
// - When you change the BoundingBoxColor and LabelInfosColor
// The New Color is not Updated immediately, only after a new Click
// (see in UpdateGizmo, SetBoundingBoxColor
// and SetLabelInfosColor Procedures)
// -  Bounding Box is not always drawn correctly because it does not
// use objects' BarryCenter. For Example, if you select Space Text.
// ------------------------------------------------------------------------------

interface

{$I Stage.Defines.inc}

uses
  System.Classes,
  System.SysUtils,
  Vcl.StdCtrls,

  Stage.VectorTypes,
  Stage.VectorGeometry,
  Stage.Strings,

  GLS.Scene,
  GLS.PersistentClasses,
  GLS.Color,
  GLS.Objects,
  GLS.Material,
  GLS.GeomObjects,
  GLS.BitmapFont,
  GLS.SceneViewer,
  GLS.VectorFileObjects,
  GLS.Coordinates,
  GLS.RenderContextInfo,
  GLS.State,
  GLS.Selection;

type
  TGLGizmoUndoCollection = class;
  TGLGizmo = class;

  TGLGizmoUndoItem = class(TCollectionItem)
  private
    FOldLibMaterialName: string;
    FOldAutoScaling: TGLCoordinates;
    FEffectedObject: TGLCustomSceneObject;
    FOldMatr: TGLMatrix;
    FOldMatrix: TGLMatrix;
    procedure SetEffectedObject(const Value: TGLCustomSceneObject);
    procedure SetOldAutoScaling(const Value: TGLCoordinates);
    procedure SetOldMatrix(const Value: TGLMatrix);
  protected
    procedure DoUndo; virtual;
    function GetParent: TGLGizmoUndoCollection;
    function GetGizmo: TGLGizmo;
  public
    constructor Create(AOwner: TCollection); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); virtual;
    procedure AssignFromObject(const AObject: TGLCustomSceneObject);
    // TODO: create a special type for Matrix.
    property OldMatrix: TGLMatrix read FOldMatrix write SetOldMatrix;
  published
    property EffectedObject: TGLCustomSceneObject read FEffectedObject
      write SetEffectedObject;
    property OldAutoScaling: TGLCoordinates read FOldAutoScaling
      write SetOldAutoScaling;
    property OldLibMaterialName: string read FOldLibMaterialName
      write FOldLibMaterialName;
  end;

  TGLGizmoUndoCollection = class(TOwnedCollection)
  private
    function GetItems(const Index: Integer): TGLGizmoUndoItem;
    procedure SetItems(const Index: Integer; const Value: TGLGizmoUndoItem);
  protected
    function GetParent: TGLGizmo;
  public
    procedure Notification(AComponent: TComponent; Operation: TOperation);
    procedure RemoveByObject(const AObject: TGLCustomSceneObject);
    function Add: TGLGizmoUndoItem;
    property Items[const Index: Integer]: TGLGizmoUndoItem read GetItems
      write SetItems; default;
  end;

  TGLGizmoElement = (geMove, geRotate, geScale, geAxisLabel, geObjectInfos,
    geBoundingBox);
  TGLGizmoElements = set of TGLGizmoElement;

  TGLGizmoVisibleInfoLabel = (vliName, vliOperation, vliCoords);
  TGLGizmoVisibleInfoLabels = set of TGLGizmoVisibleInfoLabel;

  TGLGizmoAxis = (gaNone, gaX, gaY, gaZ, gaXY, gaXZ, gaYZ);

  TGLGizmoOperation = (gopMove, gopRotate, gopScale, gopNone, gpMoveGizmo,
    gpRotateGizmo);

  TGLGizmoAcceptEvent = procedure(Sender: TObject; var Obj: TGLBaseSceneObject;
    var Accept: Boolean; var Dimensions: TGLVector) of object;
  TGLGizmoUpdateEvent = procedure(Sender: TObject; Obj: TGLBaseSceneObject;
    Axis: TGLGizmoAxis; Operation: TGLGizmoOperation; var Vector: TGLVector)
    of object;

  TGLGizmoPickMode = (pmGetPickedObjects, pmRayCast);

  TGLGizmoRayCastHitData = class(TPersistent)
  public
    Obj: TGLBaseSceneObject;
    Point: TGLVector;
  end;

  TGLGizmoPickCube = class(TGLCube)
  end;

  TGLGizmoPickTorus = class(TGLTorus)
  end;

  TGLGizmo = class(TComponent)
  private
    _GZObaseGizmo: TGLBaseSceneObject;
    _GZOBoundingcube: TGLCube;
    _GZOrootHelpers: TGLBaseSceneObject;
    _GZOrootLines: TGLBaseSceneObject;
    _GZOrootTorus: TGLBaseSceneObject;
    _GZOrootCubes: TGLBaseSceneObject;
    _GZORootAxisLabel: TGLBaseSceneObject;
    _GZORootVisibleInfoLabels: TGLBaseSceneObject;
    _GZOlineX, _GZOlineY, _GZOlineZ, _GZOplaneXY, _GZOplaneXZ,
      _GZOplaneYZ: TGLLines; // For Move
    _GZOTorusX, _GZOTorusY, _GZOTorusZ: TGLGizmoPickTorus; // For Rotate
    _GZOCubeX, _GZOCubeY, _GZOCubeZ: TGLGizmoPickCube; // For Scale
    _GZOAxisLabelX, _GZOAxisLabelY, _GZOAxisLabelZ: TGLFlatText;
    _GZOVisibleInfoLabels: TGLFlatText;
    FRootGizmo: TGLBaseSceneObject;
    FSelectedObj: TGLBaseSceneObject;
    // FLastOperation,
    FOperation: TGLGizmoOperation;
    FSelAxis: TGLGizmoAxis;
    FBoundingBoxColor: TGLColor;
    FSelectedColor: TGLColor;
    FVisibleInfoLabelsColor: TGLColor;
    FBoundingBoxColorChanged: Boolean;
    FVisibleInfoLabelsColorChanged: Boolean;
    FForceOperation: Boolean;
    FForceAxis: Boolean;
    FForceUniformScale: Boolean;
    FAutoZoom: Boolean;
    FExcludeObjects: Boolean;
    FNoZWrite: Boolean;
    FEnabled: Boolean;
    FAutoZoomFactor: Single;
    FZoomFactor: Single;
    FMoveCoef: Single;
    FRotationCoef: Single;
    FViewer: TGLSceneViewer;
    FGizmoElements: TGLGizmoElements;
    FVisibleVisibleInfoLabels: TGLGizmoVisibleInfoLabels;
    FExcludeObjectsList: TStrings;
    Moving: Boolean;
    Mx, My: Integer;
    Rx, Ry: Integer;
    dglEnable, dglDisable, dgtEnable, dgtDisable, dgcEnable, dgcDisable,
      dglaEnable, dglaDisable, dgliEnable, dgliDisable: TGLDirectOpenGL;
    LastMousePos: TGLVector;
    ObjDimensions: TGLVector;
    FOnBeforeSelect: TGLGizmoAcceptEvent;
    FOnBeforeUpdate: TGLGizmoUpdateEvent;
    FOnSelectionLost: TNotifyEvent;
    FScaleCoef: Single;
    FGizmoThickness: Single;
    FPickMode: TGLGizmoPickMode;
    FInternalRaycastHitData: TList;
    FUndoHistory: TGLGizmoUndoCollection;
    FLabelFont: TGLCustomBitmapFont;
    procedure SetRootGizmo(const AValue: TGLBaseSceneObject);
    procedure SetGizmoElements(const AValue: TGLGizmoElements);
    procedure SeTGLGizmoVisibleInfoLabels(const AValue: TGLGizmoVisibleInfoLabels);
    procedure SetBoundingBoxColor(const AValue: TGLColor);
    procedure SetSelectedColor(const AValue: TGLColor);
    procedure SetVisibleInfoLabelsColor(const AValue: TGLColor);
    procedure SetExcludeObjectsList(const AValue: TStrings);
    procedure DirectGlDisable(Sender: TObject; var Rci: TGLRenderContextInfo);
    procedure DirectGlEnable(Sender: TObject; var Rci: TGLRenderContextInfo);
    function MouseWorldPos(const X, Y: Integer): TGLVector;
    function CheckObjectInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
    procedure UpdateVisibleInfoLabels;
    procedure SetGLGizmoThickness(const Value: Single);
    function InternalGetPickedObjects(const X1, Y1, X2, Y2: Integer;
      const GuessCount: Integer = 8): TGLPickList;
    procedure ClearInternalRaycastHitData;
    procedure SetViewer(const Value: TGLSceneViewer);
    procedure SetLabelFont(const Value: TGLCustomBitmapFont);
    procedure SetSelectedObj(const Value: TGLBaseSceneObject);
  public
    PickableObjectsWithRayCast: TList;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure ViewerMouseMove(const X, Y: Integer);
    procedure ViewerMouseDown(const X, Y: Integer);
    procedure ViewerMouseUp(const X, Y: Integer);
    procedure UpdateGizmo; overload;
    procedure UpdateGizmo(const NewDimensions: TGLVector); overload;
    procedure SetVisible(const AValue: Boolean);
    function GetPickedObjectPoint(const Obj: TGLBaseSceneObject): TGLVector;
    procedure LooseSelection; virtual;
    procedure UndoAdd(const AObject: TGLCustomSceneObject);
    property RootGizmo: TGLBaseSceneObject read FRootGizmo write SetRootGizmo;
    // --------------------------------------------------------------------
  published
    property Viewer: TGLSceneViewer read FViewer write SetViewer;
    property GizmoElements: TGLGizmoElements read FGizmoElements
      write SetGizmoElements;
    property BoundingBoxColor: TGLColor read FBoundingBoxColor
      write SetBoundingBoxColor;
    property SelectedColor: TGLColor read FSelectedColor write SetSelectedColor;
    property SelAxis: TGLGizmoAxis read FSelAxis write FSelAxis;
    property ForceAxis: Boolean read FForceAxis write FForceAxis;
    property SelectedObj: TGLBaseSceneObject read FSelectedObj
      write SetSelectedObj;
    property Operation: TGLGizmoOperation read FOperation write FOperation;
    property ForceOperation: Boolean read FForceOperation write FForceoperation;
    property ForceUniformScale: Boolean read FForceUniformScale
      write FForceUniformScale;
    property ExcludeObjects: Boolean read FExcludeObjects write FExcludeObjects;
    property ExcludeObjectsList: TStrings read FExcludeObjectsList
      write SetExcludeObjectsList;
    property VisibleInfoLabels: TGLGizmoVisibleInfoLabels
      read FVisibleVisibleInfoLabels write SeTGLGizmoVisibleInfoLabels;
    property VisibleInfoLabelsColor: TGLColor read FVisibleInfoLabelsColor
      write SetVisibleInfoLabelsColor;
    property AutoZoom: Boolean read FAutoZoom write FAutoZoom;
    property AutoZoomFactor: Single read FAutoZoomFactor write FAutoZoomFactor;
    property ZoomFactor: Single read FZoomFactor write FZoomFactor;
    property MoveCoef: Single read FMoveCoef write FMoveCoef;
    property RotationCoef: Single read FRotationCoef write FRotationCoef;
    property ScaleCoef: Single read FScaleCoef write FScaleCoef;
    property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
    property GizmoThickness: Single read FGizmoThickness
      write SeTGLGizmoThickness;
    (*  Indicates whether the gizmo is enabled or not.
      WARNING: When loading/editing (possibly whenever a structureChanged
      call is made) a model, sometimes the gizmo will trigger a
      bug if the mouse is inside the glscene Viewer. To prevent that,
      remember to disable the gizmo before loading, then process windows
      messages (i.e. application.processMessage) and then enable the gizmo again.
      Warning Enable is ReadOnly property if you set to False, Gizmo is not Hidden
      use Visible instead if you want to Hide, if you want to Hide but keep enabled
      see the VisibleGizmo property *)
    property Enabled: Boolean read FEnabled write FEnabled default False;
    property LabelFont: TGLCustomBitmapFont read FLabelFont write SetLabelFont
      default nil;
    property OnBeforeSelect: TGLGizmoAcceptEvent read FOnBeforeSelect
      write FOnBeforeSelect;
    property OnSelectionLost: TNotifyEvent read FOnSelectionLost
      write FOnSelectionLost;
    (*  Called before an Update is applied. The "vector" parameter is the difference
      that will be applied to the object, according to the axis and operation selected. *)
    property OnBeforeUpdate: TGLGizmoUpdateEvent read FOnBeforeUpdate
      write FOnBeforeUpdate;
    property PickMode: TGLGizmoPickMode read FPickMode write FPickMode
      default PmGetPickedObjects;
  end;

//=========================================================
implementation
//=========================================================

procedure RotateAroundArbitraryAxis(const AnObject: TGLBaseSceneObject;
  const Axis, Origin: TAffineVector; const Angle: Single);
var
  M, M1, M2, M3: TGLMatrix;
begin
  M1 := CreateTranslationMatrix(VectorNegate(Origin));
  M2 := CreateRotationMatrix(Axis, Angle * PI / 180);
  M3 := CreateTranslationMatrix(Origin);
  M := MatrixMultiply(M1, M2);
  M := MatrixMultiply(M, M3);
  AnObject.SetMatrix(MatrixMultiply(AnObject.Matrix^, M));

  // Just a workarround to Update angles...
  AnObject.Roll(0);
  AnObject.Pitch(0);
  AnObject.Turn(0);
end;

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

procedure TGLGizmo.ClearInternalRaycastHitData;
var
  T: Integer;
begin
  for T := FInternalRaycastHitData.Count - 1 downto 0 do
  begin
    TGLGizmoRayCastHitData(FInternalRaycastHitData[T]).Free;
  end;
  FInternalRaycastHitData.Clear;
end;

constructor TGLGizmo.Create(AOwner: TComponent);
var
  Cub: TGLCube;
begin
  inherited Create(AOwner);
  FUndoHistory := TGLGizmoUndoCollection.Create(Self, TGLGizmoUndoItem);
  FPickMode := PmGetPickedObjects;
  PickableObjectsWithRayCast := TList.Create;
  FRotationCoef := 1;
  FMoveCoef := 0.1;
  FScaleCoef := 0.1;
  FGizmoThickness := 1;

  FInternalRaycastHitData := TList.Create;
  FBoundingBoxColor := TGLColor.Create(Self);
  FBoundingBoxColor.Color := ClrWhite;
  FBoundingBoxColorChanged := False;
  FSelectedColor := TGLColor.Create(Self);
  FSelectedColor.Color := ClrYellow;
  FVisibleInfoLabelsColor := TGLColor.Create(Self);
  FVisibleInfoLabelsColor.Color := ClrYellow;
  FVisibleInfoLabelsColorChanged := False;

  _GZObaseGizmo := TGLDummyCube.Create(Self);
  _GZORootHelpers := TGLDummyCube(_GZObaseGizmo.AddNewChild(TGLDummyCube));
  _GZOBoundingcube := TGLCube(_GZORootHelpers.AddNewChild(TGLCube));

  _GZORootLines := _GZORootHelpers.AddNewChild(TGLDummyCube);
  _GZORootTorus := _GZORootHelpers.AddNewChild(TGLDummyCube);
  _GZORootCubes := _GZORootHelpers.AddNewChild(TGLDummyCube);
  _GZORootAxisLabel := _GZORootHelpers.AddNewChild(TGLDummyCube);
  _GZORootVisibleInfoLabels := _GZORootHelpers.AddNewChild(TGLDummyCube);

  DglDisable := TGLDirectOpenGL(_GZORootLines.AddNewChild(TGLDirectOpenGL));
  DglDisable.OnRender := DirectGlDisable;
  DgtDisable := TGLDirectOpenGL(_GZORootTorus.AddNewChild(TGLDirectOpenGL));
  DgtDisable.OnRender := DirectGlDisable;
  DgcDisable := TGLDirectOpenGL(_GZORootCubes.AddNewChild(TGLDirectOpenGL));
  DgcDisable.OnRender := DirectGlDisable;
  DglaDisable := TGLDirectOpenGL
    (_GZORootAxisLabel.AddNewChild(TGLDirectOpenGL));
  DglaDisable.OnRender := DirectGlDisable;
  DgliDisable := TGLDirectOpenGL(_GZORootVisibleInfoLabels.AddNewChild
    (TGLDirectOpenGL));
  DgliDisable.OnRender := DirectGlDisable;

  with _GZOBoundingcube.Material do
  begin
    FaceCulling := FcNoCull;
    PolygonMode := PmLines;
    with FrontProperties do
    begin
      Diffuse.Color := FBoundingBoxColor.Color;
      Ambient.Color := FBoundingBoxColor.Color;
      Emission.Color := FBoundingBoxColor.Color;
    end;
    with BackProperties do
    begin
      Diffuse.Color := FBoundingBoxColor.Color;
      Ambient.Color := FBoundingBoxColor.Color;
      Emission.Color := FBoundingBoxColor.Color;
    end;
  end;

  _GZOlinex := TGLLines(_GZORootLines.AddnewChild(TGLLines));
  with _GZOlinex do
  begin
    LineColor.Color := clrRed;
    LineWidth := 3;
    NodesAspect := LnaInvisible;
    AddNode(0, 0, 0);
    AddNode(1, 0, 0);
    AddNode(0.9, 0, -0.1);
    AddNode(1, 0, 0);
    AddNode(0.9, 0, 0.1);
    // Raycast pickable object
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
    Cub.Up.SetVector(1, 0, 0);
    Cub.CubeWidth := 0.1;
    Cub.CubeHeight := 1;
    Cub.CubeDepth := 0.1;
    Cub.Position.SetPoint(0.5, 0, 0);
    Cub.Visible := False;
  end;

  _GZOliney := TGLLines(_GZORootLines.AddnewChild(TGLLines));
  with _GZOliney do
  begin
    LineColor.Color := clrLime;
    LineWidth := 3;
    NodesAspect := LnaInvisible;
    AddNode(0, 0, 0);
    AddNode(0, 1, 0);
    AddNode(0.1, 0.9, 0);
    AddNode(0, 1, 0);
    AddNode(-0.1, 0.9, 0);
    // Raycast pickable object
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
    Cub.Up.SetVector(0, 1, 0);
    Cub.CubeWidth := 0.1;
    Cub.CubeHeight := 1;
    Cub.CubeDepth := 0.1;
    Cub.Position.SetPoint(0, 0.5, 0);
    Cub.Visible := False;
  end;

  _GZOlinez := TGLLines(_GZORootLines.AddnewChild(TGLLines));
  with _GZOlinez do
  begin
    LineColor.Color := clrBlue;
    LineWidth := 3;
    NodesAspect := LnaInvisible;
    AddNode(0, 0, 0);
    AddNode(0, 0, 1);
    AddNode(0.1, 0, 0.9);
    AddNode(0, 0, 1);
    AddNode(-0.1, 0, 0.9);
    // Raycast pickable object
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
    Cub.Up.SetVector(0, 0, 1);
    Cub.CubeWidth := 0.1;
    Cub.CubeHeight := 1;
    Cub.CubeDepth := 0.1;
    Cub.Position.SetPoint(0, 0, 0.5);
    Cub.Visible := False;
  end;

  _GZOplaneXY := TGLLines(_GZORootLines.AddnewChild(TGLLines));
  with _GZOplaneXY do
  begin
    LineWidth := 3;
    Options := [LoUseNodeColorForLines];
    NodesAspect := LnaInvisible;
    SplineMode := LsmSegments;
    AddNode(0.8, 1, 0);
    TGLLinesNode(Nodes[0]).Color.Color := clrRed;
    AddNode(1, 1, 0);
    TGLLinesNode(Nodes[1]).Color.Color := clrRed;
    AddNode(1, 1, 0);
    TGLLinesNode(Nodes[2]).Color.Color := clrLime;
    AddNode(1, 0.8, 0);
    TGLLinesNode(Nodes[3]).Color.Color := clrLime;
    // Raycast pickable object
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
    Cub.Up.SetVector(1, 0, 0);
    Cub.CubeWidth := 0.2;
    Cub.CubeHeight := 0.2;
    Cub.CubeDepth := 0.1;
    Cub.Position.SetPoint(0.9, 0.9, 0);
    Cub.Visible := False;
  end;

  _GZOplaneXZ := TGLLines(_GZORootLines.AddnewChild(TGLLines));
  with _GZOplaneXZ do
  begin
    LineWidth := 3;
    Options := [LoUseNodeColorForLines];
    NodesAspect := LnaInvisible;
    SplineMode := LsmSegments;
    AddNode(1, 0, 0.8);
    TGLLinesNode(Nodes[0]).Color.Color := clrBlue;
    AddNode(1, 0, 1);
    TGLLinesNode(Nodes[1]).Color.Color := clrBlue;
    AddNode(1, 0, 1);
    TGLLinesNode(Nodes[2]).Color.Color := clrRed;
    AddNode(0.8, 0, 1);
    TGLLinesNode(Nodes[3]).Color.Color := clrRed;
    // Raycast pickable object
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
    Cub.Up.SetVector(1, 0, 0);
    Cub.CubeWidth := 0.1;
    Cub.CubeHeight := 0.2;
    Cub.CubeDepth := 0.2;
    Cub.Position.SetPoint(0.9, 0, 0.9);
    Cub.Visible := False;
  end;

  _GZOplaneYZ := TGLLines(_GZORootLines.AddnewChild(TGLLines));
  with _GZOplaneYZ do
  begin
    LineWidth := 3;
    Options := [LoUseNodeColorForLines];
    NodesAspect := LnaInvisible;
    SplineMode := LsmSegments;
    AddNode(0, 0.8, 1);
    TGLLinesNode(Nodes[0]).Color.Color := clrLime;
    AddNode(0, 1, 1);
    TGLLinesNode(Nodes[1]).Color.Color := clrLime;
    AddNode(0, 1, 1);
    TGLLinesNode(Nodes[2]).Color.Color := clrBlue;
    AddNode(0, 1, 0.8);
    TGLLinesNode(Nodes[3]).Color.Color := clrBlue;
    // Raycast pickable object
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
    Cub.Up.SetVector(0, 0, 1);
    Cub.CubeWidth := 0.2;
    Cub.CubeHeight := 0.2;
    Cub.CubeDepth := 0.1;
    Cub.Position.SetPoint(0, 0.9, 0.9);
    Cub.Visible := False;
  end;

  _GZOTorusX := TGLGizmoPickTorus(_GZORootTorus.AddnewChild(TGLGizmoPickTorus));
  with _GZOTorusX do
  begin
    Rings := 16;
    Sides := 4;
    MajorRadius := 0.6;
    MinorRadius := 0.03;
    PitchAngle := 90;
    TurnAngle := 90;
    with Material do
    begin
      // FaceCulling:= fcNoCull;
      PolygonMode := PmFill;
      // BackProperties.PolygonMode:= pmFill;
      FrontProperties.Emission.Color := clrBlue;
    end;
  end;

  _GZOTorusY := TGLGizmoPickTorus(_GZORootTorus.AddnewChild(TGLGizmoPickTorus));
  with _GZOTorusY do
  begin
    Rings := 16;
    Sides := 4;
    MajorRadius := 0.6;
    MinorRadius := 0.03;
    PitchAngle := 90;
    with Material do
    begin
      // FaceCulling:= fcNoCull;
      PolygonMode := PmFill;
      // BackProperties.PolygonMode:= pmFill;
      FrontProperties.Emission.Color := clrRed;
    end;
  end;

  _GZOTorusZ := TGLGizmoPickTorus(_GZORootTorus.AddnewChild(TGLGizmoPickTorus));
  with _GZOTorusZ do
  begin
    Rings := 16;
    Sides := 4;
    MajorRadius := 0.6;
    MinorRadius := 0.03;
    with Material do
    begin
      // FaceCulling:= fcNoCull;
      PolygonMode := PmFill;
      // BackProperties.PolygonMode:= pmFill;
      FrontProperties.Emission.Color := clrLime;
    end;
  end;

  _GZOCubeX := TGLGizmoPickCube(_GZORootCubes.AddnewChild(TGLGizmoPickCube));
  with _GZOCubeX do
  begin
    CubeDepth := 0.1;
    CubeHeight := 0.1;
    CubeWidth := 0.1;
    Position.X := 1.15;
    with Material do
    begin
      FaceCulling := FcNoCull;
      PolygonMode := PmFill;
      FrontProperties.Emission.Color := clrRed;
    end;
  end;

  _GZOCubeY := TGLGizmoPickCube(_GZORootCubes.AddnewChild(TGLGizmoPickCube));
  with _GZOCubeY do
  begin
    CubeDepth := 0.1;
    CubeHeight := 0.1;
    CubeWidth := 0.1;
    Position.Y := 1.15;
    with Material do
    begin
      FaceCulling := FcNoCull;
      PolygonMode := PmFill;
      FrontProperties.Emission.Color := clrLime;
    end;
  end;

  _GZOCubeZ := TGLGizmoPickCube(_GZORootCubes.AddnewChild(TGLGizmoPickCube));
  with _GZOCubeZ do
  begin
    CubeDepth := 0.1;
    CubeHeight := 0.1;
    CubeWidth := 0.1;
    Position.Z := 1.15;
    with Material do
    begin
      FaceCulling := FcNoCull;
      PolygonMode := PmFill;
      FrontProperties.Emission.Color := clrBlue;
    end;
  end;

  _GZOAxisLabelX := TGLFlatText(_GZORootAxisLabel.AddNewChild(TGLFlatText));
  with _GZOAxisLabelX do
  begin
    ModulateColor.Color := ClrRed;
    Alignment := TaCenter;
    Layout := TTextLayout.tlCenter;
    Options := Options + [FtoTwoSided];
    Position.X := 1.5;
    Scale.X := 0.02;
    Scale.Y := 0.02;
    Text := 'X';
  end;

  _GZOAxisLabelY := TGLFlatText(_GZORootAxisLabel.AddNewChild(TGLFlatText));
  with _GZOAxisLabelY do
  begin
    ModulateColor.Color := clrLime;
    Alignment := TaCenter;
    Layout := TlCenter;
    Options := Options + [FtoTwoSided];
    Position.Y := 1.5;
    Scale.X := 0.02;
    Scale.Y := 0.02;
    Text := 'Y';
  end;

  _GZOAxisLabelZ := TGLFlatText(_GZORootAxisLabel.AddNewChild(TGLFlatText));
  with _GZOAxisLabelZ do
  begin
    ModulateColor.Color := ClrBlue;
    Alignment := TaCenter;
    Layout := TlCenter;
    Options := Options + [FtoTwoSided];
    Position.Z := 1.5;
    Scale.X := 0.02;
    Scale.Y := 0.02;
    Text := 'Z';
  end;

  _GZOVisibleInfoLabels :=
    TGLFlatText(_GZORootVisibleInfoLabels.AddNewChild(TGLFlatText));
  with _GZOVisibleInfoLabels do
  begin
    ModulateColor.Color := clrYellow;
    Alignment := TaCenter;
    Layout := TlCenter;
    Options := Options + [FtoTwoSided];
    Position.Y := 1.8;
    Position.X := 0;
    Scale.X := 0.01;
    Scale.Y := 0.01;
    Text := '';
  end;

  DglEnable := TGLDirectOpenGL(_GZORootLines.AddNewChild(TGLDirectOpenGL));
  DglEnable.OnRender := DirectGlEnable;
  DgtEnable := TGLDirectOpenGL(_GZORootTorus.AddNewChild(TGLDirectOpenGL));
  DgtEnable.OnRender := DirectGlEnable;
  DgcEnable := TGLDirectOpenGL(_GZORootCubes.AddNewChild(TGLDirectOpenGL));
  DgcEnable.OnRender := DirectGlEnable;
  DglaEnable := TGLDirectOpenGL(_GZORootAxisLabel.AddNewChild(TGLDirectOpenGL));
  DglaEnable.OnRender := DirectGlEnable;
  DgliEnable := TGLDirectOpenGL(_GZORootVisibleInfoLabels.AddNewChild
    (TGLDirectOpenGL));
  DgliEnable.OnRender := DirectGlEnable;

  _GZObaseGizmo.Visible := False;
  FGizmoElements := FGizmoElements + [GeMove, GeRotate, GeScale, GeAxisLabel,
    GeObjectInfos, GeBoundingBox];
  FVisibleVisibleInfoLabels := FVisibleVisibleInfoLabels +
    [VliName, VliOperation, VliCoords];
  AutoZoom := True;
  AutoZoomFactor := 5.0;
  ZoomFactor := 0.35;
  ForceOperation := False;
  ForceAxis := False;
  ForceUniformScale := False;
  Enabled := True;
  FNoZWrite := True;
  FExcludeObjectsList := TStringList.Create;
end;

destructor TGLGizmo.Destroy;
begin
  if Assigned(FRootGizmo) then
    FRootGizmo.DeleteChildren
  else
  begin
    _GZOBaseGizmo.DeleteChildren;
    _GZOBaseGizmo.Free;
  end;

  FBoundingBoxColor.Free;
  FSelectedColor.Free;
  FVisibleInfoLabelsColor.Free;
  PickableObjectsWithRayCast.Free;
  FExcludeObjectsList.Free;
  ClearInternalRaycastHitData;
  FInternalRaycastHitData.Free;

  // FUndoHistory has to be nil before Notification() is called.
  FreeAndNil(FUndoHistory);
  inherited Destroy;
end;

procedure TGLGizmo.SetVisible(const AValue: Boolean);
begin
  _GZObaseGizmo.Visible := AValue;
end;

procedure TGLGizmo.SetGizmoElements(const AValue: TGLGizmoElements);
begin
  if AValue <> FGizmoElements then
  begin
    FGizmoElements := AValue;
    _GZORootLines.Visible := GeMove in FGizmoElements;
    _GZORootTorus.Visible := GeRotate in FGizmoElements;
    _GZORootCubes.Visible := GeScale in FGizmoElements;
    _GZORootAxisLabel.Visible := GeAxisLabel in FGizmoElements;
    _GZORootVisibleInfoLabels.Visible := GeObjectInfos in FGizmoElements;
    _GZOBoundingcube.Visible := GeBoundingBox in FGizmoElements;
  end;
end;

procedure TGLGizmo.SetBoundingBoxColor(const AValue: TGLColor);
begin
  // Bug Here New Color is not Updated
  if AValue <> FBoundingBoxColor then
  begin
    FBoundingBoxColor.Color := AValue.Color;
    with _GZOBoundingcube.Material do
    begin
      with FrontProperties do
      begin
        Diffuse.Color := FBoundingBoxColor.Color;
        Ambient.Color := FBoundingBoxColor.Color;
        Emission.Color := FBoundingBoxColor.Color;
      end;
      with BackProperties do
      begin
        Diffuse.Color := FBoundingBoxColor.Color;
        Ambient.Color := FBoundingBoxColor.Color;
        Emission.Color := FBoundingBoxColor.Color;
      end;
    end;
    FBoundingBoxColorChanged := True;
  end;
end;

procedure TGLGizmo.SetSelectedColor(const AValue: TGLColor);
begin
  if AValue <> FSelectedColor then
  begin
    FSelectedColor.Color := AValue.Color;
  end;
end;

procedure TGLGizmo.SetVisibleInfoLabelsColor(const AValue: TGLColor);
begin
  // Bug Here New Color is not Updated
  if AValue <> FSelectedColor then
  begin
    FVisibleInfoLabelsColor.Color := AValue.Color;
    _GZOVisibleInfoLabels.ModulateColor.Color := AValue.Color;
    FVisibleInfoLabelsColorChanged := True;
  end;
end;

procedure TGLGizmo.SeTGLGizmoVisibleInfoLabels(const AValue
  : TGLGizmoVisibleInfoLabels);
begin
  if AValue <> FVisibleVisibleInfoLabels then
  begin
    FVisibleVisibleInfoLabels := AValue;
    if not(CsDesigning in ComponentState) then
      UpdateGizmo;
  end;
end;

procedure TGLGizmo.UndoAdd(const AObject: TGLCustomSceneObject);
begin
  if AObject <> nil then
  begin
    FUndoHistory.Add.AssignFromObject(AObject)
  end;
end;

procedure TGLGizmo.SetRootGizmo(const AValue: TGLBaseSceneObject);
begin
  if FRootGizmo <> AValue then
  begin
    if FRootGizmo <> nil then
      FRootGizmo.RemoveFreeNotification(Self);
    FRootGizmo := AValue;
    if FRootGizmo <> nil then
      FRootGizmo.FreeNotification(Self);
    _GZObaseGizmo.MoveTo(AValue);
  end;
end;

procedure TGLGizmo.SetExcludeObjectsList(const AValue: TStrings);
begin
  FExcludeObjectsList.Clear;
  FExcludeObjectsList.AddStrings(AValue);
end;

procedure TGLGizmo.SetGLGizmoThickness(const Value: Single);
var
  Thk: Single;
begin
  if FGizmoThickness <> Value then
  begin
    Thk := MaxInteger(1, Round(3 * Value));
    _GZOlinex.LineWidth := Thk;
    _GZOliney.LineWidth := Thk;
    _GZOlinez.LineWidth := Thk;
    _GZOplaneXY.LineWidth := Thk;
    _GZOplaneXZ.LineWidth := Thk;
    _GZOplaneYZ.LineWidth := Thk;

    _GZOTorusX.MinorRadius := 0.03 * Value;
    _GZOTorusY.MinorRadius := 0.03 * Value;
    _GZOTorusZ.MinorRadius := 0.03 * Value;

    with _GZOCubeX do
    begin
      CubeDepth := 0.1 * Value;
      CubeHeight := 0.1 * Value;
      CubeWidth := 0.1 * Value;
    end;
    with _GZOCubeY do
    begin
      CubeDepth := 0.1 * Value;
      CubeHeight := 0.1 * Value;
      CubeWidth := 0.1 * Value;
    end;
    with _GZOCubeZ do
    begin
      CubeDepth := 0.1 * Value;
      CubeHeight := 0.1 * Value;
      CubeWidth := 0.1 * Value;
    end;

    FGizmoThickness := Value;
  end;
end;

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

procedure TGLGizmo.DirectGlDisable(Sender: TObject;
  var Rci: TGLRenderContextInfo);
begin
  if FNoZWrite then
    Rci.GLStates.Disable(StDepthTest);
end;

procedure TGLGizmo.SetLabelFont(const Value: TGLCustomBitmapFont);
begin
  if FLabelFont <> Value then
  begin
    if FLabelFont <> nil then
      FLabelFont.RemoveFreeNotification(Self);
    FLabelFont := Value;
    if FLabelFont <> nil then
      FLabelFont.FreeNotification(Self);

    _GZOAxisLabelX.BitmapFont := Value;
    _GZOAxisLabelY.BitmapFont := Value;
    _GZOAxisLabelZ.BitmapFont := Value;
    _GZOVisibleInfoLabels.BitmapFont := Value;
  end;
end;

procedure TGLGizmo.DirectGlEnable(Sender: TObject; var Rci: TGLRenderContextInfo);
begin
  if FNoZWrite then
    Rci.GLStates.Enable(StDepthTest);
end;

function TGLGizmo.GetPickedObjectPoint(const Obj: TGLBaseSceneObject): TGLVector;
var
  T: Integer;
  R: TGLGizmoRayCastHitData;
begin
  for T := 0 to FInternalRaycastHitData.Count - 1 do
  begin
    R := TGLGizmoRayCastHitData(FInternalRaycastHitData[T]);
    if R.Obj = Obj then
    begin
      Result := R.Point;
      Break;
    end;
  end;
end;

function TGLGizmo.InternalGetPickedObjects(const X1, Y1, X2, Y2: Integer;
  const GuessCount: Integer): TGLPickList;
var
  T: Integer;
  RayStart, RayVector, IPoint, INormal: TGLVector;
  O: TGLBaseSceneObject;
  Dist: Single;
  HitData: TGLGizmoRayCastHitData;

  procedure AddGizmosToPicklListRecurse(const Root: TGLBaseSceneObject);
  var
    U: Integer;
  begin
    for U := 0 to Root.Count - 1 do
    begin
      if ((Root[U] is TGLGizmoPickTorus) or (Root[U] is TGLGizmoPickCube)) then
        PickableObjectsWithRayCast.Add(Root[U]);
      AddGizmosToPicklListRecurse(Root[U]);
    end;
  end;

begin
  case FPickMode of
    PmGetPickedObjects:
      begin
        Result := Viewer.Buffer.GetPickedObjects(Rect(X1, Y1, X2, Y2),
          GuessCount);
      end;

    PmRayCast:
      begin
        Result := TGLPickList.Create(PsMinDepth);
        ClearInternalRaycastHitData;
        SetVector(RayStart, Viewer.Camera.AbsolutePosition);
        SetVector(RayVector, Viewer.Buffer.ScreenToVector
          (AffineVectorMake((X1 + X2) * 0.5,
          Viewer.Height - ((Y1 + Y2) * 0.5), 0)));
        NormalizeVector(RayVector);
        // Add gizmos
        if (RootGizmo <> nil) and (SelectedObj <> nil) then
          AddGizmosToPicklListRecurse(RootGizmo);
        // pick
        for T := 0 to PickableObjectsWithRayCast.Count - 1 do
        begin
          O := TGLBaseSceneObject(PickableObjectsWithRayCast[T]);
          if (O.RayCastIntersect(RayStart, RayVector, @IPoint, @INormal)) and
            (VectorDotProduct(RayVector, INormal) < 0) then
          begin
            try
              Dist := VectorLength(VectorSubtract(IPoint, RayStart));
              Result.AddHit(O, nil, Dist, 0);
              HitData := TGLGizmoRayCastHitData.Create;
              HitData.Obj := O;
              MakeVector(HitData.Point, IPoint);
              FInternalRaycastHitData.Add(HitData);
            except
              //
            end;
          end;
        end;
      end;

  else
    begin
      Result := nil;
      Assert(False, strErrorEx + strUnknownType);
    end;

  end;
end;

procedure TGLGizmo.Loaded;
begin
  inherited;
  SeTGLGizmoThickness(GizmoThickness);
end;

// ------------------------------------------------------------------------------
procedure TGLGizmo.UpdateVisibleInfoLabels;
var
  T: string;
  X, Y, Z: Single;
begin
  T := '';
  if not(Assigned(SelectedObj)) then
    Exit;
  if VliName in FVisibleVisibleInfoLabels then
    T := SelectedObj.Name;

  if VliOperation in FVisibleVisibleInfoLabels then
  begin
    if (Operation <> GopNone) then
    begin
      if Length(T) > 0 then
        T := T + ' - ';
      case Operation of
        GopMove:
          T := T + 'Move';
        GopRotate:
          T := T + 'Rotate';
        GopScale:
          T := T + 'Scale';
      end;
    end;
  end;

  if VliCoords in FVisibleVisibleInfoLabels then
  begin
    if (Operation <> GopNone) then
    begin
      if Length(T) > 0 then
        T := T + ' - ';
      case Operation of
        GopMove:
          begin
            X := SelectedObj.Position.X;
            Y := SelectedObj.Position.Y;
            Z := SelectedObj.Position.Z;
            T := T + 'X : ' + Format('%2.3f', [X]);
            T := T + ' Y : ' + Format('%2.3f', [Y]);
            T := T + ' Z : ' + Format('%2.3f', [Z]);
          end;
        GopRotate:
          begin
            X := SelectedObj.Rotation.X;
            Y := SelectedObj.Rotation.Y;
            Z := SelectedObj.Rotation.Z;
            T := T + 'X : ' + Format('%2.3f', [X]);
            T := T + ' Y : ' + Format('%2.3f', [Y]);
            T := T + ' Z : ' + Format('%2.3f', [Z]);
          end;
        GopScale:
          begin
            X := SelectedObj.Scale.X;
            Y := SelectedObj.Scale.Y;
            Z := SelectedObj.Scale.Z;
            T := T + 'X : ' + Format('%2.3f', [X]);
            T := T + ' Y : ' + Format('%2.3f', [Y]);
            T := T + ' Z : ' + Format('%2.3f', [Z]);
          end;
      end;
    end;
  end;

  _GZOVisibleInfoLabels.Text := T;
  _GZOVisibleInfoLabels.StructureChanged;
end;

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

function TGLGizmo.CheckObjectInExcludeList
  (const Obj: TGLBaseSceneObject): Boolean;
var
  I: Integer;
begin
  Result := False;
  if FExcludeObjects then
  begin
    for I := 0 to FExcludeObjectsList.Count - 1 do
    begin
      if UpperCase(Obj.Name) = UpperCase(FExcludeObjectsList[I]) then
      begin
        Result := True;
        Exit;
      end;
    end;
  end;
end;

function TGLGizmo.MouseWorldPos(const X, Y: Integer): TGLVector;
var
  V: TGLVector;
  InvertedY: Integer;
begin
  InvertedY := Viewer.Height - Y;
  if Assigned(SelectedObj) then
  begin
    SetVector(V, X, InvertedY, 0);

    case SelAxis of
      GaX:
        if not Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(V,
          SelectedObj.AbsolutePosition.Y, Result) then
          MakeVector(Result, X / 5, 0, 0);

      GaY:
        if not Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(V,
          SelectedObj.AbsolutePosition.X, Result) then
          MakeVector(Result, 0, InvertedY / 5, 0);

      GaZ:
        if not Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(V,
          SelectedObj.AbsolutePosition.X, Result) then
          MakeVector(Result, 0, 0, -InvertedY / 5);

      GaXY:
        begin
          Viewer.Buffer.ScreenVectorIntersectWithPlaneXY(V,
            SelectedObj.AbsolutePosition.Z, Result);
        end;
      GaXZ:
        begin
          Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(V,
            SelectedObj.AbsolutePosition.Y, Result);
        end;
      GaYZ:
        begin
          Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(V,
            SelectedObj.AbsolutePosition.X, Result);
        end;
    end;

  end
  else
    SetVector(Result, NullVector);
end;

procedure TGLGizmo.ViewerMouseMove(const X, Y: Integer);
var
  PickList: TGLPickList;
  MousePos: TGLVector;

  function IndexOf(Obj: TGLBaseSceneObject): Integer;
  var
    I: Integer;
  begin
    Result := -1;
    for I := 0 to PickList.Count - 1 do
      if PickList.Hit[I] = Obj then
      begin
        Result := I;
        Break;
      end;
  end;

  function LightLine(const Line: TGLLines; const Dark: TGLVector;
    const Axis: TGLGizmoAxis; AlterStyle: Boolean = False): Boolean;
  var
    PickObj: TGLBaseSceneObject;
  begin
    case FPickMode of
      PmGetPickedObjects:
        PickObj := Line;
      PmRayCast:
        PickObj := Line;
    else
      begin
        PickObj := nil;
        Assert(False, strErrorEx + strUnknownType);
      end;
    end;

    if IndexOf(PickObj) > -1 then
    begin
      Line.LineColor.Color := FSelectedColor.Color;
      if not(FForceOperation) then
        if Operation <> GopMove then
          Operation := GopMove;
      Line.Options := [];
      if not(FForceAxis) then
        SelAxis := Axis;
      Result := True;
    end
    else
    begin
      Line.LineColor.Color := Dark;
      if not(FForceOperation) then
        Operation := GopNone;
      if AlterStyle then
        Line.Options := [LoUseNodeColorForLines];
      if not(FForceAxis) then
        if SelAxis = Axis then
          SelAxis := GaNone;
      Result := False;
    end;
  end;

  function LightTorus(const Torus: TGLGizmoPickTorus; const Dark: TGLVector;
    const Axis: TGLGizmoAxis; AlterStyle: Boolean = False): Boolean;
  begin
    if IndexOf(Torus) > -1 then
    begin
      Torus.Material.FrontProperties.Emission.Color := FSelectedColor.Color;
      if not(FForceOperation) then
        if Operation <> GopRotate then
          Operation := GopRotate;
      if not(FForceAxis) then
        SelAxis := Axis;
      Result := True;
    end
    else
    begin
      Torus.Material.FrontProperties.Emission.Color := Dark;
      if not(FForceOperation) then
        Operation := GopNone;
      if not(FForceAxis) then
        if SelAxis = Axis then
          SelAxis := GaNone;
      Result := False;
    end;
  end;

  function LightCube(const Cube: TGLCube; const Dark: TGLVector;
    const Axis: TGLGizmoAxis; AlterStyle: Boolean = False): Boolean;
  begin
    if IndexOf(Cube) > -1 then
    begin
      Cube.Material.FrontProperties.Emission.Color := FSelectedColor.Color;
      if not(FForceOperation) then
        if Operation <> GopScale then
          Operation := GopScale;
      if not(FForceAxis) then
        SelAxis := Axis;
      Result := True;
    end
    else
    begin
      Cube.Material.FrontProperties.Emission.Color := Dark;
      if not(FForceOperation) then
        Operation := GopNone;
      if not(FForceAxis) then
        if SelAxis = Axis then
          SelAxis := GaNone;
      Result := False;
    end;
  end;

  procedure OpeMove(MousePos: TGLVector);
  var
    Vec1, Vec2: TGLVector;
    QuantizedMousePos, QuantizedMousePos2: TGLVector;
    T: Integer;
  begin
    for T := 0 to 3 do
    begin
      QuantizedMousePos.V[T] := (Round(MousePos.V[T] / MoveCoef)) * MoveCoef;
      QuantizedMousePos2.V[T] := (Round(LastMousePos.V[T] / MoveCoef)) * MoveCoef;
    end;
    case SelAxis of
      GaX:
        begin
          MakeVector(Vec1, QuantizedMousePos.X, 0, 0);
          MakeVector(Vec2, QuantizedMousePos2.X, 0, 0);
        end;
      GaY:
        begin
          MakeVector(Vec1, 0, QuantizedMousePos.Y, 0);
          MakeVector(Vec2, 0, QuantizedMousePos2.Y, 0);
        end;
      GaZ:
        begin
          MakeVector(Vec1, 0, 0, QuantizedMousePos.Z);
          MakeVector(Vec2, 0, 0, QuantizedMousePos2.Z);
        end;
    else
      begin
        Vec1 := QuantizedMousePos;
        Vec2 := QuantizedMousePos2;
      end;
    end;
    SubtractVector(Vec1, Vec2);
    if Assigned(OnBeforeUpdate) then
      OnBeforeUpdate(Self, SelectedObj, SelAxis, Operation, Vec1);
    Vec1 := SelectedObj.Parent.AbsoluteToLocal(Vec1);
    if (VectorLength(Vec1) > 0) then // prevents NAN problems
    begin
      SelectedObj.Position.Translate(Vec1);
    end;
  end;

  procedure OpeRotate(const X, Y: Integer);
  var
    Vec1: TGLVector;
    RotV: TAffineVector;
    Pmat: TGLMatrix;

  begin
    Vec1.X := 0;
    Vec1.Y := 0;
    if Abs(X - Rx) >= RotationCoef then
    begin
      if RotationCoef > 1 then
        Vec1.X := RotationCoef * (Round((X - Rx) / (RotationCoef)))
      else
        Vec1.X := RotationCoef * (X - Rx);
      Rx := X;
    end;
    if Abs(Y - Ry) >= RotationCoef then
    begin
      if RotationCoef > 1 then
        Vec1.Y := RotationCoef * (Round((Y - Ry) / (RotationCoef)))
      else
        Vec1.Y := RotationCoef * (Y - Ry);
      Ry := Y;
    end;

    Vec1.Z := 0;
    Vec1.W := 0;
    if Assigned(OnBeforeUpdate) then
      OnBeforeUpdate(Self, SelectedObj, SelAxis, Operation, Vec1);

    Pmat := SelectedObj.Parent.InvAbsoluteMatrix;
    SetVector(Pmat.V[3], NullHmgPoint);
    case SelAxis of
      GaX:
        begin
          RotV := VectorTransform(XVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.Y);
        end;
      GaY:
        begin
          RotV := VectorTransform(YVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.X);
        end;
      GaZ:
        begin
          RotV := VectorTransform(ZVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.Y);
        end;
      GaXY:
        begin
          RotV := VectorTransform(XVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.Y);
          RotV := VectorTransform(YVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.X);
        end;
      GaXZ:
        begin
          RotV := VectorTransform(XVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.Y);
          RotV := VectorTransform(ZVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.X);
        end;
      GaYZ:
        begin
          RotV := VectorTransform(YVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.Y);
          RotV := VectorTransform(ZVector, Pmat);
          RotateAroundArbitraryAxis(SelectedObj, RotV,
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.X);
        end;
    end;
  end;

  procedure OpeScale(const MousePos: TGLVector);
  var
    Vec1, Vec2: TGLVector;
    QuantizedMousePos, QuantizedMousePos2: TGLVector;
    T: Integer;
  begin
    for T := 0 to 3 do
    begin
      QuantizedMousePos.V[T] := (Round(MousePos.V[T] / ScaleCoef)) * FScaleCoef;
      QuantizedMousePos2.V[T] := (Round(LastMousePos.V[T] / FScaleCoef)) *
        FScaleCoef;
    end;
    case SelAxis of
      GaX:
        begin
          if FForceUniformScale then
          begin
            MakeVector(Vec1, QuantizedMousePos.X, QuantizedMousePos.X,
              QuantizedMousePos.X);
            MakeVector(Vec2, QuantizedMousePos2.X, QuantizedMousePos2.X,
              QuantizedMousePos2.X);
          end
          else
          begin
            MakeVector(Vec1, QuantizedMousePos.X, 0, 0);
            MakeVector(Vec2, QuantizedMousePos2.X, 0, 0);
          end;

        end;

      GaY:
        begin
          if FForceUniformScale then
          begin
            MakeVector(Vec1, QuantizedMousePos.Y, QuantizedMousePos.Y,
              QuantizedMousePos.Y);
            MakeVector(Vec2, QuantizedMousePos2.Y, QuantizedMousePos2.Y,
              QuantizedMousePos2.Y);
          end
          else
          begin
            MakeVector(Vec1, 0, QuantizedMousePos.Y, 0);
            MakeVector(Vec2, 0, QuantizedMousePos2.Y, 0);
          end;
        end;

      GaZ:
        begin
          if FForceUniformScale then
          begin
            MakeVector(Vec1, QuantizedMousePos.Z, QuantizedMousePos.Z,
              QuantizedMousePos.Z);
            MakeVector(Vec2, QuantizedMousePos2.Z, QuantizedMousePos2.Z,
              QuantizedMousePos2.Z);
          end
          else
          begin
            MakeVector(Vec1, 0, 0, QuantizedMousePos.Z);
            MakeVector(Vec2, 0, 0, QuantizedMousePos2.Z);
          end;
        end;
    else
      begin
        Vec1 := QuantizedMousePos;
        Vec2 := QuantizedMousePos2;
      end;
    end;
    SubtractVector(Vec1, Vec2);
    if Assigned(OnBeforeUpdate) then
      OnBeforeUpdate(Self, SelectedObj, SelAxis, Operation, Vec1);
    SelectedObj.Scale.Translate(Vec1);
    UpdateGizmo;
  end;

begin
  if not Enabled then
    Exit;

  if Assigned(SelectedObj) and (SelAxis <> GaNone) and Moving then
  begin
    MousePos := MouseWorldPos(X, Y);

    // moving object...
    if Operation = GopMove then
    begin
      // FLastOperation = gopMove;
      OpeMove(MousePos);
    end
    else if Operation = GopRotate then
    begin
      // FLastOperation = gopRotate;
      OpeRotate(X, Y);
    end
    else if Operation = GopScale then
    begin
      // FLastOperation = gopScale;
      OpeScale(MousePos);
    end;

    UpdateGizmo;
    Mx := X;
    My := Y;
    LastMousePos := MousePos;
    Exit;
  end;

  Assert(FViewer <> nil, 'Viewer not Assigned to gizmo');
  Picklist := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1, 8);
  // Viewer.buffer.GetPickedObjects(rect(x-1, y-1, x+1, y+1), 8);

  if not LightLine(_GZOlinex, ClrRed, GaX) and not LightLine(_GZOliney, ClrLime,
    GaY) and not LightLine(_GZOlinez, ClrBlue, GaZ) and
    not LightTorus(_GZOTorusX, ClrRed, GaX) and
    not LightTorus(_GZOTorusY, ClrLime, GaY) and
    not LightTorus(_GZOTorusz, ClrBlue, GaZ) and
    not LightCube(_GZOCubeX, ClrRed, GaX) and not LightCube(_GZOCubeY, ClrLime,
    GaY) and not LightCube(_GZOCubeZ, ClrBlue, GaZ) and
    not LightLine(_GZOplaneXY, ClrWhite, GaXY, True) and
    not LightLine(_GZOplaneXZ, ClrWhite, GaXZ, True) and
    not LightLine(_GZOplaneYZ, ClrWhite, GaYZ, True) then
  begin
    if not(FForceAxis) then
      SelAxis := GaNone;
    if not(FForceOperation) then
      Operation := GopNone;
  end;

  Picklist.Free;

  Mx := X;
  My := Y;
end;

procedure TGLGizmo.ViewerMouseDown(const X, Y: Integer);
var
  Pick: TGLPickList;
  I: Integer;
  Accept: Boolean;
  Dimensions: TGLVector;
  GotPick: Boolean;
  PickedObj: TGLBaseSceneObject;
begin
  Mx := X;
  My := Y;
  Rx := X;
  Ry := Y;

  if not Enabled then
    Exit;

  Pick := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1);
  // Viewer.Buffer.GetPickedObjects(rect(x-1, y-1, x+1, y+1));
  GotPick := False;
  Accept := False;

  case FPickMode of
    PmGetPickedObjects:
      begin
        // primeiro, ver se é uma das linhas/planos
        for I := 0 to Pick.Count - 1 do
          if (_GZOrootLines.IndexOfChild(TGLBaseSceneObject(Pick.Hit[I])) > -1)
            or (_GZOrootTorus.IndexOfChild(TGLBaseSceneObject(Pick.Hit[I])) >
            -1) or (_GZOrootCubes.IndexOfChild(TGLBaseSceneObject(Pick.Hit[I]))
            > -1) then
            GotPick := True;
      end;

    PmRayCast:
      begin
        for I := 0 to Pick.Count - 1 do
        begin
          if (Pick.Hit[I] is TGLGizmoPickCube) or
            (Pick.Hit[I] is TGLGizmoPickTorus) then
            GotPick := True;
        end;
      end;
  else
    begin
      Assert(False, strErrorEx + strUnknownType);
    end;

  end;

  if not GotPick then
  begin
    for I := 0 to Pick.Count - 1 do

      if (Pick.Hit[I] <> _GZOBoundingcube) and (Pick.Hit[I] <> _GZOAxisLabelX)
        and (Pick.Hit[I] <> _GZOAxisLabelY) and (Pick.Hit[I] <> _GZOAxisLabelZ)
        and (Pick.Hit[I] <> _GZOVisibleInfoLabels) and
        not(CheckObjectInExcludeList(TGLBaseSceneObject(Pick.Hit[I]))) then
      begin
        Accept := True;
        PickedObj := TGLBaseSceneObject(Pick.Hit[I]);
        Dimensions := PickedObj.AxisAlignedDimensions;
        if Assigned(OnBeforeSelect) then
          OnBeforeSelect(Self, PickedObj, Accept, Dimensions);

        Break;
      end;

    if Accept then
      SetSelectedObj(PickedObj)
    else
      SetSelectedObj(nil);
  end
  else
    UpdateVisibleInfoLabels();

  Pick.Free;

  Moving := True;
  LastMousePos := MouseWorldPos(X, Y);
end;

procedure TGLGizmo.ViewerMouseUp(const X, Y: Integer);
begin
  Moving := False;
end;

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

procedure TGLGizmo.UpdateGizmo;
var
  D: Single;
begin
  if SelectedObj = nil then
  begin
    _GZObaseGizmo.Visible := False;
    Exit;
  end;

  _GZObaseGizmo.Position.AsVector := SelectedObj.AbsolutePosition;
  if GeObjectInfos in FGizmoElements then
    UpdateVisibleInfoLabels;

  _GZOBoundingcube.SetMatrix(SelectedObj.AbsoluteMatrix);
  _GZOBoundingcube.Position.SetPoint(0, 0, 0);

  // We must Update Color Of the BoundingBox And VisibleInfoLabels Here
  // If not Color is not Updated;

  // if FBoundingBoxColorChanged then
  // Begin
  with _GZOBoundingcube.Material do
  begin
    with FrontProperties do
    begin
      Diffuse.Color := FBoundingBoxColor.Color;
      Ambient.Color := FBoundingBoxColor.Color;
      Emission.Color := FBoundingBoxColor.Color;
    end;
    with BackProperties do
    begin
      Diffuse.Color := FBoundingBoxColor.Color;
      Ambient.Color := FBoundingBoxColor.Color;
      Emission.Color := FBoundingBoxColor.Color;
    end;
  end;
  // FBoundingBoxColorChanged:=False;
  // End;
  // If FVisibleInfoLabelsColorChanged then
  // Begin
  _GZOVisibleInfoLabels.ModulateColor.Color := FVisibleInfoLabelsColor.Color;
  // FVisibleInfoLabelsColorChanged:=False;
  // End;

  ObjDimensions := SelectedObj.AxisAlignedDimensions;
  _GZOBoundingcube.Scale.AsVector := VectorScale(ObjDimensions, 2);

  Assert(Viewer <> nil, 'Viewer not Assigned to gizmo');

  _GZOAxisLabelX.PointTo(Viewer.Camera.Position.AsVector,
    Viewer.Camera.Up.AsVector);
  _GZOAxisLabelX.StructureChanged;
  _GZOAxisLabelY.PointTo(Viewer.Camera.Position.AsVector,
    Viewer.Camera.Up.AsVector);
  _GZOAxisLabelY.StructureChanged;
  _GZOAxisLabelZ.PointTo(Viewer.Camera.Position.AsVector,
    Viewer.Camera.Up.AsVector);
  _GZOAxisLabelZ.StructureChanged;
  _GZOVisibleInfoLabels.PointTo(Viewer.Camera.Position.AsVector,
    Viewer.Camera.Up.AsVector);
  _GZOVisibleInfoLabels.StructureChanged;
  if FAutoZoom then
    D := Viewer.Camera.DistanceTo(SelectedObj) / FAutoZoomFactor
  else
    D := FZoomFactor;
  _GZOrootLines.Scale.AsVector := VectorMake(D, D, D);
  _GZOrootTorus.Scale.AsVector := VectorMake(D, D, D);
  _GZOrootCubes.Scale.AsVector := VectorMake(D, D, D);
  _GZOrootAxisLabel.Scale.AsVector := VectorMake(D, D, D);
  _GZOrootVisibleInfoLabels.Scale.AsVector := VectorMake(D, D, D);
end;

procedure TGLGizmo.UpdateGizmo(const NewDimensions: TGLVector);
begin
  ObjDimensions := NewDimensions;
  UpdateGizmo;
end;

procedure TGLGizmo.LooseSelection;
begin
  SelectedObj := nil;
  UpdateGizmo;
  if Assigned(OnSelectionLost) then
    OnSelectionLost(Self);
end;

procedure TGLGizmo.SetViewer(const Value: TGLSceneViewer);
begin
  if FViewer <> Value then
  begin
    if FViewer <> nil then
      FViewer.RemoveFreeNotification(Self);
    FViewer := Value;
    if FViewer <> nil then
      FViewer.FreeNotification(Self);
  end;
end;

procedure TGLGizmo.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = OpRemove then
  begin
    if AComponent = FViewer then
      FViewer := nil;
    if AComponent = FRootGizmo then
      FRootGizmo := nil;
  end;

  if FUndoHistory <> nil then
    FUndoHistory.Notification(AComponent, Operation);
end;

procedure TGLGizmoUndoItem.AssignFromObject(const AObject
  : TGLCustomSceneObject);
begin
  SetEffectedObject(AObject);
  SetOldMatrix(AObject.Matrix^);
  if AObject is TGLFreeForm then
  begin
    FOldAutoScaling.Assign(TGLFreeForm(AObject).AutoScaling);
  end;
  FOldLibMaterialName := AObject.Material.LibMaterialName;
end;

constructor TGLGizmoUndoItem.Create(AOwner: TCollection);
begin
  inherited;
  FOldAutoScaling := TGLCoordinates.CreateInitialized(Self,
    NullHmgVector, CsPoint);
end;

destructor TGLGizmoUndoItem.Destroy;
begin
  FOldAutoScaling.Free;
  inherited;
end;

procedure TGLGizmoUndoItem.DoUndo;
begin
  FEffectedObject.SetMatrix(FOldMatr);
  if FEffectedObject is TGLFreeForm then
    TGLFreeForm(FEffectedObject).AutoScaling.Assign(FOldAutoScaling);
  FEffectedObject.Material.LibMaterialName := FOldLibMaterialName;
end;

function TGLGizmoUndoItem.GetGizmo: TGLGizmo;
begin
  if GetParent <> nil then
    Result := GetPArent.GetParent
  else
    Result := nil;
end;

function TGLGizmoUndoItem.GetParent: TGLGizmoUndoCollection;
begin
  Result := TGLGizmoUndoCollection(GetOwner);
end;

procedure TGLGizmoUndoItem.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = OpRemove then
  begin
    if AComponent = FEffectedObject then
      FEffectedObject := nil;
  end;
end;

procedure TGLGizmoUndoItem.SetEffectedObject(const Value: TGLCustomSceneObject);
begin
  if FEffectedObject <> nil then
    FEffectedObject.RemoveFreeNotification(GetGizmo);
  FEffectedObject := Value;
  if FEffectedObject <> nil then
    FEffectedObject.FreeNotification(GetGizmo);
end;

procedure TGLGizmoUndoItem.SetOldAutoScaling(const Value: TGLCoordinates);
begin
  FOldAutoScaling.Assign(Value);
end;

procedure TGLGizmoUndoItem.SetOldMatrix(const Value: TGLMatrix);
begin
  FOldMatrix := Value;
end;

{ TGLGizmoUndoCollection }

function TGLGizmoUndoCollection.Add: TGLGizmoUndoItem;
begin
  Result := TGLGizmoUndoItem(inherited Add);
end;

function TGLGizmoUndoCollection.GetItems(const Index: Integer)
  : TGLGizmoUndoItem;
begin
  Result := TGLGizmoUndoItem(inherited GetItem(Index));
end;

function TGLGizmoUndoCollection.GetParent: TGLGizmo;
begin
  Result := TGLGizmo(GetOwner);
end;

procedure TGLGizmoUndoCollection.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  if Count <> 0 then
    for I := 0 to Count - 1 do
      GetItems(I).Notification(AComponent, Operation);
end;

procedure TGLGizmoUndoCollection.RemoveByObject(const AObject
  : TGLCustomSceneObject);
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    if GetItems(I).FEffectedObject = AObject then
      GetItems(I).Free;
end;

procedure TGLGizmoUndoCollection.SetItems(const Index: Integer;
  const Value: TGLGizmoUndoItem);
begin
  GetItems(Index).Assign(Value);
end;

procedure TGLGizmo.SetSelectedObj(const Value: TGLBaseSceneObject);
begin
  if FSelectedObj <> Value then
  begin
    FSelectedObj := Value;

    if Value <> nil then
    begin
      SetVisible(True);
      UpdateVisibleInfoLabels();
      UpdateGizmo();
    end
    else
    begin
      LooseSelection();
      SetVisible(False);
    end;
  end;
end;

end.