GLScene/Sourcex/GXS.Scene.pas

//
// The graphics engine GLXEngine. The unit of GXScene for Delphi
//
unit GXS.Scene;

(* Base classes and structures *)

interface

{$I Stage.Defines.inc}

uses
  Winapi.Windows,
  Winapi.OpenGL,
  Winapi.OpenGLext,

  System.Classes,
  System.SysUtils,
  System.UITypes,
  System.Math,
  FMX.Graphics,
  FMX.Controls,
  FMX.Types,
  FMX.Dialogs,

  Stage.OpenGLTokens,
  GXS.XCollection,
  Stage.VectorTypes,
  Stage.VectorGeometry,
  Stage.TextureFormat,
  Stage.Strings,
  Stage.Utils,
  Stage.PipelineTransform,

  GXS.BaseClasses,
  GXS.Coordinates,
  GXS.GeometryBB,
  GXS.VectorLists,
  GXS.Color,
  GXS.XOpenGL,
  GXS.PersistentClasses,
  GXS.ApplicationFileIO,
  GXS.Context,
  GXS.Silhouette,
  GXS.State,
  GXS.Graphics,
  GXS.Texture,
  GXS.RenderContextInfo,
  GXS.Material,
  GXS.Selection,
  GXS.ImageUtils;

type
  // Defines which features are taken from the master object.
  TgxProxyObjectOption = (pooEffects, pooObjects, pooTransformation);
  TgxProxyObjectOptions = set of TgxProxyObjectOption;

  TgxCameraInvarianceMode = (cimNone, cimPosition, cimOrientation);

  TgxSceneViewerMode = (svmDisabled, svmDefault, svmNavigation, svmGizmo);

const
  cDefaultProxyOptions = [pooEffects, pooObjects, pooTransformation];
  SCENE_REVISION = '$Revision: 2025$';
  SCENE_VERSION = 'v2.5 %s';

type

  TgxNormalDirection = (ndInside, ndOutside);

  (* Used to describe only the changes in an object,
    which have to be reflected in the scene *)
  TgxObjectChange = (ocTransformation, ocAbsoluteMatrix, ocInvAbsoluteMatrix, ocStructure);
  TgxObjectChanges = set of TgxObjectChange;

  TgxObjectBBChange = (oBBcChild, oBBcStructure);
  TgxObjectBBChanges = set of TgxObjectBBChange;

  // Flags for design notification
  TgxSceneOperation = (soAdd, soRemove, soMove, soRename, soSelect, soBeginUpdate, soEndUpdate);

  (* Options for the rendering context.
    roSoftwareMode: force software rendering.
    roDoubleBuffer: enables double-buffering.
    roRenderToWindows: ignored (legacy).
    roTwoSideLighting: enables two-side lighting model.
    roStereo: enables stereo support in the driver (it needs a stereo device to test...)
    roDestinationAlpha: request an Alpha channel for the rendered output
    roNoColorBuffer: don't request a color buffer (color depth setting ignored)
    roNoColorBufferClear: do not clear the color buffer automatically, if the
    whole viewer is fully repainted each frame, this can improve framerate
    roNoSwapBuffers: don't perform RenderingContext.SwapBuffers after rendering
    roNoDepthBufferClear: do not clear the depth buffer automatically. Useful for early-z culling.
    roForwardContext: force OpenGL forward context *)
  TgxContextOption = (roSoftwareMode, roDoubleBuffer, roStencilBuffer,
    roRenderToWindow, roTwoSideLighting, roStereo, roDestinationAlpha,
    roNoColorBuffer, roNoColorBufferClear, roNoSwapBuffers,
    roNoDepthBufferClear, roDebugContext, roForwardContext,
    roOpenGL_ES2_Context);
  TgxContextOptions = set of TgxContextOption;

  // IDs for limit determination
  TgxLimitType = (limClipPlanes, limEvalOrder, limLights, limListNesting,
    limModelViewStack, limNameStack, limPixelMapTable, limProjectionStack,
    limTextureSize, limTextureStack, limViewportDims, limAccumAlphaBits,
    limAccumBlueBits, limAccumGreenBits, limAccumRedBits, limAlphaBits,
    limAuxBuffers, limBlueBits, limGreenBits, limRedBits, limIndexBits,
    limStereo, limDoubleBuffer, limSubpixelBits, limDepthBits, limStencilBits,
    limNbTextureUnits);

  TgxBaseSceneObject = class;
  TgxSceneObjectClass = class of TgxBaseSceneObject;
  TgxCustomSceneObject = class;
  TgxScene = class;
  TgxBehaviour = class;
  TgxBehaviourClass = class of TgxBehaviour;
  TgxBehaviours = class;
  TgxEffect = class;
  TgxEffectClass = class of TgxEffect;
  TgxEffects = class;
  TgxSceneBuffer = class;

  (* Possible styles/options for objects.
    Allowed styles are:
    osDirectDraw : object shall not make use of compiled call lists, but issue
    direct calls each time a render should be performed.
    osIgnoreDepthBuffer : object is rendered with depth test disabled,
    this is true for its children too.
    osNoVisibilityCulling : whatever the VisibilityCulling setting,
    it will be ignored and the object rendered *)
  TgxObjectStyle = (
    osDirectDraw,
	osIgnoreDepthBuffer,
	osNoVisibilityCulling);
  TgxObjectStyles = set of TgxObjectStyle;

  // Interface to objects that need initialization
  IgxInitializable = interface
    ['{EA40AE8E-79B3-42F5-ADF2-7A901B665E12}']
    procedure InitializeObject(ASender: TObject; const ARci: TgxRenderContextInfo);
  end;

  // Just a list of objects that support IGLInitializable.
  TgxInitializableObjectList = class(TList)
  private
    function GetItems(const Index: NativeInt): IgxInitializable;
    procedure PutItems(const Index: NativeInt; const Value: IgxInitializable);
  public
    function Add(const Item: IgxInitializable): Integer;
    property Items[const Index: NativeInt]: IgxInitializable read GetItems write PutItems; default;
  end;

  (* Base class for all scene objects.
    A scene object is part of scene hierarchy (each scene object can have
    multiple children), this hierarchy primarily defines transformations
    (each child coordinates are relative to its parent), but is also used
    for depth-sorting, bounding and visibility culling purposes.
    Subclasses implement either visual scene objects (that are made to be
    visible at runtime, like a Cube) or structural objects (that influence
    rendering or are used for varied structural manipulations,
    like the ProxyObject).
    To add children at runtime, use the AddNewChild method of TgxBaseSceneObject;
    other children manipulations methods and properties are provided (to browse,
    move and delete them). Using the regular TComponent methods is not encouraged. *)
  TgxBaseSceneObject = class(TgxCoordinatesUpdateAbleComponent)
  private
    FAbsoluteMatrix, FInvAbsoluteMatrix: TMatrix4f;
    FLocalMatrix: TMatrix4f;
    FObjectStyle: TgxObjectStyles;
    FListHandle: TgxListHandle; // created on 1st use
    FPosition: TgxCoordinates;
    FDirection, FUp: TgxCoordinates;
    FScaling: TgxCoordinates;
    FChanges: TgxObjectChanges;
    FParent: TgxBaseSceneObject;
    FScene: TgxScene;
    FBBChanges: TgxObjectBBChanges;
    FBoundingBoxPersonalUnscaled: THmgBoundingBox;
    FBoundingBoxOfChildren: THmgBoundingBox;
    FBoundingBoxIncludingChildren: THmgBoundingBox;
    FChildren: TgxPersistentObjectList; // created on 1st use
    FVisible: Boolean;
    FUpdateCount: Integer;
    FShowAxes: Boolean;
    FRotation: TgxCoordinates; // current rotation angles
    FIsCalculating: Boolean;
    FObjectsSorting: TgxObjectsSorting;
    FVisibilityCulling: TgxVisibilityCulling;
    FOnProgress: TgxProgressEvent;
    FOnAddedToParent: TNotifyEvent;
    FBehaviours: TgxBehaviours;
    FEffects: TgxEffects;
    FPickable: Boolean;
    FOnPicked: TNotifyEvent;
    FTagObject: TObject;
    FTagFloat: Single;

    ObjList: TgxPersistentObjectList;
    DistList: TgxSingleList;
    /// FOriginalFiler: TFiler;   //used to allow persistent events in behaviours & effects
    (* If somebody could look at DefineProperties, ReadBehaviours, ReadEffects
      and verify code is safe to use then it could be uncommented *)
    function Get(Index: Integer): TgxBaseSceneObject; inline;
    function GetCount: Integer; inline;
    function GetIndex: Integer; inline;
    procedure SetParent(const val: TgxBaseSceneObject); inline;
    procedure SetIndex(aValue: Integer);
    procedure SetDirection(AVector: TgxCoordinates);
    procedure SetUp(AVector: TgxCoordinates);
    function GetMatrix: PMatrix4f; inline;
    procedure SetPosition(APosition: TgxCoordinates);
    procedure SetPitchAngle(AValue: Single);
    procedure SetRollAngle(AValue: Single);
    procedure SetTurnAngle(AValue: Single);
    procedure SetRotation(aRotation: TgxCoordinates);
    function GetPitchAngle: Single; inline;
    function GetTurnAngle: Single; inline;
    function GetRollAngle: Single; inline;
    procedure SetShowAxes(AValue: Boolean);
    procedure SetScaling(AValue: TgxCoordinates);
    procedure SetObjectsSorting(const val: TgxObjectsSorting);
    procedure SetVisibilityCulling(const val: TgxVisibilityCulling);
    procedure SetBehaviours(const val: TgxBehaviours);
    function GetBehaviours: TgxBehaviours;
    procedure SetEffects(const val: TgxEffects);
    function GetEffects: TgxEffects;
    function GetAbsoluteAffineScale: TAffineVector;
    function GetAbsoluteScale: TVector4f;
    procedure SetAbsoluteAffineScale(const Value: TAffineVector);
    procedure SetAbsoluteScale(const Value: TVector4f);
    function GetAbsoluteMatrix: TMatrix4f; inline;
    procedure SetAbsoluteMatrix(const Value: TMatrix4f);
    procedure SetBBChanges(const Value: TgxObjectBBChanges);
    function GetDirectAbsoluteMatrix: PMatrix4f;
    function GetLocalMatrix: PMatrix4f; inline;
  protected
    procedure Loaded; override;
    procedure SetScene(const Value: TgxScene); virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure WriteBehaviours(stream: TStream);
    procedure ReadBehaviours(stream: TStream);
    procedure WriteEffects(stream: TStream);
    procedure ReadEffects(stream: TStream);
    procedure WriteRotations(stream: TStream);
    procedure ReadRotations(stream: TStream);
    function GetVisible: Boolean; virtual;
    function GetPickable: Boolean; virtual;
    procedure SetVisible(aValue: Boolean); virtual;
    procedure SetPickable(aValue: Boolean); virtual;
    procedure SetAbsolutePosition(const v: TVector4f);
    function GetAbsolutePosition: TVector4f; inline;
    procedure SetAbsoluteUp(const v: TVector4f);
    function GetAbsoluteUp: TVector4f;
    procedure SetAbsoluteDirection(const v: TVector4f);
    function GetAbsoluteDirection: TVector4f;
    function GetAbsoluteAffinePosition: TAffineVector;
    procedure SetAbsoluteAffinePosition(const Value: TAffineVector);
    procedure SetAbsoluteAffineUp(const v: TAffineVector);
    function GetAbsoluteAffineUp: TAffineVector;
    procedure SetAbsoluteAffineDirection(const v: TAffineVector);
    function GetAbsoluteAffineDirection: TAffineVector;
    procedure RecTransformationChanged; inline;
    procedure DrawAxes(var rci: TgxRenderContextInfo; pattern: Word);
    procedure GetChildren(AProc: TGetChildProc; Root: TComponent); override;
    // Should the object be considered as blended for sorting purposes?
    function Blended: Boolean; virtual;
    procedure RebuildMatrix;
    procedure SetName(const NewName: TComponentName); override;
    procedure SetParentComponent(Value: TComponent); override;
    procedure DestroyHandle; virtual;
    procedure DestroyHandles;
    procedure DeleteChildCameras;
    procedure DoOnAddedToParent; virtual;
    (* Used to re-calculate BoundingBoxes every time we need it.
      GetLocalUnscaleBB() must return the local BB, not the axis-aligned one.
      By default it is calculated from AxisAlignedBoundingBoxUnscaled and
      BarycenterAbsolutePosition, but for most objects there is a more
      efficient method, that's why it is virtual. *)
    procedure CalculateBoundingBoxPersonalUnscaled(var ANewBoundingBox: THmgBoundingBox); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateAsChild(aParentOwner: TgxBaseSceneObject);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    (* Controls and adjusts internal optimizations based on object's style.
      Advanced user only. *)
    property ObjectStyle: TgxObjectStyles read FObjectStyle write FObjectStyle;
    (* Returns the handle to the object's build list.
      Use with caution! Some objects don't support buildlists! *)
    function GetHandle(var rci: TgxRenderContextInfo): Cardinal;
    function ListHandleAllocated: Boolean; inline;
    (* The local transformation (relative to parent).
      If you're *sure* the local matrix is up-to-date, you may use LocalMatrix
      for quicker access. *)
    procedure SetMatrix(const aValue: TMatrix4f); inline;
    property Matrix: PMatrix4f read GetMatrix;
    (* Holds the local transformation (relative to parent).
      If you're not *sure* the local matrix is up-to-date, use Matrix property. *)
    property LocalMatrix: PMatrix4f read GetLocalMatrix;
    (* Forces the local matrix to the specified value.
      AbsoluteMatrix, InverseMatrix, etc. will honour that change, but
      may become invalid if the specified matrix isn't orthonormal (can
      be used for specific rendering or projection effects).
      The local matrix will be reset by the next TransformationChanged,
      position or attitude change. *)
    procedure ForceLocalMatrix(const aMatrix: TMatrix4f); inline;
    // See AbsoluteMatrix.
    function AbsoluteMatrixAsAddress: PMatrix4f;
    (* Holds the absolute transformation matrix.
      If you're not *sure* the absolute matrix is up-to-date,
      use the AbsoluteMatrix property, this one may be nil... *)
    property DirectAbsoluteMatrix: PMatrix4f read GetDirectAbsoluteMatrix;
    (* Calculates the object's absolute inverse matrix.
      Multiplying an absolute coordinate with this matrix gives a local coordinate.
      The current implem uses transposition(AbsoluteMatrix), which is true
      unless you're using some scaling... *)
    function InvAbsoluteMatrix: TMatrix4f; inline;
    // See InvAbsoluteMatrix.
    function InvAbsoluteMatrixAsAddress: PMatrix4f;
    (* The object's absolute matrix by composing all local matrices.
      Multiplying a local coordinate with this matrix gives an absolute coordinate. *)
    property AbsoluteMatrix: TMatrix4f read GetAbsoluteMatrix write SetAbsoluteMatrix;
    // Direction vector in absolute coordinates.
    property AbsoluteDirection: TVector4f read GetAbsoluteDirection write SetAbsoluteDirection;
    property AbsoluteAffineDirection: TAffineVector read GetAbsoluteAffineDirection write SetAbsoluteAffineDirection;
    (* Scale vector in absolute coordinates.
      Warning: SetAbsoluteScale() does not work correctly at the moment. *)
    property AbsoluteScale: TVector4f read GetAbsoluteScale write SetAbsoluteScale;
    property AbsoluteAffineScale: TAffineVector read GetAbsoluteAffineScale write SetAbsoluteAffineScale;
    // Up vector in absolute coordinates.
    property AbsoluteUp: TVector4f read GetAbsoluteUp write SetAbsoluteUp;
    property AbsoluteAffineUp: TAffineVector read GetAbsoluteAffineUp write SetAbsoluteAffineUp;
    // Calculate the right vector in absolute coordinates.
    function AbsoluteRight: TVector4f;
    // Calculate the left vector in absolute coordinates.
    function AbsoluteLeft: TVector4f;
    // Computes and allows to set the object's absolute coordinates.
    property AbsolutePosition: TVector4f read GetAbsolutePosition write SetAbsolutePosition;
    property AbsoluteAffinePosition: TAffineVector read GetAbsoluteAffinePosition write SetAbsoluteAffinePosition;
    function AbsolutePositionAsAddress: PVector4f;
    // Returns the Absolute X Vector expressed in local coordinates.
    function AbsoluteXVector: TVector4f;
    // Returns the Absolute Y Vector expressed in local coordinates.
    function AbsoluteYVector: TVector4f;
    // Returns the Absolute Z Vector expressed in local coordinates.
    function AbsoluteZVector: TVector4f;
    // Converts a vector/point from absolute coordinates to local coordinates.
    function AbsoluteToLocal(const v: TVector4f): TVector4f; overload;
    // Converts a vector from absolute coordinates to local coordinates.
    function AbsoluteToLocal(const v: TAffineVector): TAffineVector; overload;
    // Converts a vector/point from local coordinates to absolute coordinates.
    function LocalToAbsolute(const v: TVector4f): TVector4f; overload;
    // Converts a vector from local coordinates to absolute coordinates.
    function LocalToAbsolute(const v: TAffineVector): TAffineVector; overload;
    // Returns the Right vector (based on Up and Direction)
    function Right: TVector4f; inline;
    // Returns the Left vector (based on Up and Direction)
    function LeftVector: TVector4f; inline;
    // Returns the Right vector (based on Up and Direction)
    function AffineRight: TAffineVector; inline;
    // Returns the Left vector (based on Up and Direction)
    function AffineLeftVector: TAffineVector; inline;
    (* Calculates the object's square distance to a point/object.
      pt is assumed to be in absolute coordinates,
      AbsolutePosition is considered as being the object position. *)
    function SqrDistanceTo(anObject: TgxBaseSceneObject): Single; overload;
    function SqrDistanceTo(const pt: TVector4f): Single; overload;
    function SqrDistanceTo(const pt: TAffineVector): Single; overload;
    (* Computes the object's distance to a point/object.
      Only objects AbsolutePositions are considered. *)
    function DistanceTo(anObject: TgxBaseSceneObject): Single; overload;
    function DistanceTo(const pt: TAffineVector): Single; overload;
    function DistanceTo(const pt: TVector4f): Single; overload;
    (* Calculates the object's barycenter in absolute coordinates.
      Default behaviour is to consider Barycenter=AbsolutePosition
      (whatever the number of children).
      SubClasses where AbsolutePosition is not the barycenter should
      override this method as it is used for distance calculation, during
      rendering for instance, and may lead to visual inconsistencies. *)
    function BarycenterAbsolutePosition: TVector4f; virtual;
    // Calculates the object's barycenter distance to a point.
    function BarycenterSqrDistanceTo(const pt: TVector4f): Single;
    (* Shall returns the object's axis aligned extensions.
      The dimensions are measured from object center and are expressed
      with scale accounted for, in the object's coordinates
      (not in absolute coordinates).
      Default value is half the object's Scale. *)
    function AxisAlignedDimensions: TVector4f; virtual;
    function AxisAlignedDimensionsUnscaled: TVector4f; virtual;
    (* Calculates and return the AABB for the object.
      The AABB is currently calculated from the BB.
      There is  no  caching scheme for them. *)
    function AxisAlignedBoundingBox(const AIncludeChilden: Boolean = True): TAABB;
    function AxisAlignedBoundingBoxUnscaled(const AIncludeChilden: Boolean = True): TAABB;
    function AxisAlignedBoundingBoxAbsolute(const AIncludeChilden: Boolean = True;
      const AUseBaryCenter: Boolean = False): TAABB;
    (* Advanced AABB functions that use a caching scheme.
      Also they include children and use BaryCenter. *)
    function AxisAlignedBoundingBoxEx: TAABB;
    function AxisAlignedBoundingBoxAbsoluteEx: TAABB;
    (* Calculates and return the Bounding Box for the object.
      The BB is calculated  each  time this method is invoked,
      based on the AxisAlignedDimensions of the object and that of its
      children. There is  no  caching scheme for them. *)
    function BoundingBox(const AIncludeChilden: Boolean = True; const
	  AUseBaryCenter: Boolean = False): THmgBoundingBox;
    function BoundingBoxUnscaled(const AIncludeChilden: Boolean = True; const
	  AUseBaryCenter: Boolean = False): THmgBoundingBox;
    function BoundingBoxAbsolute(const AIncludeChilden: Boolean = True; const
	  AUseBaryCenter: Boolean = False): THmgBoundingBox;
    (* Advanced BB functions that use a caching scheme.
      Also they include children and use BaryCenter. *)
    function BoundingBoxPersonalUnscaledEx: THmgBoundingBox;
    function BoundingBoxOfChildrenEx: THmgBoundingBox;
    function BoundingBoxIncludingChildrenEx: THmgBoundingBox;
    // Max distance of corners of the BoundingBox.
    function BoundingSphereRadius: Single; inline;
    function BoundingSphereRadiusUnscaled: Single; inline;
    (* Indicates if a point is within an object.
      Given coordinate is an absolute coordinate.
      Linear or surfacic objects shall always return False.
      Default value is based on AxisAlignedDimension and a cube bounding. *)
    function PointInObject(const point: TVector4f): Boolean; virtual;
    (* Request to determine an intersection with a casted ray.
      Given coordinates & vector are in absolute coordinates, rayVector
      must be normalized.
      rayStart may be a point inside the object, allowing retrieval of
      the multiple intersects of the ray.
      When intersectXXX parameters are nil (default) implementation should
      take advantage of this to optimize calculus, if not, and an intersect
      is found, non nil parameters should be defined.
      The intersectNormal needs NOT be normalized by the implementations.
      Default value is based on bounding sphere. *)
    function RayCastIntersect(const rayStart, rayVector: TVector4f;
	  intersectPoint: PVector4f = nil;
	  intersectNormal: PVector4f = nil): Boolean; virtual;
    (* Request to generate silhouette outlines.
      Default implementation assumes the objects is a sphere of
      AxisAlignedDimensionUnscaled size. Subclasses may choose to return
      nil instead, which will be understood as an empty silhouette. *)
    function GenerateSilhouette(const silhouetteParameters:
	  TgxSilhouetteParameters): TgxSilhouette; virtual;
    property Children[Index: Integer]: TgxBaseSceneObject read Get; default;
    property Count: Integer read GetCount;
    property Index: Integer read GetIndex write SetIndex;
    // Create a new scene object and add it to this object as new child
    function AddNewChild(AChild: TgxSceneObjectClass): TgxBaseSceneObject; virtual;
    // Create a new scene object and add it to this object as first child
    function AddNewChildFirst(AChild: TgxSceneObjectClass): TgxBaseSceneObject; virtual;
    procedure AddChild(AChild: TgxBaseSceneObject); virtual;
    function GetOrCreateBehaviour(aBehaviour: TgxBehaviourClass): TgxBehaviour;
    function AddNewBehaviour(aBehaviour: TgxBehaviourClass): TgxBehaviour;
    function GetOrCreateEffect(anEffect: TgxEffectClass): TgxEffect;
    function AddNewEffect(anEffect: TgxEffectClass): TgxEffect;
    function HasSubChildren: Boolean;
    procedure DeleteChildren; virtual;
    procedure Insert(AIndex: Integer; AChild: TgxBaseSceneObject); virtual;
    (* Takes a scene object out of the child list, but doesn't destroy it.
      If 'KeepChildren' is true its children will be kept as new children
      in this scene object. *)
    procedure Remove(AChild: TgxBaseSceneObject; keepChildren: Boolean); virtual;
    function IndexOfChild(AChild: TgxBaseSceneObject): Integer;
    function FindChild(const aName: string; ownChildrenOnly: Boolean): TgxBaseSceneObject;
    (* The "safe" version of this procedure checks if indexes are inside
      the list. If not, no exception if raised. *)
    procedure ExchangeChildrenSafe(anIndex1, anIndex2: Integer);
    (* The "regular" version of this procedure does not perform any checks
      and calls FChildren.Exchange directly. User should/can perform range
      checks manualy. *)
    procedure ExchangeChildren(anIndex1, anIndex2: Integer);
    // These procedures are safe.
    procedure MoveChildUp(anIndex: Integer);
    procedure MoveChildDown(anIndex: Integer);
    procedure MoveChildFirst(anIndex: Integer);
    procedure MoveChildLast(anIndex: Integer);
    procedure DoProgress(const progressTime: TgxProgressTimes); override;
    procedure MoveTo(newParent: TgxBaseSceneObject); virtual;
    procedure MoveUp;
    procedure MoveDown;
    procedure MoveFirst;
    procedure MoveLast;
    procedure BeginUpdate; inline;
    procedure EndUpdate; inline;
    (* Make object-specific geometry description here.
      Subclasses should MAINTAIN OpenGL states (restore the states if
      they were altered). *)
    procedure BuildList(var rci: TgxRenderContextInfo); virtual;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override; final;
    function IsUpdating: Boolean; inline;
    // Moves the object along the Up vector (move up/down)
    procedure Lift(ADistance: Single);
    // Moves the object along the direction vector
    procedure Move(ADistance: Single);
    // Translates the object
    procedure Translate(tx, ty, tz: Single);
    procedure MoveObjectAround(anObject: TgxBaseSceneObject; pitchDelta, turnDelta: Single);
    procedure MoveObjectAllAround(anObject: TgxBaseSceneObject; pitchDelta, turnDelta: Single);
    procedure Pitch(angle: Single);
    procedure Roll(angle: Single);
    procedure Turn(angle: Single);
    (* Sets all rotations to zero and restores default Direction/Up.
      Using this function then applying roll/pitch/turn in the order that
      suits you, you can give an "absolute" meaning to rotation angles
      (they are still applied locally though).
      Scale and Position are not affected. *)
    procedure ResetRotations;
    // Reset rotations and applies them back in the specified order.
    procedure ResetAndPitchTurnRoll(const degX, degY, degZ: Single);
    // Applies rotations around absolute X, Y and Z axis.
    procedure RotateAbsolute(const rx, ry, rz: Single); overload;
    // Applies rotations around the absolute given vector (angle in degrees).
    procedure RotateAbsolute(const axis: TAffineVector; angle: Single); overload;
    // Moves camera along the right vector (move left and right)
    procedure Slide(ADistance: Single);
    // Orients the object toward a target object
    procedure PointTo(const ATargetObject: TgxBaseSceneObject; const AUpVector: TVector4f); overload;
    // Orients the object toward a target absolute position
    procedure PointTo(const AAbsolutePosition, AUpVector: TVector4f); overload;
    procedure Render(var ARci: TgxRenderContextInfo);
    procedure DoRender(var ARci: TgxRenderContextInfo;
	  ARenderSelf, ARenderChildren: Boolean); virtual;
    procedure RenderChildren(firstChildIndex, lastChildIndex: Integer;
	  var rci: TgxRenderContextInfo);
    procedure StructureChanged; virtual;
    procedure ClearStructureChanged; inline;
    // Recalculate an orthonormal system
    procedure CoordinateChanged(Sender: TgxCustomCoordinates); override;
    procedure TransformationChanged; inline;
    procedure NotifyChange(Sender: TObject); override;
    property Rotation: TgxCoordinates read FRotation write SetRotation;
    property PitchAngle: Single read GetPitchAngle write SetPitchAngle;
    property RollAngle: Single read GetRollAngle write SetRollAngle;
    property TurnAngle: Single read GetTurnAngle write SetTurnAngle;
    property ShowAxes: Boolean read FShowAxes write SetShowAxes default False;
    property Changes: TgxObjectChanges read FChanges;
    property BBChanges: TgxObjectBBChanges read FBBChanges write SetBBChanges;
    property Parent: TgxBaseSceneObject read FParent write SetParent;
    property Position: TgxCoordinates read FPosition write SetPosition;
    property Direction: TgxCoordinates read FDirection write SetDirection;
    property Up: TgxCoordinates read FUp write SetUp;
    property Scale: TgxCoordinates read FScaling write SetScaling;
    property Scene: TgxScene read FScene;
    property Visible: Boolean read FVisible write SetVisible default True;
    property Pickable: Boolean read FPickable write SetPickable default True;
    property ObjectsSorting: TgxObjectsSorting read FObjectsSorting write
	  SetObjectsSorting default osInherited;
    property VisibilityCulling: TgxVisibilityCulling read FVisibilityCulling
	  write SetVisibilityCulling default vcInherited;
    property OnProgress: TgxProgressEvent read FOnProgress write FOnProgress;
    property OnPicked: TNotifyEvent read FOnPicked write FOnPicked;
    property OnAddedToParent: TNotifyEvent read FOnAddedToParent write FOnAddedToParent;
    property Behaviours: TgxBehaviours read GetBehaviours write SetBehaviours stored False;
    property Effects: TgxEffects read GetEffects write SetEffects stored False;
    property TagObject: TObject read FTagObject write FTagObject;
  published
    property TagFloat: Single read FTagFloat write FTagFloat;
  end;

  (* Base class for implementing behaviours in TgxScene.
    Behaviours are regrouped in a collection attached to a TgxBaseSceneObject,
    and are part of the "Progress" chain of events. Behaviours allows clean
    application of time-based alterations to objects (movements, shape or
    texture changes...).
    Since behaviours are implemented as classes, there are basicly two kinds
    of strategies for subclasses :
    stand-alone : the subclass does it all, and holds all necessary data
    (covers animation, inertia etc.)
    proxy : the subclass is an interface to and external, shared operator
    (like gravity, force-field effects etc.)

    Some behaviours may be cooperative (like force-fields affects inertia)
    or unique (e.g. only one inertia behaviour per object).
    NOTES : Don't forget to override the ReadFromFiler/WriteToFiler persistence
    methods if you add data in a subclass !
    Subclasses must be registered using the RegisterXCollectionItemClass function *)
  TgxBaseBehaviour = class(TXCollectionItem)
  protected
    procedure SetName(const val: string); override;
    // Override this function to write subclass data.
    procedure WriteToFiler(writer: TWriter); override;
    // Override this function to read subclass data.
    procedure ReadFromFiler(reader: TReader); override;
    (* Returns the TgxBaseSceneObject on which the behaviour should be applied.
      Does NOT check for nil owners. *)
    function OwnerBaseSceneObject: TgxBaseSceneObject;
  public
    constructor Create(AOwner: TXCollection); override;
    destructor Destroy; override;
    procedure DoProgress(const progressTime: TgxProgressTimes); virtual;
  end;

  (* Ancestor for non-rendering behaviours.
    This class shall never receive any properties, it's just here to differentiate
    rendereing and non-rendering behaviours. Rendereing behaviours are named
    "TgxEffect", non-rendering effects (like inertia) are simply named
    "TgxBehaviour". *)
  TgxBehaviour = class(TgxBaseBehaviour)
  end;

  (* Holds a list of TgxBehaviour objects.
    This object expects itself to be owned by a TgxBaseSceneObject.
    As a TXCollection (and contrary to a TCollection), this list can contain
    objects of varying class, the only constraint being that they should all
    be TgxBehaviour subclasses. *)
  TgxBehaviours = class(TXCollection)
  protected
    function GetBehaviour(Index: Integer): TgxBehaviour;
  public
    constructor Create(AOwner: TPersistent); override;
    function GetNamePath: string; override;
    class function ItemsClass: TXCollectionItemClass; override;
    property Behaviour[index: Integer]: TgxBehaviour read GetBehaviour; default;
    function CanAdd(aClass: TXCollectionItemClass): Boolean; override;
    procedure DoProgress(const progressTimes: TgxProgressTimes); inline;
  end;

  (* A rendering effect that can be applied to SceneObjects.
    ObjectEffect is a subclass of behaviour that gets a chance to Render
    an object-related special effect.
    TgxEffect should not be used as base class for custom effects,
    instead you should use the following base classes :
    TgxObjectPreEffect is rendered before owner object render
    TgxObjectPostEffect is rendered after the owner object render
    TgxObjectAfterEffect is rendered at the end of the scene rendering
    NOTES :
    Don't forget to override the ReadFromFiler/WriteToFiler persistence
    methods if you add data in a subclass !
    Subclasses must be registered using the RegisterXCollectionItemClass
    function *)

  // TgxEffectClass = class of TgxEffect;

  TgxEffect = class(TgxBaseBehaviour)
  protected
    // Override this function to write subclass data.
    procedure WriteToFiler(writer: TWriter); override;
    // Override this function to read subclass data.
    procedure ReadFromFiler(reader: TReader); override;
  public
    procedure Render(var rci: TgxRenderContextInfo); virtual;
  end;

  (* An object effect that gets rendered before owner object's render.
    The current OpenGL matrices and material are that of the owner object. *)
  TgxObjectPreEffect = class(TgxEffect)
  end;
  (* An object effect that gets rendered after owner object's render.
    The current OpenGL matrices and material are that of the owner object. *)
  TgxObjectPostEffect = class(TgxEffect)
  end;

  (* An object effect that gets rendered at scene's end.
    No particular OpenGL matrices or material should be assumed. *)
  TgxObjectAfterEffect = class(TgxEffect)
  end;

  (* Holds a list of object effects.
    This object expects itself to be owned by a TgxBaseSceneObject. *)
  TgxEffects = class(TXCollection)
  protected
    function GetEffect(Index: Integer): TgxEffect;
  public
    constructor Create(AOwner: TPersistent); override;
    function GetNamePath: string; override;
    class function ItemsClass: TXCollectionItemClass; override;
    property ObjectEffect[index: Integer]: TgxEffect read GetEffect; default;
    function CanAdd(aClass: TXCollectionItemClass): Boolean; override;
    procedure DoProgress(const progressTime: TgxProgressTimes);
    procedure RenderPreEffects(var rci: TgxRenderContextInfo); inline;
    // Also take care of registering after effects with the GLXceneViewer.
    procedure RenderPostEffects(var rci: TgxRenderContextInfo); inline;
  end;

  (* Extended base scene object class with a material property.
    The material allows defining a color and texture for the object, see TgxMaterial. *)
  TgxCustomSceneObject = class(TgxBaseSceneObject)
  private
    FMaterial: TgxMaterial;
    FHint: string;
  protected
    function Blended: Boolean; override;
    procedure SetVKMaterial(aValue: TgxMaterial); inline;
    procedure DestroyHandle; override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override;
    property Material: TgxMaterial read FMaterial write SetVKMaterial;
    property Hint: string read FHint write FHint;
  end;

  (* This class shall be used only as a hierarchy root.
    It exists only as a container and shall never be rotated/scaled etc. as
    the class type is used in parenting optimizations.
    Shall never implement or add any functionality, the "Create" override
    only take cares of disabling the build list. *)
  TgxSceneRootObject = class(TgxBaseSceneObject)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  (* Base class for objects that do not have a published "material".
    Note that the material is available in public properties, but isn't
    applied automatically before invoking BuildList.
    Subclassing should be reserved to structural objects and objects that
    have no material of their own. *)
  TgxImmaterialSceneObject = class(TgxCustomSceneObject)
  public
    procedure DoRender(var ARci: TgxRenderContextInfo;
	  ARenderSelf, ARenderChildren: Boolean); override;
  published
    property ObjectsSorting;
    property VisibilityCulling;
    property Direction;
    property PitchAngle;
    property Position;
    property RollAngle;
    property Scale;
    property ShowAxes;
    property TurnAngle;
    property Up;
    property Visible;
    property Pickable;
    property OnProgress;
    property OnPicked;
    property Behaviours;
    property Effects;
    property Hint;
  end;

  (* Base class for camera invariant objects.
    Camera invariant objects bypass camera settings, such as camera
    position (object is always centered on camera) or camera orientation
    (object always has same orientation as camera). *)
  TgxCameraInvariantObject = class(TgxImmaterialSceneObject)
  private
    FCamInvarianceMode: TgxCameraInvarianceMode;
  protected
    procedure SetCamInvarianceMode(const val: TgxCameraInvarianceMode);
    property CamInvarianceMode: TgxCameraInvarianceMode read FCamInvarianceMode
	  write SetCamInvarianceMode;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Assign(Source: TPersistent); override;
    procedure DoRender(var ARci: TgxRenderContextInfo;
	  ARenderSelf, ARenderChildren: Boolean); override;
  end;

  // Base class for standard scene objects. Publishes the Material property.
  TgxSceneObject = class(TgxCustomSceneObject)
  published
    property Material;
    property ObjectsSorting;
    property VisibilityCulling;
    property Direction;
    property PitchAngle;
    property Position;
    property RollAngle;
    property Scale;
    property ShowAxes;
    property TurnAngle;
    property Up;
    property Visible;
    property Pickable;
    property OnProgress;
    property OnPicked;
    property Behaviours;
    property Effects;
    property Hint;
  end;

  // Event for user-specific rendering in a TgxDirectOpenVX object.
  TDirectRenderEvent = procedure(Sender: TObject; var rci: TgxRenderContextInfo) of object;

  (* Provides a way to issue direct OpenGL calls during the rendering.
    You can use this object to do your specific rendering task in its OnRender
    event. The OpenGL calls shall restore the OpenGL states they found when
    entering, or exclusively use the GLMisc utility functions to alter the states. *)
  TgxDirectOpenGL = class(TgxImmaterialSceneObject)
  private
    FUseBuildList: Boolean;
    FOnRender: TDirectRenderEvent;
    FBlend: Boolean;
  protected
    procedure SetUseBuildList(const val: Boolean);
    function Blended: Boolean; override;
    procedure SetBlend(const val: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Assign(Source: TPersistent); override;
    procedure BuildList(var rci: TgxRenderContextInfo); override;
    function AxisAlignedDimensionsUnscaled: TVector4f; override;
  published
    (* Specifies if a build list be made.
      If True, GXScene will generate a build list (side cache),
      ie. OnRender will only be invoked once for the first render, or after
      a StructureChanged call. This is suitable for "static" geometry and
      will usually speed up rendering of things that don't change.
      If false, OnRender will be invoked for each render. This is suitable
      for dynamic geometry (things that change often or constantly). *)
    property UseBuildList: Boolean read FUseBuildList write SetUseBuildList;
    (* Place your specific OpenGL code here.
      The OpenGL calls shall restore the OpenGL states they found when
      entering, or exclusively use the GLMisc utility functions to alter
      the states. *)
    property OnRender: TDirectRenderEvent read FOnRender write FOnRender;
    (* Defines if the object uses blending.
      This property will allow direct OpenGL objects to be flagged as
      blended for object sorting purposes. *)
    property Blend: Boolean read FBlend write SetBlend;
  end;

  (* Scene object that allows other objects to issue rendering at some point.
    This object is used to specify a render point for which other components
    have (rendering) tasks to perform. It doesn't render anything itself
    and is invisible, but other components can register and be notified
    when the point is reached in the rendering phase.
    Callbacks must be explicitly unregistered. *)
  TgxRenderPoint = class(TgxImmaterialSceneObject)
  private
    FCallBacks: array of TDirectRenderEvent;
    FFreeCallBacks: array of TNotifyEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BuildList(var rci: TgxRenderContextInfo); override;
    procedure RegisterCallBack(renderEvent: TDirectRenderEvent;
	  renderPointFreed: TNotifyEvent);
    procedure UnRegisterCallBack(renderEvent: TDirectRenderEvent);
    procedure Clear;
  end;

  (* A full proxy object.
    This object literally uses another object's Render method to do its own
    rendering, however, it has a coordinate system and a life of its own.
    Use it for duplicates of an object. *)
  TgxProxyObject = class(TgxBaseSceneObject)
  private
    FMasterObject: TgxBaseSceneObject;
    FProxyOptions: TgxProxyObjectOptions;
  protected
    FRendering: Boolean;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetMasterObject(const val: TgxBaseSceneObject); virtual;
    procedure SetProxyOptions(const val: TgxProxyObjectOptions);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override;
    function BarycenterAbsolutePosition: TVector4f; override;
    function AxisAlignedDimensions: TVector4f; override;
    function AxisAlignedDimensionsUnscaled: TVector4f; override;
    function RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil)
      : Boolean; override;
    function GenerateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters): TgxSilhouette; override;
  published
    // Specifies the Master object which will be proxy'ed.
    property MasterObject: TgxBaseSceneObject read FMasterObject write SetMasterObject;
    // Specifies how and what is proxy'ed.
    property ProxyOptions: TgxProxyObjectOptions read FProxyOptions write SetProxyOptions default cDefaultProxyOptions;
    property ObjectsSorting;
    property Direction;
    property PitchAngle;
    property Position;
    property RollAngle;
    property Scale;
    property ShowAxes;
    property TurnAngle;
    property Up;
    property Visible;
    property Pickable;
    property OnProgress;
    property OnPicked;
    property Behaviours;
  end;

  TgxProxyObjectClass = class of TgxProxyObject;

  (* Defines the various styles for lightsources.
    lsSpot : a spot light, oriented and with a cutoff zone (note that if
    cutoff is 180, the spot is rendered as an omni source)
    lsOmni : an omnidirectionnal source, punctual and sending light in
    all directions uniformously
    lsParallel : a parallel light, oriented as the light source is (this
    type of light can help speed up rendering) *)
  TgxLightStyle = (lsSpot, lsOmni, lsParallel, lsParallelSpot);

  (* Standard light source.
    The standard light source covers spotlights, omnidirectionnal and
    parallel sources (see TLightStyle).
    Lights are colored, have distance attenuation parameters and are turned
    on/off through their Shining property.
    Lightsources are managed in a specific object by the TgxScene for rendering
    purposes. The maximum number of light source in a scene is limited by the
    OpenGL implementation (8 lights are supported under most ICDs), though the
    more light you use, the slower rendering may get. If you want to render
    many more light/lightsource, you may have to resort to other techniques
    like lightmapping. *)
  TgxLightSource = class(TgxBaseSceneObject)
  private
    FLightID: Cardinal;
    FSpotDirection: TgxCoordinates;
    FSpotExponent, FSpotCutOff: Single;
    FConstAttenuation, FLinearAttenuation, FQuadraticAttenuation: Single;
    FShining: Boolean;
    FAmbient, FDiffuse, FSpecular: TgxColor;
    FLightStyle: TgxLightStyle;
  protected
    procedure SetAmbient(aValue: TgxColor);
    procedure SetDiffuse(aValue: TgxColor);
    procedure SetSpecular(aValue: TgxColor);
    procedure SetConstAttenuation(aValue: Single);
    procedure SetLinearAttenuation(aValue: Single);
    procedure SetQuadraticAttenuation(aValue: Single);
    procedure SetShining(aValue: Boolean);
    procedure SetSpotDirection(AVector: TgxCoordinates);
    procedure SetSpotExponent(aValue: Single);
    procedure SetSpotCutOff(const val: Single);
    procedure SetLightStyle(const val: TgxLightStyle);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override;
    // light sources have different handle types than normal scene objects
    function RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil)
      : Boolean; override;
    procedure CoordinateChanged(Sender: TgxCustomCoordinates); override;
    function GenerateSilhouette(const silhouetteParameters: TgxSilhouetteParameters): TgxSilhouette; override;
    property LightID: Cardinal read FLightID;
    function Attenuated: Boolean;
  published
    property Ambient: TgxColor read FAmbient write SetAmbient;
    property ConstAttenuation: Single read FConstAttenuation write SetConstAttenuation;
    property Diffuse: TgxColor read FDiffuse write SetDiffuse;
    property LinearAttenuation: Single read FLinearAttenuation write SetLinearAttenuation;
    property QuadraticAttenuation: Single read FQuadraticAttenuation write SetQuadraticAttenuation;
    property Position;
    property LightStyle: TgxLightStyle read FLightStyle write SetLightStyle default lsSpot;
    property Shining: Boolean read FShining write SetShining default True;
    property Specular: TgxColor read FSpecular write SetSpecular;
    property SpotCutOff: Single read FSpotCutOff write SetSpotCutOff;
    property SpotDirection: TgxCoordinates read FSpotDirection write SetSpotDirection;
    property SpotExponent: Single read FSpotExponent write SetSpotExponent;
    property OnProgress;
  end;

  TgxCameraStyle = (csPerspective, csOrthogonal, csOrtho2D, csCustom, csInfinitePerspective, csPerspectiveKeepFOV);
  TgxCameraKeepFOVMode = (ckmHorizontalFOV, ckmVerticalFOV);
  TgxOnCustomPerspective = procedure(const viewport: TRectangle; width, height: Integer; DPI: Integer; var viewPortRadius: Single)
    of object;

  (* Camera object.
    This object is commonly referred by TgxSceneViewer and defines a position,
    direction, focal length, depth of view... all the properties needed for
    defining a point of view and optical characteristics. *)
  TgxCamera = class(TgxBaseSceneObject)
  private
    FFocalLength: Single;
    FDepthOfView: Single;
    FNearPlane: Single; // nearest distance to the camera
    FNearPlaneBias: Single; // scaling bias applied to near plane
    FViewPortRadius: Single; // viewport bounding radius per distance unit
    FTargetObject: TgxBaseSceneObject;
    FLastDirection: TVector4f; // Not persistent
    FCameraStyle: TgxCameraStyle;
    FKeepFOVMode: TgxCameraKeepFOVMode;
    FSceneScale: Single;
    FDeferredApply: TNotifyEvent;
    FOnCustomPerspective: TgxOnCustomPerspective;
    FDesign: Boolean;
    FFOVY, FFOVX: Double;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetTargetObject(const val: TgxBaseSceneObject);
    procedure SetDepthOfView(aValue: Single);
    procedure SetFocalLength(aValue: Single);
    procedure SetCameraStyle(const val: TgxCameraStyle);
    procedure SetKeepFOVMode(const val: TgxCameraKeepFOVMode);
    procedure SetSceneScale(Value: Single);
    function StoreSceneScale: Boolean;
    procedure SetNearPlaneBias(Value: Single);
    function StoreNearPlaneBias: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    (* Nearest clipping plane for the frustum.
      This value depends on the FocalLength and DepthOfView fields and
      is calculated to minimize Z-Buffer crawling as suggested by the OpenGL documentation. *)
    property NearPlane: Single read FNearPlane;

    // Apply camera transformation
    procedure Apply;
    procedure DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override;
    function RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil)
      : Boolean; override;
    procedure ApplyPerspective(const AViewport: TRectangle; AWidth, AHeight: Integer; ADPI: Integer);
    procedure AutoLeveling(Factor: Single);
    procedure Reset(aSceneBuffer: TgxSceneBuffer);
    // Position the camera so that the whole scene can be seen
    procedure ZoomAll(aSceneBuffer: TgxSceneBuffer);
    procedure RotateObject(obj: TgxBaseSceneObject; pitchDelta, turnDelta: Single; rollDelta: Single = 0);
    procedure RotateTarget(pitchDelta, turnDelta: Single; rollDelta: Single = 0);
    (* Change camera's position to make it move around its target.
      If TargetObject is nil, nothing happens. This method helps in quickly
      implementing camera controls. Camera's Up and Direction properties are unchanged.
      Angle deltas are in degrees, camera parent's coordinates should be identity.
      Tip : make the camera a child of a "target" dummycube and make
      it a target the dummycube. Now, to pan across the scene, just move
      the dummycube, to change viewing angle, use this method. *)
    procedure MoveAroundTarget(pitchDelta, turnDelta: Single);
    (* Change camera's position to make it move all around its target.
      If TargetObject is nil, nothing happens. This method helps in quickly
      implementing camera controls. Camera's Up and Direction properties are changed.
      Angle deltas are in degrees. *)
    procedure MoveAllAroundTarget(pitchDelta, turnDelta: Single);
    // Moves the camera in eye space coordinates.
    procedure MoveInEyeSpace(forwardDistance, rightDistance, upDistance: Single);
    // Moves the target in eye space coordinates.
    procedure MoveTargetInEyeSpace(forwardDistance, rightDistance, upDistance: Single);
    // Computes the absolute vector corresponding to the eye-space translations.
    function AbsoluteEyeSpaceVector(forwardDistance, rightDistance, upDistance: Single): TVector4f;
    (* Adjusts distance from camera to target by applying a ratio.
      If TargetObject is nil, nothing happens. This method helps in quickly
      implementing camera controls. Only the camera's position is changed. *)
    procedure AdjustDistanceToTarget(distanceRatio: Single);
    (* Returns the distance from camera to target.
      If TargetObject is nil, returns 1. *)
    function DistanceToTarget: Single;
    (* Computes the absolute normalized vector to the camera target.
      If no target is defined, AbsoluteDirection is returned. *)
    function AbsoluteVectorToTarget: TVector4f;
    (* Computes the absolute normalized right vector to the camera target.
      If no target is defined, AbsoluteRight is returned. *)
    function AbsoluteRightVectorToTarget: TVector4f;
    (* Computes the absolute normalized up vector to the camera target.
      If no target is defined, AbsoluteUpt is returned. *)
    function AbsoluteUpVectorToTarget: TVector4f;
    (* Calculate an absolute translation vector from a screen vector.
      Ratio is applied to both screen delta, planeNormal should be the
      translation plane's normal. *)
    function ScreenDeltaToVector(deltaX, deltaY: Integer; ratio: Single; const planeNormal: TVector4f): TVector4f;
    // Same as ScreenDeltaToVector but optimized for XY plane.
    function ScreenDeltaToVectorXY(deltaX, deltaY: Integer; ratio: Single): TVector4f;
    // Same as ScreenDeltaToVector but optimized for XZ plane.
    function ScreenDeltaToVectorXZ(deltaX, deltaY: Integer; ratio: Single): TVector4f;
    // Same as ScreenDeltaToVector but optimized for YZ plane.
    function ScreenDeltaToVectorYZ(deltaX, deltaY: Integer; ratio: Single): TVector4f;
    // Returns true if a point is in front of the camera.
    function PointInFront(const point: TVector4f): Boolean; overload;
    (* Calculates the field of view in degrees, given a viewport dimension
      (width or height). F.i. you may wish to use the minimum of the two. *)
    function GetFieldOfView(const AViewportDimension: Single): Single;
    (* Sets the FocalLength in degrees, given a field of view and a viewport
      dimension (width or height). *)
    procedure SetFieldOfView(const AFieldOfView, AViewportDimension: Single);
  published
    (* Depth of field/view.
      Adjusts the maximum distance, beyond which objects will be clipped
      (ie. not visisble).
      You must adjust this value if you are experiencing disappearing
      objects (increase the value) of Z-Buffer crawling (decrease the
      value). Z-Buffer crawling happens when depth of view is too large
      and the Z-Buffer precision cannot account for all that depth
      accurately : objects farther overlap closer objects and vice-versa.
      Note that this value is ignored in cSOrtho2D mode. *)
    property DepthOfView: Single read FDepthOfView write SetDepthOfView;
    (* Focal Length of the camera.
      Adjusting this value allows for lens zooming effects (use SceneScale
      for linear zooming). This property affects near/far planes clipping. *)
    property FocalLength: Single read FFocalLength write SetFocalLength;
    (* Scene scaling for camera point.
      This is a linear 2D scaling of the camera's output, allows for
      linear zooming (use FocalLength for lens zooming). *)
    property SceneScale: Single read FSceneScale write SetSceneScale stored StoreSceneScale;
    (* Scaling bias applied to near-plane calculation.
      Values inferior to one will move the nearplane nearer, and also
      reduce medium/long range Z-Buffer precision, values superior
      to one will move the nearplane farther, and also improve medium/long
      range Z-Buffer precision. *)
    property NearPlaneBias: Single read FNearPlaneBias write SetNearPlaneBias stored StoreNearPlaneBias;
    (* If set, camera will point to this object.
      When camera is pointing an object, the Direction vector is ignored
      and the Up vector is used as an absolute vector to the up. *)
    property TargetObject: TgxBaseSceneObject read FTargetObject write SetTargetObject;
    (* Adjust the camera style.
      Three styles are available :
      csPerspective, the default value for perspective projection
      csOrthogonal, for orthogonal (or isometric) projection.
      csOrtho2D, setups orthogonal 2D projection in which 1 unit
      (in x or y) represents 1 pixel.
      csInfinitePerspective, for perspective view without depth limit.
      csKeepCamAnglePerspective, for perspective view with keeping aspect on view resize.
      csCustom, setup is deferred to the OnCustomPerspective event. *)
    property CameraStyle: TgxCameraStyle read FCameraStyle write SetCameraStyle default csPerspective;
    (* Keep camera angle mode.
      When CameraStyle is csKeepCamAnglePerspective, select which camera angle you want to keep.
      kaHeight, for Keep Height oriented camera angle
      kaWidth,  for Keep Width oriented camera angle *)
    property KeepFOVMode: TgxCameraKeepFOVMode read FKeepFOVMode write SetKeepFOVMode default ckmHorizontalFOV;
    (* Custom perspective event.
      This event allows you to specify your custom perpective, either
      with a glFrustrum, a glOrtho or whatever method suits you.
      You must compute viewPortRadius for culling to work.
      This event is only called if CameraStyle is csCustom. *)
    property OnCustomPerspective: TgxOnCustomPerspective read FOnCustomPerspective write FOnCustomPerspective;
    property Position;
    property Direction;
    property Up;
    property OnProgress;
  end;

  (* Scene object.
    The scene contains the scene description (lights, geometry...), which is
    basicly a hierarchical scene graph made of TgxBaseSceneObject. It will
    usually contain one or more TgxCamera object, which can be referred by
    a Viewer component for rendering purposes.
    The scene's objects can be accessed directly from Delphi code (as regular
    components), but those are edited with a specific editor (double-click
    on the TgxScene component at design-time to invoke it). To add objects
    at runtime, use the AddNewChild method of TgxBaseSceneObject. *)
  TgxScene = class(TgxUpdateAbleComponent)
  private
    FUpdateCount: Integer;
    FObjects: TgxSceneRootObject;
    FBaseContext: TgxContext; // reference, not owned!
    FLights, FBuffers: TgxPersistentObjectList;
    FCurrentCamera: TgxCamera;
    FCurrentBuffer: TgxSceneBuffer;
    FObjectsSorting: TgxObjectsSorting;
    FVisibilityCulling: TgxVisibilityCulling;
    FOnBeforeProgress: TgxProgressEvent;
    FOnProgress: TgxProgressEvent;
    FCurrentDeltaTime: Double;
    FInitializableObjects: TgxInitializableObjectList;
  protected
    procedure AddLight(aLight: TgxLightSource);
    procedure RemoveLight(aLight: TgxLightSource);
    // Adds all lights in the subtree (anObj included)
    procedure AddLights(anObj: TgxBaseSceneObject);
    // Removes all lights in the subtree (anObj included)
    procedure RemoveLights(anObj: TgxBaseSceneObject);
    procedure GetChildren(AProc: TGetChildProc; Root: TComponent); override;
    procedure SetChildOrder(AChild: TComponent; Order: Integer); override;
    procedure SetObjectsSorting(const val: TgxObjectsSorting);
    procedure SetVisibilityCulling(const val: TgxVisibilityCulling);
    procedure ReadState(reader: TReader); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    function IsUpdating: Boolean;
    procedure AddBuffer(aBuffer: TgxSceneBuffer);
    procedure RemoveBuffer(aBuffer: TgxSceneBuffer);
    procedure SetupLights(maxLights: Integer);
    procedure NotifyChange(Sender: TObject); override;
    procedure Progress(const deltaTime, newTime: Double);
    function FindSceneObject(const aName: string): TgxBaseSceneObject;
    (* Calculates, finds and returns the first object intercepted by the ray.
      Returns nil if no intersection was found. This function will be
      accurate only for objects that overrided their RayCastIntersect
      method with accurate code, otherwise, bounding sphere intersections
      will be returned. *)
    function RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil)
      : TgxBaseSceneObject; virtual;
    procedure ShutdownAllLights;
    // Saves the scene to a file (recommended extension : .GLS)
    procedure SaveToFile(const fileName: string);
    (* Load the scene from a file.
      Existing objects/lights/cameras are freed, then the file is loaded.
      Delphi's IDE is not handling this behaviour properly yet, ie. if
      you load a scene in the IDE, objects will be properly loaded, but
      no declare will be placed in the code. *)
    procedure LoadFromFile(const fileName: string);
    procedure SaveToStream(aStream: TStream);
    procedure LoadFromStream(aStream: TStream);
    // Saves the scene to a text file
    procedure SaveToTextFile(const fileName: string);
    (* Load the scene from a text files.
      See LoadFromFile for details. *)
    procedure LoadFromTextFile(const fileName: string);
    property CurrentCamera: TgxCamera read FCurrentCamera;
    property Lights: TgxPersistentObjectList read FLights;
    property Objects: TgxSceneRootObject read FObjects;
    property CurrentBuffer: TgxSceneBuffer read FCurrentBuffer;
    (* List of objects that request to be initialized when rendering context is active.
      They are removed automaticly from this list once initialized. *)
    property InitializableObjects: TgxInitializableObjectList read FInitializableObjects;
    property CurrentDeltaTime: Double read FCurrentDeltaTime;
  published
    // Defines default ObjectSorting option for scene objects.
    property ObjectsSorting: TgxObjectsSorting read FObjectsSorting write SetObjectsSorting default osRenderBlendedLast;
    // Defines default VisibilityCulling option for scene objects.
    property VisibilityCulling: TgxVisibilityCulling read FVisibilityCulling write SetVisibilityCulling default vcNone;
    property OnBeforeProgress: TgxProgressEvent read FOnBeforeProgress write FOnBeforeProgress;
    property OnProgress: TgxProgressEvent read FOnProgress write FOnProgress;
  end;

  TgxFogMode = (fmLinear, fmExp, fmExp2);

  (* Fog distance calculation mode.
    fdDefault: let OpenGL use its default formula
    fdEyeRadial: uses radial "true" distance (best quality)
    fdEyePlane: uses the distance to the projection plane (same as Z-Buffer, faster)
    Requires support of GL_NV_fog_distance extension, otherwise, it is ignored. *)
  TgxFogDistance = (fdDefault, fdEyeRadial, fdEyePlane);

  (* Parameters for fog environment in a scene.
    The fog descibed by this object is a distance-based fog, ie. the "intensity"
    of the fog is given by a formula depending solely on the distance, this
    intensity is used for blending to a fixed color. *)
  TgxFogEnvironment = class(TgxUpdateAbleObject)
  private
    FSceneBuffer: TgxSceneBuffer;
    FFogColor: TgxColor; // alpha value means the fog density
    FFogStart, FFogEnd: Single;
    FFogMode: TgxFogMode;
    FFogDistance: TgxFogDistance;
  protected
    procedure SetFogColor(Value: TgxColor);
    procedure SetFogStart(Value: Single);
    procedure SetFogEnd(Value: Single);
    procedure SetFogMode(Value: TgxFogMode);
    procedure SetFogDistance(const val: TgxFogDistance);
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure ApplyFog;
    procedure Assign(Source: TPersistent); override;
    function IsAtDefaultValues: Boolean;
  published
    // Color of the fog when it is at 100% intensity.
    property FogColor: TgxColor read FFogColor write SetFogColor;
    // Minimum distance for fog, what is closer is not affected.
    property FogStart: Single read FFogStart write SetFogStart;
    // Maximum distance for fog, what is farther is at 100% fog intensity.
    property FogEnd: Single read FFogEnd write SetFogEnd;
    // The formula used for converting distance to fog intensity.
    property FogMode: TgxFogMode read FFogMode write SetFogMode default fmLinear;
    (* Adjusts the formula used for calculating fog distances.
      This option is honoured if and only if the OpenGL ICD supports the
      GL_NV_fog_distance extension, otherwise, it is ignored.
      fdDefault: let OpenGL use its default formula
      fdEyeRadial: uses radial "true" distance (best quality)
      fdEyePlane: uses the distance to the projection plane  (same as Z-Buffer, faster) *)
    property FogDistance: TgxFogDistance read FFogDistance write SetFogDistance default fdDefault;
  end;

  TgxDepthPrecision = (dpDefault, dp16bits, dp24bits, dp32bits);
  TgxColorDepth = (cdDefault, cd8bits, cd16bits, cd24bits, cdFloat64bits, cdFloat128bits); // float_type
  TgxShadeModel = (smDefault, smSmooth, smFlat);

  // Encapsulates an OpenGL frame/rendering buffer.
  TgxSceneBuffer = class(TgxUpdateAbleObject)
  private
    // Internal state
    FRendering: Boolean;
    FRenderingContext: TgxContext;
    FAfterRenderEffects: TgxPersistentObjectList;
    FViewMatrixStack: array of TMatrix4f;
    FProjectionMatrixStack: array of TMatrix4f;
    FBaseProjectionMatrix: TMatrix4f;
    FCameraAbsolutePosition: TVector4f;
    FViewPort: TRectangle;
    FSelector: TgxBaseSelectTechnique;
    // Options & User Properties
    FFaceCulling, FFogEnable, FLighting: Boolean;
    FDepthTest: Boolean;
    FBackgroundColor: TColor;
    FBackgroundAlpha: Single;
    FAmbientColor: TgxColor;
    FAntiAliasing: TgxAntiAliasing;
    FDepthPrecision: TgxDepthPrecision;
    FColorDepth: TgxColorDepth;
    FContextOptions: TgxContextOptions;
    FShadeModel: TgxShadeModel;
    FRenderDPI: Integer;
    FFogEnvironment: TgxFogEnvironment;
    FAccumBufferBits: Integer;
    FLayer: TgxContextLayer;
    // Cameras
    FCamera: TgxCamera;
    // Freezing
    FFreezeBuffer: Pointer;
    FFreezed: Boolean;
    FFreezedViewPort: TRectangle;
    // Monitoring
    FFrameCount: Longint;
    FFramesPerSecond: Single;
    FFirstPerfCounter: Int64;
    FLastFrameTime: Single;
    // Events
    FOnChange: TNotifyEvent;
    FOnStructuralChange: TNotifyEvent;
    FOnPrepareGLContext: TNotifyEvent;
    FBeforeRender: TNotifyEvent;
    FViewerBeforeRender: TNotifyEvent;
    FPostRender: TNotifyEvent;
    FAfterRender: TNotifyEvent;
    FInitiateRendering: TDirectRenderEvent;
    FWrapUpRendering: TDirectRenderEvent;
    procedure SetLayer(const Value: TgxContextLayer);
  protected
    procedure SetBackgroundColor(AColor: TColor);
    procedure SetBackgroundAlpha(alpha: Single);
    procedure SetAmbientColor(AColor: TgxColor);
    function GetLimit(Which: TgxLimitType): Integer;
    procedure SetCamera(ACamera: TgxCamera);
    procedure SetContextOptions(Options: TgxContextOptions);
    procedure SetDepthTest(aValue: Boolean);
    procedure SetFaceCulling(aValue: Boolean);
    procedure SetLighting(aValue: Boolean);
    procedure SetAntiAliasing(const val: TgxAntiAliasing);
    procedure SetDepthPrecision(const val: TgxDepthPrecision);
    procedure SetColorDepth(const val: TgxColorDepth);
    procedure SetShadeModel(const val: TgxShadeModel);
    procedure SetFogEnable(aValue: Boolean);
    procedure SetFogEnvironment(aValue: TgxFogEnvironment);
    function StoreFog: Boolean;
    procedure SetAccumBufferBits(const val: Integer);
    procedure PrepareRenderingMatrices(const AViewport: TRectangle; resolution: Integer; pickingRect: PRect = nil);
    procedure DoBaseRender(const AViewport: TRectangle; resolution: Integer; drawState: TGXDrawState;
      baseObject: TgxBaseSceneObject);
    procedure SetupRenderingContext(Context: TgxContext);
    procedure SetupRCOptions(Context: TgxContext);
    procedure PrepareGLContext;
    procedure DoChange;
    procedure DoStructuralChange;
    // DPI for current/last render
    property RenderDPI: Integer read FRenderDPI;
    property OnPrepareGLContext: TNotifyEvent read FOnPrepareGLContext write FOnPrepareGLContext;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure NotifyChange(Sender: TObject); override;
    procedure CreateRC(AWindowHandle: THandle; memoryContext: Boolean; // in VCL -> HWND
      BufferCount: Integer = 1); overload;
    procedure ClearBuffers;
    procedure DestroyRC;
    function RCInstantiated: Boolean;
    procedure Resize(newLeft, newTop, newWidth, newHeight: Integer);
    // Indicates hardware acceleration support
    function Acceleration: TgxContextAcceleration;
    // ViewPort for current/last render
    property viewport: TRectangle read FViewPort;
    // Fills the PickList with objects in Rect area
    procedure PickObjects(const rect: TRect; pickList: TgxPickList; objectCountGuess: Integer);
    (* Returns a PickList with objects in Rect area.
      Returned list should be freed by caller.
      Objects are sorted by depth (nearest objects first). *)
    function GetPickedObjects(const rect: TRect; objectCountGuess: Integer = 64): TgxPickList;
    // Returns the nearest object at x, y coordinates or nil if there is none
    function GetPickedObject(x, y: Integer): TgxBaseSceneObject;
    // Returns the color of the pixel at x, y in the frame buffer
    function GetPixelColor(x, y: Integer): TColor;
    (* Returns the raw depth (Z buffer) of the pixel at x, y in the frame buffer.
      This value does not map to the actual eye-object distance, but to
      a depth buffer value in the [0; 1] range. *)
    function GetPixelDepth(x, y: Integer): Single;
    (* Converts a raw depth (Z buffer value) to frustrum distance.
      This calculation is only accurate for the pixel at the centre of the viewer,
      because it does not take into account that the corners of the frustrum
      are further from the eye than its centre. *)
    function PixelDepthToDistance(aDepth: Single): Single;
    (* Converts a raw depth (Z buffer value) to world distance.
      It also compensates for the fact that the corners of the frustrum
      are further from the eye, than its centre. *)
    function PixelToDistance(x, y: Integer): Single;
    // Design time notification
    procedure NotifyMouseMove(Shift: TShiftState; x, y: Single);
    (* Renders the scene on the viewer.
      You do not need to call this method, unless you explicitly want a
      render at a specific time. If you just want the control to get
      refreshed, use Invalidate instead. *)
    procedure Render(baseObject: TgxBaseSceneObject); overload;
    procedure Render; overload;
    procedure RenderScene(aScene: TgxScene; const viewPortSizeX, viewPortSizeY: Integer; drawState: TGXDrawState;
      baseObject: TgxBaseSceneObject);
    (* Render the scene to a bitmap at given DPI.
      DPI = "dots per inch".
      The "magic" DPI of the screen is 96 under Windows. *)
    procedure RenderToBitmap(ABitmap: TBitmap; DPI: Integer = 0);
    (* Render the scene to a bitmap at given DPI and saves it to a file.
      DPI = "dots per inch".
      The "magic" DPI of the screen is 96 under Windows. *)
    procedure RenderToFile(const AFile: string; DPI: Integer = 0); overload;
    (* Renders to bitmap of given size, then saves it to a file.
      DPI is adjusted to make the bitmap similar to the viewer. *)
    procedure RenderToFile(const AFile: string; bmpWidth, bmpHeight: Integer); overload;
    (* Creates a TgxBitmap32 that is a snapshot of current OpenGL content.
      When possible, use this function instead of RenderToBitmap, it won't
      request a redraw and will be significantly faster.
      The returned TgxBitmap32 should be freed by calling code. *)
    function CreateSnapShot: TgxImage;
    // Creates a bitmap that is a snapshot of current graphic content.
    function CreateSnapShotBitmap: TBitmap;
    procedure CopyToTexture(aTexture: TgxTexture); overload;
    procedure CopyToTexture(aTexture: TgxTexture; xSrc, ySrc, AWidth, AHeight: Integer; xDest, yDest: Integer;
      glCubeFace: GLEnum = 0); overload;
    // Save as raw float data to a file
    procedure SaveAsFloatToFile(const aFilename: string);
    // Event reserved for viewer-specific uses.
    property ViewerBeforeRender: TNotifyEvent read FViewerBeforeRender write FViewerBeforeRender stored False;
    procedure SetViewPort(x, y, W, H: Integer);
    function width: Integer;
    function height: Integer;
    // Indicates if the Viewer is "frozen".
    property Freezed: Boolean read FFreezed;
    (* Freezes rendering leaving the last rendered scene on the buffer. This
      is usefull in windowed applications for temporarily stopping rendering
      (when moving the window, for example). *)
    procedure Freeze;
    { Restarts rendering after it was freezed. }
    procedure Melt;
    // Displays a window with info on current OpenGL ICD and context.
    procedure ShowInfo(Modal: Boolean = False);
    // Currently Rendering?
    property Rendering: Boolean read FRendering;
    // Adjusts background alpha channel.
    property BackgroundAlpha: Single read FBackgroundAlpha write SetBackgroundAlpha;
    // Returns the projection matrix in use or used for the last rendering.
    function ProjectionMatrix: TMatrix4f; deprecated;
    // Returns the view matrix in use or used for the last rendering.
    function ViewMatrix: TMatrix4f; deprecated;
    function ModelMatrix: TMatrix4f; deprecated;
    (* Returns the base projection matrix in use or used for the last rendering.
      The "base" projection is (as of now) either identity or the pick
      matrix, ie. it is the matrix on which the perspective or orthogonal
      matrix gets applied. *)
    property BaseProjectionMatrix: TMatrix4f read FBaseProjectionMatrix;
    (* Back up current View matrix and replace it with newMatrix.
      This method has no effect on theOpenVX matrix, only on the Buffer's
      matrix, and is intended for special effects rendering. *)
    procedure PushViewMatrix(const newMatrix: TMatrix4f); deprecated;
    // Restore a View matrix previously pushed.
    procedure PopViewMatrix; deprecated;
    procedure PushProjectionMatrix(const newMatrix: TMatrix4f); deprecated;
    procedure PopProjectionMatrix; deprecated;
    (* Converts a screen pixel coordinate into 3D coordinates for orthogonal projection.
      This function accepts standard canvas coordinates, with (0,0) being
      the top left corner, and returns, when the camera is in orthogonal
      mode, the corresponding 3D world point that is in the camera's plane. *)
    function OrthoScreenToWorld(screenX, screenY: Integer): TAffineVector; overload;
    (* Converts a screen coordinate into world (3D) coordinates.
      This methods wraps a call to gluUnProject.
      Note that screen coord (0,0) is the lower left corner. *)
    function ScreenToWorld(const aPoint: TAffineVector): TAffineVector; overload;
    function ScreenToWorld(const aPoint: TVector4f): TVector4f; overload;
    (* Converts a screen pixel coordinate into 3D world coordinates.
      This function accepts standard canvas coordinates, with (0,0) being
      the top left corner. *)
    function ScreenToWorld(screenX, screenY: Integer): TAffineVector; overload;
    (* Converts an absolute world coordinate into screen coordinate.
      This methods wraps a call to gluProject.
      Note that screen coord (0,0) is the lower left corner. *)
    function WorldToScreen(const aPoint: TAffineVector): TAffineVector; overload;
    function WorldToScreen(const aPoint: TVector4f): TVector4f; overload;
    // Converts a set of point absolute world coordinates into screen coordinates.
    procedure WorldToScreen(points: PVector4f; nbPoints: Integer); overload;
    (* Calculates the 3D vector corresponding to a 2D screen coordinate.
      The vector originates from the camera's absolute position and is
      expressed in absolute coordinates.
      Note that screen coord (0,0) is the lower left corner. *)
    function ScreenToVector(const aPoint: TAffineVector): TAffineVector; overload;
    function ScreenToVector(const aPoint: TVector4f): TVector4f; overload;
    function ScreenToVector(const x, y: Integer): TVector4f; overload;
    (* Calculates the 2D screen coordinate of a vector from the camera's
      absolute position and is expressed in absolute coordinates.
      Note that screen coord (0,0) is the lower left corner. *)
    function VectorToScreen(const VectToCam: TAffineVector): TAffineVector;
    (* Calculates intersection between a plane and screen vector.
      If an intersection is found, returns True and places result in
      intersectPoint. *)
    function ScreenVectorIntersectWithPlane(const aScreenPoint: TVector4f; const planePoint, planeNormal: TVector4f;
      var intersectPoint: TVector4f): Boolean;
    (* Calculates intersection between plane XY and screen vector.
      If an intersection is found, returns True and places result in intersectPoint. *)
    function ScreenVectorIntersectWithPlaneXY(const aScreenPoint: TVector4f; const z: Single;
      var intersectPoint: TVector4f): Boolean;
    (* Calculates intersection between plane YZ and screen vector.
      If an intersection is found, returns True and places result in intersectPoint. *)
    function ScreenVectorIntersectWithPlaneYZ(const aScreenPoint: TVector4f; const x: Single;
      var intersectPoint: TVector4f): Boolean;
    (* Calculates intersection between plane XZ and screen vector.
      If an intersection is found, returns True and places result in intersectPoint. *)
    function ScreenVectorIntersectWithPlaneXZ(const aScreenPoint: TVector4f; const y: Single;
      var intersectPoint: TVector4f): Boolean;
    (* Calculates a 3D coordinate from screen position and ZBuffer.
      This function returns a world absolute coordinate from a 2D point
      in the viewer, the depth being extracted from the ZBuffer data
      (DepthTesting and ZBuffer must be enabled for this function to work).
      Note that ZBuffer precision is not linear and can be quite low on
      some boards (either from compression or resolution approximations). *)
    function PixelRayToWorld(x, y: Integer): TAffineVector;
    (* Time (in second) spent to issue rendering order for the last frame.
      Be aware that since execution by the hardware isn't synchronous,
      this value may not be an accurate measurement of the time it took
      to render the last frame, it's a measurement of only the time it
      took to issue rendering orders. *)
    property LastFrameTime: Single read FLastFrameTime;
    (* Current FramesPerSecond rendering speed.
      You must keep the renderer busy to get accurate figures from this
      property.
      This is an average value, to reset the counter, call
      ResetPerfomanceMonitor. *)
    property FramesPerSecond: Single read FFramesPerSecond;
    (* Resets the perfomance monitor and begin a new statistics set.
      See FramesPerSecond. *)
    procedure ResetPerformanceMonitor;
    (* Retrieve one of the OpenGL limits for the current viewer.
      Limits include max texture size, OpenGL stack depth, etc. *)
    property LimitOf[Which: TgxLimitType]: Integer read GetLimit;
    (* Current rendering context.
      The context is a wrapper around platform-specific contexts
      (see TgxContext) and takes care of context activation and handle
      management. *)
    property RenderingContext: TgxContext read FRenderingContext;
    (* The camera from which the scene is rendered.
      A camera is an object you can add and define in a TgxScene component. *)
    property Camera: TgxCamera read FCamera write SetCamera;
    // Specifies the layer plane that the rendering context is bound to.
    property Layer: TgxContextLayer read FLayer write SetLayer default clMainPlane;
  published
    // Fog environment options. See TgxFogEnvironment.
    property FogEnvironment: TgxFogEnvironment read FFogEnvironment write SetFogEnvironment stored StoreFog;
    // Color used for filling the background prior to any rendering.
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default TColors.SysBtnFace;
    (* Scene ambient color vector.
      This ambient color is defined independantly from all lightsources,
      which can have their own ambient components. *)
    property AmbientColor: TgxColor read FAmbientColor write SetAmbientColor;
    (* Context options allows to setup specifics of the rendering context.
      Not all contexts support all options. *)
    property ContextOptions: TgxContextOptions read FContextOptions write SetContextOptions
      default [roDoubleBuffer, roRenderToWindow, roDebugContext];
    // Number of precision bits for the accumulation buffer.
    property AccumBufferBits: Integer read FAccumBufferBits write SetAccumBufferBits default 0;
    (* DepthTest enabling.
      When DepthTest is enabled, objects closer to the camera will hide
      farther ones (via use of Z-Buffering).
      When DepthTest is disabled, the latest objects drawn/rendered overlap
      all previous objects, whatever their distance to the camera.
      Even when DepthTest is enabled, objects may chose to ignore depth
      testing through the osIgnoreDepthBuffer of their ObjectStyle property. *)
    property DepthTest: Boolean read FDepthTest write SetDepthTest default True;
    (* Enable or disable face culling in the renderer.
      Face culling is used in hidden faces removal algorithms : each face
      is given a normal or 'outside' direction. When face culling is enabled,
      only faces whose normal points towards the observer are rendered. *)
    property FaceCulling: Boolean read FFaceCulling write SetFaceCulling default True;
    // Toggle to enable or disable the fog settings.
    property FogEnable: Boolean read FFogEnable write SetFogEnable default False;
    (* Toggle to enable or disable lighting calculations.
      When lighting is enabled, objects will be lit according to lightsources,
      when lighting is disabled, objects are rendered in their own colors,
      without any shading.
      Lighting does NOT generate shadows in OpenGL. *)
    property Lighting: Boolean read FLighting write SetLighting default True;
    (* AntiAliasing option.
      Ignored if not hardware supported, currently based on ARB_multisample. *)
    property AntiAliasing: TgxAntiAliasing read FAntiAliasing write SetAntiAliasing default aaDefault;
    (* Depth buffer precision.
      Default is highest available (below and including 24 bits) *)
    property DepthPrecision: TgxDepthPrecision read FDepthPrecision write SetDepthPrecision default dpDefault;
    (* Color buffer depth.
      Default depth buffer is highest available (below and including 24 bits) *)
    property ColorDepth: TgxColorDepth read FColorDepth write SetColorDepth default cdDefault;
    // Shade model. Default is "Smooth".
    property ShadeModel: TgxShadeModel read FShadeModel write SetShadeModel default smDefault;
    (* Indicates a change in the scene or buffer options.
      A simple re-render is enough to take into account the changes. *)
    property OnChange: TNotifyEvent read FOnChange write FOnChange stored False;
    (* Indicates a structural change in the scene or buffer options.
      A reconstruction of the RC is necessary to take into account the
      changes (this may lead to a driver switch or lengthy operations). *)
    property OnStructuralChange: TNotifyEvent read FOnStructuralChange write FOnStructuralChange stored False;
    (* Triggered before the scene's objects get rendered.
      You may use this event to execute your own OpenGL rendering
      (usually background stuff). *)
    property BeforeRender: TNotifyEvent read FBeforeRender write FBeforeRender stored False;
    (* Triggered after BeforeRender, before rendering objects.
      This one is fired after the rci has been initialized and can be used
      to alter it or perform early renderings that require an rci,
      the Sender is the buffer. *)
    property InitiateRendering: TDirectRenderEvent read FInitiateRendering write FInitiateRendering stored False;
    (* Triggered after rendering all scene objects, before PostRender.
      This is the last point after which the rci becomes unavailable,
      the Sender is the buffer. *)
    property WrapUpRendering: TDirectRenderEvent read FWrapUpRendering write FWrapUpRendering stored False;
    (* Triggered just after all the scene's objects have been rendered.
      The OpenGL context is still active in this event, and you may use it
      to execute your own OpenGL rendering (usually for HUD, 2D overlays
      or after effects). *)
    property PostRender: TNotifyEvent read FPostRender write FPostRender stored False;
    (* Called after rendering.
      You cannot issue OpenGL calls in this event, if you want to do your own
      OpenGL stuff, use the PostRender event. *)
    property AfterRender: TNotifyEvent read FAfterRender write FAfterRender stored False;
  end;

  (* Base class for non-visual viewer.
    Non-visual viewer may actually render visuals, but they are non-visual
    (ie. non interactive) at design time. Such viewers include memory
    or full-screen viewers. *)
  TgxNonVisualViewer = class(TComponent)
  private
    FBuffer: TgxSceneBuffer;
    FWidth, FHeight: Integer;
    FCubeMapRotIdx: Integer;
    FCubeMapZNear, FCubeMapZFar: Single;
    FCubeMapTranslation: TAffineVector;
    // FCreateTexture : Boolean;
  protected
    procedure SetBeforeRender(const val: TNotifyEvent);
    function GetBeforeRender: TNotifyEvent;
    procedure SetPostRender(const val: TNotifyEvent);
    function GetPostRender: TNotifyEvent;
    procedure SetAfterRender(const val: TNotifyEvent);
    function GetAfterRender: TNotifyEvent;
    procedure SetCamera(const val: TgxCamera);
    function GetCamera: TgxCamera;
    procedure SetBuffer(const val: TgxSceneBuffer);
    procedure SetWidth(const val: Integer);
    procedure SetHeight(const val: Integer);
    procedure SetupCubeMapCamera(Sender: TObject);
    procedure DoOnPrepareVXContext(Sender: TObject);
    procedure PrepareVXContext; virtual;
    procedure DoBufferChange(Sender: TObject); virtual;
    procedure DoBufferStructuralChange(Sender: TObject); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Render(baseObject: TgxBaseSceneObject = nil); virtual; abstract;
    procedure CopyToTexture(aTexture: TgxTexture); overload; virtual;
    procedure CopyToTexture(aTexture: TgxTexture; xSrc, ySrc, width, height: Integer; xDest, yDest: Integer); overload;
    // CopyToTexture for Multiple-Render-Target
    procedure CopyToTextureMRT(aTexture: TgxTexture; BufferIndex: Integer); overload; virtual;
    procedure CopyToTextureMRT(aTexture: TgxTexture; xSrc, ySrc, width, height: Integer; xDest, yDest: Integer;
      BufferIndex: Integer); overload;
    (* Renders the 6 texture maps from a scene.
      The viewer is used to render the 6 images, one for each face
      of the cube, from the absolute position of the camera.
      This does NOT alter the content of the Pictures in the image,
      and will only change or define the content of textures as
      registered by OpenGL. *)
    procedure RenderCubeMapTextures(cubeMapTexture: TgxTexture; zNear: Single = 0; zFar: Single = 0);
  published
    // Camera from which the scene is rendered.
    property Camera: TgxCamera read GetCamera write SetCamera;
    property width: Integer read FWidth write SetWidth default 256;
    property height: Integer read FHeight write SetHeight default 256;
    (* Triggered before the scene's objects get rendered.
      You may use this event to execute your own OpenGL rendering. *)
    property BeforeRender: TNotifyEvent read GetBeforeRender write SetBeforeRender;
    (* Triggered just after all the scene's objects have been rendered.
      The OpenGL context is still active in this event, and you may use it
      to execute your own OpenGL rendering. *)
    property PostRender: TNotifyEvent read GetPostRender write SetPostRender;
    (* Called after rendering.
      You cannot issue OpenGL calls in this event, if you want to do your own
      OpenGL stuff, use the PostRender event. *)
    property AfterRender: TNotifyEvent read GetAfterRender write SetAfterRender;
    // Access to buffer properties.
    property Buffer: TgxSceneBuffer read FBuffer write SetBuffer;
  end;

  (* Component to render a scene to memory only.
    This component curently requires that the OpenGL ICD supports the
    WGL_ARB_pbuffer extension (indirectly). *)
  TgxMemoryViewer = class(TgxNonVisualViewer)
  private
    FBufferCount: Integer;
    procedure SetBufferCount(const Value: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    procedure InstantiateRenderingContext;
    procedure Render(baseObject: TgxBaseSceneObject = nil); override;
  published
    (* Set BufferCount > 1 for multiple render targets.
      Users should check if the corresponding extension (GL_ATI_draw_buffers)
      is supported. Current hardware limit is BufferCount = 4. *)
    property BufferCount: Integer read FBufferCount write SetBufferCount default 1;
  end;

  TInvokeInfoForm = procedure(aSceneBuffer: TgxSceneBuffer; Modal: Boolean);

(* Register an event handler triggered by any TgxBaseSceneObject Name change.
   *INCOMPLETE*, currently allows for only 1 (one) event, and is used by
   FSceneEdit in the IDE. *)
procedure RegisterBaseSceneObjectNameChangeEvent(notifyEvent: TNotifyEvent);
(* Deregister an event handler triggered by any TgxBaseSceneObject Name change.
  See RegisterVKBaseSceneObjectNameChangeEvent. *)
procedure DeRegisterBaseSceneObjectNameChangeEvent(notifyEvent: TNotifyEvent);
(* Register an event handler triggered by any TgxBehaviour Name change.
  *INCOMPLETE*, currently allows for only 1 (one) event, and is used by
  FBehavioursEditor in the IDE. *)
procedure RegisterBehaviourNameChangeEvent(notifyEvent: TNotifyEvent);
(* Deregister an event handler triggered by any TgxBaseSceneObject Name change.
  See RegisterVKBaseSceneObjectNameChangeEvent. *)
procedure DeRegisterBehaviourNameChangeEvent(notifyEvent: TNotifyEvent);

// Issues OpenGL calls for drawing X, Y, Z axes in a standard style.
procedure AxesBuildList(var rci: TgxRenderContextInfo; pattern: Word; AxisLen: Single);

// Registers the procedure call used to invoke the info form.
procedure RegisterInfoForm(infoForm: TInvokeInfoForm);
procedure InvokeInfoForm(aSceneBuffer: TgxSceneBuffer; Modal: Boolean);

function GetCurrentRenderingObject: TgxBaseSceneObject;

var
  vCounterFrequency: Int64;
{$IFNDEF USE_MULTITHREAD}

var
{$ELSE}
  threadvar
{$ENDIF}
    vCurrentRenderingObject: TgxBaseSceneObject;

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

function GetCurrentRenderingObject: TgxBaseSceneObject;
begin
  Result := vCurrentRenderingObject;
end;

procedure AxesBuildList(var rci: TgxRenderContextInfo; pattern: Word; AxisLen: Single);
begin
{$IFDEF USE_OPENGL_DEBUG}
  if GL_GREMEDY_string_marker then
    GL_StringMarkerGREMEDY(13, 'AxesBuildList');
{$ENDIF}
  with rci.gxStates do
  begin
    Disable(stLighting);
    if not rci.ignoreBlendingRequests then
    begin
      Enable(stBlend);
      SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
    end;
    LineWidth := 1;
    Enable(stLineStipple);
    LineStippleFactor := 1;
    LineStipplePattern := pattern;
    DepthWriteMask := False;
    DepthFunc := cfLEqual;
    if rci.bufferDepthTest then
      Enable(stDepthTest);
  end;
  glBegin(GL_LINES);
  glColor3f(0.5, 0.0, 0.0);
  glVertex3f(0, 0, 0);
  glVertex3f(-AxisLen, 0, 0);
  glColor3f(1.0, 0.0, 0.0);
  glVertex3f(0, 0, 0);
  glVertex3f(AxisLen, 0, 0);
  glColor3f(0.0, 0.5, 0.0);
  glVertex3f(0, 0, 0);
  glVertex3f(0, -AxisLen, 0);
  glColor3f(0.0, 1.0, 0.0);
  glVertex3f(0, 0, 0);
  glVertex3f(0, AxisLen, 0);
  glColor3f(0.0, 0.0, 0.5);
  glVertex3f(0, 0, 0);
  glVertex3f(0, 0, -AxisLen);
  glColor3f(0.0, 0.0, 1.0);
  glVertex3f(0, 0, 0);
  glVertex3f(0, 0, AxisLen);
  glEnd;
end;

var
  vInfoForm: TInvokeInfoForm = nil;

procedure RegisterInfoForm(infoForm: TInvokeInfoForm);
begin
  vInfoForm := infoForm;
end;

procedure InvokeInfoForm(aSceneBuffer: TgxSceneBuffer; Modal: Boolean);
begin
  if Assigned(vInfoForm) then
    vInfoForm(aSceneBuffer, Modal)
  else
    InformationDlg('InfoForm not available.');
end;

// ------------------ internal global routines ----------------------------------

var
  vBaseSceneObjectNameChangeEvent: TNotifyEvent;
  vBehaviourNameChangeEvent: TNotifyEvent;

procedure RegisterBaseSceneObjectNameChangeEvent(notifyEvent: TNotifyEvent);
begin
  vBaseSceneObjectNameChangeEvent := notifyEvent;
end;

procedure DeRegisterBaseSceneObjectNameChangeEvent(notifyEvent: TNotifyEvent);
begin
  vBaseSceneObjectNameChangeEvent := nil;
end;

procedure RegisterBehaviourNameChangeEvent(notifyEvent: TNotifyEvent);
begin
  vBehaviourNameChangeEvent := notifyEvent;
end;

procedure DeRegisterBehaviourNameChangeEvent(notifyEvent: TNotifyEvent);
begin
  vBehaviourNameChangeEvent := nil;
end;

// ------------------
// ------------------ TgxBaseSceneObject ------------------
// ------------------

constructor TgxBaseSceneObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FListHandle := TgxListHandle.Create;
  FObjectStyle := [];
  FChanges := [ocTransformation, ocStructure, ocAbsoluteMatrix, ocInvAbsoluteMatrix];
  FPosition := TgxCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
  FRotation := TgxCoordinates.CreateInitialized(Self, NullHmgVector, csVector);
  FDirection := TgxCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  FUp := TgxCoordinates.CreateInitialized(Self, YHmgVector, csVector);
  FScaling := TgxCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
  FLocalMatrix := IdentityHmgMatrix;
  FVisible := True;
  FPickable := True;
  FObjectsSorting := osInherited;
  FVisibilityCulling := vcInherited;
  FChildren := TgxPersistentObjectList.Create;

  FBBChanges := [oBBcChild, oBBcStructure];
  FBoundingBoxPersonalUnscaled := NullBoundingBox;
  FBoundingBoxOfChildren := NullBoundingBox;
  FBoundingBoxIncludingChildren := NullBoundingBox;

  distList := TgxSingleList.Create;
  objList := TgxPersistentObjectList.Create;

end;

constructor TgxBaseSceneObject.CreateAsChild(aParentOwner: TgxBaseSceneObject);
begin
  Create(aParentOwner);
  aParentOwner.AddChild(Self);
end;

destructor TgxBaseSceneObject.Destroy;
begin
  DeleteChildCameras;
  FEffects.Free;
  FBehaviours.Free;
  FListHandle.Free;
  FPosition.Free;
  FRotation.Free;
  FDirection.Free;
  FUp.Free;
  FScaling.Free;
  if Assigned(FParent) then
    FParent.Remove(Self, False);
  DeleteChildren;
  FChildren.Free;
  objList.Free;
  distList.Free;

  inherited Destroy;
end;

function TgxBaseSceneObject.GetHandle(var rci: TgxRenderContextInfo): Cardinal;
begin
  // Special case.. dirty trixxors
  if not Assigned(FListHandle) then
  begin
    Result := 0;
    Exit;
  end;

  Result := FListHandle.Handle;
  if Result = 0 then
    Result := FListHandle.AllocateHandle;

  if ocStructure in FChanges then
  begin
    ClearStructureChanged;
    FListHandle.NotifyChangesOfData;
  end;

  if FListHandle.IsDataNeedUpdate then
  begin
    rci.gxStates.NewList(Result, GL_COMPILE);
    // try
    BuildList(rci);
    // finally
    rci.gxStates.EndList;
    // end;
    FListHandle.NotifyDataUpdated;
  end;
end;

function TgxBaseSceneObject.ListHandleAllocated: Boolean;
begin
  Result := Assigned(FListHandle) and (FListHandle.Handle <> 0) and not(ocStructure in FChanges);
end;

procedure TgxBaseSceneObject.DestroyHandle;
begin
  if Assigned(FListHandle) then
    FListHandle.DestroyHandle;
end;

procedure TgxBaseSceneObject.DestroyHandles;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    Children[i].DestroyHandles;
  DestroyHandle;
end;

procedure TgxBaseSceneObject.SetBBChanges(const Value: TgxObjectBBChanges);
begin
  if Value <> FBBChanges then
  begin
    FBBChanges := Value;
    if Assigned(FParent) then
      FParent.BBChanges := FParent.BBChanges + [oBBcChild];
  end;
end;

function TgxBaseSceneObject.Blended: Boolean;
begin
  Result := False;
end;

procedure TgxBaseSceneObject.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TgxBaseSceneObject.EndUpdate;
begin
  if FUpdateCount > 0 then
  begin
    Dec(FUpdateCount);
    if FUpdateCount = 0 then
      NotifyChange(Self);
  end
  else
    Assert(False, strUnBalancedBeginEndUpdate);
end;

procedure TgxBaseSceneObject.BuildList(var rci: TgxRenderContextInfo);
begin
  // nothing
end;

procedure TgxBaseSceneObject.DeleteChildCameras;
var
  i: Integer;
  child: TgxBaseSceneObject;
begin
  i := 0;
  while i < FChildren.Count do
  begin
    child := TgxBaseSceneObject(FChildren.List^[i]);
    child.DeleteChildCameras;
    if child is TgxCamera then
    begin
      Remove(child, True);
      child.Free;
    end
    else
      Inc(i);
  end;
end;

procedure TgxBaseSceneObject.DeleteChildren;
var
  child: TgxBaseSceneObject;
begin
  DeleteChildCameras;
  if Assigned(FScene) then
    FScene.RemoveLights(Self);
  while FChildren.Count > 0 do
  begin
    child := TgxBaseSceneObject(FChildren.Pop);
    child.FParent := nil;
    child.Free;
  end;
  BBChanges := BBChanges + [oBBcChild];
end;

procedure TgxBaseSceneObject.Loaded;
begin
  inherited;
  FPosition.W := 1;
  if Assigned(FBehaviours) then
    FBehaviours.Loaded;
  if Assigned(FEffects) then
    FEffects.Loaded;
end;

procedure TgxBaseSceneObject.DefineProperties(Filer: TFiler);
begin
  inherited;
  { FOriginalFiler := Filer; }

  Filer.DefineBinaryProperty('BehavioursData', ReadBehaviours, WriteBehaviours,
    (Assigned(FBehaviours) and (FBehaviours.Count > 0)));
  Filer.DefineBinaryProperty('EffectsData', ReadEffects, WriteEffects,
    (Assigned(FEffects) and (FEffects.Count > 0)));
  { FOriginalFiler:=nil; }
end;

procedure TgxBaseSceneObject.WriteBehaviours(stream: TStream);
var
  writer: TWriter;
begin
  writer := TWriter.Create(stream, 16384);
  try
    Behaviours.WriteToFiler(writer);
  finally
    writer.Free;
  end;
end;

procedure TgxBaseSceneObject.ReadBehaviours(stream: TStream);
var
  reader: TReader;
begin
  reader := TReader.Create(stream, 16384);
  { with TReader(FOriginalFiler) do }
  try
    { reader.Root                 := Root;
      reader.OnError              := OnError;
      reader.OnFindMethod         := OnFindMethod;
      reader.OnSetName            := OnSetName;
      reader.OnReferenceName      := OnReferenceName;
      reader.OnAncestorNotFound   := OnAncestorNotFound;
      reader.OnCreateComponent    := OnCreateComponent;
      reader.OnFindComponentClass := OnFindComponentClass; }
    Behaviours.ReadFromFiler(reader);
  finally
    reader.Free;
  end;
end;

procedure TgxBaseSceneObject.WriteEffects(stream: TStream);
var
  writer: TWriter;
begin
  writer := TWriter.Create(stream, 16384);
  try
    Effects.WriteToFiler(writer);
  finally
    writer.Free;
  end;
end;

procedure TgxBaseSceneObject.ReadEffects(stream: TStream);
var
  reader: TReader;
begin
  reader := TReader.Create(stream, 16384);
  // with TReader(FOriginalFiler) do
  try
    (* reader.Root                 := Root;
      reader.OnError              := OnError;
      reader.OnFindMethod         := OnFindMethod;
      reader.OnSetName            := OnSetName;
      reader.OnReferenceName      := OnReferenceName;
      reader.OnAncestorNotFound   := OnAncestorNotFound;
      reader.OnCreateComponent    := OnCreateComponent;
      reader.OnFindComponentClass := OnFindComponentClass; *)
    Effects.ReadFromFiler(reader);
  finally
    reader.Free;
  end;
end;

procedure TgxBaseSceneObject.WriteRotations(stream: TStream);
begin
  stream.Write(FRotation.AsAddress^, 3 * SizeOf(Single));
end;

procedure TgxBaseSceneObject.ReadRotations(stream: TStream);
begin
  stream.Read(FRotation.AsAddress^, 3 * SizeOf(Single));
end;

procedure TgxBaseSceneObject.DrawAxes(var rci: TgxRenderContextInfo; pattern: Word);
begin
  AxesBuildList(rci, pattern, rci.rcci.farClippingDistance - rci.rcci.nearClippingDistance);
end;

procedure TgxBaseSceneObject.GetChildren(AProc: TGetChildProc; Root: TComponent);
var
  i: Integer;
begin
  for i := 0 to FChildren.Count - 1 do
    if not IsSubComponent(TComponent(FChildren.List^[i])) then
      AProc(TComponent(FChildren.List^[i]));
end;

function TgxBaseSceneObject.Get(Index: Integer): TgxBaseSceneObject;
begin
  Result := TgxBaseSceneObject(FChildren[Index]);
end;

function TgxBaseSceneObject.GetCount: Integer;
begin
  Result := FChildren.Count;
end;

function TgxBaseSceneObject.GetDirectAbsoluteMatrix: PMatrix4f;
begin
  Result := @FAbsoluteMatrix;
end;

function TgxBaseSceneObject.HasSubChildren: Boolean;
var
  i: Integer;
begin
  Result := False;
  if Count <> 0 then
    for i := 0 to Count - 1 do
      if IsSubComponent(Children[i]) then
      begin
        Result := True;
        Exit;
      end;
end;

procedure TgxBaseSceneObject.AddChild(AChild: TgxBaseSceneObject);
begin
  if Assigned(FScene) then
    FScene.AddLights(AChild);
  FChildren.Add(AChild);
  AChild.FParent := Self;
  AChild.SetScene(FScene);
  TransformationChanged;
  AChild.TransformationChanged;
  AChild.DoOnAddedToParent;
  BBChanges := BBChanges + [oBBcChild];
end;

function TgxBaseSceneObject.AddNewChild(AChild: TgxSceneObjectClass): TgxBaseSceneObject;
begin
  Result := AChild.Create(Owner);
  AddChild(Result);
end;

function TgxBaseSceneObject.AddNewChildFirst(AChild: TgxSceneObjectClass): TgxBaseSceneObject;
begin
  Result := AChild.Create(Owner);
  Insert(0, Result);
end;

function TgxBaseSceneObject.GetOrCreateBehaviour(aBehaviour: TgxBehaviourClass): TgxBehaviour;
begin
  Result := TgxBehaviour(Behaviours.GetOrCreate(aBehaviour));
end;

function TgxBaseSceneObject.AddNewBehaviour(aBehaviour: TgxBehaviourClass): TgxBehaviour;
begin
  Assert(Behaviours.CanAdd(aBehaviour));
  Result := aBehaviour.Create(Behaviours)
end;

function TgxBaseSceneObject.GetOrCreateEffect(anEffect: TgxEffectClass): TgxEffect;
begin
  Result := TgxEffect(Effects.GetOrCreate(anEffect));
end;

function TgxBaseSceneObject.AddNewEffect(anEffect: TgxEffectClass): TgxEffect;
begin
  Assert(Effects.CanAdd(anEffect));
  Result := anEffect.Create(Effects)
end;

procedure TgxBaseSceneObject.RebuildMatrix;
begin
  if ocTransformation in Changes then
  begin
    VectorScale(LeftVector, Scale.x, FLocalMatrix.x);
    VectorScale(FUp.AsVector, Scale.y, FLocalMatrix.y);
    VectorScale(FDirection.AsVector, Scale.z, FLocalMatrix.z);
    SetVector(FLocalMatrix.W, FPosition.AsVector);
    Exclude(FChanges, ocTransformation);
    Include(FChanges, ocAbsoluteMatrix);
    Include(FChanges, ocInvAbsoluteMatrix);
  end;
end;

procedure TgxBaseSceneObject.ForceLocalMatrix(const aMatrix: TMatrix4f);
begin
  FLocalMatrix := aMatrix;
  Exclude(FChanges, ocTransformation);
  Include(FChanges, ocAbsoluteMatrix);
  Include(FChanges, ocInvAbsoluteMatrix);
end;

function TgxBaseSceneObject.AbsoluteMatrixAsAddress: PMatrix4f;
begin
  if ocAbsoluteMatrix in FChanges then
  begin
    RebuildMatrix;
    if Assigned(Parent) { and (not (Parent is TgxSceneRootObject)) } then
    begin
      MatrixMultiply(FLocalMatrix, TgxBaseSceneObject(Parent).AbsoluteMatrixAsAddress^, FAbsoluteMatrix);
    end
    else
      FAbsoluteMatrix := FLocalMatrix;
    Exclude(FChanges, ocAbsoluteMatrix);
    Include(FChanges, ocInvAbsoluteMatrix);
  end;
  Result := @FAbsoluteMatrix;
end;

function TgxBaseSceneObject.InvAbsoluteMatrix: TMatrix4f;
begin
  Result := InvAbsoluteMatrixAsAddress^;
end;

function TgxBaseSceneObject.InvAbsoluteMatrixAsAddress: PMatrix4f;
begin
  if ocInvAbsoluteMatrix in FChanges then
  begin
    if VectorEquals(Scale.DirectVector, XYZHmgVector) then
    begin
      RebuildMatrix;
      if Parent <> nil then
        FInvAbsoluteMatrix := MatrixMultiply(Parent.InvAbsoluteMatrixAsAddress^, AnglePreservingMatrixInvert(FLocalMatrix))
      else
        FInvAbsoluteMatrix := AnglePreservingMatrixInvert(FLocalMatrix);
    end
    else
    begin
      FInvAbsoluteMatrix := AbsoluteMatrixAsAddress^;
      InvertMatrix(FInvAbsoluteMatrix);
    end;
    Exclude(FChanges, ocInvAbsoluteMatrix);
  end;
  Result := @FInvAbsoluteMatrix;
end;

function TgxBaseSceneObject.GetAbsoluteMatrix: TMatrix4f;
begin
  Result := AbsoluteMatrixAsAddress^;
end;

procedure TgxBaseSceneObject.SetAbsoluteMatrix(const Value: TMatrix4f);
begin
  if not MatrixEquals(Value, FAbsoluteMatrix) then
  begin
    FAbsoluteMatrix := Value;
    if Parent <> nil then
      SetMatrix(MatrixMultiply(FAbsoluteMatrix, Parent.InvAbsoluteMatrixAsAddress^))
    else
      SetMatrix(Value);
  end;
end;

function TgxBaseSceneObject.GetAbsoluteDirection: TVector4f;
begin
  Result := VectorNormalize(AbsoluteMatrixAsAddress^.z);
end;

procedure TgxBaseSceneObject.SetAbsoluteDirection(const v: TVector4f);
begin
  if Parent <> nil then
    Direction.AsVector := Parent.AbsoluteToLocal(v)
  else
    Direction.AsVector := v;
end;

function TgxBaseSceneObject.GetAbsoluteScale: TVector4f;
begin
  Result.x := AbsoluteMatrixAsAddress^.x.x;
  Result.y := AbsoluteMatrixAsAddress^.y.y;
  Result.z := AbsoluteMatrixAsAddress^.z.z;

  Result.W := 0;
end;

procedure TgxBaseSceneObject.SetAbsoluteScale(const Value: TVector4f);
begin
  if Parent <> nil then
    Scale.AsVector := Parent.AbsoluteToLocal(Value)
  else
    Scale.AsVector := Value;
end;

function TgxBaseSceneObject.GetAbsoluteUp: TVector4f;
begin
  Result := VectorNormalize(AbsoluteMatrixAsAddress^.y);
end;

procedure TgxBaseSceneObject.SetAbsoluteUp(const v: TVector4f);
begin
  if Parent <> nil then
    Up.AsVector := Parent.AbsoluteToLocal(v)
  else
    Up.AsVector := v;
end;

function TgxBaseSceneObject.AbsoluteRight: TVector4f;
begin
  Result := VectorNormalize(AbsoluteMatrixAsAddress^.x);
end;

function TgxBaseSceneObject.AbsoluteLeft: TVector4f;
begin
  Result := VectorNegate(AbsoluteRight);
end;

function TgxBaseSceneObject.GetAbsolutePosition: TVector4f;
begin
  Result := AbsoluteMatrixAsAddress^.W;
end;

procedure TgxBaseSceneObject.SetAbsolutePosition(const v: TVector4f);
begin
  if Assigned(Parent) then
    Position.AsVector := Parent.AbsoluteToLocal(v)
  else
    Position.AsVector := v;
end;

function TgxBaseSceneObject.AbsolutePositionAsAddress: PVector4f;
begin
  Result := @AbsoluteMatrixAsAddress^.W;
end;

function TgxBaseSceneObject.AbsoluteXVector: TVector4f;
begin
  AbsoluteMatrixAsAddress;
  SetVector(Result, PAffineVector(@FAbsoluteMatrix.x)^);
end;

function TgxBaseSceneObject.AbsoluteYVector: TVector4f;
begin
  AbsoluteMatrixAsAddress;
  SetVector(Result, PAffineVector(@FAbsoluteMatrix.y)^);
end;

function TgxBaseSceneObject.AbsoluteZVector: TVector4f;
begin
  AbsoluteMatrixAsAddress;
  SetVector(Result, PAffineVector(@FAbsoluteMatrix.z)^);
end;

function TgxBaseSceneObject.AbsoluteToLocal(const v: TVector4f): TVector4f;
begin
  Result := VectorTransform(v, InvAbsoluteMatrixAsAddress^);
end;

function TgxBaseSceneObject.AbsoluteToLocal(const v: TAffineVector): TAffineVector;
begin
  Result := VectorTransform(v, InvAbsoluteMatrixAsAddress^);
end;

function TgxBaseSceneObject.LocalToAbsolute(const v: TVector4f): TVector4f;
begin
  Result := VectorTransform(v, AbsoluteMatrixAsAddress^);
end;

function TgxBaseSceneObject.LocalToAbsolute(const v: TAffineVector): TAffineVector;
begin
  Result := VectorTransform(v, AbsoluteMatrixAsAddress^);
end;

function TgxBaseSceneObject.Right: TVector4f;
begin
  Result := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
end;

function TgxBaseSceneObject.LeftVector: TVector4f;
begin
  Result := VectorCrossProduct(FUp.AsVector, FDirection.AsVector);
end;

function TgxBaseSceneObject.BarycenterAbsolutePosition: TVector4f;
begin
  Result := AbsolutePosition;
end;

function TgxBaseSceneObject.SqrDistanceTo(anObject: TgxBaseSceneObject): Single;
begin
  if Assigned(anObject) then
    Result := VectorDistance2(AbsolutePosition, anObject.AbsolutePosition)
  else
    Result := 0;
end;

function TgxBaseSceneObject.SqrDistanceTo(const pt: TVector4f): Single;
begin
  Result := VectorDistance2(pt, AbsolutePosition);
end;

function TgxBaseSceneObject.DistanceTo(anObject: TgxBaseSceneObject): Single;
begin
  if Assigned(anObject) then
    Result := VectorDistance(AbsolutePosition, anObject.AbsolutePosition)
  else
    Result := 0;
end;

function TgxBaseSceneObject.DistanceTo(const pt: TVector4f): Single;
begin
  Result := VectorDistance(AbsolutePosition, pt);
end;

function TgxBaseSceneObject.BarycenterSqrDistanceTo(const pt: TVector4f): Single;
var
  d: TVector4f;
begin
  d := BarycenterAbsolutePosition;
  Result := VectorDistance2(d, pt);
end;

function TgxBaseSceneObject.AxisAlignedDimensions: TVector4f;
begin
  Result := AxisAlignedDimensionsUnscaled();
  ScaleVector(Result, Scale.AsVector);
end;

function TgxBaseSceneObject.AxisAlignedDimensionsUnscaled: TVector4f;
begin
  Result.x := 0.5;
  Result.y := 0.5;
  Result.z := 0.5;
  Result.W := 0;
end;

function TgxBaseSceneObject.AxisAlignedBoundingBox(const AIncludeChilden: Boolean): TAABB;
var
  i: Integer;
  aabb: TAABB;
  child: TgxBaseSceneObject;
begin
  SetAABB(Result, AxisAlignedDimensionsUnscaled);
  // not tested for child objects
  if AIncludeChilden then
  begin
    for i := 0 to FChildren.Count - 1 do
    begin
      child := TgxBaseSceneObject(FChildren.List^[i]);
      aabb := child.AxisAlignedBoundingBoxUnscaled(AIncludeChilden);
      AABBTransform(aabb, child.Matrix^);
      AddAABB(Result, aabb);
    end;
  end;
  AABBScale(Result, Scale.AsAffineVector);
end;

function TgxBaseSceneObject.AxisAlignedBoundingBoxUnscaled(const AIncludeChilden: Boolean): TAABB;
var
  i: Integer;
  aabb: TAABB;
begin
  SetAABB(Result, AxisAlignedDimensionsUnscaled);
  // not tested for child objects
  if AIncludeChilden then
  begin
    for i := 0 to FChildren.Count - 1 do
    begin
      aabb := TgxBaseSceneObject(FChildren.List^[i]).AxisAlignedBoundingBoxUnscaled(AIncludeChilden);
      AABBTransform(aabb, TgxBaseSceneObject(FChildren.List^[i]).Matrix^);
      AddAABB(Result, aabb);
    end;
  end;
end;

function TgxBaseSceneObject.AxisAlignedBoundingBoxAbsolute(const AIncludeChilden: Boolean;
  const AUseBaryCenter: Boolean): TAABB;
begin
  Result := BBToAABB(BoundingBoxAbsolute(AIncludeChilden, AUseBaryCenter));
end;

function TgxBaseSceneObject.BoundingBox(const AIncludeChilden: Boolean; const AUseBaryCenter: Boolean): THmgBoundingBox;
var
  CurrentBaryOffset: TVector4f;
begin
  Result := AABBToBB(AxisAlignedBoundingBox(AIncludeChilden));

  // DaStr: code not tested...
  if AUseBaryCenter then
  begin
    CurrentBaryOffset := VectorSubtract(AbsoluteToLocal(BarycenterAbsolutePosition), Position.AsVector);
    OffsetBBPoint(Result, CurrentBaryOffset);
  end;
end;

function TgxBaseSceneObject.BoundingBoxUnscaled(const AIncludeChilden: Boolean; const AUseBaryCenter: Boolean): THmgBoundingBox;
var
  CurrentBaryOffset: TVector4f;
begin
  Result := AABBToBB(AxisAlignedBoundingBoxUnscaled(AIncludeChilden));

  // DaStr: code not tested...
  if AUseBaryCenter then
  begin
    CurrentBaryOffset := VectorSubtract(AbsoluteToLocal(BarycenterAbsolutePosition), Position.AsVector);
    OffsetBBPoint(Result, CurrentBaryOffset);
  end;
end;

function TgxBaseSceneObject.BoundingBoxAbsolute(const AIncludeChilden: Boolean; const AUseBaryCenter: Boolean): THmgBoundingBox;
var
  i: Integer;
  CurrentBaryOffset: TVector4f;
begin
  Result := BoundingBoxUnscaled(AIncludeChilden, False);
  for i := 0 to 7 do
    Result.BBox[i] := LocalToAbsolute(Result.BBox[i]);

  if AUseBaryCenter then
  begin
    CurrentBaryOffset := VectorSubtract(BarycenterAbsolutePosition, AbsolutePosition);
    OffsetBBPoint(Result, CurrentBaryOffset);
  end;
end;

function TgxBaseSceneObject.BoundingSphereRadius: Single;
begin
  Result := VectorLength(AxisAlignedDimensions);
end;

function TgxBaseSceneObject.BoundingSphereRadiusUnscaled: Single;
begin
  Result := VectorLength(AxisAlignedDimensionsUnscaled);
end;

function TgxBaseSceneObject.PointInObject(const point: TVector4f): Boolean;
var
  localPt, dim: TVector4f;
begin
  dim := AxisAlignedDimensions;
  localPt := VectorTransform(point, InvAbsoluteMatrix);
  Result := (Abs(localPt.x * Scale.x) <= dim.x) and (Abs(localPt.y * Scale.y) <= dim.y) and (Abs(localPt.z * Scale.z) <= dim.z);
end;

procedure TgxBaseSceneObject.CalculateBoundingBoxPersonalUnscaled(var ANewBoundingBox: THmgBoundingBox);
begin
  // Using the standard method to get the local BB.
  ANewBoundingBox := AABBToBB(AxisAlignedBoundingBoxUnscaled(False));
  OffsetBBPoint(ANewBoundingBox, AbsoluteToLocal(BarycenterAbsolutePosition));
end;

function TgxBaseSceneObject.BoundingBoxPersonalUnscaledEx: THmgBoundingBox;
begin
  if oBBcStructure in FBBChanges then
  begin
    CalculateBoundingBoxPersonalUnscaled(FBoundingBoxPersonalUnscaled);
    Exclude(FBBChanges, oBBcStructure);
  end;
  Result := FBoundingBoxPersonalUnscaled;
end;

function TgxBaseSceneObject.AxisAlignedBoundingBoxAbsoluteEx: TAABB;
var
  pBB: THmgBoundingBox;
begin
  pBB := BoundingBoxIncludingChildrenEx;
  BBTransform(pBB, AbsoluteMatrix);
  Result := BBToAABB(pBB);
end;

function TgxBaseSceneObject.AxisAlignedBoundingBoxEx: TAABB;
begin
  Result := BBToAABB(BoundingBoxIncludingChildrenEx);
  AABBScale(Result, Scale.AsAffineVector);
end;

function TgxBaseSceneObject.BoundingBoxOfChildrenEx: THmgBoundingBox;
var
  i: Integer;
  pBB: THmgBoundingBox;
begin
  if oBBcChild in FBBChanges then
  begin
    // Computing
    FBoundingBoxOfChildren := NullBoundingBox;
    for i := 0 to FChildren.Count - 1 do
    begin
      pBB := TgxBaseSceneObject(FChildren.List^[i]).BoundingBoxIncludingChildrenEx;
      if not BoundingBoxesAreEqual(@pBB, @NullBoundingBox) then
      begin
        // transformation with local matrix
        BBTransform(pBB, TgxBaseSceneObject(FChildren.List^[i]).Matrix^);
        if BoundingBoxesAreEqual(@FBoundingBoxOfChildren, @NullBoundingBox) then
          FBoundingBoxOfChildren := pBB
        else
          AddBB(FBoundingBoxOfChildren, pBB);
      end;
    end;
    Exclude(FBBChanges, oBBcChild);
  end;
  Result := FBoundingBoxOfChildren;
end;

function TgxBaseSceneObject.BoundingBoxIncludingChildrenEx: THmgBoundingBox;
var
  pBB: THmgBoundingBox;
begin
  if (oBBcStructure in FBBChanges) or (oBBcChild in FBBChanges) then
  begin
    pBB := BoundingBoxPersonalUnscaledEx;
    if BoundingBoxesAreEqual(@pBB, @NullBoundingBox) then
      FBoundingBoxIncludingChildren := BoundingBoxOfChildrenEx
    else
    begin
      FBoundingBoxIncludingChildren := pBB;
      pBB := BoundingBoxOfChildrenEx;
      if not BoundingBoxesAreEqual(@pBB, @NullBoundingBox) then
        AddBB(FBoundingBoxIncludingChildren, pBB);
    end;
  end;
  Result := FBoundingBoxIncludingChildren;
end;

function TgxBaseSceneObject.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil;
  intersectNormal: PVector4f = nil): Boolean;
var
  i1, i2, absPos: TVector4f;
begin
  SetVector(absPos, AbsolutePosition);
  if RayCastSphereIntersect(rayStart, rayVector, absPos, BoundingSphereRadius, i1, i2) > 0 then
  begin
    Result := True;
    if Assigned(intersectPoint) then
      SetVector(intersectPoint^, i1);
    if Assigned(intersectNormal) then
    begin
      SubtractVector(i1, absPos);
      NormalizeVector(i1);
      SetVector(intersectNormal^, i1);
    end;
  end
  else
    Result := False;
end;

function TgxBaseSceneObject.GenerateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters): TgxSilhouette;
const
  cNbSegments = 21;
var
  i, j: Integer;
  d, r, vr, s, c, angleFactor: Single;
  sVec, tVec: TAffineVector;
begin
  r := BoundingSphereRadiusUnscaled;
  d := VectorLength(silhouetteParameters.SeenFrom);
  // determine visible radius
  case silhouetteParameters.Style of
    ssOmni:
      vr := SphereVisibleRadius(d, r);
    ssParallel:
      vr := r;
  else
    Assert(False);
    vr := r;
  end;
  // determine a local orthonormal matrix, viewer-oriented
  sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, XVector);
  if VectorLength(sVec) < 1E-3 then
    sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, YVector);
  tVec := VectorCrossProduct(silhouetteParameters.SeenFrom, sVec);
  NormalizeVector(sVec);
  NormalizeVector(tVec);
  // generate the silhouette (outline and capping)
  Result := TgxSilhouette.Create;
  angleFactor := (2 * PI) / cNbSegments;
  vr := vr * 0.98;
  for i := 0 to cNbSegments - 1 do
  begin
    SinCosine(i * angleFactor, vr, s, c);
    Result.Vertices.AddPoint(VectorCombine(sVec, tVec, s, c));
    j := (i + 1) mod cNbSegments;
    Result.Indices.Add(i, j);
    if silhouetteParameters.CappingRequired then
      Result.CapIndices.Add(cNbSegments, i, j)
  end;
  if silhouetteParameters.CappingRequired then
    Result.Vertices.Add(NullHmgPoint);
end;

procedure TgxBaseSceneObject.Assign(Source: TPersistent);
var
  i: Integer;
  child, newChild: TgxBaseSceneObject;
begin
  if Assigned(Source) and (Source is TgxBaseSceneObject) then
  begin
    DestroyHandles;
    FVisible := TgxBaseSceneObject(Source).FVisible;
    TgxBaseSceneObject(Source).RebuildMatrix;
    SetMatrix(TgxBaseSceneObject(Source).FLocalMatrix);
    FShowAxes := TgxBaseSceneObject(Source).FShowAxes;
    FObjectsSorting := TgxBaseSceneObject(Source).FObjectsSorting;
    FVisibilityCulling := TgxBaseSceneObject(Source).FVisibilityCulling;
    FRotation.Assign(TgxBaseSceneObject(Source).FRotation);
    DeleteChildren;
    if Assigned(Scene) then
      Scene.BeginUpdate;
    if Assigned(TgxBaseSceneObject(Source).FChildren) then
    begin
      for i := 0 to TgxBaseSceneObject(Source).FChildren.Count - 1 do
      begin
        child := TgxBaseSceneObject(TgxBaseSceneObject(Source).FChildren[i]);
        newChild := AddNewChild(TgxSceneObjectClass(child.ClassType));
        newChild.Assign(child);
      end;
    end;
    if Assigned(Scene) then
      Scene.EndUpdate;
    OnProgress := TgxBaseSceneObject(Source).OnProgress;
    if Assigned(TgxBaseSceneObject(Source).FBehaviours) then
      Behaviours.Assign(TgxBaseSceneObject(Source).Behaviours)
    else
      FreeAndNil(FBehaviours);
    if Assigned(TgxBaseSceneObject(Source).FEffects) then
      Effects.Assign(TgxBaseSceneObject(Source).Effects)
    else
      FreeAndNil(FEffects);
    Tag := TgxBaseSceneObject(Source).Tag;
    FTagFloat := TgxBaseSceneObject(Source).FTagFloat;
  end
  else
    inherited Assign(Source);
end;

function TgxBaseSceneObject.IsUpdating: Boolean;
begin
  Result := (FUpdateCount <> 0) or (csReading in ComponentState);
end;

function TgxBaseSceneObject.GetParentComponent: TComponent;
begin
  if FParent is TgxSceneRootObject then
    Result := FScene
  else
    Result := FParent;
end;

function TgxBaseSceneObject.HasParent: Boolean;
begin
  Result := Assigned(FParent);
end;

procedure TgxBaseSceneObject.Lift(ADistance: Single);
begin
  FPosition.AddScaledVector(ADistance, FUp.AsVector);
  TransformationChanged;
end;

procedure TgxBaseSceneObject.Move(ADistance: Single);
begin
  FPosition.AddScaledVector(ADistance, FDirection.AsVector);
  TransformationChanged;
end;

procedure TgxBaseSceneObject.Slide(ADistance: Single);
begin
  FPosition.AddScaledVector(ADistance, Right);
  TransformationChanged;
end;

procedure TgxBaseSceneObject.ResetRotations;
begin
  FillChar(FLocalMatrix, SizeOf(TMatrix4f), 0);
  FLocalMatrix.x.x := Scale.DirectX;
  FLocalMatrix.y.y := Scale.DirectY;
  FLocalMatrix.z.z := Scale.DirectZ;
  SetVector(FLocalMatrix.W, Position.DirectVector);
  FRotation.DirectVector := NullHmgPoint;
  FDirection.DirectVector := ZHmgVector;
  FUp.DirectVector := YHmgVector;
  TransformationChanged;
  Exclude(FChanges, ocTransformation);
end;

procedure TgxBaseSceneObject.ResetAndPitchTurnRoll(const degX, degY, degZ: Single);
var
  rotMatrix: TMatrix4f;
  v: TVector4f;
begin
  ResetRotations;
  // set DegX (Pitch)
  rotMatrix := CreateRotationMatrix(Right, degX * cPIdiv180);
  v := VectorTransform(FUp.AsVector, rotMatrix);
  NormalizeVector(v);
  FUp.DirectVector := v;
  v := VectorTransform(FDirection.AsVector, rotMatrix);
  NormalizeVector(v);
  FDirection.DirectVector := v;
  FRotation.DirectX := NormalizeDegAngle(degX);
  // set DegY (Turn)
  rotMatrix := CreateRotationMatrix(FUp.AsVector, degY * cPIdiv180);
  v := VectorTransform(FUp.AsVector, rotMatrix);
  NormalizeVector(v);
  FUp.DirectVector := v;
  v := VectorTransform(FDirection.AsVector, rotMatrix);
  NormalizeVector(v);
  FDirection.DirectVector := v;
  FRotation.DirectY := NormalizeDegAngle(degY);
  // set DegZ (Roll)
  rotMatrix := CreateRotationMatrix(Direction.AsVector, degZ * cPIdiv180);
  v := VectorTransform(FUp.AsVector, rotMatrix);
  NormalizeVector(v);
  FUp.DirectVector := v;
  v := VectorTransform(FDirection.AsVector, rotMatrix);
  NormalizeVector(v);
  FDirection.DirectVector := v;
  FRotation.DirectZ := NormalizeDegAngle(degZ);
  TransformationChanged;
  NotifyChange(Self);
end;

procedure TgxBaseSceneObject.RotateAbsolute(const rx, ry, rz: Single);
var
  resMat: TMatrix4f;
  v: TAffineVector;
begin
  resMat := Matrix^;
  // No we build rotation matrices and use them to rotate the obj
  if rx <> 0 then
  begin
    SetVector(v, AbsoluteToLocal(XVector));
    resMat := MatrixMultiply(CreateRotationMatrix(v, -DegToRadian(rx)), resMat);
  end;
  if ry <> 0 then
  begin
    SetVector(v, AbsoluteToLocal(YVector));
    resMat := MatrixMultiply(CreateRotationMatrix(v, -DegToRadian(ry)), resMat);
  end;
  if rz <> 0 then
  begin
    SetVector(v, AbsoluteToLocal(ZVector));
    resMat := MatrixMultiply(CreateRotationMatrix(v, -DegToRadian(rz)), resMat);
  end;
  SetMatrix(resMat);
end;

procedure TgxBaseSceneObject.RotateAbsolute(const axis: TAffineVector; angle: Single);
var
  v: TAffineVector;
begin
  if angle <> 0 then
  begin
    SetVector(v, AbsoluteToLocal(axis));
    SetMatrix(MatrixMultiply(CreateRotationMatrix(v, DegToRadian(angle)), Matrix^));
  end;
end;

procedure TgxBaseSceneObject.Pitch(angle: Single);
var
  r: Single;
  rightVector: TVector4f;
begin
  FIsCalculating := True;
  try
    angle := -DegToRad(angle);
    rightVector := Right;
    FUp.Rotate(rightVector, angle);
    FUp.Normalize;
    FDirection.Rotate(rightVector, angle);
    FDirection.Normalize;
    r := -RadToDeg(ArcTan2(FDirection.y, VectorLength(FDirection.x, FDirection.z)));
    if FDirection.x < 0 then
      if FDirection.y < 0 then
        r := 180 - r
      else
        r := -180 - r;
    FRotation.x := r;
  finally
    FIsCalculating := False;
  end;
  TransformationChanged;
end;

procedure TgxBaseSceneObject.SetPitchAngle(aValue: Single);
var
  diff: Single;
  rotMatrix: TMatrix4f;
begin
  if aValue <> FRotation.x then
  begin
    if not(csLoading in ComponentState) then
    begin
      FIsCalculating := True;
      // try
      diff := DegToRadian(FRotation.x - aValue);
      rotMatrix := CreateRotationMatrix(Right, diff);
      FUp.DirectVector := VectorTransform(FUp.AsVector, rotMatrix);
      FUp.Normalize;
      FDirection.DirectVector := VectorTransform(FDirection.AsVector, rotMatrix);
      FDirection.Normalize;
      TransformationChanged;
      // finally
      FIsCalculating := False;
      // end;
    end;
    FRotation.DirectX := NormalizeDegAngle(aValue);
  end;
end;

// Roll
//

procedure TgxBaseSceneObject.Roll(angle: Single);
var
  r: Single;
  rightVector, directionVector: TVector4f;
begin
  FIsCalculating := True;
  try
    angle := DegToRadian(angle);
    directionVector := Direction.AsVector;
    FUp.Rotate(directionVector, angle);
    FUp.Normalize;
    FDirection.Rotate(directionVector, angle);
    FDirection.Normalize;

    // calculate new rotation angle from vectors
    rightVector := Right;
    r := -RadToDeg(ArcTan2(rightVector.y, VectorLength(rightVector.x, rightVector.z)));
    if rightVector.x < 0 then
      if rightVector.y < 0 then
        r := 180 - r
      else
        r := -180 - r;
    FRotation.z := r;
  finally
    FIsCalculating := False;
  end;
  TransformationChanged;
end;

procedure TgxBaseSceneObject.SetRollAngle(aValue: Single);
var
  diff: Single;
  rotMatrix: TMatrix4f;
begin
  if aValue <> FRotation.z then
  begin
    if not(csLoading in ComponentState) then
    begin
      FIsCalculating := True;
      // try
      diff := DegToRadian(FRotation.z - aValue);
      rotMatrix := CreateRotationMatrix(Direction.AsVector, diff);
      FUp.DirectVector := VectorTransform(FUp.AsVector, rotMatrix);
      FUp.Normalize;
      FDirection.DirectVector := VectorTransform(FDirection.AsVector, rotMatrix);
      FDirection.Normalize;
      TransformationChanged;
      // finally
      FIsCalculating := False;
      // end;
    end;
    FRotation.DirectZ := NormalizeDegAngle(aValue);
  end;
end;

procedure TgxBaseSceneObject.Turn(angle: Single);
var
  r: Single;
  upVector: TVector4f;
begin
  FIsCalculating := True;
  try
    angle := DegToRadian(angle);
    upVector := Up.AsVector;
    FUp.Rotate(upVector, angle);
    FUp.Normalize;
    FDirection.Rotate(upVector, angle);
    FDirection.Normalize;
    r := -RadToDeg(ArcTan2(FDirection.x, VectorLength(FDirection.y, FDirection.z)));
    if FDirection.x < 0 then
      if FDirection.y < 0 then
        r := 180 - r
      else
        r := -180 - r;
    FRotation.y := r;
  finally
    FIsCalculating := False;
  end;
  TransformationChanged;
end;

procedure TgxBaseSceneObject.SetTurnAngle(aValue: Single);
var
  diff: Single;
  rotMatrix: TMatrix4f;
begin
  if aValue <> FRotation.y then
  begin
    if not(csLoading in ComponentState) then
    begin
      FIsCalculating := True;
      // try
      diff := DegToRadian(FRotation.y - aValue);
      rotMatrix := CreateRotationMatrix(Up.AsVector, diff);
      FUp.DirectVector := VectorTransform(FUp.AsVector, rotMatrix);
      FUp.Normalize;
      FDirection.DirectVector := VectorTransform(FDirection.AsVector, rotMatrix);
      FDirection.Normalize;
      TransformationChanged;
      // finally
      FIsCalculating := False;
      // end;
    end;
    FRotation.DirectY := NormalizeDegAngle(aValue);
  end;
end;

procedure TgxBaseSceneObject.SetRotation(aRotation: TgxCoordinates);
begin
  FRotation.Assign(aRotation);
  TransformationChanged;
end;

function TgxBaseSceneObject.GetPitchAngle: Single;
begin
  Result := FRotation.x;
end;

function TgxBaseSceneObject.GetTurnAngle: Single;
begin
  Result := FRotation.y;
end;

function TgxBaseSceneObject.GetRollAngle: Single;
begin
  Result := FRotation.z;
end;

procedure TgxBaseSceneObject.PointTo(const ATargetObject: TgxBaseSceneObject; const AUpVector: TVector4f);
begin
  PointTo(ATargetObject.AbsolutePosition, AUpVector);
end;

procedure TgxBaseSceneObject.PointTo(const AAbsolutePosition, AUpVector: TVector4f);
var
  absDir, absRight, absUp: TVector4f;
begin
  // first compute absolute attitude for pointing
  absDir := VectorSubtract(AAbsolutePosition, Self.AbsolutePosition);
  NormalizeVector(absDir);
  absRight := VectorCrossProduct(absDir, AUpVector);
  NormalizeVector(absRight);
  absUp := VectorCrossProduct(absRight, absDir);
  // convert absolute to local and adjust object
  if Parent <> nil then
  begin
    FDirection.AsVector := Parent.AbsoluteToLocal(absDir);
    FUp.AsVector := Parent.AbsoluteToLocal(absUp);
  end
  else
  begin
    FDirection.AsVector := absDir;
    FUp.AsVector := absUp;
  end;
  TransformationChanged
end;

procedure TgxBaseSceneObject.SetShowAxes(aValue: Boolean);
begin
  if FShowAxes <> aValue then
  begin
    FShowAxes := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.SetScaling(aValue: TgxCoordinates);
begin
  FScaling.Assign(aValue);
  TransformationChanged;
end;

procedure TgxBaseSceneObject.SetName(const NewName: TComponentName);
begin
  if Name <> NewName then
  begin
    inherited SetName(NewName);
    if Assigned(vBaseSceneObjectNameChangeEvent) then
      vBaseSceneObjectNameChangeEvent(Self);
  end;
end;

procedure TgxBaseSceneObject.SetParent(const val: TgxBaseSceneObject);
begin
  MoveTo(val);
end;

function TgxBaseSceneObject.GetIndex: Integer;
begin
  if Assigned(FParent) then
    Result := FParent.FChildren.IndexOf(Self)
  else
    Result := -1;
end;

function TgxBaseSceneObject.GetLocalMatrix: PMatrix4f;
begin
  Result := @FLocalMatrix;
end;

procedure TgxBaseSceneObject.SetIndex(aValue: Integer);
var
  LCount: Integer;
  parentBackup: TgxBaseSceneObject;
begin
  if Assigned(FParent) then
  begin
    if aValue < 0 then
      aValue := 0;
    LCount := FParent.Count;
    if aValue >= LCount then
      aValue := LCount - 1;
    if aValue <> Index then
    begin
      if Assigned(FScene) then
        FScene.BeginUpdate;
      parentBackup := FParent;
      parentBackup.Remove(Self, False);
      parentBackup.Insert(aValue, Self);
      if Assigned(FScene) then
        FScene.EndUpdate;
    end;
  end;
end;

procedure TgxBaseSceneObject.SetParentComponent(Value: TComponent);
begin
  inherited;
  if Value = FParent then
    Exit;

  if Value is TgxScene then
    SetParent(TgxScene(Value).Objects)
  else if Value is TgxBaseSceneObject then
    SetParent(TgxBaseSceneObject(Value))
  else
    SetParent(nil);
end;

procedure TgxBaseSceneObject.StructureChanged;
begin
  if not(ocStructure in FChanges) then
  begin
    Include(FChanges, ocStructure);
    NotifyChange(Self);
  end
  else if osDirectDraw in ObjectStyle then
    NotifyChange(Self);
end;

procedure TgxBaseSceneObject.ClearStructureChanged;
begin
  Exclude(FChanges, ocStructure);
  SetBBChanges(BBChanges + [oBBcStructure]);
end;

procedure TgxBaseSceneObject.RecTransformationChanged;
var
  i: Integer;
  List: PgxPointerObjectList;
  matSet: TgxObjectChanges;
begin
  matSet := [ocAbsoluteMatrix, ocInvAbsoluteMatrix];
  if matSet * FChanges <> matSet then
  begin
    FChanges := FChanges + matSet;
    List := FChildren.List;
    for i := 0 to FChildren.Count - 1 do
      TgxBaseSceneObject(List^[i]).RecTransformationChanged;
  end;
end;

procedure TgxBaseSceneObject.TransformationChanged;
begin
  if not(ocTransformation in FChanges) then
  begin
    Include(FChanges, ocTransformation);
    RecTransformationChanged;
    if not(csLoading in ComponentState) then
      NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.MoveTo(newParent: TgxBaseSceneObject);
begin
  if newParent = FParent then
    Exit;
  if Assigned(FParent) then
  begin
    FParent.Remove(Self, False);
    FParent := nil;
  end;
  if Assigned(newParent) then
    newParent.AddChild(Self)
  else
    SetScene(nil);
end;

procedure TgxBaseSceneObject.MoveUp;
begin
  if Assigned(Parent) then
    Parent.MoveChildUp(Parent.IndexOfChild(Self));
end;

procedure TgxBaseSceneObject.MoveDown;
begin
  if Assigned(Parent) then
    Parent.MoveChildDown(Parent.IndexOfChild(Self));
end;

procedure TgxBaseSceneObject.MoveFirst;
begin
  if Assigned(Parent) then
    Parent.MoveChildFirst(Parent.IndexOfChild(Self));
end;

procedure TgxBaseSceneObject.MoveLast;
begin
  if Assigned(Parent) then
    Parent.MoveChildLast(Parent.IndexOfChild(Self));
end;

procedure TgxBaseSceneObject.MoveObjectAround(anObject: TgxBaseSceneObject; pitchDelta, turnDelta: Single);
var
  originalT2C, normalT2C, normalCameraRight, newPos: TVector4f;
  pitchNow, dist: Single;
begin
  if Assigned(anObject) then
  begin
    // normalT2C points away from the direction the camera is looking
    originalT2C := VectorSubtract(AbsolutePosition, anObject.AbsolutePosition);
    SetVector(normalT2C, originalT2C);
    dist := VectorLength(normalT2C);
    NormalizeVector(normalT2C);
    // normalRight points to the camera's right
    // the camera is pitching around this axis.
    normalCameraRight := VectorCrossProduct(AbsoluteUp, normalT2C);
    if VectorLength(normalCameraRight) < 0.001 then
      SetVector(normalCameraRight, XVector) // arbitrary vector
    else
      NormalizeVector(normalCameraRight);
    // calculate the current pitch.
    // 0 is looking down and PI is looking up
    pitchNow := ArcCos(VectorDotProduct(AbsoluteUp, normalT2C));
    pitchNow := ClampValue(pitchNow + DegToRad(pitchDelta), 0 + 0.025, PI - 0.025);
    // creates a new vector pointing up and then rotate it down
    // into the new position
    SetVector(normalT2C, AbsoluteUp);
    RotateVector(normalT2C, normalCameraRight, -pitchNow);
    RotateVector(normalT2C, AbsoluteUp, -DegToRadian(turnDelta));
    ScaleVector(normalT2C, dist);
    newPos := VectorAdd(AbsolutePosition, VectorSubtract(normalT2C, originalT2C));
    if Assigned(Parent) then
      newPos := Parent.AbsoluteToLocal(newPos);
    Position.AsVector := newPos;
  end;
end;

procedure TgxBaseSceneObject.MoveObjectAllAround(anObject: TgxBaseSceneObject; pitchDelta, turnDelta: Single);
var
  upVector: TVector4f;
  lookat: TVector4f;
  rightVector: TVector4f;
  tempvector: TVector4f;
  T2C: TVector4f;

begin

  // if camera has got a target
  if Assigned(anObject) then
  begin
    // vector camera to target
    lookat := VectorNormalize(VectorSubtract(anObject.AbsolutePosition, AbsolutePosition));
    // camera up vector
    upVector := VectorNormalize(AbsoluteUp);

    // if upvector and lookat vector are colinear, it is necessary to compute new up vector
    if Abs(VectorDotProduct(lookat, upVector)) > 0.99 then
    begin
      // X or Y vector use to generate upvector
      SetVector(tempvector, 1, 0, 0);
      // if lookat is colinear to X vector use Y vector to generate upvector
      if Abs(VectorDotProduct(tempvector, lookat)) > 0.99 then
      begin
        SetVector(tempvector, 0, 1, 0);
      end;
      upVector := VectorCrossProduct(tempvector, lookat);
      rightVector := VectorCrossProduct(lookat, upVector);
    end
    else
    begin
      rightVector := VectorCrossProduct(lookat, upVector);
      upVector := VectorCrossProduct(rightVector, lookat);
    end;
    // now the up right and lookat vector are orthogonal

    // vector Target to camera
    T2C := VectorSubtract(AbsolutePosition, anObject.AbsolutePosition);
    RotateVector(T2C, rightVector, DegToRadian(-pitchDelta));
    RotateVector(T2C, upVector, DegToRadian(-turnDelta));
    AbsolutePosition := VectorAdd(anObject.AbsolutePosition, T2C);

    // now update new up vector
    RotateVector(upVector, rightVector, DegToRadian(-pitchDelta));
    AbsoluteUp := upVector;
    AbsoluteDirection := VectorSubtract(anObject.AbsolutePosition, AbsolutePosition);

  end;
end;

procedure TgxBaseSceneObject.CoordinateChanged(Sender: TgxCustomCoordinates);
var
  rightVector: TVector4f;
begin
  if FIsCalculating then
    Exit;
  FIsCalculating := True;
  try
    if Sender = FDirection then
    begin
      if FDirection.VectorLength = 0 then
        FDirection.DirectVector := ZHmgVector;
      FDirection.Normalize;
      // adjust up vector
      rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
      // Rightvector is zero if direction changed exactly by 90 degrees,
      // in this case assume a default vector
      if VectorLength(rightVector) < 1E-5 then
      begin
        rightVector := VectorCrossProduct(ZHmgVector, FUp.AsVector);
        if VectorLength(rightVector) < 1E-5 then
          rightVector := VectorCrossProduct(XHmgVector, FUp.AsVector);
      end;
      FUp.DirectVector := VectorCrossProduct(rightVector, FDirection.AsVector);
      FUp.Normalize;
    end
    else if Sender = FUp then
    begin
      if FUp.VectorLength = 0 then
        FUp.DirectVector := YHmgVector;
      FUp.Normalize;
      // adjust up vector
      rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
      // Rightvector is zero if direction changed exactly by 90 degrees,
      // in this case assume a default vector
      if VectorLength(rightVector) < 1E-5 then
      begin
        rightVector := VectorCrossProduct(ZHmgVector, FUp.AsVector);
        if VectorLength(rightVector) < 1E-5 then
          rightVector := VectorCrossProduct(XHmgVector, FUp.AsVector);
      end;
      FDirection.DirectVector := VectorCrossProduct(FUp.AsVector, rightVector);
      FDirection.Normalize;
    end;
    TransformationChanged;
  finally
    FIsCalculating := False;
  end;
end;

procedure TgxBaseSceneObject.DoProgress(const progressTime: TgxProgressTimes);
var
  i: Integer;
begin
  for i := FChildren.Count - 1 downto 0 do
    TgxBaseSceneObject(FChildren.List^[i]).DoProgress(progressTime);
  if Assigned(FBehaviours) then
    FBehaviours.DoProgress(progressTime);
  if Assigned(FEffects) then
    FEffects.DoProgress(progressTime);
  if Assigned(FOnProgress) then
    with progressTime do
      FOnProgress(Self, deltaTime, newTime);
end;

procedure TgxBaseSceneObject.Insert(AIndex: Integer; AChild: TgxBaseSceneObject);
begin
  with FChildren do
  begin
    if Assigned(AChild.FParent) then
      AChild.FParent.Remove(AChild, False);
    Insert(AIndex, AChild);
  end;
  AChild.FParent := Self;
  if AChild.FScene <> FScene then
    AChild.DestroyHandles;
  AChild.SetScene(FScene);
  if Assigned(FScene) then
    FScene.AddLights(AChild);
  AChild.TransformationChanged;

  AChild.DoOnAddedToParent;
end;

procedure TgxBaseSceneObject.Remove(AChild: TgxBaseSceneObject; keepChildren: Boolean);
var
  i: Integer;
begin
  if not Assigned(FChildren) then
    Exit;
  if AChild.Parent = Self then
  begin
    if Assigned(FScene) then
      FScene.RemoveLights(AChild);
    if AChild.Owner = Self then
      RemoveComponent(AChild);
    FChildren.Remove(AChild);
    AChild.FParent := nil;
    if keepChildren then
    begin
      BeginUpdate;
      if AChild.Count <> 0 then
        for i := AChild.Count - 1 downto 0 do
          if not IsSubComponent(AChild.Children[i]) then
            AChild.Children[i].MoveTo(Self);
      EndUpdate;
    end
    else
      NotifyChange(Self);
  end;
end;

function TgxBaseSceneObject.IndexOfChild(AChild: TgxBaseSceneObject): Integer;
begin
  Result := FChildren.IndexOf(AChild)
end;

function TgxBaseSceneObject.FindChild(const aName: string; ownChildrenOnly: Boolean): TgxBaseSceneObject;
var
  i: Integer;
  res: TgxBaseSceneObject;
begin
  res := nil;
  Result := nil;
  for i := 0 to FChildren.Count - 1 do
  begin
    if CompareText(TgxBaseSceneObject(FChildren[i]).Name, aName) = 0 then
    begin
      res := TgxBaseSceneObject(FChildren[i]);
      Break;
    end;
  end;
  if not ownChildrenOnly then
  begin
    for i := 0 to FChildren.Count - 1 do
      with TgxBaseSceneObject(FChildren[i]) do
      begin
        Result := FindChild(aName, ownChildrenOnly);
        if Assigned(Result) then
          Break;
      end;
  end;
  if not Assigned(Result) then
    Result := res;
end;

procedure TgxBaseSceneObject.ExchangeChildren(anIndex1, anIndex2: Integer);
begin
  Assert(Assigned(FChildren), 'No children found!');
  FChildren.Exchange(anIndex1, anIndex2);
  NotifyChange(Self);
end;

procedure TgxBaseSceneObject.ExchangeChildrenSafe(anIndex1, anIndex2: Integer);
begin
  Assert(Assigned(FChildren), 'No children found!');
  if (anIndex1 < FChildren.Count) and (anIndex2 < FChildren.Count) and (anIndex1 > -1) and (anIndex2 > -1) and
    (anIndex1 <> anIndex2) then
  begin
    FChildren.Exchange(anIndex1, anIndex2);
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.MoveChildUp(anIndex: Integer);
begin
  Assert(Assigned(FChildren), 'No children found!');
  if anIndex > 0 then
  begin
    FChildren.Exchange(anIndex, anIndex - 1);
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.MoveChildDown(anIndex: Integer);
begin
  Assert(Assigned(FChildren), 'No children found!');
  if anIndex < FChildren.Count - 1 then
  begin
    FChildren.Exchange(anIndex, anIndex + 1);
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.MoveChildFirst(anIndex: Integer);
begin
  Assert(Assigned(FChildren), 'No children found!');
  if anIndex <> 0 then
  begin
    FChildren.Move(anIndex, 0);
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.MoveChildLast(anIndex: Integer);
begin
  Assert(Assigned(FChildren), 'No children found!');
  if anIndex <> FChildren.Count - 1 then
  begin
    FChildren.Move(anIndex, FChildren.Count - 1);
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.Render(var ARci: TgxRenderContextInfo);
var
  shouldRenderSelf, shouldRenderChildren: Boolean;
  aabb: TAABB;
  master: TObject;
begin
{$IFDEF USE_OPENGL_DEBUG}
  if GL_GREMEDY_string_marker then
    GL_StringMarkerGREMEDY(Length(Name) + Length('.Render'), PGLChar(String(Name + '.Render')));
{$ENDIF}
  if (ARci.drawState = dsPicking) and not FPickable then
    Exit;
  // visibility culling determination
  if ARci.VisibilityCulling in [vcObjectBased, vcHierarchical] then
  begin
    if ARci.VisibilityCulling = vcObjectBased then
    begin
      shouldRenderSelf := (osNoVisibilityCulling in ObjectStyle) or
        (not IsVolumeClipped(BarycenterAbsolutePosition, BoundingSphereRadius, ARci.rcci.frustum));
      shouldRenderChildren := Assigned(FChildren);
    end
    else
    begin // vcHierarchical
      aabb := AxisAlignedBoundingBox;
      shouldRenderSelf := (osNoVisibilityCulling in ObjectStyle) or
        (not IsVolumeClipped(aabb.min, aabb.max, ARci.rcci.frustum));
      shouldRenderChildren := shouldRenderSelf and Assigned(FChildren);
    end;
    if not(shouldRenderSelf or shouldRenderChildren) then
      Exit;
  end
  else
  begin
    Assert(ARci.VisibilityCulling in [vcNone, vcInherited], 'Unknown visibility culling option');
    shouldRenderSelf := True;
    shouldRenderChildren := FChildren.Count > 0;
  end;

  // Prepare Matrix and PickList stuff
  ARci.PipeLineTransformation.Push;

  if ocTransformation in FChanges then
    RebuildMatrix;

  if ARci.proxySubObject then
    ARci.PipeLineTransformation.SetModelMatrix(MatrixMultiply(LocalMatrix^, ARci.PipeLineTransformation.ModelMatrix^))
  else
    ARci.PipeLineTransformation.SetModelMatrix(AbsoluteMatrix);

  master := nil;
  if ARci.drawState = dsPicking then
  begin
    if ARci.proxySubObject then
      master := TgxSceneBuffer(ARci.Buffer).FSelector.CurrentObject;
    TgxSceneBuffer(ARci.Buffer).FSelector.CurrentObject := Self;
  end;

  // Start rendering
  if shouldRenderSelf then
  begin
    vCurrentRenderingObject := Self;
{$IFNDEF USE_OPTIMIZATIONS}
    if FShowAxes then
      DrawAxes(ARci, $CCCC);
{$ENDIF}
    if Assigned(FEffects) and (FEffects.Count > 0) then
    begin
      ARci.PipeLineTransformation.Push;
      FEffects.RenderPreEffects(ARci);
      ARci.PipeLineTransformation.Pop;

      ARci.PipeLineTransformation.Push;
      if osIgnoreDepthBuffer in ObjectStyle then
      begin
        ARci.gxStates.Disable(stDepthTest);
        DoRender(ARci, True, shouldRenderChildren);
        ARci.gxStates.Enable(stDepthTest);
      end
      else
        DoRender(ARci, True, shouldRenderChildren);

      FEffects.RenderPostEffects(ARci);
      ARci.PipeLineTransformation.Pop;
    end
    else
    begin
      if osIgnoreDepthBuffer in ObjectStyle then
      begin
        ARci.gxStates.Disable(stDepthTest);
        DoRender(ARci, True, shouldRenderChildren);
        ARci.gxStates.Enable(stDepthTest);
      end
      else
        DoRender(ARci, True, shouldRenderChildren);
    end;
    vCurrentRenderingObject := nil;
  end
  else
  begin
    if (osIgnoreDepthBuffer in ObjectStyle) and TgxSceneBuffer(ARci.Buffer).DepthTest then
    begin
      ARci.gxStates.Disable(stDepthTest);
      DoRender(ARci, False, shouldRenderChildren);
      ARci.gxStates.Enable(stDepthTest);
    end
    else
      DoRender(ARci, False, shouldRenderChildren);
  end;
  // Pop Name & Matrix
  if Assigned(master) then
    TgxSceneBuffer(ARci.Buffer).FSelector.CurrentObject := master;
  ARci.PipeLineTransformation.Pop;
end;

procedure TgxBaseSceneObject.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  // start rendering self
  if ARenderSelf then
  begin
    if (osDirectDraw in ObjectStyle) or ARci.amalgamating then
      BuildList(ARci)
    else
      ARci.gxStates.CallList(GetHandle(ARci));
  end;
  // start rendering children (if any)
  if ARenderChildren then
    Self.RenderChildren(0, Count - 1, ARci);
end;

procedure TgxBaseSceneObject.RenderChildren(firstChildIndex, lastChildIndex: Integer; var rci: TgxRenderContextInfo);
var
  i: Integer;

  plist: PgxPointerObjectList;
  obj: TgxBaseSceneObject;
  oldSorting: TgxObjectsSorting;
  oldCulling: TgxVisibilityCulling;
begin

  oldCulling := rci.VisibilityCulling;
  if Self.VisibilityCulling <> vcInherited then
    rci.VisibilityCulling := Self.VisibilityCulling;
  if lastChildIndex = firstChildIndex then
  begin
    obj := TgxBaseSceneObject(FChildren.List^[firstChildIndex]);
    if obj.Visible then
      obj.Render(rci)
  end
  else if lastChildIndex > firstChildIndex then
  begin
    oldSorting := rci.ObjectsSorting;
    if Self.ObjectsSorting <> osInherited then
      rci.ObjectsSorting := Self.ObjectsSorting;
    case rci.ObjectsSorting of
      osNone:
        begin
          plist := FChildren.List;
          for i := firstChildIndex to lastChildIndex do
          begin
            obj := TgxBaseSceneObject(plist^[i]);
            if obj.Visible then
              obj.Render(rci);
          end;
        end;
      osRenderFarthestFirst, osRenderBlendedLast, osRenderNearestFirst:
        begin
          distList.Flush;
          objList.Count := 0;
          distList.GrowthDelta := lastChildIndex + 1; // no reallocations
          objList.GrowthDelta := distList.GrowthDelta;
          // try
          case rci.ObjectsSorting of
            osRenderBlendedLast:
              // render opaque stuff
              for i := firstChildIndex to lastChildIndex do
              begin
                obj := TgxBaseSceneObject(FChildren.List^[i]);
                if obj.Visible then
                begin
                  if not obj.Blended then
                    obj.Render(rci)
                  else
                  begin
                    objList.Add(obj);
                    distList.Add(1 + obj.BarycenterSqrDistanceTo(rci.cameraPosition));
                  end;
                end;
              end;
            osRenderFarthestFirst:
              for i := firstChildIndex to lastChildIndex do
              begin
                obj := TgxBaseSceneObject(FChildren.List^[i]);
                if obj.Visible then
                begin
                  objList.Add(obj);
                  distList.Add(1 + obj.BarycenterSqrDistanceTo(rci.cameraPosition));
                end;
              end;
            osRenderNearestFirst:
              for i := firstChildIndex to lastChildIndex do
              begin
                obj := TgxBaseSceneObject(FChildren.List^[i]);
                if obj.Visible then
                begin
                  objList.Add(obj);
                  distList.Add(-1 - obj.BarycenterSqrDistanceTo(rci.cameraPosition));
                end;
              end;
          else
            Assert(False);
          end;
          if distList.Count > 0 then
          begin
            if distList.Count > 1 then
              FastQuickSortLists(0, distList.Count - 1, distList, objList);
            plist := objList.List;
            for i := objList.Count - 1 downto 0 do
              TgxBaseSceneObject(plist^[i]).Render(rci);
          end;
          // finally
          // end;
        end;
    else
      Assert(False);
    end;
    rci.ObjectsSorting := oldSorting;
  end;
  rci.VisibilityCulling := oldCulling;
end;

procedure TgxBaseSceneObject.NotifyChange(Sender: TObject);
begin
  if Assigned(FScene) and (not IsUpdating) then
    FScene.NotifyChange(Self);
end;

function TgxBaseSceneObject.GetMatrix: PMatrix4f;
begin
  RebuildMatrix;
  Result := @FLocalMatrix;
end;

procedure TgxBaseSceneObject.SetMatrix(const aValue: TMatrix4f);
begin
  FLocalMatrix := aValue;
  FDirection.DirectVector := VectorNormalize(FLocalMatrix.z);
  FUp.DirectVector := VectorNormalize(FLocalMatrix.y);
  Scale.SetVector(VectorLength(FLocalMatrix.x), VectorLength(FLocalMatrix.y), VectorLength(FLocalMatrix.z), 0);
  FPosition.DirectVector := FLocalMatrix.W;
  TransformationChanged;
end;

procedure TgxBaseSceneObject.SetPosition(APosition: TgxCoordinates);
begin
  FPosition.SetPoint(APosition.DirectX, APosition.DirectY, APosition.DirectZ);
end;

procedure TgxBaseSceneObject.SetDirection(AVector: TgxCoordinates);
begin
  if not VectorIsNull(AVector.DirectVector) then
    FDirection.SetVector(AVector.DirectX, AVector.DirectY, AVector.DirectZ);
end;

procedure TgxBaseSceneObject.SetUp(AVector: TgxCoordinates);
begin
  if not VectorIsNull(AVector.DirectVector) then
    FUp.SetVector(AVector.DirectX, AVector.DirectY, AVector.DirectZ);
end;

function TgxBaseSceneObject.GetVisible: Boolean;
begin
  Result := FVisible;
end;

function TgxBaseSceneObject.GetPickable: Boolean;
begin
  Result := FPickable;
end;

procedure TgxBaseSceneObject.SetVisible(aValue: Boolean);
begin
  if FVisible <> aValue then
  begin
    FVisible := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.SetPickable(aValue: Boolean);
begin
  if FPickable <> aValue then
  begin
    FPickable := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.SetObjectsSorting(const val: TgxObjectsSorting);
begin
  if FObjectsSorting <> val then
  begin
    FObjectsSorting := val;
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.SetVisibilityCulling(const val: TgxVisibilityCulling);
begin
  if FVisibilityCulling <> val then
  begin
    FVisibilityCulling := val;
    NotifyChange(Self);
  end;
end;

procedure TgxBaseSceneObject.SetBehaviours(const val: TgxBehaviours);
begin
  Behaviours.Assign(val);
end;

function TgxBaseSceneObject.GetBehaviours: TgxBehaviours;
begin
  if not Assigned(FBehaviours) then
    FBehaviours := TgxBehaviours.Create(Self);
  Result := FBehaviours;
end;

procedure TgxBaseSceneObject.SetEffects(const val: TgxEffects);
begin
  Effects.Assign(val);
end;

function TgxBaseSceneObject.GetEffects: TgxEffects;
begin
  if not Assigned(FEffects) then
    FEffects := TgxEffects.Create(Self);
  Result := FEffects;
end;

procedure TgxBaseSceneObject.SetScene(const Value: TgxScene);
var
  i: Integer;
begin
  if Value <> FScene then
  begin
    // must be freed, the new scene may be using a non-compatible RC
    if FScene <> nil then
      DestroyHandles;
    FScene := Value;
    // propagate for childs
    if Assigned(FChildren) then
      for i := 0 to FChildren.Count - 1 do
        Children[i].SetScene(FScene);
  end;
end;

procedure TgxBaseSceneObject.Translate(tx, ty, tz: Single);
begin
  FPosition.Translate(AffineVectorMake(tx, ty, tz));
end;

function TgxBaseSceneObject.GetAbsoluteAffinePosition: TAffineVector;
var
  temp: TVector4f;
begin
  temp := GetAbsolutePosition;
  Result := AffineVectorMake(temp.x, temp.y, temp.z);
end;

function TgxBaseSceneObject.GetAbsoluteAffineDirection: TAffineVector;
var
  temp: TVector4f;
begin
  temp := GetAbsoluteDirection;
  Result := AffineVectorMake(temp.x, temp.y, temp.z);
end;

function TgxBaseSceneObject.GetAbsoluteAffineUp: TAffineVector;
var
  temp: TVector4f;
begin
  temp := GetAbsoluteUp;
  Result := AffineVectorMake(temp.x, temp.y, temp.z);
end;

procedure TgxBaseSceneObject.SetAbsoluteAffinePosition(const Value: TAffineVector);
begin
  SetAbsolutePosition(VectorMake(Value, 1));
end;

procedure TgxBaseSceneObject.SetAbsoluteAffineUp(const v: TAffineVector);
begin
  SetAbsoluteUp(VectorMake(v, 1));
end;

procedure TgxBaseSceneObject.SetAbsoluteAffineDirection(const v: TAffineVector);
begin
  SetAbsoluteDirection(VectorMake(v, 1));
end;

function TgxBaseSceneObject.AffineLeftVector: TAffineVector;
begin
  Result := AffineVectorMake(LeftVector);
end;

function TgxBaseSceneObject.AffineRight: TAffineVector;
begin
  Result := AffineVectorMake(Right);
end;

function TgxBaseSceneObject.DistanceTo(const pt: TAffineVector): Single;
begin
  Result := VectorDistance(AbsoluteAffinePosition, pt);
end;

function TgxBaseSceneObject.SqrDistanceTo(const pt: TAffineVector): Single;
begin
  Result := VectorDistance2(AbsoluteAffinePosition, pt);
end;

procedure TgxBaseSceneObject.DoOnAddedToParent;
begin
  if Assigned(FOnAddedToParent) then
    FOnAddedToParent(Self);
end;

function TgxBaseSceneObject.GetAbsoluteAffineScale: TAffineVector;
begin
  Result := AffineVectorMake(GetAbsoluteScale);
end;

procedure TgxBaseSceneObject.SetAbsoluteAffineScale(const Value: TAffineVector);
begin
  SetAbsoluteScale(VectorMake(Value, GetAbsoluteScale.W));
end;

// ------------------
// ------------------ TgxBaseBehaviour ------------------
// ------------------

constructor TgxBaseBehaviour.Create(AOwner: TXCollection);
begin
  inherited Create(AOwner);
  // nothing more, yet
end;

destructor TgxBaseBehaviour.Destroy;
begin
  // nothing more, yet
  inherited Destroy;
end;

procedure TgxBaseBehaviour.SetName(const val: string);
begin
  inherited SetName(val);
  if Assigned(vBehaviourNameChangeEvent) then
    vBehaviourNameChangeEvent(Self);
end;

procedure TgxBaseBehaviour.WriteToFiler(writer: TWriter);
begin
  inherited;

  with writer do
  begin
    WriteInteger(0); // Archive Version 0
    // nothing more, yet
  end;
end;

procedure TgxBaseBehaviour.ReadFromFiler(reader: TReader);
begin
  if Owner.ArchiveVersion > 0 then
    inherited;

  with reader do
  begin
    if ReadInteger <> 0 then
      Assert(False);
    // nothing more, yet
  end;
end;

function TgxBaseBehaviour.OwnerBaseSceneObject: TgxBaseSceneObject;
begin
  Result := TgxBaseSceneObject(Owner.Owner);
end;

procedure TgxBaseBehaviour.DoProgress(const progressTime: TgxProgressTimes);
begin
  // does nothing
end;

// ------------------
// ------------------ TgxBehaviours ------------------
// ------------------

// Create
//

constructor TgxBehaviours.Create(AOwner: TPersistent);
begin
  Assert(AOwner is TgxBaseSceneObject);
  inherited Create(AOwner);
end;

function TgxBehaviours.GetNamePath: string;
var
  s: string;
begin
  Result := ClassName;
  if GetOwner = nil then
    Exit;
  s := GetOwner.GetNamePath;
  if s = '' then
    Exit;
  Result := s + '.Behaviours';
end;

class function TgxBehaviours.ItemsClass: TXCollectionItemClass;
begin
  Result := TgxBehaviour;
end;

function TgxBehaviours.GetBehaviour(Index: Integer): TgxBehaviour;
begin
  Result := TgxBehaviour(Items[index]);
end;

function TgxBehaviours.CanAdd(aClass: TXCollectionItemClass): Boolean;
begin
  Result := (not aClass.InheritsFrom(TgxEffect)) and (inherited CanAdd(aClass));
end;

procedure TgxBehaviours.DoProgress(const progressTimes: TgxProgressTimes);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    TgxBehaviour(Items[i]).DoProgress(progressTimes);
end;

// ------------------
// ------------------ TgxEffect ------------------
// ------------------

procedure TgxEffect.WriteToFiler(writer: TWriter);
begin
  inherited;
  with writer do
  begin
    WriteInteger(0); // Archive Version 0
    // nothing more, yet
  end;
end;

procedure TgxEffect.ReadFromFiler(reader: TReader);
begin
  if Owner.ArchiveVersion > 0 then
    inherited;

  with reader do
  begin
    if ReadInteger <> 0 then
      Assert(False);
    // nothing more, yet
  end;
end;

procedure TgxEffect.Render(var rci: TgxRenderContextInfo);
begin
  // nothing here, this implem is just to avoid "abstract error"
end;

// ------------------
// ------------------ TgxEffects ------------------
// ------------------

constructor TgxEffects.Create(AOwner: TPersistent);
begin
  Assert(AOwner is TgxBaseSceneObject);
  inherited Create(AOwner);
end;

function TgxEffects.GetNamePath: string;
var
  s: string;
begin
  Result := ClassName;
  if GetOwner = nil then
    Exit;
  s := GetOwner.GetNamePath;
  if s = '' then
    Exit;
  Result := s + '.Effects';
end;

class function TgxEffects.ItemsClass: TXCollectionItemClass;
begin
  Result := TgxEffect;
end;

function TgxEffects.GetEffect(Index: Integer): TgxEffect;
begin
  Result := TgxEffect(Items[index]);
end;

function TgxEffects.CanAdd(aClass: TXCollectionItemClass): Boolean;
begin
  Result := (aClass.InheritsFrom(TgxEffect)) and (inherited CanAdd(aClass));
end;

procedure TgxEffects.DoProgress(const progressTime: TgxProgressTimes);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    TgxEffect(Items[i]).DoProgress(progressTime);
end;

procedure TgxEffects.RenderPreEffects(var rci: TgxRenderContextInfo);
var
  i: Integer;
  effect: TgxEffect;
begin
  for i := 0 to Count - 1 do
  begin
    effect := TgxEffect(Items[i]);
    if effect is TgxObjectPreEffect then
      effect.Render(rci);
  end;
end;

procedure TgxEffects.RenderPostEffects(var rci: TgxRenderContextInfo);
var
  i: Integer;
  effect: TgxEffect;
begin
  for i := 0 to Count - 1 do
  begin
    effect := TgxEffect(Items[i]);
    if effect is TgxObjectPostEffect then
      effect.Render(rci)
    else if Assigned(rci.afterRenderEffects) and (effect is TgxObjectAfterEffect) then
      rci.afterRenderEffects.Add(effect);
  end;
end;

// ------------------
// ------------------ TgxCustomSceneObject ------------------
// ------------------

constructor TgxCustomSceneObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMaterial := TgxMaterial.Create(Self);
end;

destructor TgxCustomSceneObject.Destroy;
begin
  inherited Destroy;
  FMaterial.Free;
end;

procedure TgxCustomSceneObject.Assign(Source: TPersistent);
begin
  if Source is TgxCustomSceneObject then
  begin
    FMaterial.Assign(TgxCustomSceneObject(Source).FMaterial);
    FHint := TgxCustomSceneObject(Source).FHint;
  end;
  inherited Assign(Source);
end;

function TgxCustomSceneObject.Blended: Boolean;
begin
  Result := Material.Blended;
end;

procedure TgxCustomSceneObject.Loaded;
begin
  inherited;
  FMaterial.Loaded;
end;

procedure TgxCustomSceneObject.SetVKMaterial(aValue: TgxMaterial);
begin
  FMaterial.Assign(aValue);
  NotifyChange(Self);
end;

procedure TgxCustomSceneObject.DestroyHandle;
begin
  inherited;
  FMaterial.DestroyHandles;
end;

procedure TgxCustomSceneObject.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  // start rendering self
  if ARenderSelf then
    if ARci.ignoreMaterials then
      if (osDirectDraw in ObjectStyle) or ARci.amalgamating then
        BuildList(ARci)
      else
        ARci.gxStates.CallList(GetHandle(ARci))
    else
    begin
      FMaterial.Apply(ARci);
      repeat
        if (osDirectDraw in ObjectStyle) or ARci.amalgamating then
          BuildList(ARci)
        else
          ARci.gxStates.CallList(GetHandle(ARci));
      until not FMaterial.UnApply(ARci);
    end;
  // start rendering children (if any)
  if ARenderChildren then
    Self.RenderChildren(0, Count - 1, ARci);
end;

// ------------------
// ------------------ TgxSceneRootObject ------------------
// ------------------

constructor TgxSceneRootObject.Create(AOwner: TComponent);
begin
  Assert(AOwner is TgxScene);
  inherited Create(AOwner);
  ObjectStyle := ObjectStyle + [osDirectDraw];
  FScene := TgxScene(AOwner);
end;

// ------------------
// ------------------ TgxCamera ------------------
// ------------------

constructor TgxCamera.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFocalLength := 50;
  FDepthOfView := 100;
  FNearPlaneBias := 1;
  FDirection.Initialize(VectorMake(0, 0, -1, 0));
  FCameraStyle := csPerspective;
  FSceneScale := 1;
  FDesign := False;
  FFOVY := -1;
  FKeepFOVMode := ckmHorizontalFOV;
end;

destructor TgxCamera.Destroy;
begin
  TargetObject := nil;
  inherited;
end;

procedure TgxCamera.Assign(Source: TPersistent);
var
  cam: TgxCamera;
  dir: TVector4f;
begin
  if Assigned(Source) then
  begin
    inherited Assign(Source);

    if Source is TgxCamera then
    begin
      cam := TgxCamera(Source);
      SetDepthOfView(cam.DepthOfView);
      SetFocalLength(cam.FocalLength);
      SetCameraStyle(cam.CameraStyle);
      SetSceneScale(cam.SceneScale);
      SetNearPlaneBias(cam.NearPlaneBias);
      SetScene(cam.Scene);
      SetKeepFOVMode(cam.FKeepFOVMode);

      if Parent <> nil then
      begin
        SetTargetObject(cam.TargetObject);
      end
      else // Design camera
      begin
        Position.AsVector := cam.AbsolutePosition;
        if Assigned(cam.TargetObject) then
        begin
          VectorSubtract(cam.TargetObject.AbsolutePosition, AbsolutePosition, dir);
          NormalizeVector(dir);
          Direction.AsVector := dir;
        end;
      end;
    end;
  end;
end;

function TgxCamera.AbsoluteVectorToTarget: TVector4f;
begin
  if TargetObject <> nil then
  begin
    VectorSubtract(TargetObject.AbsolutePosition, AbsolutePosition, Result);
    NormalizeVector(Result);
  end
  else
    Result := AbsoluteDirection;
end;

function TgxCamera.AbsoluteRightVectorToTarget: TVector4f;
begin
  if TargetObject <> nil then
  begin
    VectorSubtract(TargetObject.AbsolutePosition, AbsolutePosition, Result);
    Result := VectorCrossProduct(Result, AbsoluteUp);
    NormalizeVector(Result);
  end
  else
    Result := AbsoluteRight;
end;

function TgxCamera.AbsoluteUpVectorToTarget: TVector4f;
begin
  if TargetObject <> nil then
    Result := VectorCrossProduct(AbsoluteRightVectorToTarget, AbsoluteVectorToTarget)
  else
    Result := AbsoluteUp;
end;

// Apply
//

procedure TgxCamera.Apply;
var
  v, d, v2: TVector4f;
  absPos: TVector4f;
  LM, mat: TMatrix4f;
begin
  if Assigned(FDeferredApply) then
    FDeferredApply(Self)
  else
  begin
    if Assigned(FTargetObject) then
    begin
      v := TargetObject.AbsolutePosition;
      absPos := AbsolutePosition;
      VectorSubtract(v, absPos, d);
      NormalizeVector(d);
      FLastDirection := d;
      LM := CreateLookAtMatrix(absPos, v, Up.AsVector);
    end
    else
    begin
      if Assigned(Parent) then
        mat := Parent.AbsoluteMatrix
      else
        mat := IdentityHmgMatrix;
      absPos := AbsolutePosition;
      v := VectorTransform(Direction.AsVector, mat);
      FLastDirection := v;
      d := VectorTransform(Up.AsVector, mat);
      v2 := VectorAdd(absPos, v);
      LM := CreateLookAtMatrix(absPos, v2, d);
    end;
    with CurrentContext.PipeLineTransformation do
      SetViewMatrix(MatrixMultiply(LM, ViewMatrix^));
    ClearStructureChanged;
  end;
end;

procedure TgxCamera.ApplyPerspective(const AViewport: TRectangle; AWidth, AHeight: Integer; ADPI: Integer);
var
  vLeft, vRight, vBottom, vTop, vFar: Single;
  MaxDim, ratio, f: Double;
  xmax, ymax: Double;
  mat: TMatrix4f;
const
  cEpsilon: Single = 1E-4;

  function IsPerspective(CamStyle: TgxCameraStyle): Boolean;
  begin
    Result := CamStyle in [csPerspective, csInfinitePerspective, csPerspectiveKeepFOV];
  end;

begin
  if (AWidth <= 0) or (AHeight <= 0) then
    Exit;

  if CameraStyle = csOrtho2D then
  begin
    vLeft := 0;
    vRight := AWidth;
    vBottom := 0;
    vTop := AHeight;
    FNearPlane := -1;
    vFar := 1;
    mat := CreateOrthoMatrix(vLeft, vRight, vBottom, vTop, FNearPlane, vFar);
    with CurrentContext.PipeLineTransformation do
      SetProjectionMatrix(MatrixMultiply(mat, ProjectionMatrix^));
    FViewPortRadius := VectorLength(AWidth, AHeight) / 2;
  end
  else if CameraStyle = csCustom then
  begin
    FViewPortRadius := VectorLength(AWidth, AHeight) / 2;
    if Assigned(FOnCustomPerspective) then
      FOnCustomPerspective(AViewport, AWidth, AHeight, ADPI, FViewPortRadius);
  end
  else
  begin
    // determine biggest dimension and resolution (height or width)
    MaxDim := AWidth;
    if AHeight > MaxDim then
      MaxDim := AHeight;

    // calculate near plane distance and extensions;
    // Scene ratio is determined by the window ratio. The viewport is just a
    // specific part of the entire window and has therefore no influence on the
    // scene ratio. What we need to know, though, is the ratio between the window
    // borders (left, top, right and bottom) and the viewport borders.
    // Note: viewport.top is actually bottom, because the window (and viewport) origin
    // in OGL is the lower left corner

    if IsPerspective(CameraStyle) then
      f := FNearPlaneBias / (AWidth * FSceneScale)
    else
      f := 100 * FNearPlaneBias / (FocalLength * AWidth * FSceneScale);

    // calculate window/viewport ratio for right extent
    ratio := (2 * AViewport.width + 2 * AViewport.Left - AWidth) * f;
    // calculate aspect ratio correct right value of the view frustum and take
    // the window/viewport ratio also into account
    vRight := ratio * AWidth / (2 * MaxDim);

    // the same goes here for the other three extents
    // left extent:
    ratio := (AWidth - 2 * AViewport.Left) * f;
    vLeft := -ratio * AWidth / (2 * MaxDim);

    if IsPerspective(CameraStyle) then
      f := FNearPlaneBias / (AHeight * FSceneScale)
    else
      f := 100 * FNearPlaneBias / (FocalLength * AHeight * FSceneScale);

    // top extent (keep in mind the origin is left lower corner):
    ratio := (2 * AViewport.height + 2 * AViewport.Top - AHeight) * f;
    vTop := ratio * AHeight / (2 * MaxDim);

    // bottom extent:
    ratio := (AHeight - 2 * AViewport.Top) * f;
    vBottom := -ratio * AHeight / (2 * MaxDim);

    FNearPlane := FFocalLength * 2 * ADPI / (25.4 * MaxDim) * FNearPlaneBias;
    vFar := FNearPlane + FDepthOfView;

    // finally create view frustum (perspective or orthogonal)
    case CameraStyle of
      csPerspective:
        begin
          mat := CreateMatrixFromFrustum(vLeft, vRight, vBottom, vTop, FNearPlane, vFar);
        end;
      csPerspectiveKeepFOV:
        begin
          if FFOVY < 0 then // Need Update FOV
          begin
            FFOVY := ArcTan2(vTop - vBottom, 2 * FNearPlane) * 2;
            FFOVX := ArcTan2(vRight - vLeft, 2 * FNearPlane) * 2;
          end;

          case FKeepFOVMode of
            ckmVerticalFOV:
              begin
                ymax := FNearPlane * Tan(FFOVY / 2);
                xmax := ymax * AWidth / AHeight;
              end;
            ckmHorizontalFOV:
              begin
                xmax := FNearPlane * Tan(FFOVX / 2);
                ymax := xmax * AHeight / AWidth;
              end;
          else
            begin
              xmax := 0;
              ymax := 0;
              Assert(False, 'Unknown keep camera angle mode');
            end;
          end;
          mat := CreateMatrixFromFrustum(-xmax, xmax, -ymax, ymax, FNearPlane, vFar);
        end;
      csInfinitePerspective:
        begin
          mat := IdentityHmgMatrix;
          mat.x.x := 2 * FNearPlane / (vRight - vLeft);
          mat.y.y := 2 * FNearPlane / (vTop - vBottom);
          mat.z.x := (vRight + vLeft) / (vRight - vLeft);
          mat.z.y := (vTop + vBottom) / (vTop - vBottom);
          mat.z.z := cEpsilon - 1;
          mat.z.W := -1;
          mat.W.z := FNearPlane * (cEpsilon - 2);
          mat.W.W := 0;
        end;
      csOrthogonal:
        begin
          mat := CreateOrthoMatrix(vLeft, vRight, vBottom, vTop, FNearPlane, vFar);
        end;
    else
      Assert(False);
    end;

    with CurrentContext.PipeLineTransformation do
      SetProjectionMatrix(MatrixMultiply(mat, ProjectionMatrix^));
    FViewPortRadius := VectorLength(vRight, vTop) / FNearPlane
  end;
end;

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

procedure TgxCamera.AutoLeveling(Factor: Single);
var
  rightVector, rotAxis: TVector4f;
  angle: Single;
begin
  angle := RadianToDeg(ArcCosine(VectorDotProduct(FUp.AsVector, YVector)));
  rotAxis := VectorCrossProduct(YHmgVector, FUp.AsVector);
  if (angle > 1) and (VectorLength(rotAxis) > 0) then
  begin
    rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
    FUp.Rotate(AffineVectorMake(rotAxis), angle / (10 * Factor));
    FUp.Normalize;
    // adjust local coordinates
    FDirection.DirectVector := VectorCrossProduct(FUp.AsVector, rightVector);
    FRotation.z := -RadToDeg(ArcTan2(rightVector.y, VectorLength(rightVector.x, rightVector.z)));
  end;
end;

// ------------------------------------------------------------------------------
procedure TgxCamera.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FTargetObject) then
    TargetObject := nil;
  inherited;
end;

procedure TgxCamera.SetTargetObject(const val: TgxBaseSceneObject);
begin
  if (FTargetObject <> val) then
  begin
    if Assigned(FTargetObject) then
      FTargetObject.RemoveFreeNotification(Self);
    FTargetObject := val;
    if Assigned(FTargetObject) then
      FTargetObject.FreeNotification(Self);
    if not(csLoading in ComponentState) then
      TransformationChanged;
  end;
end;

procedure TgxCamera.Reset(aSceneBuffer: TgxSceneBuffer);
var
  Extent: Single;
begin
  FRotation.z := 0;
  FFocalLength := 50;
  with aSceneBuffer do
  begin
    ApplyPerspective(FViewPort, FViewPort.width, FViewPort.height, FRenderDPI);
    FUp.DirectVector := YHmgVector;
    if FViewPort.height < FViewPort.width then
      Extent := FViewPort.height * 0.25
    else
      Extent := FViewPort.width * 0.25;
  end;
  FPosition.SetPoint(0, 0, FNearPlane * Extent);
  FDirection.SetVector(0, 0, -1, 0);
  TransformationChanged;
end;

procedure TgxCamera.ZoomAll(aSceneBuffer: TgxSceneBuffer);
var
  Extent: Single;
begin
  with aSceneBuffer do
  begin
    if FViewPort.height < FViewPort.width then
      Extent := FViewPort.height * 0.25
    else
      Extent := FViewPort.width * 0.25;
    FPosition.DirectVector := NullHmgPoint;
    Move(-FNearPlane * Extent);
    // let the camera look at the scene center
    FDirection.SetVector(-FPosition.x, -FPosition.y, -FPosition.z, 0);
  end;
end;

procedure TgxCamera.RotateObject(obj: TgxBaseSceneObject; pitchDelta, turnDelta: Single; rollDelta: Single = 0);
var
  resMat: TMatrix4f;
  vDir, vUp, vRight: TVector4f;
  v: TAffineVector;
  position1: TVector4f;
  Scale1: TVector4f;
begin
  // First we need to compute the actual camera's vectors, which may not be
  // directly available if we're in "targeting" mode
  vUp := AbsoluteUp;
  if TargetObject <> nil then
  begin
    vDir := AbsoluteVectorToTarget;
    vRight := VectorCrossProduct(vDir, vUp);
    vUp := VectorCrossProduct(vRight, vDir);
  end
  else
  begin
    vDir := AbsoluteDirection;
    vRight := VectorCrossProduct(vDir, vUp);
  end;

  // save scale & position info
  Scale1 := obj.Scale.AsVector;
  position1 := obj.Position.AsVector;
  resMat := obj.Matrix^;
  // get rid of scaling & location info
  NormalizeMatrix(resMat);
  // Now we build rotation matrices and use them to rotate the obj
  if rollDelta <> 0 then
  begin
    SetVector(v, obj.AbsoluteToLocal(vDir));
    resMat := MatrixMultiply(CreateRotationMatrix(v, DegToRadian(rollDelta)), resMat);
  end;
  if turnDelta <> 0 then
  begin
    SetVector(v, obj.AbsoluteToLocal(vUp));
    resMat := MatrixMultiply(CreateRotationMatrix(v, DegToRadian(turnDelta)), resMat);
  end;
  if pitchDelta <> 0 then
  begin
    SetVector(v, obj.AbsoluteToLocal(vRight));
    resMat := MatrixMultiply(CreateRotationMatrix(v, DegToRadian(pitchDelta)), resMat);
  end;
  obj.SetMatrix(resMat);
  // restore scaling & rotation info
  obj.Scale.AsVector := Scale1;
  obj.Position.AsVector := position1;
end;

procedure TgxCamera.RotateTarget(pitchDelta, turnDelta: Single; rollDelta: Single = 0);
begin
  if Assigned(FTargetObject) then
    RotateObject(FTargetObject, pitchDelta, turnDelta, rollDelta)
end;

procedure TgxCamera.MoveAroundTarget(pitchDelta, turnDelta: Single);
begin
  MoveObjectAround(FTargetObject, pitchDelta, turnDelta);
end;

procedure TgxCamera.MoveAllAroundTarget(pitchDelta, turnDelta: Single);
begin
  MoveObjectAllAround(FTargetObject, pitchDelta, turnDelta);
end;

procedure TgxCamera.MoveInEyeSpace(forwardDistance, rightDistance, upDistance: Single);
var
  trVector: TVector4f;
begin
  trVector := AbsoluteEyeSpaceVector(forwardDistance, rightDistance, upDistance);
  if Assigned(Parent) then
    Position.Translate(Parent.AbsoluteToLocal(trVector))
  else
    Position.Translate(trVector);
end;

procedure TgxCamera.MoveTargetInEyeSpace(forwardDistance, rightDistance, upDistance: Single);
var
  trVector: TVector4f;
begin
  if TargetObject <> nil then
  begin
    trVector := AbsoluteEyeSpaceVector(forwardDistance, rightDistance, upDistance);
    TargetObject.Position.Translate(TargetObject.Parent.AbsoluteToLocal(trVector));
  end;
end;

function TgxCamera.AbsoluteEyeSpaceVector(forwardDistance, rightDistance, upDistance: Single): TVector4f;
begin
  Result := NullHmgVector;
  if forwardDistance <> 0 then
    CombineVector(Result, AbsoluteVectorToTarget, forwardDistance);
  if rightDistance <> 0 then
    CombineVector(Result, AbsoluteRightVectorToTarget, rightDistance);
  if upDistance <> 0 then
    CombineVector(Result, AbsoluteUpVectorToTarget, upDistance);
end;

procedure TgxCamera.AdjustDistanceToTarget(distanceRatio: Single);
var
  vect: TVector4f;
begin
  if Assigned(FTargetObject) then
  begin
    // calculate vector from target to camera in absolute coordinates
    vect := VectorSubtract(AbsolutePosition, TargetObject.AbsolutePosition);
    // ratio -> translation vector
    ScaleVector(vect, -(1 - distanceRatio));
    AddVector(vect, AbsolutePosition);
    if Assigned(Parent) then
      vect := Parent.AbsoluteToLocal(vect);
    Position.AsVector := vect;
  end;
end;

function TgxCamera.DistanceToTarget: Single;
var
  vect: TVector4f;
begin
  if Assigned(FTargetObject) then
  begin
    vect := VectorSubtract(AbsolutePosition, TargetObject.AbsolutePosition);
    Result := VectorLength(vect);
  end
  else
    Result := 1;
end;

function TgxCamera.ScreenDeltaToVector(deltaX, deltaY: Integer; ratio: Single; const planeNormal: TVector4f): TVector4f;
var
  screenY, screenX: TVector4f;
  screenYoutOfPlaneComponent: Single;
begin
  // calculate projection of direction vector on the plane
  if Assigned(FTargetObject) then
    screenY := VectorSubtract(TargetObject.AbsolutePosition, AbsolutePosition)
  else
    screenY := Direction.AsVector;
  screenYoutOfPlaneComponent := VectorDotProduct(screenY, planeNormal);
  screenY := VectorCombine(screenY, planeNormal, 1, -screenYoutOfPlaneComponent);
  NormalizeVector(screenY);
  // calc the screenX vector
  screenX := VectorCrossProduct(screenY, planeNormal);
  // and here, we're done
  Result := VectorCombine(screenX, screenY, deltaX * ratio, deltaY * ratio);
end;

function TgxCamera.ScreenDeltaToVectorXY(deltaX, deltaY: Integer; ratio: Single): TVector4f;
var
  screenY: TVector4f;
  dxr, dyr, d: Single;
begin
  // calculate projection of direction vector on the plane
  if Assigned(FTargetObject) then
    screenY := VectorSubtract(TargetObject.AbsolutePosition, AbsolutePosition)
  else
    screenY := Direction.AsVector;
  d := VectorLength(screenY.x, screenY.y);
  if d <= 1E-10 then
    d := ratio
  else
    d := ratio / d;
  // and here, we're done
  dxr := deltaX * d;
  dyr := deltaY * d;
  Result.x := screenY.y * dxr + screenY.x * dyr;
  Result.y := screenY.y * dyr - screenY.x * dxr;
  Result.z := 0;
  Result.W := 0;
end;

function TgxCamera.ScreenDeltaToVectorXZ(deltaX, deltaY: Integer; ratio: Single): TVector4f;
var
  screenY: TVector4f;
  d, dxr, dzr: Single;
begin
  // calculate the projection of direction vector on the plane
  if Assigned(FTargetObject) then
    screenY := VectorSubtract(TargetObject.AbsolutePosition, AbsolutePosition)
  else
    screenY := Direction.AsVector;
  d := VectorLength(screenY.x, screenY.z);
  if d <= 1E-10 then
    d := ratio
  else
    d := ratio / d;
  dxr := deltaX * d;
  dzr := deltaY * d;
  Result.x := -screenY.z * dxr + screenY.x * dzr;
  Result.y := 0;
  Result.z := screenY.z * dzr + screenY.x * dxr;
  Result.W := 0;
end;

function TgxCamera.ScreenDeltaToVectorYZ(deltaX, deltaY: Integer; ratio: Single): TVector4f;
var
  screenY: TVector4f;
  d, dyr, dzr: Single;
begin
  // calculate the projection of direction vector on the plane
  if Assigned(FTargetObject) then
    screenY := VectorSubtract(TargetObject.AbsolutePosition, AbsolutePosition)
  else
    screenY := Direction.AsVector;
  d := VectorLength(screenY.y, screenY.z);
  if d <= 1E-10 then
    d := ratio
  else
    d := ratio / d;
  dyr := deltaX * d;
  dzr := deltaY * d;
  Result.x := 0;
  Result.y := screenY.z * dyr + screenY.y * dzr;
  Result.z := screenY.z * dzr - screenY.y * dyr;
  Result.W := 0;
end;

function TgxCamera.PointInFront(const point: TVector4f): Boolean;
begin
  Result := PointIsInHalfSpace(point, AbsolutePosition, AbsoluteDirection);
end;

procedure TgxCamera.SetDepthOfView(aValue: Single);
begin
  if FDepthOfView <> aValue then
  begin
    FDepthOfView := aValue;
    FFOVY := -1;
    if not(csLoading in ComponentState) then
      TransformationChanged;
  end;
end;

procedure TgxCamera.SetFocalLength(aValue: Single);
begin
  if aValue <= 0 then
    aValue := 1;
  if FFocalLength <> aValue then
  begin
    FFocalLength := aValue;
    FFOVY := -1;
    if not(csLoading in ComponentState) then
      TransformationChanged;
  end;
end;

function TgxCamera.GetFieldOfView(const AViewportDimension: Single): Single;
begin
  if FFocalLength = 0 then
    Result := 0
  else
    Result := RadToDeg(2 * ArcTan2(AViewportDimension * 0.5, FFocalLength));
end;

procedure TgxCamera.SetFieldOfView(const AFieldOfView, AViewportDimension: Single);
begin
  FocalLength := AViewportDimension / (2 * Tan(DegToRadian(AFieldOfView / 2)));
end;

procedure TgxCamera.SetCameraStyle(const val: TgxCameraStyle);
begin
  if FCameraStyle <> val then
  begin
    FCameraStyle := val;
    FFOVY := -1;
    NotifyChange(Self);
  end;
end;

procedure TgxCamera.SetKeepFOVMode(const val: TgxCameraKeepFOVMode);
begin
  if FKeepFOVMode <> val then
  begin
    FKeepFOVMode := val;
    FFOVY := -1;
    if FCameraStyle = csPerspectiveKeepFOV then
      NotifyChange(Self);
  end;
end;

procedure TgxCamera.SetSceneScale(Value: Single);
begin
  if Value = 0 then
    Value := 1;
  if FSceneScale <> Value then
  begin
    FSceneScale := Value;
    FFOVY := -1;
    NotifyChange(Self);
  end;
end;

function TgxCamera.StoreSceneScale: Boolean;
begin
  Result := (FSceneScale <> 1);
end;

procedure TgxCamera.SetNearPlaneBias(Value: Single);
begin
  if Value <= 0 then
    Value := 1;
  if FNearPlaneBias <> Value then
  begin
    FNearPlaneBias := Value;
    FFOVY := -1;
    NotifyChange(Self);
  end;
end;

function TgxCamera.StoreNearPlaneBias: Boolean;
begin
  Result := (FNearPlaneBias <> 1);
end;

procedure TgxCamera.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  if ARenderChildren and (Count > 0) then
    Self.RenderChildren(0, Count - 1, ARci);
end;

function TgxCamera.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil;
  intersectNormal: PVector4f = nil): Boolean;
begin
  Result := False;
end;

// ------------------
// ------------------ TgxImmaterialSceneObject ------------------
// ------------------

procedure TgxImmaterialSceneObject.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  // start rendering self
  if ARenderSelf then
  begin
    if (osDirectDraw in ObjectStyle) or ARci.amalgamating then
      BuildList(ARci)
    else
      ARci.gxStates.CallList(GetHandle(ARci));
  end;
  // start rendering children (if any)
  if ARenderChildren then
    Self.RenderChildren(0, Count - 1, ARci);
end;

// ------------------
// ------------------ TgxCameraInvariantObject ------------------
// ------------------

constructor TgxCameraInvariantObject.Create(AOwner: TComponent);
begin
  inherited;
  FCamInvarianceMode := cimNone;
end;

procedure TgxCameraInvariantObject.Assign(Source: TPersistent);
begin
  if Source is TgxCameraInvariantObject then
  begin
    FCamInvarianceMode := TgxCameraInvariantObject(Source).FCamInvarianceMode;
  end;
  inherited Assign(Source);
end;

procedure TgxCameraInvariantObject.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  if CamInvarianceMode <> cimNone then
    with ARci.PipeLineTransformation do
    begin
      Push;
      // try
      // prepare
      case CamInvarianceMode of
        cimPosition:
          begin
            SetViewMatrix(MatrixMultiply(CreateTranslationMatrix(ARci.cameraPosition),
              ARci.PipeLineTransformation.ViewMatrix^));
          end;
        cimOrientation:
          begin
            // makes the coordinates system more 'intuitive' (Z+ forward)
            SetViewMatrix(CreateScaleMatrix(Vector3fMake(1, -1, -1)))
          end;
      else
        Assert(False);
      end;
      // Apply local transform
      SetModelMatrix(LocalMatrix^);

      if ARenderSelf then
      begin
        if (osDirectDraw in ObjectStyle) or ARci.amalgamating then
          BuildList(ARci)
        else
          ARci.gxStates.CallList(GetHandle(ARci));
      end;
      if ARenderChildren then
        Self.RenderChildren(0, Count - 1, ARci);
      // finally
      Pop;
      // end;
    end
  else
    inherited;
end;

procedure TgxCameraInvariantObject.SetCamInvarianceMode(const val: TgxCameraInvarianceMode);
begin
  if FCamInvarianceMode <> val then
  begin
    FCamInvarianceMode := val;
    NotifyChange(Self);
  end;
end;

// ------------------
// ------------------ TxDirectOpenGL ------------------
// ------------------

constructor TgxDirectOpenGL.Create(AOwner: TComponent);
begin
  inherited;
  ObjectStyle := ObjectStyle + [osDirectDraw];
  FBlend := False;
end;

procedure TgxDirectOpenGL.Assign(Source: TPersistent);
begin
  if Source is TgxDirectOpenGL then
  begin
    UseBuildList := TgxDirectOpenGL(Source).UseBuildList;
    FOnRender := TgxDirectOpenGL(Source).FOnRender;
    FBlend := TgxDirectOpenGL(Source).Blend;
  end;
  inherited Assign(Source);
end;

procedure TgxDirectOpenGL.BuildList(var rci: TgxRenderContextInfo);
begin
  if Assigned(FOnRender) then
  begin
    xglMapTexCoordToMain; // single texturing by default
    OnRender(Self, rci);
  end;
end;

function TgxDirectOpenGL.AxisAlignedDimensionsUnscaled: TVector4f;
begin
  Result := NullHmgPoint;
end;

procedure TgxDirectOpenGL.SetUseBuildList(const val: Boolean);
begin
  if val <> FUseBuildList then
  begin
    FUseBuildList := val;
    if val then
      ObjectStyle := ObjectStyle - [osDirectDraw]
    else
      ObjectStyle := ObjectStyle + [osDirectDraw];
  end;
end;

function TgxDirectOpenGL.Blended: Boolean;
begin
  Result := FBlend;
end;

procedure TgxDirectOpenGL.SetBlend(const val: Boolean);
begin
  if val <> FBlend then
  begin
    FBlend := val;
    StructureChanged;
  end;
end;

// ------------------
// ------------------ TgxRenderPoint ------------------
// ------------------

constructor TgxRenderPoint.Create(AOwner: TComponent);
begin
  inherited;
  ObjectStyle := ObjectStyle + [osDirectDraw];
end;

destructor TgxRenderPoint.Destroy;
begin
  Clear;
  inherited;
end;

procedure TgxRenderPoint.BuildList(var rci: TgxRenderContextInfo);
var
  i: Integer;
begin
  for i := 0 to High(FCallBacks) do
    FCallBacks[i](Self, rci);
end;

procedure TgxRenderPoint.RegisterCallBack(renderEvent: TDirectRenderEvent; renderPointFreed: TNotifyEvent);
var
  n: Integer;
begin
  n := Length(FCallBacks);
  SetLength(FCallBacks, n + 1);
  SetLength(FFreeCallBacks, n + 1);
  FCallBacks[n] := renderEvent;
  FFreeCallBacks[n] := renderPointFreed;
end;

procedure TgxRenderPoint.UnRegisterCallBack(renderEvent: TDirectRenderEvent);
type
  TEventContainer = record
    event: TDirectRenderEvent;
  end;
var
  i, j, n: Integer;
  refContainer, listContainer: TEventContainer;
begin
  refContainer.event := renderEvent;
  n := Length(FCallBacks);
  for i := 0 to n - 1 do
  begin
    listContainer.event := FCallBacks[i];
    if CompareMem(@listContainer, @refContainer, SizeOf(TEventContainer)) then
    begin
      for j := i + 1 to n - 1 do
      begin
        FCallBacks[j - 1] := FCallBacks[j];
        FFreeCallBacks[j - 1] := FFreeCallBacks[j];
      end;
      SetLength(FCallBacks, n - 1);
      SetLength(FFreeCallBacks, n - 1);
      Break;
    end;
  end;
end;

procedure TgxRenderPoint.Clear;
begin
  while Length(FCallBacks) > 0 do
  begin
    FFreeCallBacks[High(FCallBacks)](Self);
    SetLength(FCallBacks, Length(FCallBacks) - 1);
  end;
end;

// ------------------
// ------------------ TgxProxyObject ------------------
// ------------------

constructor TgxProxyObject.Create(AOwner: TComponent);
begin
  inherited;
  FProxyOptions := cDefaultProxyOptions;
end;

destructor TgxProxyObject.Destroy;
begin
  SetMasterObject(nil);
  inherited;
end;

procedure TgxProxyObject.Assign(Source: TPersistent);
begin
  if Source is TgxProxyObject then
  begin
    SetMasterObject(TgxProxyObject(Source).MasterObject);
  end;
  inherited Assign(Source);
end;

procedure TgxProxyObject.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
var
  gotMaster, masterGotEffects, oldProxySubObject: Boolean;
begin
  if FRendering then
    Exit;
  FRendering := True;
  try
    gotMaster := Assigned(FMasterObject);
    masterGotEffects := gotMaster and (pooEffects in FProxyOptions) and (FMasterObject.Effects.Count > 0);
    if gotMaster then
    begin
      if pooObjects in FProxyOptions then
      begin
        oldProxySubObject := ARci.proxySubObject;
        ARci.proxySubObject := True;
        if pooTransformation in FProxyOptions then
          with ARci.PipeLineTransformation do
            SetModelMatrix(MatrixMultiply(FMasterObject.Matrix^, ModelMatrix^));
        FMasterObject.DoRender(ARci, ARenderSelf, (FMasterObject.Count > 0));
        ARci.proxySubObject := oldProxySubObject;
      end;
    end;
    // now render self stuff (our children, our effects, etc.)
    if ARenderChildren and (Count > 0) then
      Self.RenderChildren(0, Count - 1, ARci);
    if masterGotEffects then
      FMasterObject.Effects.RenderPostEffects(ARci);
  finally
    FRendering := False;
  end;
  ClearStructureChanged;
end;

function TgxProxyObject.AxisAlignedDimensions: TVector4f;
begin
  If Assigned(FMasterObject) then
  begin
    Result := FMasterObject.AxisAlignedDimensionsUnscaled;
    If (pooTransformation in ProxyOptions) then
      ScaleVector(Result, FMasterObject.Scale.AsVector)
    else
      ScaleVector(Result, Scale.AsVector);
  end
  else
    Result := inherited AxisAlignedDimensions;
end;

function TgxProxyObject.AxisAlignedDimensionsUnscaled: TVector4f;
begin
  if Assigned(FMasterObject) then
  begin
    Result := FMasterObject.AxisAlignedDimensionsUnscaled;
  end
  else
    Result := inherited AxisAlignedDimensionsUnscaled;
end;

function TgxProxyObject.BarycenterAbsolutePosition: TVector4f;
var
  lAdjustVector: TVector4f;
begin
  if Assigned(FMasterObject) then
  begin
    // Not entirely correct, but better than nothing...
    lAdjustVector := VectorSubtract(FMasterObject.BarycenterAbsolutePosition, FMasterObject.AbsolutePosition);
    Position.AsVector := VectorAdd(Position.AsVector, lAdjustVector);
    Result := AbsolutePosition;
    Position.AsVector := VectorSubtract(Position.AsVector, lAdjustVector);
  end
  else
    Result := inherited BarycenterAbsolutePosition;
end;

procedure TgxProxyObject.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FMasterObject) then
    MasterObject := nil;
  inherited;
end;

procedure TgxProxyObject.SetMasterObject(const val: TgxBaseSceneObject);
begin
  if FMasterObject <> val then
  begin
    if Assigned(FMasterObject) then
      FMasterObject.RemoveFreeNotification(Self);
    FMasterObject := val;
    if Assigned(FMasterObject) then
      FMasterObject.FreeNotification(Self);
    StructureChanged;
  end;
end;

procedure TgxProxyObject.SetProxyOptions(const val: TgxProxyObjectOptions);
begin
  if FProxyOptions <> val then
  begin
    FProxyOptions := val;
    StructureChanged;
  end;
end;

function TgxProxyObject.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil;
  intersectNormal: PVector4f = nil): Boolean;
var
  localRayStart, localRayVector: TVector4f;
begin
  if Assigned(MasterObject) then
  begin
    SetVector(localRayStart, AbsoluteToLocal(rayStart));
    SetVector(localRayStart, MasterObject.LocalToAbsolute(localRayStart));
    SetVector(localRayVector, AbsoluteToLocal(rayVector));
    SetVector(localRayVector, MasterObject.LocalToAbsolute(localRayVector));
    NormalizeVector(localRayVector);

    Result := MasterObject.RayCastIntersect(localRayStart, localRayVector, intersectPoint, intersectNormal);
    if Result then
    begin
      if Assigned(intersectPoint) then
      begin
        SetVector(intersectPoint^, MasterObject.AbsoluteToLocal(intersectPoint^));
        SetVector(intersectPoint^, LocalToAbsolute(intersectPoint^));
      end;
      if Assigned(intersectNormal) then
      begin
        SetVector(intersectNormal^, MasterObject.AbsoluteToLocal(intersectNormal^));
        SetVector(intersectNormal^, LocalToAbsolute(intersectNormal^));
      end;
    end;
  end
  else
    Result := False;
end;

function TgxProxyObject.GenerateSilhouette(const silhouetteParameters: TgxSilhouetteParameters): TgxSilhouette;
begin
  if Assigned(MasterObject) then
    Result := MasterObject.GenerateSilhouette(silhouetteParameters)
  else
    Result := nil;
end;

// ------------------
// ------------------ TxLightSource ------------------
// ------------------

constructor TgxLightSource.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FListHandle := nil;
  FShining := True;
  FSpotDirection := TgxCoordinates.CreateInitialized(Self, VectorMake(0, 0, -1, 0), csVector);
  FConstAttenuation := 1;
  FLinearAttenuation := 0;
  FQuadraticAttenuation := 0;
  FSpotCutOff := 180;
  FSpotExponent := 0;
  FLightStyle := lsSpot;
  FAmbient := TgxColor.Create(Self);
  FDiffuse := TgxColor.Create(Self);
  FDiffuse.Initialize(clrWhite);
  FSpecular := TgxColor.Create(Self);
end;

destructor TgxLightSource.Destroy;
begin
  FSpotDirection.Free;
  FAmbient.Free;
  FDiffuse.Free;
  FSpecular.Free;
  inherited Destroy;
end;

procedure TgxLightSource.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  if ARenderChildren and Assigned(FChildren) then
    Self.RenderChildren(0, Count - 1, ARci);
end;

function TgxLightSource.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil;
  intersectNormal: PVector4f = nil): Boolean;
begin
  Result := False;
end;

procedure TgxLightSource.CoordinateChanged(Sender: TgxCustomCoordinates);
begin
  inherited;
  if Sender = FSpotDirection then
    TransformationChanged;
end;

function TgxLightSource.GenerateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters): TgxSilhouette;
begin
  Result := nil;
end;

procedure TgxLightSource.SetShining(aValue: Boolean);
begin
  if aValue <> FShining then
  begin
    FShining := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxLightSource.SetSpotDirection(AVector: TgxCoordinates);
begin
  FSpotDirection.DirectVector := AVector.AsVector;
  FSpotDirection.W := 0;
  NotifyChange(Self);
end;

procedure TgxLightSource.SetSpotExponent(aValue: Single);
begin
  if FSpotExponent <> aValue then
  begin
    FSpotExponent := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxLightSource.SetSpotCutOff(const val: Single);
begin
  if FSpotCutOff <> val then
  begin
    if ((val >= 0) and (val <= 90)) or (val = 180) then
    begin
      FSpotCutOff := val;
      NotifyChange(Self);
    end;
  end;
end;

procedure TgxLightSource.SetLightStyle(const val: TgxLightStyle);
begin
  if FLightStyle <> val then
  begin
    FLightStyle := val;
    NotifyChange(Self);
  end;
end;

procedure TgxLightSource.SetAmbient(aValue: TgxColor);
begin
  FAmbient.Color := aValue.Color;
  NotifyChange(Self);
end;

procedure TgxLightSource.SetDiffuse(aValue: TgxColor);
begin
  FDiffuse.Color := aValue.Color;
  NotifyChange(Self);
end;

procedure TgxLightSource.SetSpecular(aValue: TgxColor);
begin
  FSpecular.Color := aValue.Color;
  NotifyChange(Self);
end;

procedure TgxLightSource.SetConstAttenuation(aValue: Single);
begin
  if FConstAttenuation <> aValue then
  begin
    FConstAttenuation := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxLightSource.SetLinearAttenuation(aValue: Single);
begin
  if FLinearAttenuation <> aValue then
  begin
    FLinearAttenuation := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxLightSource.SetQuadraticAttenuation(aValue: Single);
begin
  if FQuadraticAttenuation <> aValue then
  begin
    FQuadraticAttenuation := aValue;
    NotifyChange(Self);
  end;
end;

function TgxLightSource.Attenuated: Boolean;
begin
  Result := (LightStyle <> lsParallel) and ((ConstAttenuation <> 1) or (LinearAttenuation <> 0) or (QuadraticAttenuation <> 0));
end;

// ------------------
// ------------------ TgxScene ------------------
// ------------------

constructor TgxScene.Create(AOwner: TComponent);
begin
  inherited;
  // root creation
  FCurrentBuffer := nil;
  FObjects := TgxSceneRootObject.Create(Self);
  FObjects.Name := 'ObjectRoot';
  FLights := TgxPersistentObjectList.Create;
  FObjectsSorting := osRenderBlendedLast;
  FVisibilityCulling := vcNone;
  // actual maximum number of lights is stored in TgxSceneViewer
  FLights.Count := 8;
  FInitializableObjects := TgxInitializableObjectList.Create;
end;

destructor TgxScene.Destroy;
begin
  InitializableObjects.Free;
  FObjects.DestroyHandles;
  FLights.Free;
  FObjects.Free;
  if Assigned(FBuffers) then
    FreeAndNil(FBuffers);
  inherited Destroy;
end;

procedure TgxScene.AddLight(aLight: TgxLightSource);
var
  i: Integer;
begin
  for i := 0 to FLights.Count - 1 do
    if FLights.List^[i] = nil then
    begin
      FLights.List^[i] := aLight;
      aLight.FLightID := i;
      Break;
    end;
end;

procedure TgxScene.RemoveLight(aLight: TgxLightSource);
var
  idx: Integer;
begin
  idx := FLights.IndexOf(aLight);
  if idx >= 0 then
    FLights[idx] := nil;
end;

procedure TgxScene.AddLights(anObj: TgxBaseSceneObject);
var
  i: Integer;
begin
  if anObj is TgxLightSource then
    AddLight(TgxLightSource(anObj));
  for i := 0 to anObj.Count - 1 do
    AddLights(anObj.Children[i]);
end;

procedure TgxScene.RemoveLights(anObj: TgxBaseSceneObject);
var
  i: Integer;
begin
  if anObj is TgxLightSource then
    RemoveLight(TgxLightSource(anObj));
  for i := 0 to anObj.Count - 1 do
    RemoveLights(anObj.Children[i]);
end;

procedure TgxScene.ShutdownAllLights;

  procedure DoShutdownLight(obj: TgxBaseSceneObject);
  var
    i: Integer;
  begin
    if obj is TgxLightSource then
      TgxLightSource(obj).Shining := False;
    for i := 0 to obj.Count - 1 do
      DoShutdownLight(obj[i]);
  end;

begin
  DoShutdownLight(FObjects);
end;

procedure TgxScene.AddBuffer(aBuffer: TgxSceneBuffer);
begin
  if not Assigned(FBuffers) then
    FBuffers := TgxPersistentObjectList.Create;
  if FBuffers.IndexOf(aBuffer) < 0 then
  begin
    FBuffers.Add(aBuffer);
    if FBaseContext = nil then
      FBaseContext := TgxSceneBuffer(FBuffers[0]).RenderingContext;
    if (FBuffers.Count > 1) and Assigned(FBaseContext) then
      aBuffer.RenderingContext.ShareLists(FBaseContext);
  end;
end;

procedure TgxScene.RemoveBuffer(aBuffer: TgxSceneBuffer);
var
  i: Integer;
begin
  if Assigned(FBuffers) then
  begin
    i := FBuffers.IndexOf(aBuffer);
    if i >= 0 then
    begin
      if FBuffers.Count = 1 then
      begin
        FreeAndNil(FBuffers);
        FBaseContext := nil;
      end
      else
      begin
        FBuffers.Delete(i);
        FBaseContext := TgxSceneBuffer(FBuffers[0]).RenderingContext;
      end;
    end;
  end;
end;

procedure TgxScene.GetChildren(AProc: TGetChildProc; Root: TComponent);
begin
  FObjects.GetChildren(AProc, Root);
end;

procedure TgxScene.SetChildOrder(AChild: TComponent; Order: Integer);
begin
  (AChild as TgxBaseSceneObject).Index := Order;
end;

function TgxScene.IsUpdating: Boolean;
begin
  Result := (FUpdateCount <> 0) or (csLoading in ComponentState) or (csDestroying in ComponentState);
end;

procedure TgxScene.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TgxScene.EndUpdate;
begin
  Assert(FUpdateCount > 0);
  Dec(FUpdateCount);
  if FUpdateCount = 0 then
    NotifyChange(Self);
end;

procedure TgxScene.SetObjectsSorting(const val: TgxObjectsSorting);
begin
  if FObjectsSorting <> val then
  begin
    if val = osInherited then
      FObjectsSorting := osRenderBlendedLast
    else
      FObjectsSorting := val;
    NotifyChange(Self);
  end;
end;

procedure TgxScene.SetVisibilityCulling(const val: TgxVisibilityCulling);
begin
  if FVisibilityCulling <> val then
  begin
    if val = vcInherited then
      FVisibilityCulling := vcNone
    else
      FVisibilityCulling := val;
    NotifyChange(Self);
  end;
end;

procedure TgxScene.ReadState(reader: TReader);
var
  SaveRoot: TComponent;
begin
  SaveRoot := reader.Root;
  try
    if Owner <> nil then
      reader.Root := Owner;
    inherited;
  finally
    reader.Root := SaveRoot;
  end;
end;

procedure TgxScene.Progress(const deltaTime, newTime: Double);
var
  pt: TgxProgressTimes;
begin
  pt.deltaTime := deltaTime;
  pt.newTime := newTime;
  FCurrentDeltaTime := deltaTime;
  if Assigned(FOnBeforeProgress) then
    FOnBeforeProgress(Self, deltaTime, newTime);
  FObjects.DoProgress(pt);
  if Assigned(FOnProgress) then
    FOnProgress(Self, deltaTime, newTime);
end;

procedure TgxScene.SaveToFile(const fileName: string);
var
  stream: TStream;
begin
  stream := TFileStream.Create(fileName, fmCreate);
  try
    SaveToStream(stream);
  finally
    stream.Free;
  end;
end;

procedure TgxScene.LoadFromFile(const fileName: string);

  procedure CheckResFileStream(stream: TStream);
  var
    n: Integer;
    B: Byte;
  begin
    n := stream.Position;
    stream.Read(B, SizeOf(B));
    stream.Position := n;
    if B = $FF then
      stream.ReadResHeader;
  end;

var
  stream: TStream;
begin
  stream := TFileStream.Create(fileName, fmOpenRead);
  try
    CheckResFileStream(stream);
    LoadFromStream(stream);
  finally
    stream.Free;
  end;
end;

procedure TgxScene.SaveToTextFile(const fileName: string);
var
  mem: TMemoryStream;
  fil: TStream;
begin
  mem := TMemoryStream.Create;
  fil := TFileStream.Create(fileName, fmCreate);
  try
    SaveToStream(mem);
    mem.Position := 0;
    ObjectBinaryToText(mem, fil);
  finally
    fil.Free;
    mem.Free;
  end;
end;

procedure TgxScene.LoadFromTextFile(const fileName: string);
var
  mem: TMemoryStream;
  fil: TStream;
begin
  mem := TMemoryStream.Create;
  fil := TFileStream.Create(fileName, fmOpenRead);
  try
    ObjectTextToBinary(fil, mem);
    mem.Position := 0;
    LoadFromStream(mem);
  finally
    fil.Free;
    mem.Free;
  end;
end;

procedure TgxScene.LoadFromStream(aStream: TStream);
var
  fixups: TStringList;
  i: Integer;
  obj: TgxBaseSceneObject;
begin
  fixups := TStringList.Create;
  try
    if Assigned(FBuffers) then
    begin
      for i := 0 to FBuffers.Count - 1 do
        fixups.AddObject(TgxSceneBuffer(FBuffers[i]).Camera.Name, FBuffers[i]);
    end;
    ShutdownAllLights;
    // will remove Viewer from FBuffers
    Objects.DeleteChildren;
    aStream.ReadComponent(Self);
    for i := 0 to fixups.Count - 1 do
    begin
      obj := FindSceneObject(fixups[i]);
      if obj is TgxCamera then
        TgxSceneBuffer(fixups.Objects[i]).Camera := TgxCamera(obj)
      else { can assign default camera (if existing, of course) instead }
          ;
    end;
  finally
    fixups.Free;
  end;
end;

procedure TgxScene.SaveToStream(aStream: TStream);
begin
  aStream.WriteComponent(Self);
end;

function TgxScene.FindSceneObject(const aName: string): TgxBaseSceneObject;
begin
  Result := FObjects.FindChild(aName, False);
end;

function TgxScene.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil;
  intersectNormal: PVector4f = nil): TgxBaseSceneObject;
var
  bestDist2: Single;
  bestHit: TgxBaseSceneObject;
  iPoint, iNormal: TVector4f;
  pINormal: PVector4f;

  function RecursiveDive(baseObject: TgxBaseSceneObject): TgxBaseSceneObject;
  var
    i: Integer;
    curObj: TgxBaseSceneObject;
    dist2: Single;
    fNear, fFar: Single;
  begin
    Result := nil;
    for i := 0 to baseObject.Count - 1 do
    begin
      curObj := baseObject.Children[i];
      if curObj.Visible then
      begin
        if RayCastAABBIntersect(rayStart, rayVector, curObj.AxisAlignedBoundingBoxAbsoluteEx, fNear, fFar) then
        begin
          if fNear * fNear > bestDist2 then
          begin
            if not PointInAABB(rayStart, curObj.AxisAlignedBoundingBoxAbsoluteEx) then
              continue;
          end;
          if curObj.RayCastIntersect(rayStart, rayVector, @iPoint, pINormal) then
          begin
            dist2 := VectorDistance2(rayStart, iPoint);
            if dist2 < bestDist2 then
            begin
              bestHit := curObj;
              bestDist2 := dist2;
              if Assigned(intersectPoint) then
                intersectPoint^ := iPoint;
              if Assigned(intersectNormal) then
                intersectNormal^ := iNormal;
            end;
          end;
          RecursiveDive(curObj);
        end;
      end;
    end;
  end;

begin
  bestDist2 := 1E20;
  bestHit := nil;
  if Assigned(intersectNormal) then
    pINormal := @iNormal
  else
    pINormal := nil;
  RecursiveDive(Objects);
  Result := bestHit;
end;

procedure TgxScene.NotifyChange(Sender: TObject);
var
  i: Integer;
begin
  if (not IsUpdating) and Assigned(FBuffers) then
    for i := 0 to FBuffers.Count - 1 do
      TgxSceneBuffer(FBuffers[i]).NotifyChange(Self);
end;

procedure TgxScene.SetupLights(maxLights: Integer);
var
  i: Integer;
  lightSource: TgxLightSource;
  nbLights: Integer;
  lPos: TVector4f;
begin
  nbLights := FLights.Count;
  if nbLights > maxLights then
    nbLights := maxLights;
  // setup all light sources
  with CurrentContext.gxStates, CurrentContext.PipeLineTransformation do
  begin
    for i := 0 to nbLights - 1 do
    begin
      lightSource := TgxLightSource(FLights[i]);
      if Assigned(lightSource) then
        with lightSource do
        begin
          LightEnabling[FLightID] := Shining;
          if Shining then
          begin
            if FixedFunctionPipeLight then
            begin
              RebuildMatrix;
              if LightStyle in [lsParallel, lsParallelSpot] then
              begin
                SetModelMatrix(AbsoluteMatrix);
                glLightfv(GL_LIGHT0 + FLightID, GL_POSITION, @SpotDirection.AsAddress^);
              end
              else
              begin
                SetModelMatrix(Parent.AbsoluteMatrix);
                glLightfv(GL_LIGHT0 + FLightID, GL_POSITION, @Position.AsAddress^);
              end;
              if LightStyle in [lsSpot, lsParallelSpot] then
              begin
                if FSpotCutOff <> 180 then
                  glLightfv(GL_LIGHT0 + FLightID, GL_SPOT_DIRECTION, @FSpotDirection.AsAddress^);
              end;
            end;

            lPos := lightSource.AbsolutePosition;
            if LightStyle in [lsParallel, lsParallelSpot] then
              lPos.W := 0.0
            else
              lPos.W := 1.0;
            LightPosition[FLightID] := lPos;
            LightSpotDirection[FLightID] := lightSource.SpotDirection.AsAffineVector;

            LightAmbient[FLightID] := FAmbient.Color;
            LightDiffuse[FLightID] := FDiffuse.Color;
            LightSpecular[FLightID] := FSpecular.Color;

            LightConstantAtten[FLightID] := FConstAttenuation;
            LightLinearAtten[FLightID] := FLinearAttenuation;
            LightQuadraticAtten[FLightID] := FQuadraticAttenuation;

            LightSpotExponent[FLightID] := FSpotExponent;
            LightSpotCutoff[FLightID] := FSpotCutOff;
          end;
        end
      else
        LightEnabling[i] := False;
    end;
    // turn off other lights
    for i := nbLights to maxLights - 1 do
      LightEnabling[i] := False;
    SetModelMatrix(IdentityHmgMatrix);
  end;
end;

// ------------------
// ------------------ TgxFogEnvironment ------------------
// ------------------

// Note: The fog implementation is not conformal with the rest of the scene management
// because it is viewer bound not scene bound.

constructor TgxFogEnvironment.Create(AOwner: TPersistent);
begin
  inherited;
  FSceneBuffer := (AOwner as TgxSceneBuffer);
  FFogColor := TgxColor.CreateInitialized(Self, clrBlack);
  FFogMode := fmLinear;
  FFogStart := 10;
  FFogEnd := 1000;
  FFogDistance := fdDefault;
end;

destructor TgxFogEnvironment.Destroy;
begin
  FFogColor.Free;
  inherited Destroy;
end;

procedure TgxFogEnvironment.SetFogColor(Value: TgxColor);
begin
  if Assigned(Value) then
  begin
    FFogColor.Assign(Value);
    NotifyChange(Self);
  end;
end;

procedure TgxFogEnvironment.SetFogStart(Value: Single);
begin
  if Value <> FFogStart then
  begin
    FFogStart := Value;
    NotifyChange(Self);
  end;
end;

procedure TgxFogEnvironment.SetFogEnd(Value: Single);
begin
  if Value <> FFogEnd then
  begin
    FFogEnd := Value;
    NotifyChange(Self);
  end;
end;

procedure TgxFogEnvironment.Assign(Source: TPersistent);
begin
  if Source is TgxFogEnvironment then
  begin
    FFogColor.Assign(TgxFogEnvironment(Source).FFogColor);
    FFogStart := TgxFogEnvironment(Source).FFogStart;
    FFogEnd := TgxFogEnvironment(Source).FFogEnd;
    FFogMode := TgxFogEnvironment(Source).FFogMode;
    FFogDistance := TgxFogEnvironment(Source).FFogDistance;
    NotifyChange(Self);
  end;
  inherited;
end;

function TgxFogEnvironment.IsAtDefaultValues: Boolean;
begin
  Result := VectorEquals(FogColor.Color, FogColor.DefaultColor) and (FogStart = 10) and (FogEnd = 1000) and (FogMode = fmLinear)
    and (FogDistance = fdDefault);
end;

procedure TgxFogEnvironment.SetFogMode(Value: TgxFogMode);
begin
  if Value <> FFogMode then
  begin
    FFogMode := Value;
    NotifyChange(Self);
  end;
end;

procedure TgxFogEnvironment.SetFogDistance(const val: TgxFogDistance);
begin
  if val <> FFogDistance then
  begin
    FFogDistance := val;
    NotifyChange(Self);
  end;
end;

var
  vImplemDependantFogDistanceDefault: Integer = -1;

procedure TgxFogEnvironment.ApplyFog;
var
  tempActivation: Boolean;
begin
  with FSceneBuffer do
  begin
    if not Assigned(FRenderingContext) then
      Exit;
    tempActivation := not FRenderingContext.Active;
    if tempActivation then
      FRenderingContext.Activate;
  end;

  case FFogMode of
    fmLinear:
      glFogi(GL_FOG_MODE, GL_LINEAR);
    fmExp:
      begin
        glFogi(GL_FOG_MODE, GL_EXP);
        glFogf(GL_FOG_DENSITY, FFogColor.alpha);
      end;
    fmExp2:
      begin
        glFogi(GL_FOG_MODE, GL_EXP2);
        glFogf(GL_FOG_DENSITY, FFogColor.alpha);
      end;
  end;
  glFogfv(GL_FOG_COLOR, @FFogColor.AsAddress^);
  glFogf(GL_FOG_START, FFogStart);
  glFogf(GL_FOG_END, FFogEnd);
  case FogDistance of
    fdDefault:
      begin
        if vImplemDependantFogDistanceDefault = -1 then
          glGetIntegerv(Cardinal(GL_FOG_DISTANCE_MODE_NV), // GL_FOG_DISTANCE_MODE_NV,
            @vImplemDependantFogDistanceDefault)
        else
          glFogi(Cardinal(GL_FOG_DISTANCE_MODE_NV), vImplemDependantFogDistanceDefault);
      end;
    fdEyePlane:
      glFogi(Cardinal(GL_FOG_DISTANCE_MODE_NV), GL_EYE_PLANE_ABSOLUTE_NV);
    fdEyeRadial:
      glFogi(GL_FOG_DISTANCE_MODE_NV, GL_EYE_RADIAL_NV);
  else
    Assert(False);
  end;

  if tempActivation then
    FSceneBuffer.RenderingContext.Deactivate;
end;

// ------------------
// ------------------ TgxSceneBuffer ------------------
// ------------------

constructor TgxSceneBuffer.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);

  // initialize private state variables
  FFogEnvironment := TgxFogEnvironment.Create(Self);
  FBackgroundColor := TColors.SysBtnFace;
  FBackgroundAlpha := 1;
  FAmbientColor := TgxColor.CreateInitialized(Self, clrGray20);
  FDepthTest := True;
  FFaceCulling := True;
  FLighting := True;
  FAntiAliasing := aaDefault;
  FDepthPrecision := dpDefault;
  FColorDepth := cdDefault;
  FShadeModel := smDefault;
  FFogEnable := False;
  FLayer := clMainPlane;
  FAfterRenderEffects := TgxPersistentObjectList.Create;
  FContextOptions := [roDoubleBuffer, roRenderToWindow, roDebugContext];
  ResetPerformanceMonitor;
end;

destructor TgxSceneBuffer.Destroy;
begin
  Melt;
  DestroyRC;
  FAmbientColor.Free;
  FAfterRenderEffects.Free;
  FFogEnvironment.Free;
  inherited Destroy;
end;

procedure TgxSceneBuffer.PrepareGLContext;
begin
  if Assigned(FOnPrepareGLContext) then
    FOnPrepareGLContext(Self);
end;

procedure TgxSceneBuffer.SetupRCOptions(Context: TgxContext);
const
  cColorDepthToColorBits: array [cdDefault .. cdFloat128bits] of Integer = (24, 8, 16, 24, 64, 128); // float_type
  cDepthPrecisionToDepthBits: array [dpDefault .. dp32bits] of Integer = (24, 16, 24, 32);
var
  locOptions: TgxRCOptions;
  locStencilBits, locAlphaBits, locColorBits: Integer;
begin
  locOptions := [];

  if roDoubleBuffer in ContextOptions then
    locOptions := locOptions + [rcoDoubleBuffered];
  if roStereo in ContextOptions then
    locOptions := locOptions + [rcoStereo];
  if roDebugContext in ContextOptions then
    locOptions := locOptions + [rcoDebug];
  if roOpenGL_ES2_Context in ContextOptions then
    locOptions := locOptions + [rcoOGL_ES];
  if roNoColorBuffer in ContextOptions then
    locColorBits := 0
  else
    locColorBits := cColorDepthToColorBits[ColorDepth];
  if roStencilBuffer in ContextOptions then
    locStencilBits := 8
  else
    locStencilBits := 0;
  if roDestinationAlpha in ContextOptions then
    locAlphaBits := 8
  else
    locAlphaBits := 0;
  with Context do
  begin
    if roSoftwareMode in ContextOptions then
      Acceleration := chaSoftware
    else
      Acceleration := chaHardware;
    Options := locOptions;
    ColorBits := locColorBits;
    DepthBits := cDepthPrecisionToDepthBits[DepthPrecision];
    StencilBits := locStencilBits;
    AlphaBits := locAlphaBits;
    AccumBits := AccumBufferBits;
    AuxBuffers := 0;
    AntiAliasing := Self.AntiAliasing;
    Layer := Self.Layer;
    { gxStates.ForwardContext := roForwardContext in ContextOptions; }
    PrepareGLContext;
  end;
end;

procedure TgxSceneBuffer.CreateRC(AWindowHandle: THandle; memoryContext: Boolean; BufferCount: Integer);
begin
  DestroyRC;
  FRendering := True;

  try
    // will be freed in DestroyWindowHandle
    FRenderingContext := GXContextManager.CreateContext;
    if not Assigned(FRenderingContext) then
      raise Exception.Create('Failed to create RenderingContext.');
    SetupRCOptions(FRenderingContext);

    if Assigned(FCamera) and Assigned(FCamera.FScene) then
      FCamera.FScene.AddBuffer(Self);

    with FRenderingContext do
    begin
      try
        if memoryContext then
          CreateMemoryContext(AWindowHandle, FViewPort.width, FViewPort.height, BufferCount)
        else
          CreateContext(AWindowHandle);
      except
        FreeAndNil(FRenderingContext);
        raise;
      end;
    end;
    FRenderingContext.Activate;
    try
      // this one should NOT be replaced with an assert
      if (GL_VERSION < 1.1) then
      begin
        ShowMessage(strWrongVersion);
        Abort;
      end;
      // define viewport, this is necessary because the first WM_SIZE message
      // is posted before the rendering context has been created
      FRenderingContext.gxStates.viewport := Vector4iMake(FViewPort.Left, FViewPort.Top, FViewPort.width, FViewPort.height);
      // set up initial context states
      SetupRenderingContext(FRenderingContext);
      FRenderingContext.gxStates.ColorClearValue := ConvertWinColor(FBackgroundColor);
    finally
      FRenderingContext.Deactivate;
    end;
  finally
    FRendering := False;
  end;
end;

procedure TgxSceneBuffer.DestroyRC;
begin
  if Assigned(FRenderingContext) then
  begin
    Melt;
    // for some obscure reason, Mesa3D doesn't like this call... any help welcome
    FreeAndNil(FSelector);
    FreeAndNil(FRenderingContext);
    if Assigned(FCamera) and Assigned(FCamera.FScene) then
      FCamera.FScene.RemoveBuffer(Self);
  end;
end;

function TgxSceneBuffer.RCInstantiated: Boolean;
begin
  Result := Assigned(FRenderingContext);
end;

procedure TgxSceneBuffer.Resize(newLeft, newTop, newWidth, newHeight: Integer);
begin
  if newWidth < 1 then
    newWidth := 1;
  if newHeight < 1 then
    newHeight := 1;
  FViewPort.Left := newLeft;
  FViewPort.Top := newTop;
  FViewPort.width := newWidth;
  FViewPort.height := newHeight;
  if Assigned(FRenderingContext) then
  begin
    FRenderingContext.Activate;
    try
      // Part of workaround for MS OpenGL "black borders" bug
      FRenderingContext.gxStates.viewport := Vector4iMake(FViewPort.Left, FViewPort.Top, FViewPort.width, FViewPort.height);
    finally
      FRenderingContext.Deactivate;
    end;
  end;
end;

function TgxSceneBuffer.Acceleration: TgxContextAcceleration;
begin
  if Assigned(FRenderingContext) then
    Result := FRenderingContext.Acceleration
  else
    Result := chaUnknown;
end;

procedure TgxSceneBuffer.SetupRenderingContext(Context: TgxContext);

  procedure SetState(bool: Boolean; csState: TgxState);
  begin
    case bool of
      True:
        Context.gxStates.PerformEnable(csState);
      False:
        Context.gxStates.PerformDisable(csState);
    end;
  end;

var
  LColorDepth: Cardinal;
begin
  if not Assigned(Context) then
    Exit;

  if not(roForwardContext in ContextOptions) then
  begin
    glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @FAmbientColor.AsAddress^);
    if roTwoSideLighting in FContextOptions then
      glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE)
    else
      glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_FALSE);
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
    case ShadeModel of
      smDefault, smSmooth:
        glShadeModel(GL_SMOOTH);
      smFlat:
        glShadeModel(GL_FLAT);
    else
      Assert(False, strErrorEx + strUnknownType);
    end;
  end;

  with Context.gxStates do
  begin
    Enable(stNormalize);
    SetState(DepthTest, stDepthTest);
    SetState(FaceCulling, stCullFace);
    SetState(Lighting, stLighting);
    SetState(FogEnable, stFog);
    Disable(stDepthClamp);
    if not(roForwardContext in ContextOptions) then
    begin
      glGetIntegerv(GL_BLUE_BITS, @LColorDepth); // could've used red or green too
      SetState((LColorDepth < 8), stDither);
    end;
    ResetAllTextureMatrix;
  end;
end;

function TgxSceneBuffer.GetLimit(Which: TgxLimitType): Integer;
var
  VP: array [0 .. 1] of Double;
begin
  case Which of
    limClipPlanes:
      glGetIntegerv(GL_MAX_CLIP_PLANES, @Result);
    limEvalOrder:
      glGetIntegerv(GL_MAX_EVAL_ORDER, @Result);
    limLights:
      glGetIntegerv(GL_MAX_LIGHTS, @Result);
    limListNesting:
      glGetIntegerv(GL_MAX_LIST_NESTING, @Result);
    limModelViewStack:
      glGetIntegerv(GL_MAX_MODELVIEW_STACK_DEPTH, @Result);
    limNameStack:
      glGetIntegerv(GL_MAX_NAME_STACK_DEPTH, @Result);
    limPixelMapTable:
      glGetIntegerv(GL_MAX_PIXEL_MAP_TABLE, @Result);
    limProjectionStack:
      glGetIntegerv(GL_MAX_PROJECTION_STACK_DEPTH, @Result);
    limTextureSize:
      glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Result);
    limTextureStack:
      glGetIntegerv(GL_MAX_TEXTURE_STACK_DEPTH, @Result);
    limViewportDims:
      begin
        glGetDoublev(GL_MAX_VIEWPORT_DIMS, @VP);
        if VP[0] > VP[1] then
          Result := Round(VP[0])
        else
          Result := Round(VP[1]);
      end;
    limAccumAlphaBits: glGetIntegerv(GL_ACCUM_ALPHA_BITS, @Result);
    limAccumBlueBits: glGetIntegerv(GL_ACCUM_BLUE_BITS, @Result);
    limAccumGreenBits: glGetIntegerv(GL_ACCUM_GREEN_BITS, @Result);
    limAccumRedBits: glGetIntegerv(GL_ACCUM_RED_BITS, @Result);
    limAlphaBits: glGetIntegerv(GL_ALPHA_BITS, @Result);
    limAuxBuffers: glGetIntegerv(GL_AUX_BUFFERS, @Result);
    limDepthBits: glGetIntegerv(GL_DEPTH_BITS, @Result);
    limStencilBits: glGetIntegerv(GL_STENCIL_BITS, @Result);
    limBlueBits: glGetIntegerv(GL_BLUE_BITS, @Result);
    limGreenBits: glGetIntegerv(GL_GREEN_BITS, @Result);
    limRedBits: glGetIntegerv(GL_RED_BITS, @Result);
    limIndexBits: glGetIntegerv(GL_INDEX_BITS, @Result);
    limStereo: glGetIntegerv(GL_STEREO, @Result);
    limDoubleBuffer: glGetIntegerv(GL_DOUBLEBUFFER, @Result);
    limSubpixelBits: glGetIntegerv(GL_SUBPIXEL_BITS, @Result);
    limNbTextureUnits: glGetIntegerv(GL_MAX_TEXTURE_UNITS_ARB, @Result);
  else
    Result := 0;
  end;
end;

procedure TgxSceneBuffer.RenderToFile(const AFile: string; DPI: Integer);
var
  ABitmap: TBitmap;
  saveAllowed: Boolean;
  fileName: string;
begin
  Assert((not FRendering), strAlreadyRendering);
  ABitmap := TBitmap.Create;
  try
    ABitmap.width := FViewPort.width;
    ABitmap.height := FViewPort.height;
    { TODO -oPW : E2129 Cannot assign to a read-only property }
    // aBitmap.PixelFormat := glpf24Bit;
    RenderToBitmap(ABitmap, DPI);
    fileName := AFile;
    if fileName = '' then
      saveAllowed := SavePictureDialog(fileName)
    else
      saveAllowed := True;
    if saveAllowed then
    begin
      if FileExists(fileName) then
        saveAllowed := QuestionDlg(Format('Overwrite file %s?', [fileName]));
      if saveAllowed then
        ABitmap.SaveToFile(fileName);
    end;
  finally
    ABitmap.Free;
  end;
end;

procedure TgxSceneBuffer.RenderToFile(const AFile: string; bmpWidth, bmpHeight: Integer);
var
  ABitmap: TBitmap;
  saveAllowed: Boolean;
  fileName: string;
begin
  Assert((not FRendering), strAlreadyRendering);
  ABitmap := TBitmap.Create;
  try
    ABitmap.width := bmpWidth;
    ABitmap.height := bmpHeight;
    { TODO -oPW : E2129 Cannot assign to a read-only property }
    (* GLS-> aBitmap.PixelFormat := glpf24Bit; *)
    RenderToBitmap(ABitmap,
      // GLS-> (GetDeviceLogicalPixelsX(Cardinal(ABitmap.Canvas.Handle)) * bmpWidth) div
      (GetDeviceLogicalPixelsX(ABitmap.Handle) * bmpWidth) div FViewPort.width);
    fileName := AFile;
    if fileName = '' then
      saveAllowed := SavePictureDialog(fileName)
    else
      saveAllowed := True;
    if saveAllowed then
    begin
      if FileExists(fileName) then
        saveAllowed := QuestionDlg(Format('Overwrite file %s?', [fileName]));
      if saveAllowed then
        ABitmap.SaveToFile(fileName);
    end;
  finally
    ABitmap.Free;
  end;
end;

function TgxSceneBuffer.CreateSnapShot: TgxBitmap32;
begin
  Result := TgxBitmap32.Create;
  Result.width := FViewPort.width;
  Result.height := FViewPort.height;
  if Assigned(Camera) and Assigned(Camera.Scene) then
  begin
    FRenderingContext.Activate;
    try
      Result.ReadPixels(rect(0, 0, FViewPort.width, FViewPort.height));
    finally
      FRenderingContext.Deactivate;
    end;
  end;
end;

function TgxSceneBuffer.CreateSnapShotBitmap: TBitmap;
var
  bmp32: TgxBitmap32;
begin
  bmp32 := CreateSnapShot;
  try
    Result := bmp32.Create32BitsBitmap;
  finally
    bmp32.Free;
  end;
end;

procedure TgxSceneBuffer.CopyToTexture(aTexture: TgxTexture);
begin
  CopyToTexture(aTexture, 0, 0, width, height, 0, 0);
end;

procedure TgxSceneBuffer.CopyToTexture(aTexture: TgxTexture; xSrc, ySrc, AWidth, AHeight: Integer; xDest, yDest: Integer;
  glCubeFace: GLEnum = 0);
var
  bindTarget: TglTextureTarget;
begin
  if RenderingContext <> nil then
  begin
    RenderingContext.Activate;
    try
      if not(aTexture.Image is TgxBlankImage) then
        aTexture.ImageClassName := TgxBlankImage.ClassName;
      if aTexture.Image.width <> AWidth then
        TgxBlankImage(aTexture.Image).width := AWidth;
      if aTexture.Image.height <> AHeight then
        TgxBlankImage(aTexture.Image).height := AHeight;
      if aTexture.Image.Depth <> 0 then
        TgxBlankImage(aTexture.Image).Depth := 0;
      if TgxBlankImage(aTexture.Image).CubeMap <> (glCubeFace > 0) then
        TgxBlankImage(aTexture.Image).CubeMap := (glCubeFace > 0);

      bindTarget := aTexture.Image.NativeTextureTarget;
      RenderingContext.gxStates.TextureBinding[0, bindTarget] := aTexture.Handle;
      if glCubeFace > 0 then
        glCopyTexSubImage2D(glCubeFace, 0, xDest, yDest, xSrc, ySrc, AWidth, AHeight)
      else
        glCopyTexSubImage2D(DecodeTextureTarget(bindTarget), 0, xDest, yDest, xSrc, ySrc, AWidth, AHeight)
    finally
      RenderingContext.Deactivate;
    end;
  end;
end;

procedure TgxSceneBuffer.SaveAsFloatToFile(const aFilename: string);
var
  Data: Pointer;
  DataSize: Integer;
  stream: TMemoryStream;
const
  FloatSize = 4;
begin
  if Assigned(Camera) and Assigned(Camera.Scene) then
  begin
    DataSize := width * height * FloatSize * FloatSize;
    GetMem(Data, DataSize);
    FRenderingContext.Activate;
    try
      glReadPixels(0, 0, width, height, GL_RGBA, GL_FLOAT, Data);
      glGetError;

      stream := TMemoryStream.Create;
      try
        stream.Write(Data^, DataSize);
        stream.SaveToFile(aFilename);
      finally
        stream.Free;
      end;
    finally
      FRenderingContext.Deactivate;
      FreeMem(Data);
    end;
  end;
end;

procedure TgxSceneBuffer.SetViewPort(x, y, W, H: Integer);
begin
  with FViewPort do
  begin
    Left := x;
    Top := y;
    width := W;
    height := H;
  end;
  NotifyChange(Self);
end;

function TgxSceneBuffer.width: Integer;
begin
  Result := FViewPort.width;
end;

function TgxSceneBuffer.height: Integer;
begin
  Result := FViewPort.height;
end;

procedure TgxSceneBuffer.Freeze;
begin
  if Freezed then
    Exit;
  if RenderingContext = nil then
    Exit;
  Render;
  FFreezed := True;
  RenderingContext.Activate;
  try
    FFreezeBuffer := AllocMem(FViewPort.width * FViewPort.height * 4);
    glReadPixels(0, 0, FViewPort.width, FViewPort.height, GL_RGBA, GL_UNSIGNED_BYTE, FFreezeBuffer);
    FFreezedViewPort := FViewPort;
  finally
    RenderingContext.Deactivate;
  end;
end;

procedure TgxSceneBuffer.Melt;
begin
  if not Freezed then
    Exit;
  FreeMem(FFreezeBuffer);
  FFreezeBuffer := nil;
  FFreezed := False;
end;

procedure TgxSceneBuffer.RenderToBitmap(ABitmap: TBitmap; DPI: Integer);
var
  nativeContext: TgxContext;
  aColorBits: Integer;
begin
  Assert((not FRendering), strAlreadyRendering);
  FRendering := True;
  nativeContext := RenderingContext;
  try
    aColorBits := PixelFormatToColorBits(ABitmap.PixelFormat);
    if aColorBits < 8 then
      aColorBits := 8;
    FRenderingContext := GXContextManager.CreateContext;
    SetupRCOptions(FRenderingContext);
    with FRenderingContext do
    begin
      Options := []; // no such things for bitmap rendering
      ColorBits := aColorBits; // honour Bitmap's pixel depth
      AntiAliasing := aaNone; // no AA for bitmap rendering
      CreateContext(ABitmap.Handle); // CreateContext(ABitmap.Canvas.Handle);
    end;
    try
      FRenderingContext.Activate;
      try
        SetupRenderingContext(FRenderingContext);
        FRenderingContext.gxStates.ColorClearValue := ConvertWinColor(FBackgroundColor);
        // set the desired viewport and limit output to this rectangle
        with FViewPort do
        begin
          Left := 0;
          Top := 0;
          width := ABitmap.width;
          height := ABitmap.height;
          FRenderingContext.gxStates.viewport := Vector4iMake(Left, Top, width, height);
        end;
        ClearBuffers;
        FRenderDPI := DPI;
        if FRenderDPI = 0 then
          FRenderDPI := GetDeviceLogicalPixelsX(ABitmap.Handle);
        // render
        DoBaseRender(FViewPort, FRenderDPI, dsPrinting, nil);
        if nativeContext <> nil then
          FViewPort := TRectangle(nativeContext.gxStates.viewport);
        glFinish;
      finally
        FRenderingContext.Deactivate;
      end;
    finally
      FRenderingContext.Free;
    end;
  finally
    FRenderingContext := nativeContext;
    FRendering := False;
  end;
  if Assigned(FAfterRender) then
    if Owner is TComponent then
      if not(csDesigning in TComponent(Owner).ComponentState) then
        FAfterRender(Self);
end;

procedure TgxSceneBuffer.ShowInfo(Modal: Boolean);
begin
  if not Assigned(FRenderingContext) then
    Exit;
  // most info is available with active context only
  FRenderingContext.Activate;
  try
    InvokeInfoForm(Self, Modal);
  finally
    FRenderingContext.Deactivate;
  end;
end;

procedure TgxSceneBuffer.ResetPerformanceMonitor;
begin
  FFramesPerSecond := 0;
  FFrameCount := 0;
  FFirstPerfCounter := 0;
end;

procedure TgxSceneBuffer.PushViewMatrix(const newMatrix: TMatrix4f);
var
  n: Integer;
begin
  n := Length(FViewMatrixStack);
  SetLength(FViewMatrixStack, n + 1);
  FViewMatrixStack[n] := RenderingContext.PipeLineTransformation.ViewMatrix^;
  RenderingContext.PipeLineTransformation.SetViewMatrix(newMatrix);
end;

procedure TgxSceneBuffer.PopViewMatrix;
var
  n: Integer;
begin
  n := High(FViewMatrixStack);
  Assert(n >= 0, 'Unbalanced PopViewMatrix');
  RenderingContext.PipeLineTransformation.SetViewMatrix(FViewMatrixStack[n]);
  SetLength(FViewMatrixStack, n);
end;

procedure TgxSceneBuffer.PushProjectionMatrix(const newMatrix: TMatrix4f);
var
  n: Integer;
begin
  n := Length(FProjectionMatrixStack);
  SetLength(FProjectionMatrixStack, n + 1);
  FProjectionMatrixStack[n] := RenderingContext.PipeLineTransformation.ProjectionMatrix^;
  RenderingContext.PipeLineTransformation.SetProjectionMatrix(newMatrix);
end;

procedure TgxSceneBuffer.PopProjectionMatrix;
var
  n: Integer;
begin
  n := High(FProjectionMatrixStack);
  Assert(n >= 0, 'Unbalanced PopProjectionMatrix');
  RenderingContext.PipeLineTransformation.SetProjectionMatrix(FProjectionMatrixStack[n]);
  SetLength(FProjectionMatrixStack, n);
end;

function TgxSceneBuffer.ProjectionMatrix;
begin
  Result := RenderingContext.PipeLineTransformation.ProjectionMatrix^;
end;

function TgxSceneBuffer.ViewMatrix: TMatrix4f;
begin
  Result := RenderingContext.PipeLineTransformation.ViewMatrix^;
end;

function TgxSceneBuffer.ModelMatrix: TMatrix4f;
begin
  Result := RenderingContext.PipeLineTransformation.ModelMatrix^;
end;

function TgxSceneBuffer.OrthoScreenToWorld(screenX, screenY: Integer): TAffineVector;
var
  camPos, camUp, camRight: TAffineVector;
  f: Single;
begin
  if Assigned(FCamera) then
  begin
    SetVector(camPos, FCameraAbsolutePosition);
    if Camera.TargetObject <> nil then
    begin
      SetVector(camUp, FCamera.AbsoluteUpVectorToTarget);
      SetVector(camRight, FCamera.AbsoluteRightVectorToTarget);
    end
    else
    begin
      SetVector(camUp, Camera.AbsoluteUp);
      SetVector(camRight, Camera.AbsoluteRight);
    end;
    f := 100 * FCamera.NearPlaneBias / (FCamera.FocalLength * FCamera.SceneScale);
    if FViewPort.width > FViewPort.height then
      f := f / FViewPort.width
    else
      f := f / FViewPort.height;
    SetVector(Result, VectorCombine3(camPos, camUp, camRight, 1, (screenY - (FViewPort.height div 2)) * f,
      (screenX - (FViewPort.width div 2)) * f));
  end
  else
    Result := NullVector;
end;

function TgxSceneBuffer.ScreenToWorld(const aPoint: TAffineVector): TAffineVector;
var
  rslt: TVector4f;
begin
  if Assigned(FCamera) and UnProject(VectorMake(aPoint), RenderingContext.PipeLineTransformation.ViewProjectionMatrix^,
    PHomogeneousIntVector(@FViewPort)^, rslt) then
    Result := Vector3fMake(rslt)
  else
    Result := aPoint;
end;

function TgxSceneBuffer.ScreenToWorld(const aPoint: TVector4f): TVector4f;
begin
  MakePoint(Result, ScreenToWorld(AffineVectorMake(aPoint)));
end;

function TgxSceneBuffer.ScreenToWorld(screenX, screenY: Integer): TAffineVector;
begin
  Result := ScreenToWorld(AffineVectorMake(screenX, FViewPort.height - screenY, 0));
end;

function TgxSceneBuffer.WorldToScreen(const aPoint: TAffineVector): TAffineVector;
var
  rslt: TVector4f;
begin
  RenderingContext.Activate;
  try
    PrepareRenderingMatrices(FViewPort, FRenderDPI);
    if Assigned(FCamera) and Project(VectorMake(aPoint), RenderingContext.PipeLineTransformation.ViewProjectionMatrix^,
      TVector4i(FViewPort), rslt) then
      Result := Vector3fMake(rslt)
    else
      Result := aPoint;
  finally
    RenderingContext.Deactivate;
  end;
end;

function TgxSceneBuffer.WorldToScreen(const aPoint: TVector4f): TVector4f;
begin
  SetVector(Result, WorldToScreen(AffineVectorMake(aPoint)));
end;

procedure TgxSceneBuffer.WorldToScreen(points: PVector4f; nbPoints: Integer);
var
  i: Integer;
begin
  if Assigned(FCamera) then
  begin
    for i := nbPoints - 1 downto 0 do
    begin
      Project(points^, RenderingContext.PipeLineTransformation.ViewProjectionMatrix^,
        PHomogeneousIntVector(@FViewPort)^, points^);
      Inc(points);
    end;
  end;
end;

function TgxSceneBuffer.ScreenToVector(const aPoint: TAffineVector): TAffineVector;
begin
  Result := VectorSubtract(ScreenToWorld(aPoint), PAffineVector(@FCameraAbsolutePosition)^);
end;

function TgxSceneBuffer.ScreenToVector(const aPoint: TVector4f): TVector4f;
begin
  SetVector(Result, VectorSubtract(ScreenToWorld(aPoint), FCameraAbsolutePosition));
  Result.W := 0;
end;

function TgxSceneBuffer.ScreenToVector(const x, y: Integer): TVector4f;
var
  av: TAffineVector;
begin
  av.x := x;
  av.y := y;
  av.z := 0;
  SetVector(Result, ScreenToVector(av));
end;

function TgxSceneBuffer.VectorToScreen(const VectToCam: TAffineVector): TAffineVector;
begin
  Result := WorldToScreen(VectorAdd(VectToCam, PAffineVector(@FCameraAbsolutePosition)^));
end;

function TgxSceneBuffer.ScreenVectorIntersectWithPlane(const aScreenPoint: TVector4f; const planePoint, planeNormal: TVector4f;
  var intersectPoint: TVector4f): Boolean;
var
  v: TVector4f;
begin
  if Assigned(FCamera) then
  begin
    SetVector(v, ScreenToVector(aScreenPoint));
    Result := RayCastPlaneIntersect(FCameraAbsolutePosition, v, planePoint, planeNormal, @intersectPoint);
    intersectPoint.W := 1;
  end
  else
    Result := False;
end;

function TgxSceneBuffer.ScreenVectorIntersectWithPlaneXY(const aScreenPoint: TVector4f; const z: Single;
  var intersectPoint: TVector4f): Boolean;
begin
  Result := ScreenVectorIntersectWithPlane(aScreenPoint, VectorMake(0, 0, z), ZHmgVector, intersectPoint);
  intersectPoint.W := 0;
end;

function TgxSceneBuffer.ScreenVectorIntersectWithPlaneYZ(const aScreenPoint: TVector4f; const x: Single;
  var intersectPoint: TVector4f): Boolean;
begin
  Result := ScreenVectorIntersectWithPlane(aScreenPoint, VectorMake(x, 0, 0), XHmgVector, intersectPoint);
  intersectPoint.W := 0;
end;

function TgxSceneBuffer.ScreenVectorIntersectWithPlaneXZ(const aScreenPoint: TVector4f; const y: Single;
  var intersectPoint: TVector4f): Boolean;
begin
  Result := ScreenVectorIntersectWithPlane(aScreenPoint, VectorMake(0, y, 0), YHmgVector, intersectPoint);
  intersectPoint.W := 0;
end;

function TgxSceneBuffer.PixelRayToWorld(x, y: Integer): TAffineVector;
var
  dov, np, fp, z, dst, wrpdst: Single;
  vec, cam, targ, rayhit, pix: TAffineVector;
  camAng: real;
begin
  if Camera.CameraStyle = csOrtho2D then
    dov := 2
  else
    dov := Camera.DepthOfView;
  np := Camera.NearPlane;
  fp := Camera.NearPlane + dov;
  z := GetPixelDepth(x, y);
  dst := (fp * np) / (fp - z * dov); // calc from z-buffer value to world depth
  // ------------------------
  // z:=1-(fp/d-1)/(fp/np-1);  //calc from world depth to z-buffer value
  // ------------------------
  vec.x := x;
  vec.y := FViewPort.height - y;
  vec.z := 0;
  vec := ScreenToVector(vec);
  NormalizeVector(vec);
  SetVector(cam, Camera.AbsolutePosition);
  // targ:=Camera.TargetObject.Position.AsAffineVector;
  // SubtractVector(targ,cam);
  pix.x := FViewPort.width * 0.5;
  pix.y := FViewPort.height * 0.5;
  pix.z := 0;
  targ := Self.ScreenToVector(pix);

  camAng := VectorAngleCosine(targ, vec);
  wrpdst := dst / camAng;
  rayhit := cam;
  CombineVector(rayhit, vec, wrpdst);
  Result := rayhit;
end;

procedure TgxSceneBuffer.ClearBuffers;
var
  bufferBits: GLbitfield;
begin
  if roNoDepthBufferClear in ContextOptions then
    bufferBits := 0
  else
  begin
    bufferBits := GL_DEPTH_BUFFER_BIT;
    CurrentContext.gxStates.DepthWriteMask := True;
  end;
  if ContextOptions * [roNoColorBuffer, roNoColorBufferClear] = [] then
  begin
    bufferBits := bufferBits or GL_COLOR_BUFFER_BIT;
    CurrentContext.gxStates.SetColorMask(cAllColorComponents);
  end;
  if roStencilBuffer in ContextOptions then
  begin
    bufferBits := bufferBits or GL_STENCIL_BUFFER_BIT;
  end;
  if bufferBits <> 0 then
    glClear(bufferBits);
end;

procedure TgxSceneBuffer.NotifyChange(Sender: TObject);
begin
  DoChange;
end;

procedure TgxSceneBuffer.PickObjects(const rect: TRect; pickList: TgxPickList; objectCountGuess: Integer);
var
  i: Integer;
  obj: TgxBaseSceneObject;
begin
  if not Assigned(FCamera) then
    Exit;
  Assert((not FRendering), strAlreadyRendering);
  Assert(Assigned(pickList));
  FRenderingContext.Activate;
  FRendering := True;
  try
    // Creates best selector which techniques is hardware can do
    if not Assigned(FSelector) then
      FSelector := GetBestSelectorClass.Create;

    xglMapTexCoordToNull; // turn off
    PrepareRenderingMatrices(FViewPort, RenderDPI, @rect);
    FSelector.Hits := -1;
    if objectCountGuess > 0 then
      FSelector.objectCountGuess := objectCountGuess;
    repeat
      FSelector.Start;
      // render the scene (in select mode, nothing is drawn)
      FRenderDPI := 96;
      if Assigned(FCamera) and Assigned(FCamera.FScene) then
        RenderScene(FCamera.FScene, FViewPort.width, FViewPort.height, dsPicking, nil);
    until FSelector.Stop;
    FSelector.FillPickingList(pickList);
    for i := 0 to pickList.Count - 1 do
    begin
      obj := TgxBaseSceneObject(pickList[i]);
      if Assigned(obj.FOnPicked) then
        obj.FOnPicked(obj);
    end;
  finally
    FRendering := False;
    FRenderingContext.Deactivate;
  end;
end;

function TgxSceneBuffer.GetPickedObjects(const rect: TRect; objectCountGuess: Integer = 64): TgxPickList;
begin
  Result := TgxPickList.Create(psMinDepth);
  PickObjects(rect, Result, objectCountGuess);
end;

function TgxSceneBuffer.GetPickedObject(x, y: Integer): TgxBaseSceneObject;
var
  pkList: TgxPickList;
begin
  pkList := GetPickedObjects(rect(x - 1, y - 1, x + 1, y + 1));
  try
    if pkList.Count > 0 then
      Result := TgxBaseSceneObject(pkList.Hit[0])
    else
      Result := nil;
  finally
    pkList.Free;
  end;
end;

function TgxSceneBuffer.GetPixelColor(x, y: Integer): TColor;
var
  buf: array [0 .. 2] of Byte;
begin
  if not Assigned(FCamera) then
  begin
    Result := 0;
    Exit;
  end;
  FRenderingContext.Activate;
  try
    glReadPixels(x, FViewPort.height - y, 1, 1, GL_RGB, GL_UNSIGNED_BYTE, @buf[0]);
  finally
    FRenderingContext.Deactivate;
  end;
  Result := RGB(buf[0], buf[1], buf[2]);
end;

function TgxSceneBuffer.GetPixelDepth(x, y: Integer): Single;
begin
  if not Assigned(FCamera) then
  begin
    Result := 0;
    Exit;
  end;
  FRenderingContext.Activate;
  try
    glReadPixels(x, FViewPort.height - y, 1, 1, GL_DEPTH_COMPONENT, GL_FLOAT, @Result);
  finally
    FRenderingContext.Deactivate;
  end;
end;

function TgxSceneBuffer.PixelDepthToDistance(aDepth: Single): Single;
var
  dov, np, fp: Single;
begin
  if Camera.CameraStyle = csOrtho2D then
    dov := 2
  else
    dov := Camera.DepthOfView; // Depth of View (from np to fp)
  np := Camera.NearPlane; // Near plane distance
  fp := np + dov; // Far plane distance
  Result := (fp * np) / (fp - aDepth * dov);
  // calculate world distance from z-buffer value
end;

function TgxSceneBuffer.PixelToDistance(x, y: Integer): Single;
var
  z, dov, np, fp, dst, camAng: Single;
  norm, coord, vec: TAffineVector;
begin
  z := GetPixelDepth(x, y);
  if Camera.CameraStyle = csOrtho2D then
    dov := 2
  else
    dov := Camera.DepthOfView; // Depth of View (from np to fp)
  np := Camera.NearPlane; // Near plane distance
  fp := np + dov; // Far plane distance
  dst := (np * fp) / (fp - z * dov);
  // calculate from z-buffer value to frustrum depth
  coord.x := x;
  coord.y := y;
  vec := Self.ScreenToVector(coord); // get the pixel vector
  coord.x := FViewPort.width div 2;
  coord.y := FViewPort.height div 2;
  norm := Self.ScreenToVector(coord); // get the absolute camera direction
  camAng := VectorAngleCosine(norm, vec);
  Result := dst / camAng; // compensate for flat frustrum face
end;

procedure TgxSceneBuffer.NotifyMouseMove(Shift: TShiftState; x, y: Single);
begin
  // Nothing
end;

procedure TgxSceneBuffer.PrepareRenderingMatrices(const AViewport: TRectangle; resolution: Integer; pickingRect: PRect = nil);
begin
  RenderingContext.PipeLineTransformation.IdentityAll;
  // setup projection matrix
  if Assigned(pickingRect) then
  begin
    CurrentContext.PipeLineTransformation.SetProjectionMatrix(CreatePickMatrix((pickingRect^.Left + pickingRect^.Right) div 2,
      FViewPort.height - ((pickingRect^.Top + pickingRect^.Bottom) div 2), Abs(pickingRect^.Right - pickingRect^.Left),
      Abs(pickingRect^.Bottom - pickingRect^.Top), TVector4i(FViewPort)));
  end;
  FBaseProjectionMatrix := CurrentContext.PipeLineTransformation.ProjectionMatrix^;

  if Assigned(FCamera) then
  begin
    FCamera.Scene.FCurrentCamera := FCamera;
    // apply camera perpective
    FCamera.ApplyPerspective(AViewport, FViewPort.width, FViewPort.height, resolution);
    // setup model view matrix
    // apply camera transformation (viewpoint)
    FCamera.Apply;
    FCameraAbsolutePosition := FCamera.AbsolutePosition;
  end;
end;

procedure TgxSceneBuffer.DoBaseRender(const AViewport: TRectangle; resolution: Integer; drawState: TGXDrawState;
  baseObject: TgxBaseSceneObject);
begin
  with RenderingContext.gxStates do
  begin
    PrepareRenderingMatrices(AViewport, resolution);
    { if not ForwardContext then }
    begin
      xglMapTexCoordToNull; // force XGL rebind
      xglMapTexCoordToMain;
    end;

    if Assigned(FViewerBeforeRender) and (drawState <> dsPrinting) then
      FViewerBeforeRender(Self);
    if Assigned(FBeforeRender) then
      if Owner is TComponent then
        if not(csDesigning in TComponent(Owner).ComponentState) then
          FBeforeRender(Self);

    if Assigned(FCamera) and Assigned(FCamera.FScene) then
    begin
      with FCamera.FScene do
      begin
        SetupLights(maxLights);
        // if not ForwardContext then
        begin
          if FogEnable then
          begin
            Enable(stFog);
            FogEnvironment.ApplyFog;
          end
          else
            Disable(stFog);
        end;

        RenderScene(FCamera.FScene, AViewport.width, AViewport.height, drawState, baseObject);
      end;
    end;
    if Assigned(FPostRender) then
      if Owner is TComponent then
        if not(csDesigning in TComponent(Owner).ComponentState) then
          FPostRender(Self);
  end;
  Assert(Length(FViewMatrixStack) = 0, 'Unbalance Push/PopViewMatrix.');
  Assert(Length(FProjectionMatrixStack) = 0, 'Unbalance Push/PopProjectionMatrix.');
end;

procedure TgxSceneBuffer.Render;
begin
  Render(nil);
end;

procedure TgxSceneBuffer.Render(baseObject: TgxBaseSceneObject);
var
  perfCounter, framePerf: Int64;

begin
  if FRendering then
    Exit;
  if not Assigned(FRenderingContext) then
    Exit;

  if Freezed and (FFreezeBuffer <> nil) then
  begin
    RenderingContext.Activate;
    try
      RenderingContext.gxStates.ColorClearValue := ConvertWinColor(FBackgroundColor, FBackgroundAlpha);
      ClearBuffers;
      glMatrixMode(GL_PROJECTION);
      glLoadIdentity;
      glMatrixMode(GL_MODELVIEW);
      glLoadIdentity;
      glRasterPos2f(-1, -1);
      glDrawPixels(FFreezedViewPort.width, FFreezedViewPort.height, GL_RGBA, GL_UNSIGNED_BYTE, FFreezeBuffer);
      if not(roNoSwapBuffers in ContextOptions) then
        RenderingContext.SwapBuffers;
    finally
      RenderingContext.Deactivate;
    end;
    Exit;
  end;

  QueryPerformanceCounter(framePerf);

  if Assigned(FCamera) and Assigned(FCamera.FScene) then
  begin
    FCamera.AbsoluteMatrixAsAddress;
    FCamera.FScene.AddBuffer(Self);
  end;

  FRendering := True;
  try
    FRenderingContext.Activate;
    try
      if FFrameCount = 0 then
        QueryPerformanceCounter(FFirstPerfCounter);

      FRenderDPI := 96; // default value for screen
      SetupRenderingContext(FRenderingContext);
      // clear the buffers
      FRenderingContext.gxStates.ColorClearValue := ConvertWinColor(FBackgroundColor, FBackgroundAlpha);
      ClearBuffers;
      // render
      DoBaseRender(FViewPort, RenderDPI, dsRendering, baseObject);

      if not(roNoSwapBuffers in ContextOptions) then
        RenderingContext.SwapBuffers;

      // yes, calculate average frames per second...
      Inc(FFrameCount);
      QueryPerformanceCounter(perfCounter);
      FLastFrameTime := (perfCounter - framePerf) / vCounterFrequency;
      Dec(perfCounter, FFirstPerfCounter);
      if perfCounter > 0 then
        FFramesPerSecond := (FFrameCount * vCounterFrequency) / perfCounter;
    finally
      FRenderingContext.Deactivate;
    end;
    if Assigned(FAfterRender) and (Owner is TComponent) then
      if not(csDesigning in TComponent(Owner).ComponentState) then
        FAfterRender(Self);
  finally
    FRendering := False;
  end;
end;

procedure TgxSceneBuffer.RenderScene(aScene: TgxScene; const viewPortSizeX, viewPortSizeY: Integer; drawState: TGXDrawState;
  baseObject: TgxBaseSceneObject);

var
  i: Integer;
  rci: TgxRenderContextInfo;
  rightVector: TVector4f;
begin
  FAfterRenderEffects.Clear;
  aScene.FCurrentBuffer := Self;
  FillChar(rci, SizeOf(rci), 0);
  rci.Scene := aScene;
  rci.Buffer := Self;
  rci.afterRenderEffects := FAfterRenderEffects;
  rci.ObjectsSorting := aScene.ObjectsSorting;
  rci.VisibilityCulling := aScene.VisibilityCulling;
  rci.bufferFaceCull := FFaceCulling;
  rci.bufferLighting := FLighting;
  rci.bufferFog := FFogEnable;
  rci.bufferDepthTest := FDepthTest;
  rci.drawState := drawState;
  rci.sceneAmbientColor := FAmbientColor.Color;
  rci.primitiveMask := cAllMeshPrimitive;
  with FCamera do
  begin
    rci.cameraPosition := FCameraAbsolutePosition;
    rci.cameraDirection := FLastDirection;
    NormalizeVector(rci.cameraDirection);
    rci.cameraDirection.W := 0;
    rightVector := VectorCrossProduct(rci.cameraDirection, Up.AsVector);
    rci.cameraUp := VectorCrossProduct(rightVector, rci.cameraDirection);
    NormalizeVector(rci.cameraUp);

    with rci.rcci do
    begin
      origin := rci.cameraPosition;
      clippingDirection := rci.cameraDirection;
      viewPortRadius := FViewPortRadius;
      nearClippingDistance := FNearPlane;
      farClippingDistance := FNearPlane + FDepthOfView;
      frustum := RenderingContext.PipeLineTransformation.frustum;
    end;
  end;
  rci.viewPortSize.cx := viewPortSizeX;
  rci.viewPortSize.cy := viewPortSizeY;
  rci.RenderDPI := FRenderDPI;
  rci.gxStates := RenderingContext.gxStates;
  rci.PipeLineTransformation := RenderingContext.PipeLineTransformation;
  rci.proxySubObject := False;
  rci.ignoreMaterials := (roNoColorBuffer in FContextOptions) or (rci.drawState = dsPicking);
  rci.amalgamating := rci.drawState = dsPicking;
  rci.gxStates.SetColorWriting(not rci.ignoreMaterials);
  if Assigned(FInitiateRendering) then
    FInitiateRendering(Self, rci);

  if aScene.InitializableObjects.Count <> 0 then
  begin
    // First initialize all objects and delete them from the list.
    for i := aScene.InitializableObjects.Count - 1 downto 0 do
    begin
      aScene.InitializableObjects.Items[i].InitializeObject( { Self? } aScene, rci);
      aScene.InitializableObjects.Delete(i);
    end;
  end;

  if RenderingContext.IsPraparationNeed then
    RenderingContext.PrepareHandlesData;

  if baseObject = nil then
  begin
    aScene.Objects.Render(rci);
  end
  else
    baseObject.Render(rci);
  rci.gxStates.SetColorWriting(True);
  with FAfterRenderEffects do
    if Count > 0 then
      for i := 0 to Count - 1 do
        TgxObjectAfterEffect(Items[i]).Render(rci);
  if Assigned(FWrapUpRendering) then
    FWrapUpRendering(Self, rci);
end;

procedure TgxSceneBuffer.SetBackgroundColor(AColor: TColor);
begin
  if FBackgroundColor <> AColor then
  begin
    FBackgroundColor := AColor;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetBackgroundAlpha(alpha: Single);
begin
  if FBackgroundAlpha <> alpha then
  begin
    FBackgroundAlpha := alpha;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetAmbientColor(AColor: TgxColor);
begin
  FAmbientColor.Assign(AColor);
end;

procedure TgxSceneBuffer.SetCamera(ACamera: TgxCamera);
begin
  if FCamera <> ACamera then
  begin
    if Assigned(FCamera) then
    begin
      if Assigned(FCamera.FScene) then
        FCamera.FScene.RemoveBuffer(Self);
      FCamera := nil;
    end;
    if Assigned(ACamera) and Assigned(ACamera.FScene) then
    begin
      FCamera := ACamera;
      FCamera.TransformationChanged;
    end;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetContextOptions(Options: TgxContextOptions);
begin
  if FContextOptions <> Options then
  begin
    FContextOptions := Options;
    DoStructuralChange;
  end;
end;

procedure TgxSceneBuffer.SetDepthTest(aValue: Boolean);
begin
  if FDepthTest <> aValue then
  begin
    FDepthTest := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetFaceCulling(aValue: Boolean);
begin
  if FFaceCulling <> aValue then
  begin
    FFaceCulling := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetLayer(const Value: TgxContextLayer);
begin
  if FLayer <> Value then
  begin
    FLayer := Value;
    DoStructuralChange;
  end;
end;

procedure TgxSceneBuffer.SetLighting(aValue: Boolean);
begin
  if FLighting <> aValue then
  begin
    FLighting := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetAntiAliasing(const val: TgxAntiAliasing);
begin
  if FAntiAliasing <> val then
  begin
    FAntiAliasing := val;
    DoStructuralChange;
  end;
end;

procedure TgxSceneBuffer.SetDepthPrecision(const val: TgxDepthPrecision);
begin
  if FDepthPrecision <> val then
  begin
    FDepthPrecision := val;
    DoStructuralChange;
  end;
end;

procedure TgxSceneBuffer.SetColorDepth(const val: TgxColorDepth);
begin
  if FColorDepth <> val then
  begin
    FColorDepth := val;
    DoStructuralChange;
  end;
end;

procedure TgxSceneBuffer.SetShadeModel(const val: TgxShadeModel);
begin
  if FShadeModel <> val then
  begin
    FShadeModel := val;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetFogEnable(aValue: Boolean);
begin
  if FFogEnable <> aValue then
  begin
    FFogEnable := aValue;
    NotifyChange(Self);
  end;
end;

procedure TgxSceneBuffer.SetFogEnvironment(aValue: TgxFogEnvironment);
begin
  FFogEnvironment.Assign(aValue);
  NotifyChange(Self);
end;

function TgxSceneBuffer.StoreFog: Boolean;
begin
  Result := (not FFogEnvironment.IsAtDefaultValues);
end;

procedure TgxSceneBuffer.SetAccumBufferBits(const val: Integer);
begin
  if FAccumBufferBits <> val then
  begin
    FAccumBufferBits := val;
    DoStructuralChange;
  end;
end;

procedure TgxSceneBuffer.DoChange;
begin
  if (not FRendering) and Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TgxSceneBuffer.DoStructuralChange;
var
  bCall: Boolean;
begin
  if Assigned(Owner) then
    bCall := not(csLoading in TComponent(GetOwner).ComponentState)
  else
    bCall := True;
  if bCall and Assigned(FOnStructuralChange) then
    FOnStructuralChange(Self);
end;

// ------------------
// ------------------ TgxNonVisualViewer ------------------
// ------------------

constructor TgxNonVisualViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidth := 256;
  FHeight := 256;
  FBuffer := TgxSceneBuffer.Create(Self);
  FBuffer.OnChange := DoBufferChange;
  FBuffer.OnStructuralChange := DoBufferStructuralChange;
  FBuffer.OnPrepareGLContext := DoOnPrepareVXContext;
end;

destructor TgxNonVisualViewer.Destroy;
begin
  FBuffer.Free;
  inherited Destroy;
end;

procedure TgxNonVisualViewer.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = Camera) then
    Camera := nil;
  inherited;
end;

procedure TgxNonVisualViewer.CopyToTexture(aTexture: TgxTexture);
begin
  CopyToTexture(aTexture, 0, 0, width, height, 0, 0);
end;

procedure TgxNonVisualViewer.CopyToTexture(aTexture: TgxTexture; xSrc, ySrc, width, height: Integer; xDest, yDest: Integer);
begin
  Buffer.CopyToTexture(aTexture, xSrc, ySrc, width, height, xDest, yDest);
end;

procedure TgxNonVisualViewer.CopyToTextureMRT(aTexture: TgxTexture; BufferIndex: Integer);
begin
  CopyToTextureMRT(aTexture, 0, 0, width, height, 0, 0, BufferIndex);
end;

procedure TgxNonVisualViewer.CopyToTextureMRT(aTexture: TgxTexture; xSrc, ySrc, width, height, xDest, yDest,
  BufferIndex: Integer);
var
  target, Handle: Integer;
  buf: Pointer;
  createTexture: Boolean;

  procedure CreateNewTexture;
  begin
    GetMem(buf, width * height * 4);
    try // float_type
      glReadPixels(0, 0, width, height, GL_RGBA, GL_UNSIGNED_BYTE, buf);
      case aTexture.MinFilter of
        miNearest, miLinear:
          glTexImage2d(target, 0, aTexture.OpenGLTextureFormat, width, height,
		    0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
      else
        if (target = GL_TEXTURE_2D) then
        begin
          // hardware-accelerated when supported
          glTexParameteri(target, GL_GENERATE_MIPMAP_SGIS, GL_TRUE);
          glTexImage2d(target, 0, aTexture.OpenGLTextureFormat, width, height,
		    0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
        end
        else
        begin
          glTexImage2d(target, 0, aTexture.OpenGLTextureFormat, width, height,
		    0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
          glGenerateMipmap(target);
        end;
      end;
    finally
      FreeMem(buf);
    end;
  end;

begin
  if Buffer.RenderingContext <> nil then
  begin
    Buffer.RenderingContext.Activate;
    try
      target := DecodeTextureTarget(aTexture.Image.NativeTextureTarget);

      createTexture := True;

      if aTexture.IsFloatType then
      begin // float_type special treatment
        createTexture := False;
        Handle := aTexture.Handle;
      end
      else if (target <> GL_TEXTURE_CUBE_MAP_ARB) or (FCubeMapRotIdx = 0) then
      begin
        createTexture := not aTexture.IsHandleAllocated;
        if createTexture then
          Handle := aTexture.AllocateHandle
        else
          Handle := aTexture.Handle;
      end
      else
        Handle := aTexture.Handle;

      // For MRT
      glReadBuffer(MRT_BUFFERS[BufferIndex]);

      Buffer.RenderingContext.gxStates.TextureBinding[0, EncodeGLTextureTarget(target)] := Handle;

      if target = GL_TEXTURE_CUBE_MAP_ARB then
        target := GL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB + FCubeMapRotIdx;

      if createTexture then
        CreateNewTexture
      else
        glCopyTexSubImage2D(target, 0, xDest, yDest, xSrc, ySrc, width, height);

    finally
      Buffer.RenderingContext.Deactivate;
    end;
  end;
end;

procedure TgxNonVisualViewer.SetupCubeMapCamera(Sender: TObject);

(*
const
  cFaceMat: array[0..5] of TGXMatrix =
  (
    (X: (X:0; Y:0; Z:-1; W:0);
     Y: (X:0; Y:-1; Z:0; W:0);
     Z: (X:-1; Y:0; Z:0; W:0);
     W: (X:0; Y:0; Z:0; W:1)),
    (X:(X:2.4335928828e-08; Y:0; Z:1; W:0);
     Y:(X:0; Y:-1; Z:0; W:0);
     Z:(X:1; Y:0; Z:-2.4335928828e-08; W:0);
     W:(X:0; Y:0; Z:0; W:1)),
    (X:(X:1; Y:1.2167964414e-08; Z:-1.4805936071e-16; W:0);
     Y:(X:0; Y:-1.2167964414e-08; Z:-1; W:0);
     Z:(X:-1.2167964414e-08; Y:1; Z:-1.2167964414e-08; W:0);
     W:(X:0; Y:0; Z:0; W:1)),
    (X:(X:1; Y:-1.2167964414e-08; Z:-1.4805936071e-16; W:0);
     Y:(X:0; Y:-1.2167964414e-08; Z:1; W:0);
     Z:(X:-1.2167964414e-08; Y:-1; Z:-1.2167964414e-08; W:0);
     W:(X:0; Y:0; Z:0; W:1)),
    (X:(X:1; Y:0; Z:-1.2167964414e-08; W:0);
     Y:(X:0; Y:-1; Z:0; W:0);
     Z:(X:-1.2167964414e-08; Y:0; Z:-1; W:0);
     W:(X:0; Y:0; Z:0; W:1)),
    (X:(X:-1; Y:0; Z:-1.2167964414e-08; W:0);
     Y:(X:0; Y:-1; Z:0; W:0);
     Z:(X:-1.2167964414e-08; Y:0; Z:1; W:0);
     W:(X:0; Y:0; Z:0; W:1))
  );
*)

var
  TM: TMatrix4f;
begin
  // Setup appropriate FOV
  with CurrentContext.PipeLineTransformation do
  begin
    SetProjectionMatrix(CreatePerspectiveMatrix(90, 1, FCubeMapZNear, FCubeMapZFar));
    TM := CreateTranslationMatrix(FCubeMapTranslation);
  (* SetViewMatrix(MatrixMultiply(cFaceMat[FCubeMapRotIdx], TM)); *)
  end;
end;

procedure TgxNonVisualViewer.RenderCubeMapTextures(cubeMapTexture: TgxTexture; zNear: Single = 0; zFar: Single = 0);
var
  oldEvent: TNotifyEvent;
begin
  Assert((width = height), 'Memory Viewer must render to a square!');
  Assert(Assigned(FBuffer.FCamera), 'Camera not specified');
  Assert(Assigned(cubeMapTexture), 'Texture not specified');

  if zFar <= 0 then
    zFar := FBuffer.FCamera.DepthOfView;
  if zNear <= 0 then
    zNear := zFar * 0.001;

  oldEvent := FBuffer.FCamera.FDeferredApply;
  FBuffer.FCamera.FDeferredApply := SetupCubeMapCamera;
  FCubeMapZNear := zNear;
  FCubeMapZFar := zFar;
  VectorScale(FBuffer.FCamera.AbsolutePosition, -1, FCubeMapTranslation);
  try
    FCubeMapRotIdx := 0;
    while FCubeMapRotIdx < 6 do
    begin
      Render;
      Buffer.CopyToTexture(cubeMapTexture, 0, 0, Width, Height, 0, 0,
        GL_TEXTURE_CUBE_MAP_POSITIVE_X + FCubeMapRotIdx);
      Inc(FCubeMapRotIdx);
    end;
  finally
    FBuffer.FCamera.FDeferredApply := oldEvent;
  end;
end;

procedure TgxNonVisualViewer.SetBeforeRender(const val: TNotifyEvent);
begin
  FBuffer.BeforeRender := val;
end;

function TgxNonVisualViewer.GetBeforeRender: TNotifyEvent;
begin
  Result := FBuffer.BeforeRender;
end;

procedure TgxNonVisualViewer.SetPostRender(const val: TNotifyEvent);
begin
  FBuffer.PostRender := val;
end;

function TgxNonVisualViewer.GetPostRender: TNotifyEvent;
begin
  Result := FBuffer.PostRender;
end;

procedure TgxNonVisualViewer.SetAfterRender(const val: TNotifyEvent);
begin
  FBuffer.AfterRender := val;
end;

function TgxNonVisualViewer.GetAfterRender: TNotifyEvent;
begin
  Result := FBuffer.AfterRender;
end;

procedure TgxNonVisualViewer.SetCamera(const val: TgxCamera);
begin
  FBuffer.Camera := val;
end;

function TgxNonVisualViewer.GetCamera: TgxCamera;
begin
  Result := FBuffer.Camera;
end;

procedure TgxNonVisualViewer.SetBuffer(const val: TgxSceneBuffer);
begin
  FBuffer.Assign(val);
end;

procedure TgxNonVisualViewer.DoOnPrepareVXContext(Sender: TObject);
begin
  PrepareVXContext;
end;

procedure TgxNonVisualViewer.PrepareVXContext;
begin
  // nothing, reserved for subclasses
end;

procedure TgxNonVisualViewer.DoBufferChange(Sender: TObject);
begin
  // nothing, reserved for subclasses
end;

procedure TgxNonVisualViewer.DoBufferStructuralChange(Sender: TObject);
begin
  FBuffer.DestroyRC;
end;

procedure TgxNonVisualViewer.SetWidth(const val: Integer);
begin
  if val <> FWidth then
  begin
    FWidth := val;
    if FWidth < 1 then
      FWidth := 1;
    DoBufferStructuralChange(Self);
  end;
end;

procedure TgxNonVisualViewer.SetHeight(const val: Integer);
begin
  if val <> FHeight then
  begin
    FHeight := val;
    if FHeight < 1 then
      FHeight := 1;
    DoBufferStructuralChange(Self);
  end;
end;

// ------------------
// ------------------ TgxMemoryViewer ------------------
// ------------------

constructor TgxMemoryViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 256;
  Height := 256;
  FBufferCount := 1;
end;

procedure TgxMemoryViewer.InstantiateRenderingContext;
begin
  if FBuffer.RenderingContext = nil then
  begin
    FBuffer.SetViewPort(0, 0, Width, Height);
    FBuffer.CreateRC(HWND(0), True, FBufferCount);
  end;
end;

procedure TgxMemoryViewer.Render(baseObject: TgxBaseSceneObject = nil);
begin
  InstantiateRenderingContext;
  FBuffer.Render(baseObject);
end;

procedure TgxMemoryViewer.SetBufferCount(const Value: Integer);
const
  MaxAxuBufCount = 4; // Current hardware limit = 4
begin
  if FBufferCount = Value then
    Exit;
  FBufferCount := Value;

  if FBufferCount < 1 then
    FBufferCount := 1;

  if FBufferCount > MaxAxuBufCount then
    FBufferCount := MaxAxuBufCount;

  // Request a new Instantiation of RC on next render
  FBuffer.DestroyRC;
end;

// ------------------
// ------------------ TgxInitializableObjectList ------------------
// ------------------

function TgxInitializableObjectList.Add(const Item: IgxInitializable): Integer;
begin
  Result := inherited Add(Pointer(Item));
end;

function TgxInitializableObjectList.GetItems(const Index: NativeInt): IgxInitializable;
begin
  Result := IgxInitializable(inherited Get(Index));
end;

procedure TgxInitializableObjectList.PutItems(const Index: NativeInt; const Value: IgxInitializable);
begin
  inherited Put(Index, Pointer(Value));
end;

initialization // -------------------------------------------------------------

RegisterClasses([TgxLightSource, TgxCamera, TgxProxyObject, TgxScene, TgxDirectOpenGL, TgxRenderPoint, TgxMemoryViewer]);

// preparation for high resolution timer
QueryPerformanceFrequency(vCounterFrequency);

finalization //----------------------------------------------------------------

end.