游戏引擎

开发平台：
Delphi

CAST2.pas：源码内容
							(*
 @Abstract(CAST II Engine main unit)
 (C) 2006-2009 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
 The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
 Started Jan 15, 2006 <br>
 Unit contains basic engine classes
*)
{$Include GDefines.inc}
{$Include C2Defines.inc}
unit Cast2;
interface
uses
  TextFile, Timer,
  BaseTypes, Basics, BaseCont, Models, BaseClasses, Base3D, BaseMsg, ItemMsg, Collisions, Props, C2Types;
const
  EngineVersionMajor = '0';
  EngineVersionMinor = '992';
  // Bounding volume kinds enumeration string
  VolumeKindsEnum = 'OOBB&Sphere';
  // Items processing interval by default
  DefaultProcessingInterval = 30/1000;
  // Pass ordering enumeration string
  PassOrdersEnum = 'Preprocess&Background&Farest&Normal&Sorted&Nearest&Foreground&PostProcess';
  // This order used for preprocess passes
  poPreprocess = 0;
  // This order used for passes that should be at background
  poBackground = 1;
  // This order used for passes that should be farest
  poFarest = 2;
  // This order used for usual passes
  poNormal = 3;
  // This order used for passes that should render corresponding items in a particular order (usually transparent items)
  poSorted = 4;
  // This order used for passes that should be neartest
  poNearest = 5;
  // This order used for passes that should be at foreground
  poForeground = 6;
  // This order used for postprocess passes
  poPostProcess = 7;
  // Order corresponding to passes with sorted items
  SortedPassOrder = poSorted;
  // Number of pass groups currently supported by the engine
  PassGroupsCount = 16;
  // Pass groups enumeration string
  PassGroupsEnum = 'Group 01&Group 02&Group 03&Group 04&Group 05&Group 06&Group 07&Group 08&' +
                   'Group 09&Group 10&Group 11&Group 12&Group 13&Group 14&Group 15&Group 16';
  // Set of all pass groups
  gmAll     = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15];
  // Default set of pass groups
  gmDefault = [0, 1, 2, 3, 4, 5, 6, 7];
  // Maximum of texture coordinates sets
  MaxTextureCoordSets = 8;
  // Maximum of user-defined clipping planes currently supported by the engine
  MaxClipPlanes       = 6;
type
  // Type to specify location of an object in 3D space. Additional component can be used to work with floating coordinates, space partitioning, etc.
  TLocation = TVector4s;
  // Traverse callback results
  TTraverseResult = (// Continue traversal
                     trContinue,
                     // Skip traversal for childs of the current item
                     trSkip,
                     // Stop traversal
                     trStop);
  // Frustum planes
  TFrustumPlane = (fpLeft, fpRight, fpTop, fpBottom, fpNear, fpFar);
  TFrustumCheckResult = (// An item is completely outside of the frustum
                         fcOutside,
                         // An item is completely inside the frustum
                         fcInside,
                         // An item is partially inside the frustum
                         fcPartially);
  // Pass groups range
  TPassGroup = 0..PassGroupsCount-1;
  // Pass groups set. Groups used to perform some operations (lighting, render) for one set of passes and not to perform for other set of passes
  TPassGroupSet = set of TPassGroup;
  // User-defined clipping planes
  TClipPlanes      = array[0..MaxClipPlanes-1] of PPlane;
  // Traverse mask
  TTraverseMask = BaseTypes.TSet32;
  // Class containing collision-related information for an item
  TColliding = class(BaseCont.TBaseUniqueItem)
    // The item to which the collision information belongs
    Owner: BaseClasses.TItem;
    // Bounding volumes set
    Volumes: Collisions.TBoundingVolumes;
    constructor Create; override;
    destructor Destroy; override;
  end;
  // Tesselation buffers enumeration
  TTesselationBuffer = (// Vertex buffer
                        tbVertex,
                        // Index buffer
                        tbIndex);
  // Set of tesselation buffers                      
  TTesselationBufferSet = set of TTesselationBuffer;
  // Vertex/index buffers performace profile
  TBuffersPerfProfile = record
    // Number of tesselation calls for static and dynamic meshes in current frame. Normally should be zero for static meshes
    TesselationsPerformed,
    // Amount of data written to buffers during tesselation
    BytesWritten,
    // Number of resets of static and dynamic buffers in current frame. Normally should be zero for static buffers
    BufferResetsCount,
    // Current size of the buffer in bytes
    BufferSize: array[Boolean] of Integer;
    // Number of items rendered without tesselations of a certain buffer (vertex/index)
    TesselationsBypassed,
    // Number of buffer bytes reused
    BytesBypassed: Integer;
  end;
  TPerfTimer = (// Entire frame time
                ptFrame,
                // Render time
                ptRender,
                // Objects processing time
                ptProcessing,
                // Collision detection
                ptCollision);
  // Engine performance profile data
  TPerfProfile = class
  private
    TimeMarks: array[TPerfTimer] of TTimeMark;
    FFramesPerSecond, FMinFramesPerSecond, FMaxFramesPerSecond: Single;
    procedure SetFramesPerSecond(const Value: Single);
    function GetPrimitivesPerSecond: Single;
  public
    Times: array[TPerfTimer] of TTimeUnit;
    // Number of render target changes during rendering a frame
    RenderTargetChanges,
    // Number of primitives (triangles) rendered in current frame
    PrimitivesRendered,
    // Number of draw calls (DrawIndexedPrimitive etc) in current frame
    DrawCalls,
    // Number of clear calls during rendering a frame
    ClearCalls: Integer;
    // Number of items culled out with frustum culling in current frame
    FrustumCulledItems,
    // Number of items passed frustum culling (and probably actually drawn) in current frame
    FrustumPassedItems: Integer;
    // Number of sorted items in current frame
    SortedItems: Integer;
    // Vertex/index buffers performace profile
    BuffersProfile: array[TTesselationBuffer] of TBuffersPerfProfile;
    // Sets values which should be zeroed-out at frame render start
    procedure OnFrameStart;
    // Sets values which should be resetted at render buffers reset
    procedure OnBuffersReset;
    // Starts timing of the specified performance timer using the specified timer class
    procedure BeginTiming(Timer: TTimer; PerfTimer: TPerfTimer);
    // Stops timing and returns the specified performance timer value using the specified timer class
    function EndTiming(Timer: TTimer; PerfTimer: TPerfTimer): TTimeUnit;
    // Frame rate averaged through some time
    property FramesPerSecond: Single read FFramesPerSecond write SetFramesPerSecond;
    // Number of primitives per second
    property PrimitivesPerSecond: Single read GetPrimitivesPerSecond;
    // Minimal averaged frame rate
    property MinFramesPerSecond: Single read FMinFramesPerSecond;
    // Maximal averaged frame rate
    property MaxFramesPerSecond: Single read FMaxFramesPerSecond;
  end;
  TBaseCore = class;
  // Base class of shared tesselators manager
  TBaseSharedTesselators = class
    // Engine core (items manager)
    Core: TBaseCore;
    // Makes items associated with shared tesselators visible
    procedure Render; virtual; abstract;
    // Makes items associated with shared tesselators invisible
    procedure Reset; virtual; abstract;
    // Clears items associated with shared tesselators
    procedure Clear; virtual; abstract;
  end;
  // Engine base core class
  TBaseCore = class(TItemsManager)
  private
    FTesselatorManager: BaseCont.TReferencedItemManager;
    Subsystems: array of TSubsystem;
    FTimer, DefaultTimer: Timer.TTimer;
    procedure SetTimer(const Value: Timer.TTimer);
    procedure SetTotalProcessingClasses(const Value: Integer);
  protected
    // Time mark for delta time based items processing
    DeltaTimeBasedTimeMark: TTimeMark;
    // Number of items to process
    ProcessingItems: TItems;
    // Items to process
    TotalProcessingItems: Integer;
    // Shared tesselators manager. For internal use only
    FSharedTesselators: TBaseSharedTesselators;
    // Temporary items container. Used internally for shared tesselators visualization etc.
    FTempItems: BaseClasses.TItem;
    // Performance profile
    FPerfProfile: TPerfProfile;
    // Performs delta time based items processing
    procedure ProcessDeltaTimeBased(const DeltaTime: TTimeUnit);
    // Performs items processing
    procedure ProcessingEvent(EventID: Integer; const ErrorDelta: TTimeUnit);
    procedure OnDestroy; override;
  public
    // If <b>Paused</b> is <b>True</b> @Link(Process) methods will be called only for items which processing class includes the @Link(pfIgnorePause) flag
    Paused: Boolean;
    // Delta time scale factor for all processing classes
    TimeScale: Single;
    // Maximum of simultaneous light sources
    SimultaneousLightSources: Integer;
    // Random numbers generator
    RandomGen: Basics.TRandomGenerator;
    // By assigning this handler reference an additional message handler can be included into the message handling chain
    MessageHandler: BaseMsg.TMessageHandler;
    constructor Create; override;
    procedure HandleMessage(const Msg: TMessage); override;
    // Register a subsystem. All registered subsystems will receive all messages received by the core.
    procedure AddSubsystem(const Subsystem: TSubsystem);
    // Unregister a subsystem
    procedure RemoveSubsystem(const Subsystem: TSubsystem);
    // Returns a registered subsystem of the specified class or successor
    function QuerySubsystem(SubsystemClass: CSubsystem): TSubsystem;
    // Sets parameters of a processing class.
    procedure SetProcessingClass(Index: Integer; Interval: Single; IgnorePause, DeltaTimeBased: Boolean);
    // For internal use only.
    procedure AddPass(const Item: BaseClasses.TItem); virtual; abstract;
    // For internal use only.
    procedure RemovePass(const Item: BaseClasses.TItem); virtual; abstract;
    // Clears current scene
    procedure ClearItems; override;
    // Shared tesselators manager. For internal use only.
    property SharedTesselators: TBaseSharedTesselators read FSharedTesselators;
    // Tesselators manager. For internal use only.
    property TesselatorManager: BaseCont.TReferencedItemManager read FTesselatorManager;
    // Temporary items container. Used internally for shared tesselators visualization etc.
    property TempItems: BaseClasses.TItem read FTempItems;
    // Timer subsystem. Must be assigned.
    property Timer: Timer.TTimer read FTimer write SetTimer;
    // Performance profile
    property PerfProfile: TPerfProfile read FPerfProfile;
    // Number of processing classes
    property TotalProcessingClasses: Integer read GetTotalProcessingClasses write SetTotalProcessingClasses;
  end;
  CProcessing = class of TProcessing;
  // Base class of all processing (updateable) objects
  TProcessing = class(TBaseProcessing)
  private
  public
    TransformValid: Boolean;
    function GetTransform: TMatrix4s;
    procedure SetTransform(const ATransform: TMatrix4s);
    function GetForwardVector: TVector3s;
    function GetRightVector: TVector3s;
    function GetUpVector: TVector3s;
    function GetPosition: TVector3s;
    procedure SetPosition(const Value: TVector3s);
    function GetScale: TVector3s;
    procedure SetScale(const Value: TVector3s);
    function GetLocation: TLocation;
    procedure SetLocation(ALocation: TLocation);
    function GetOrientation: TQuaternion;
    procedure SetOrientation(AOrientation: TQuaternion);
    function GetDimensions: TVector3s;
    function GetBoundingSphereRadius: Single;
  protected
    // Transformation matrix of the item
    FTransform: TMatrix4s;
    // Current orientation of the item
    FOrientation: TQuaternion;
    // Current location of the item
    FLocation: TLocation;
    // Current scale of the item
    FScale: TVector3s;
    { In CAST II engine a lazy evaluation scheme used for transformation computations.
      This method will compute current transformation matrix when and only when it is necessary. }
    procedure ComputeTransform; virtual;
    // Calling this method will tell the engine that @Link(FTransform) became invalid and should be recomputed before next use
    procedure InvalidateTransform; virtual;       // try to avoid virtuality
    // Returns AItem if OK or nil if index is invalid or impossible to set a child
    function SetChild(Index: Integer; AItem: BaseClasses.TItem): BaseClasses.TItem; override;
  public
    // Contains information about bounding volumes of the item which will be used for collision tests
    Colliding: TColliding;
    // Returns bounding box of the item
    BoundingBox: Base3D.TBoundingBox;
//    FullBoundingBox: Base3D.TBoundingBox;
    constructor Create(AManager: TItemsManager); override;
    destructor Destroy; override;
    // Called when a collision of the item with another items was detected
    procedure OnCollision(Item: TProcessing; const ColRes: Collisions.TCollisionResult); virtual;
    { This procedure is called (by editor for example) to retrieve a list of item's properties and their values.
      Any TItem descendant class should override this method in order to add its own properties. }
    procedure AddProperties(const Result: Props.TProperties); override;
    { This procedure is called (by editor for example) to set values of item's properties.
      Any TItem descendant class should override this method to allow its own properties to be set. }
    procedure SetProperties(Properties: Props.TProperties); override;
    // Returns position of the item in world's coordinate space
    function GetAbsLocation: TVector3s;
    // Returns orientation of the item in world's coordinate space
    function GetAbsOrientation: TQuaternion;
    // Transforms a point from local model's coordinate space to world's coordinate space
    function ModelToWorld(const APoint: TVector3s): TVector3s;
    // Transforms a point from world's coordinate space to local model's coordinate space
    function WorldToModel(const APoint: TVector3s): TVector3s;
    // Transformation matrix of the item
    property Transform: TMatrix4s         read GetTransform   write SetTransform;
    // 4-component position of the item within parent's coordinate space
    property Location: TLocation          read GetLocation    write SetLocation;
    // Position of the item within parent's coordinate space
    property Position: TVector3s          read GetPosition    write SetPosition;
    // Scale of the item within parent's coordinate space
    property Scale: TVector3s             read GetScale       write SetScale;
    // Orientation of the item within parent's coordinate space
    property Orientation: TQuaternion     read GetOrientation write SetOrientation;
    // Forward direction for the item
    property ForwardVector: TVector3s     read GetForwardVector;
    // Right direction for the item
    property RightVector: TVector3s       read GetRightVector;
    // Up direction for the item
    property UpVector: TVector3s          read GetUpVector;
    // Dimensions of the item based on its bounding box (see @Link(BoundingBox))
    property Dimensions: TVector3s        read GetDimensions;
    // The item's bounding sphere radius based on @Link(Dimensions)
    property BoundingSphereRadius: Single read GetBoundingSphereRadius;
  end;
  // Item move operation
  TItemMoveOp = class(Models.TOperation)
  private
    AffectedProcessing: TProcessing;
    Location: TLocation;
  protected
    // Applies the operation
    procedure DoApply; override;
    // Merges together two move operations
    function DoMerge(AOperation: Models.TOperation): Boolean; override;
  public
    // Inits the operation with the specified processing item and its new location
    function Init(AAffectedProcessing: TProcessing; ALocation: TLocation): Boolean;
  end;
  // Item orientation change operation
  TItemRotateOp = class(Models.TOperation)
  private
    AffectedProcessing: TProcessing;
    Orientation: TQuaternion;
  protected
    // Applies the operation
    procedure DoApply; override;
    // Merges together two orientation change operations
    function DoMerge(AOperation: Models.TOperation): Boolean; override;
  public
    // Inits the operation with the specified processing item and its new orientation
    function Init(AAffectedProcessing: TProcessing; AOrientation: TQuaternion): Boolean;
  end;
  // Callback function used to traverse through items hierarchy
  TTraverseCallback = function(Item: BaseClasses.TItem): TTraverseResult;
  // Collection of items
  TItemCollection = record
    TraverseMask: TTraverseMask;
    TotalItems: Integer;
    Items: array of BaseClasses.TItem;
  end;
  { Specifies clear settings.
    <b>ClearFlags</b> - what to clear
    <b>ClearColor</b> - clear color
    <b>ClearStencil</b> - a stencil value to clear with
    <b>ClearZ</b> - a Z value to clear with  }
  TClearSettings = record
    ClearFlags: TClearFlagsSet;
    ClearColor: BaseTypes.TColor;
    ClearStencil: Longword;
    ClearZ: Single;
  end;
  // Camera
  TCamera = class(TProcessing)
  private
    FOrthographic: Boolean;
    FCurrentAspectRatio,
    FZNear,
    FZFar,
    FWidth,
    FAspectRatio,
    FHFoV: Single;
    FFrustumPlanes: array[TFrustumPlane] of TPlane;
    ViewValid: Boolean;
    FRTColorFormat, FRTDepthFormat: Integer;
    function GetViewMatrix: TMatrix4s;
    procedure SetViewMatrix(const Value: TMatrix4s);
    function GetInvViewMatrix: TMatrix4s;
    function GetTotalMatrix: TMatrix4s;
    function GetViewOrigin: TVector3s;
    function GetLookDir: TVector3s;
    function GetRightDir: TVector3s;
    function GetUpDir: TVector3s;
    procedure SetAspectRatio(const Value: Single);
    procedure ComputeFrustumPlanes;
  protected
    // View matrix
    FViewMatrix,
    // Inverse view matrix
    FInvViewMatrix,
    // Projection matrix
    FProjMatrix,
    // View * projection matrix
    FTotalMatrix: TMatrix4s;
    // Current render width
    FRenderWidth,
    // Current render height
    FRenderHeight: Integer;
    // Calling this method will tell the engine that @Link(FTransform) became invalid and should be recomputed before next use
    procedure InvalidateTransform; override;
    procedure ComputeViewMatrix; virtual;
  public
    // Default cameras can
//    Default: Boolean;
    // Default fill mode for the camera
    DefaultFillMode: TFillMode;
    // Default cull mode for the camera
    DefaultCullMode: TCullMode;
    // Determines what and when should be cleared
    ClearSettings: TClearSettings;
    // private
      RenderTargetIndex: Integer;
    // User-defined clip planes
    ClipPlanes: TClipPlanes;
    // Determines which passes can be visible through the camera
    GroupMask: TPassGroupSet;
    // Current rendering color format. Updated by renderer
    ColorFormat,
    // Current rendering depth format. Updated by renderer
    DepthFormat: Integer;
    // Width of a render target texture used if the camera will be used as a texture
    RenderTargetWidth,
    // Height of a render target texture used if the camera will be used as a texture
    RenderTargetHeight: Integer;
    // Determines how many frames should be skipped between render target texture updates
    FrameSkip: Integer;
    // Cameras can render scene in higher or lower detail which is controlled by this parameter 
    LODBias: Single;
    // Determines if a depth-stencil surface instead of color surface should be used when the camera applied as a texture
    IsDepthTexture: Boolean;
    constructor Create(AManager: TItemsManager); override;
    destructor Destroy; override;
    { This procedure is called (by editor for example) to retrieve a list of item's properties and their values.
      Any TItem descendant class should override this method in order to add its own properties. }
    procedure AddProperties(const Result: Props.TProperties); override;
    { This procedure is called (by editor for example) to set values of item's properties.
      Any TItem descendant class should override this method to allow its own properties to be set. }
    procedure SetProperties(Properties: Props.TProperties); override;
    // Sets up the camera's projection matrix with the given near and far Z planes, horizontal field of view and aspect ratio
    procedure InitProjMatrix(AZNear, AZFar, AHFoV, AAspectRatio: Single); virtual;
    // Sets up the camera's orthographic projection matrix with the given near and far Z planes, width of view and aspect ratio
    procedure InitOrthoProjMatrix(AZNear, AZFar, VisibleWidth, AAspectRatio: Single); virtual;
    // Sets the @Link(ClearSettings)
    procedure SetClearState(AClearFlags: TClearFlagsSet; AClearColor: BaseTypes.TColor; AClearZ: Single; AClearStencil: Cardinal); virtual;
    // Sets render dimensions and recalculates projection matrix. Normally called by renderer when render window size changes.
    procedure SetScreenDimensions(Width, Height: Integer; AdjustAspectRatio: Boolean);
    // Rotates the camera by the specified angles
    procedure Rotate(XA, YA, ZA: Single); virtual;
    // Moves the camera by the specified distance in camera space
    procedure Move(XD, YD, ZD: Single); virtual;
    // Returns not normalized direction of a ray in view space which starts from the camera and passes through the given point on screen
    function GetPickRay(ScreenX, ScreenY: Single): TVector3s; virtual;
    // Returns not normalized direction of a ray in world space which starts from the camera and passes through the given point on screen
    function GetPickRayInWorld(ScreenX, ScreenY: Single): TVector3s; virtual;
    // Returns the given vector after projection with the camera
    function Project(const Vec: TVector3s): TVector4s;
    // Renderer calls this event right before the camera apply
    procedure OnApply(const OldCamera: TCamera); virtual;
    // Performs a frustrum visibility check against a sphere with the given center and radius
    function IsSpehereVisible(const Center: TVector3s; Radius: Single): TFrustumCheckResult;
    // Near Z plane distance
    property ZNear: Single read FZNear;
    // Far Z plane distance
    property ZFar: Single read FZFar;
    // Initial aspect ratio. Can change
    property AspectRatio: Single read FAspectRatio write SetAspectRatio;
    // Current aspect ratio
    property CurrentAspectRatio: Single read FCurrentAspectRatio;
    // Horizontal field of view in radians
    property HFoV: Single read FHFoV;
    // Current render width
    property RenderWidth: Integer read FRenderWidth;
    // Current render height
    property RenderHeight: Integer read FRenderHeight;
    // Color format which will be used in case of use of this camera as a texture
    property RTColorFormat: Integer read FRTColorFormat;
    // Depth format which will be used in case of use of this camera as a texture
    property RTDepthFormat: Integer read FRTDepthFormat;
    // View matrix
    property ViewMatrix: TMatrix4s read GetViewMatrix write SetViewMatrix;
    // Inverse view matrix
    property InvViewMatrix: TMatrix4s read GetInvViewMatrix;
    // Projection matrix
    property ProjMatrix: TMatrix4s read FProjMatrix write FProjMatrix;
    // View * projection matrix
    property TotalMatrix: TMatrix4s read GetTotalMatrix;
    // Position of the camera's view point in world space
    property ViewOrigin: TVector3s read GetViewOrigin;
    // View direction of the camera in world space
    property LookDir: TVector3s read GetLookDir;
    // Right direction of the camera in world space
    property RightDir: TVector3s read GetRightDir;
    // Up direction of the camera in world space
    property UpDir: TVector3s read GetUpDir;
  end;
  // An item of this class should be the root of items hierarchy
  TCASTRootItem = class(TRootItem)
  private
    // collection for various sets of items from scene (e.g. renderable, processing etc)
    Collections: array of TItemCollection;
    TotalCollections: Integer;
    Collidings: TUniqueItemCollection;
//    ModifyingCollectionIndex: Integer;
//    procedure IncludeItem(Item: BaseClasses.TItem; Mask: TTraverseMask);
//    procedure ExcludeItem(Item: BaseClasses.TItem; Mask: TTraverseMask);
    // Internal function used as callback only
//    function AddToCollectionCallback(Item: BaseClasses.TItem): TTraverseResult;
//    procedure AddToCollection(CollectionIndex: Integer; Item: BaseClasses.TItem); virtual;
//    procedure RemoveFromCollection(CollectionIndex: Integer; Item: BaseClasses.TItem); virtual;
  protected
    // Adds item's collision info to a collision manager
    procedure AddColliding(AItem: TProcessing);
    // Removes item's collision info from a collision manager
    procedure RemoveColliding(AItem: TProcessing);
  public
    // Clear settings for all render stages
    StageSettings: array[poPreprocess..poPostProcess] of TClearSettings;
    constructor Create(AManager: TItemsManager); override;
    destructor Destroy; override;
    function GetItemSize(CountChilds: Boolean): Integer; override;
    { This procedure is called (by editor for example) to retrieve a list of item's properties and their values.
      Any TItem descendant class should override this method in order to add its own properties. }
    procedure AddProperties(const Result: Props.TProperties); override;
    { This procedure is called (by editor for example) to set values of item's properties.
      Any TItem descendant class should override this method to allow its own properties to be set. }
    procedure SetProperties(Properties: Props.TProperties); override;
    { Traverses through the items hierarchy and adds to Items all items matching the following:       <br>
      the item is an instance of the given class or a descendant, its State field has matches Mask and
      the item is within the given range from the given origin.
      Childs of items with non-matching State are not considered.
      Returns number of items in Items. }
    function ExtractByMaskClassInRadius(Mask: TItemFlags; AClass: CProcessing; out Items: TItems; Origin: TLocation; Range: Single): Integer;
    { Traverses through the items hierarchy and adds to Items all items matching the following:       <br>
      the item is an instance of the given class or a descendant, its State field has matches Mask and
      the item is within visibility frustum of the given camera.
      Childs of items with non-matching State are not considered.
      Returns number of items in Items. }
    function ExtractByMaskClassInCamera(Mask: TItemFlags; AClass: CProcessing; out Items: TItems; ACamera: TCamera): Integer;
    procedure HandleMessage(const Msg: TMessage); override;
    // Adds a collection of items with the specified state
    function AddCollection(Mask: TTraverseMask): Integer;
    // Removes collection specified by the index
    procedure DeleteCollection(Index: Integer);
    // Traverses through the items hierarchy and calls Callback for all items
    procedure TraverseTree(Callback: TTraverseCallback);
    // Performs a collision test. ToDo: move to core
    procedure Collide;
    // Frees all childs
    procedure FreeChilds; override;
  end;
  { @Abstract(Camera class for mirror surfaces)
    The camera constructs its view matrix as a reflection of view matrix of previous camera by XY plane if the camera's transform}
  TMirrorCamera = class(TCamera)
  private
    FOldCamera: TCamera;
  public
    // Reflects previous applyed camera view matrix by its own XY plane and assigns the result to view matrix
    procedure ComputeViewMatrix; override;
    // OnApply event overridden to assign previous camera variable and setup clipping plane
    procedure OnApply(const OldCamera: TCamera); override;
  end;
{  TRenderParameters = record
    MainCamera, ActiveCamera: TCamera;
  end;
  PRenderParameters = ^TRenderParameters;}
  // Returns a location from 3D vector
  function GetLocationFromVec3s(V: TVector3s): TLocation;
  // Retuns True if the locations are equal
  function EqualLocations(V1, V2: TLocation): Boolean;
  // Retuns squared distance between the locations
  function LocationSqDistance(V1, V2: TLocation): Single;
  // Helper functions for adding/setting properties of a certain type
  // Adds a string property named "Error" with the value contained in <b>Msg</b>
  procedure AddErrorProperty(Properties: Props.TProperties; const Msg: string);
  // Adds a 3-component vector and each its component as properties
  procedure AddVector3sProperty(Properties: Props.TProperties; const Name: string; const Vec: TVector3s);
  // Adds a 4-component vector and each its component as properties
  procedure AddVector4sProperty(Properties: Props.TProperties; const Name: string; const Vec: TVector4s);
  // Adds a quaternion and each its component as properties
  procedure AddQuaternionProperty(Properties: Props.TProperties; const Name: string; const Quat: TQuaternion);
  // Reads a 3-component vector from properties. If its not equivalent to the one contained in <b>Res</b> assigns it to <b>Res</b> and returns <b>True</b>.
  function SetVector3sProperty(Properties: Props.TProperties; const Name: string; var Res: TVector3s): Boolean;
  // Reads a 4-component vector from properties. If its not equivalent to the one contained in <b>Res</b> assigns it to <b>Res</b> and returns <b>True</b>.
  function SetVector4sProperty(Properties: Props.TProperties; const Name: string; var Res: TVector4s): Boolean;
  // Reads a quaternion from properties. If its not equivalent to the one contained in <b>Res</b> assigns it to <b>Res</b> and returns <b>True</b>.
  function SetQuaternionProperty(Properties: Props.TProperties; const Name: string; var Res: TQuaternion): Boolean;
implementation
uses SysUtils;
function GetLocationFromVec3s(V: TVector3s): TLocation;
begin
  Result.X := V.X;
  Result.Y := V.Y;
  Result.Z := V.Z;
  Result.W := 1;
end;
function EqualLocations(V1, V2: TLocation): Boolean;
begin
  Result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z) and (V1.W = V2.W);
end;
function LocationSqDistance(V1, V2: TLocation): Single;
begin
  Result := Sqr(V2.X-V1.X) + Sqr(V2.Y-V1.Y)+  Sqr(V2.Z-V1.Z);
end;
procedure AddErrorProperty(Properties: Props.TProperties; const Msg: string);
begin
  Properties.Add('Error', vtString, [poReadonly], Msg, '');
end;
procedure AddVector3sProperty(Properties: Props.TProperties; const Name: string; const Vec: TVector3s);
begin
  Properties.Add(Name,        vtString, [poReadOnly], Format('(%3.3F, %3.3F, %3.3F)', [Vec.X, Vec.Y, Vec.Z]), '');
  Properties.Add(Name + 'X', vtSingle, [], FloatToStr(Vec.X), '');
  Properties.Add(Name + 'Y', vtSingle, [], FloatToStr(Vec.Y), '');
  Properties.Add(Name + 'Z', vtSingle, [], FloatToStr(Vec.Z), '');
end;
procedure AddVector4sProperty(Properties: Props.TProperties; const Name: string; const Vec: TVector4s);
begin
  AddVector3sProperty(Properties, Name, Vec.XYZ);
  Properties.Add(Name + 'W', vtSingle, [], FloatToStr(Vec.W), '');
  Properties.Add(Name,        vtString, [poReadOnly], Format('(%3.3F, %3.3F, %3.3F, %3.3F)', [Vec.X, Vec.Y, Vec.Z, Vec.W]), '');
end;
procedure AddQuaternionProperty(Properties: Props.TProperties; const Name: string; const Quat: TQuaternion);
var Angle: Single;
begin
  AddVector3sProperty(Properties, Name, GetVector3s(Quat[1], Quat[2], Quat[3]));
  Angle := ArcTan2(Sqrt(1 - Quat[0] * Quat[0]), Quat[0])*2 * 180/pi;
  Properties.Add(Name + 'Angle', vtSingle, [], FloatToStr(Angle), '');
  Properties.Add(Name,            vtString, [poReadOnly], Format('(%3.3F, (%3.3F, %3.3F, %3.3F))', [Angle, Quat[1], Quat[2], Quat[3]]), '');
end;
function SetVector3sProperty(Properties: Props.TProperties; const Name: string; var Res: TVector3s): Boolean; overload;
var NewVec: TVector3s;
begin
  NewVec := Res;
  if Properties.Valid(Name + 'X') then NewVec.X := StrToFloatDef(Properties[Name + 'X'], 0);
  if Properties.Valid(Name + 'Y') then NewVec.Y := StrToFloatDef(Properties[Name + 'Y'], 0);
  if Properties.Valid(Name + 'Z') then NewVec.Z := StrToFloatDef(Properties[Name + 'Z'], 0);
  Result := isNan(Res.X) or isNan(Res.Y) or isNan(Res.Z) or
           (NewVec.X <> Res.X) or (NewVec.Y <> Res.Y) or (NewVec.Z <> Res.Z);
  if Result then Res := NewVec;
end;
function SetVector4sProperty(Properties: Props.TProperties; const Name: string; var Res: TVector4s): Boolean; overload;
var NewVec: TVector3s; W: Single;
begin
  NewVec := Res.XYZ;
  W := Res.W;
  Result := SetVector3sProperty(Properties, Name, NewVec);
  if Properties.Valid(Name + 'W') then W := StrToFloatDef(Properties[Name + 'W'], 0);
  Result := Result or isNan(Res.W) or (W <> Res.W);
  if Result then begin
    Res := ExpandVector3s(NewVec);
    Res.W := W;
  end;
end;
function SetQuaternionProperty(Properties: Props.TProperties; const Name: string; var Res: TQuaternion): Boolean; 
var NewVec: TVector3s; Angle: Single;
begin
  NewVec.X := Res[1]; NewVec.Y := Res[2]; NewVec.Z := Res[3];
  Result := SetVector3sProperty(Properties, Name, NewVec);
  if Properties.Valid(Name + 'Angle') then Angle := StrToFloatDef(Properties[Name + 'Angle'], 0)*pi/180 else
    Angle := ArcTan2(Sqrt(1 - Res[0] * Res[0]), Res[0])*2;
  Result := Result or isNan(Res[0]) or (Angle <> Res[0]);
  if Result then Res := GetQuaternion(Angle, NewVec);
end;
{ TPerfProfile }
procedure TPerfProfile.SetFramesPerSecond(const Value: Single);
begin
  FFramesPerSecond := Value;
  if (FMinFramesPerSecond = 0) or (FFramesPerSecond < FMinFramesPerSecond) then FMinFramesPerSecond := FFramesPerSecond;
  if FFramesPerSecond > FMaxFramesPerSecond then FMaxFramesPerSecond := FFramesPerSecond;
end;
function TPerfProfile.GetPrimitivesPerSecond: Single;
begin
  Result := PrimitivesRendered * FramesPerSecond;
end;
procedure TPerfProfile.OnFrameStart;
var BufType: TTesselationBuffer;
begin
  RenderTargetChanges := 0;
  PrimitivesRendered  := 0;
  DrawCalls           := 0;
  ClearCalls          := 0;
  FrustumCulledItems  := 0;
  FrustumPassedItems  := 0;
  SortedItems         := 0;
  for BufType := Low(TTesselationBuffer) to High(TTesselationBuffer) do begin
    BuffersProfile[BufType].TesselationsPerformed[True]  := 0;
    BuffersProfile[BufType].BytesWritten[True]           := 0;
    BuffersProfile[BufType].TesselationsPerformed[False] := 0;
    BuffersProfile[BufType].BytesWritten[False]          := 0;
    BuffersProfile[BufType].BufferResetsCount[True]      := 0;
    BuffersProfile[BufType].BufferResetsCount[False]     := 0;
    BuffersProfile[BufType].TesselationsBypassed         := 0;
    BuffersProfile[BufType].BytesBypassed                := 0;
  end;
end;
procedure TPerfProfile.OnBuffersReset;
var BufType: TTesselationBuffer;
begin
  for BufType := Low(TTesselationBuffer) to High(TTesselationBuffer) do begin
    BuffersProfile[BufType].BufferSize[True]  := 0;
    BuffersProfile[BufType].BufferSize[False] := 0;
  end;
end;
procedure TPerfProfile.BeginTiming(Timer: TTimer; PerfTimer: TPerfTimer);
begin
  Timer.GetInterval(TimeMarks[PerfTimer], True);
end;
function TPerfProfile.EndTiming(Timer: TTimer; PerfTimer: TPerfTimer): TTimeUnit;
begin
  Times[PerfTimer] := Timer.GetInterval(TimeMarks[PerfTimer], True);
  Result := Times[PerfTimer];
end;
{ TColliding }
constructor TColliding.Create;
begin
  inherited;
  Owner := Owner;
end;
destructor TColliding.Destroy;
begin
  Volumes := nil;
  inherited;
end;
{ TCASTRootItem }
constructor TCASTRootItem.Create(AManager: TItemsManager);
begin
  inherited;
  Collidings := TUniqueItemCollection.Create;
end;
destructor TCASTRootItem.Destroy;
var i: Integer;
begin
  for i := 0 to High(Collections) do DeleteCollection(i);
  inherited;
  FreeAndNil(Collidings);
end;
function TCASTRootItem.GetItemSize(CountChilds: Boolean): Integer;
var i: Integer;
begin
  Result := inherited GetItemSize(CountChilds);
  Inc(Result, TotalCollections * SizeOf(TItemCollection));
  for i := 0 to TotalCollections-1 do if Collections[i].Items <> nil then Inc(Result, Collections[i].TotalItems * SizeOf(BaseClasses.TItem));
end;
procedure TCASTRootItem.AddProperties(const Result: Props.TProperties);
var i: Integer; Core: TBaseCore; s: string;
begin
  inherited;
  if not Assigned(Result) then Exit;
  if FManager is TBaseCore then Core := (FManager as TBaseCore) else begin
    {$IFDEF LOGGING} Log.Log(ClassName + '.AddProperties: Items manager must be an instance of TBaseCore', lkError); {$ENDIF}
    Exit;
  end;
  if (Parent = nil) and (FManager.Root = Self) then begin
    Result.Add('RendererBefore backgroundClearFrame buffer',   vtBoolean, [], OnOffStr[ClearFrameBuffer   in StageSettings[poBackground].ClearFlags], '');
    Result.Add('RendererBefore backgroundClearZ buffer',       vtBoolean, [], OnOffStr[ClearZBuffer       in StageSettings[poBackground].ClearFlags], '');
    Result.Add('RendererBefore backgroundClearStencil buffer', vtBoolean, [], OnOffStr[ClearStencilBuffer in StageSettings[poBackground].ClearFlags], '');
    Result.Add('RendererBefore backgroundClearZ value',        vtSingle,  [], FloatToStr(StageSettings[poBackground].ClearZ),             '');
    Result.Add('RendererBefore backgroundClearStencil value',  vtNat,     [], IntToStr(StageSettings[poBackground].ClearStencil),        '');
    AddColorProperty(Result, 'RendererBefore backgroundClearColor value', StageSettings[poBackground].ClearColor);
    Result.Add('RendererBefore nearestClearFrame buffer',   vtBoolean, [], OnOffStr[ClearFrameBuffer   in StageSettings[poNearest].ClearFlags], '');
    Result.Add('RendererBefore nearestClearZ buffer',       vtBoolean, [], OnOffStr[ClearZBuffer       in StageSettings[poNearest].ClearFlags], '');
    Result.Add('RendererBefore nearestClearStencil buffer', vtBoolean, [], OnOffStr[ClearStencilBuffer in StageSettings[poNearest].ClearFlags], '');
    Result.Add('RendererBefore nearestClearZ value',        vtSingle,  [], FloatToStr(StageSettings[poNearest].ClearZ),             '');
    Result.Add('RendererBefore nearestClearStencil value',  vtNat,     [], IntToStr(StageSettings[poNearest].ClearStencil),        '');
    AddColorProperty(Result, 'RendererBefore nearestClearColor value', StageSettings[poNearest].ClearColor);
    Result.Add('RendererBefore postprocessClearFrame buffer',   vtBoolean, [], OnOffStr[ClearFrameBuffer   in StageSettings[poPostprocess].ClearFlags], '');
    Result.Add('RendererBefore postprocessClearZ buffer',       vtBoolean, [], OnOffStr[ClearZBuffer       in StageSettings[poPostprocess].ClearFlags], '');
    Result.Add('RendererBefore postprocessClearStencil buffer', vtBoolean, [], OnOffStr[ClearStencilBuffer in StageSettings[poPostprocess].ClearFlags], '');
    Result.Add('RendererBefore postprocessClearZ value',        vtSingle,  [], FloatToStr(StageSettings[poPostprocess].ClearZ),             '');
    Result.Add('RendererBefore postprocessClearStencil value',  vtNat,     [], IntToStr(StageSettings[poPostprocess].ClearStencil),        '');
    AddColorProperty(Result, 'RendererBefore postprocessClearColor value', StageSettings[poPostprocess].ClearColor);
    Result.Add('RendererSimultaneous light sources', vtInt, [], IntToStr(Core.SimultaneousLightSources), '');
    Result.Add('ProcessingNumber of classes', vtInt, [], IntToStr(Core.TotalProcessingClasses), '');
    for i := 0 to Core.TotalProcessingClasses-1 do begin
      s := Format('ProcessingClass %D', [i]);
      Result.Add(s + 'Interval, ms',     vtNat,     [], IntToStr(Round(Core.ProcessingClasses[i].Interval*1000)), '');
      Result.Add(s + 'Delta time-based', vtBoolean, [], OnOffStr[pfDeltaTimeBased in Core.ProcessingClasses[i].Flags], '');
      Result.Add(s + 'Ignore pause',     vtBoolean, [], OnOffStr[pfIgnorePause    in Core.ProcessingClasses[i].Flags], '');
    end;
  end;
end;
procedure TCASTRootItem.SetProperties(Properties: Props.TProperties);
var
  i, l, Newl: Integer; Core: TBaseCore; s: string;
  NewIgnorePause, NewDeltaTimeMode: Boolean;
begin
  inherited;
  if FManager is TBaseCore then Core := (FManager as TBaseCore) else begin
    {$IFDEF LOGGING} Log.Log(ClassName + '.SetProperties: Items manager must be an instance of TBaseCore', lkError); {$ENDIF}
    Exit;
  end;
  if (Parent = nil) and (FManager.Root = Self) then begin
  if Properties.Valid('RendererBefore backgroundClearFrame buffer')   then if Properties.GetAsInteger('RendererBefore backgroundClearFrame buffer')   > 0 then
    Include(StageSettings[poBackground].ClearFlags, ClearFrameBuffer)   else Exclude(StageSettings[poBackground].ClearFlags, ClearFrameBuffer);
  if Properties.Valid('RendererBefore backgroundClearZ buffer')       then if Properties.GetAsInteger('RendererBefore backgroundClearZ buffer')       > 0 then
    Include(StageSettings[poBackground].ClearFlags, ClearZBuffer)       else Exclude(StageSettings[poBackground].ClearFlags, ClearZBuffer);
  if Properties.Valid('RendererBefore backgroundClearStencil buffer') then if Properties.GetAsInteger('RendererBefore backgroundClearStencil buffer') > 0 then
    Include(StageSettings[poBackground].ClearFlags, ClearStencilBuffer) else Exclude(StageSettings[poBackground].ClearFlags, ClearStencilBuffer);
  if Properties.Valid('RendererBefore nearestClearFrame buffer')   then if Properties.GetAsInteger('RendererBefore nearestClearFrame buffer')   > 0 then
    Include(StageSettings[poNearest].ClearFlags, ClearFrameBuffer)   else Exclude(StageSettings[poNearest].ClearFlags, ClearFrameBuffer);
  if Properties.Valid('RendererBefore nearestClearZ buffer')       then if Properties.GetAsInteger('RendererBefore nearestClearZ buffer')       > 0 then
    Include(StageSettings[poNearest].ClearFlags, ClearZBuffer)       else Exclude(StageSettings[poNearest].ClearFlags, ClearZBuffer);
  if Properties.Valid('RendererBefore nearestClearStencil buffer') then if Properties.GetAsInteger('RendererBefore nearestClearStencil buffer') > 0 then
    Include(StageSettings[poNearest].ClearFlags, ClearStencilBuffer) else Exclude(StageSettings[poNearest].ClearFlags, ClearStencilBuffer);
  if Properties.Valid('RendererBefore postprocessClearFrame buffer')   then if Properties.GetAsInteger('RendererBefore postprocessClearFrame buffer')   > 0 then
    Include(StageSettings[poPostprocess].ClearFlags, ClearFrameBuffer)   else Exclude(StageSettings[poPostprocess].ClearFlags, ClearFrameBuffer);
  if Properties.Valid('RendererBefore postprocessClearZ buffer')       then if Properties.GetAsInteger('RendererBefore postprocessClearZ buffer')       > 0 then
    Include(StageSettings[poPostprocess].ClearFlags, ClearZBuffer)       else Exclude(StageSettings[poPostprocess].ClearFlags, ClearZBuffer);
  if Properties.Valid('RendererBefore postprocessClearStencil buffer') then if Properties.GetAsInteger('RendererBefore postprocessClearStencil buffer') > 0 then
    Include(StageSettings[poPostprocess].ClearFlags, ClearStencilBuffer) else Exclude(StageSettings[poPostprocess].ClearFlags, ClearStencilBuffer);
    SetColorProperty(Properties, 'RendererBefore backgroundClearColor value', StageSettings[poBackground].ClearColor);
    if Properties.Valid('RendererBefore backgroundClearZ value')        then StageSettings[poBackground].ClearZ             := StrToFloatDef(Properties['RendererBefore backgroundClearZ value'], 1);
    if Properties.Valid('RendererBefore backgroundClearStencil value')  then StageSettings[poBackground].ClearStencil       := Longword(Properties.GetAsInteger('RendererBefore backgroundClearStencil value'));
    SetColorProperty(Properties, 'RendererBefore nearestClearColor value', StageSettings[poNearest].ClearColor);
    if Properties.Valid('RendererBefore nearestClearZ value')        then StageSettings[poNearest].ClearZ             := StrToFloatDef(Properties['RendererBefore nearestClearZ value'], 1);
    if Properties.Valid('RendererBefore nearestClearStencil value')  then StageSettings[poNearest].ClearStencil       := Longword(Properties.GetAsInteger('RendererBefore nearestClearStencil value'));
    SetColorProperty(Properties, 'RendererBefore postprocessClearColor value', StageSettings[poPostprocess].ClearColor);
    if Properties.Valid('RendererBefore postprocessClearZ value')        then StageSettings[poPostprocess].ClearZ             := StrToFloatDef(Properties['RendererBefore postprocessClearZ value'], 1);
    if Properties.Valid('RendererBefore postprocessClearStencil value')  then StageSettings[poPostprocess].ClearStencil       := Longword(Properties.GetAsInteger('RendererBefore postprocessClearStencil value'));
    if Properties.Valid('RendererSimultaneous light sources') then Core.SimultaneousLightSources := Properties.GetAsInteger('RendererSimultaneous light sources');
    if Properties.Valid('ProcessingNumber of classes') then begin
      Core.TotalProcessingClasses := MaxI(1, StrToIntDef(Properties['ProcessingNumber of classes'], 1));
    end;
    for i := 0 to Core.TotalProcessingClasses-1 do begin
      s := Format('ProcessingClass %D', [i]);
      if Properties.Valid(s + 'Interval, ms') then
        Core.ProcessingClasses[i].Interval := Cardinal(StrToIntDef(Properties[s + 'Interval, ms'], 30)) / 1000;
      if Properties.Valid(s + 'Ignore pause') then
        NewIgnorePause := Properties.GetAsInteger(s + 'Ignore pause') > 0
      else
        NewIgnorePause := pfIgnorePause in Core.ProcessingClasses[i].Flags;
      if Properties.Valid(s + 'Delta time-based') then
        NewDeltaTimeMode := Properties.GetAsInteger(s + 'Delta time-based') > 0
      else
        NewDeltaTimeMode := pfDeltaTimeBased in Core.ProcessingClasses[i].Flags;
      Core.SetProcessingClass(i, Core.ProcessingClasses[i].Interval, NewIgnorePause, NewDeltaTimeMode);
    end;
  end;
end;
procedure TCASTRootItem.TraverseTree(Callback: TTraverseCallback);
  function TraverseCallback(Item: BaseClasses.TItem): TTraverseResult;
  var i: Integer;
  begin
    Result := Callback(Item);
    if Result = trContinue then for i := 0 to Item.TotalChilds-1 do begin
      {$IFDEF DEBUGMODE} Assert(Item.Childs[i] <> nil, ClassName + '.TraverseTree.Traverse: Childs[i] cannot be nil'); {$ENDIF}
      Result := TraverseCallBack(Item.Childs[i]);
      if Result = trStop then Exit;
    end;
  end;
begin
  if @Callback <> nil then TraverseCallback(Self);
end;
{procedure TCASTRootItem.IncludeItem(Item: BaseClasses.TItem; Mask: TTraverseMask);
var i: Integer;
begin
  for i := 0 to TotalCollections-1 do if Mask = Collections[i].TraverseMask then AddToCollection(i, Item);
end;
procedure TCASTRootItem.ExcludeItem(Item: BaseClasses.TItem; Mask: TTraverseMask);
var i: Integer;
begin
  for i := 0 to TotalCollections-1 do if Mask = Collections[i].TraverseMask then RemoveFromCollection(i, Item);
end;}
function TCASTRootItem.AddCollection(Mask: TTraverseMask): Integer;
var i: Integer;
begin
 Result := -1;
  for i := 0 to High(Collections) do if Collections[i].Items = nil then Result := i;
  Inc(TotalCollections);
  if Result = -1 then begin
    Result := Length(Collections);
    SetLength(Collections, Result+1);
  end;
  Collections[Result].TraverseMask := Mask;
  Collections[Result].TotalItems   := 0;
  SetLength(Collections[Result].Items, CollectionsCapacityStep);
end;
procedure TCASTRootItem.DeleteCollection(Index: Integer);
begin
  if (Index >= Length(Collections)) or (Collections[Index].Items = nil) then Exit;
  Dec(TotalCollections);
  Collections[Index].Items := nil;
end;
{function TCASTRootItem.AddToCollectionCallback(Item: BaseClasses.TItem): TTraverseResult;
begin
  AddToCollection(ModifyingCollectionIndex, Item);
  Result := trContinue;
end;}
(*procedure TCASTRootItem.AddToCollection(CollectionIndex: Integer; Item: BaseClasses.TItem);
begin
{$IFDEF DEBUGMODE}
  Assert((CollectionIndex < TotalCollections) and (Collections[CollectionIndex].Items <> nil), ClassName + '.AddToCollection: Invalid collection');
{$ENDIF}
  if (CollectionIndex < TotalCollections) and (Collections[CollectionIndex].Items <> nil) and (Item <> nil) then begin
    if Length(Collections[CollectionIndex].Items) <= Collections[CollectionIndex].TotalItems then
     SetLength(Collections[CollectionIndex].Items, Length(Collections[CollectionIndex].Items) + ChildsCapacityStep);
    Collections[CollectionIndex].Items[Collections[CollectionIndex].TotalItems] := Item;
    Inc(Collections[CollectionIndex].TotalItems);
  end;
end;
procedure TCASTRootItem.RemoveFromCollection(CollectionIndex: Integer; Item: BaseClasses.TItem);
var i: Integer;
begin
  {$IFDEF DEBUGMODE}
  Assert((CollectionIndex < TotalCollections) and (Collections[CollectionIndex].Items <> nil), ClassName + '.RemoveFromCollection: Invalid collection');
  {$ENDIF}
  if (CollectionIndex < TotalCollections) and (Collections[CollectionIndex].Items <> nil) and (Item <> nil) then
   for i := 0 to Collections[CollectionIndex].TotalItems-1 do if Collections[CollectionIndex].Items[i] = Item then begin
     Collections[CollectionIndex].Items[i] := Collections[CollectionIndex].Items[Collections[CollectionIndex].TotalItems-1];
     Collections[CollectionIndex].Items[Collections[CollectionIndex].TotalItems-1] := nil;
     Dec(Collections[CollectionIndex].TotalItems);
     Exit;
   end;
{$IFDEF DEBUGMODE}
  Assert(False, ClassName + '.RemoveFromCollection: Item not found');
{$ENDIF}
end;    *)
procedure TCASTRootItem.AddColliding(AItem: TProcessing);
begin
  Collidings.Add(AItem.Colliding);
end;
procedure TCASTRootItem.RemoveColliding(AItem: TProcessing);
begin
  Collidings.Remove(AItem.Colliding);
end;
procedure TCASTRootItem.Collide;
var i, j: Integer; ColRes: Collisions.TCollisionResult; P: Pointer;
begin
  for i := 0 to Collidings.TotalItems-2 do for j := i+1 to Collidings.TotalItems-1 do
    if Assigned(TColliding(Collidings.Items[i]).Owner) and (isProcessing in TColliding(Collidings.Items[i]).Owner.State) and
       Assigned(TColliding(Collidings.Items[j]).Owner) and (isProcessing in TColliding(Collidings.Items[j]).Owner.State) then begin
    ColRes := VolumeColDet(TColliding(Collidings.Items[i]).Volumes, TColliding(Collidings.Items[j]).Volumes,
                           TProcessing(TColliding(Collidings.Items[i]).Owner).Transform, TProcessing(TColliding(Collidings.Items[j]).Owner).Transform);
    if ColRes.Vol1 <> nil then begin
      TProcessing(TColliding(Collidings.Items[i]).Owner).OnCollision(TProcessing(TColliding(Collidings.Items[j]).Owner), ColRes);
      P := ColRes.Vol1;
      ColRes.Vol1 := ColRes.Vol2;
      ColRes.Vol2 := P;
      TProcessing(TColliding(Collidings.Items[j]).Owner).OnCollision(TProcessing(TColliding(Collidings.Items[i]).Owner), ColRes);
    end;
  end;
end;
procedure TCASTRootItem.FreeChilds;
var i: Integer;
begin
  for i := 0 to High(Collections) do Collections[i].TotalItems := 0;
  Collidings.Clear;
  inherited;
end;
function TCASTRootItem.ExtractByMaskClassInRadius(Mask: TItemFlags; AClass: CProcessing; out Items: TItems; Origin: TLocation; Range: Single): Integer;
var i: Integer; SQRange: Single;
begin
  Result := 0;
  SQRange := Sqr(Range);
  if AClass.InheritsFrom(TProcessing) then begin
    for i := 0 to ExtractByMaskClass(Mask, AClass, Items)-1 do
      if LocationSqDistance(TProcessing(Items[i]).Location, Origin) < SQRange then begin
        Items[Result] := Items[i];
        Inc(Result);
      end;
  end else
    ErrorHandler(TInvalidArgument.Create('TCASTRootItem.ExtractByMaskClassInRadius: Spatial query class argument should be TProcessing or one of its descendant class'));
  {$IFDEF DEBUGMODE}
  SetLength(Items, Result);
  {$ENDIF}  
end;
function TCASTRootItem.ExtractByMaskClassInCamera(Mask: TItemFlags; AClass: CProcessing; out Items: TItems; ACamera: TCamera): Integer;
var i: Integer;
begin
  Result := 0;
  if AClass.InheritsFrom(TProcessing) then begin
    for i := 0 to ExtractByMaskClass(Mask, AClass, Items)-1 do
      if ACamera.IsSpehereVisible(TProcessing(Items[i]).GetAbsLocation, TProcessing(Items[i]).BoundingSphereRadius) <> fcOutside then begin
        Items[Result] := Items[i];
        Inc(Result);
      end;
  end else
    ErrorHandler(TInvalidArgument.Create('TCASTRootItem.ExtractByMaskClassInRadius: Spatial query class argument should be TProcessing or one of its descendant class'));
  {$IFDEF DEBUGMODE}
  SetLength(Items, Result);
  {$ENDIF}
end;
procedure TCASTRootItem.HandleMessage(const Msg: TMessage);
begin
  inherited;
  if Msg.ClassType = ItemMsg.TAddToSceneMsg then with ItemMsg.TAddToSceneMsg(Msg) do begin
    if (Item is TProcessing) and (TProcessing(Item).Colliding <> nil) then Collidings.Add(TProcessing(Item).Colliding);
  end else if Msg.ClassType = ItemMsg.TReplaceMsg then with ItemMsg.TReplaceMsg(Msg) do begin
    if (OldItem is TProcessing) and (TProcessing(OldItem).Colliding <> nil) then Collidings.Remove(TProcessing(OldItem).Colliding);
  end else if Msg.ClassType = ItemMsg.TRemoveFromSceneMsg then with ItemMsg.TRemoveFromSceneMsg(Msg) do begin
    if (Item is TProcessing) and (TProcessing(Item).Colliding <> nil) then Collidings.Remove(TProcessing(Item).Colliding);
  end
end;
{ TProcessing }
constructor TProcessing.Create(AManager: TItemsManager);
begin
  Colliding := TColliding.Create;
  Colliding.Owner := Self;
  Colliding.Volumes := nil;
  inherited;
  FState := FState + [isProcessing];
  FScale := GetVector3s(1, 1, 1);
  Orientation := GetQuaternion(0, GetVector3s(0, 1, 0));
  ProcessingClass := 0;
  BoundingBox.P1 := GetVector3s(-1, -1, -1);
  BoundingBox.P2 := GetVector3s( 1,  1,  1);
end;
destructor TProcessing.Destroy;
begin
  if Assigned(FManager) and Assigned(FManager.Root) then (FManager.Root as TCASTRootItem).RemoveColliding(Self);
  FreeAndNil(Colliding);
  inherited;
end;
function TProcessing.SetChild(Index: Integer; AItem: BaseClasses.TItem): BaseClasses.TItem;
begin
  Result := inherited SetChild(Index, AItem);
  if (Result <> nil) and (AItem is TProcessing) then (AItem as TProcessing).InvalidateTransform;
end;
procedure TProcessing.OnCollision(Item: TProcessing; const ColRes: Collisions.TCollisionResult);
begin
  {$IFDEF LOGGING}
//  Log.Log('Collision "' + Name +'" with "' + Item.GetFullName + '"');
  {$ENDIF}
end;
procedure TProcessing.AddProperties(const Result: Props.TProperties);
var i: Integer; Str: string;
begin
  inherited;
  if not Assigned(Result) then Exit;
//  Result.AddEnumerated('Processing class', [], ProcessingClass+1, (FManager as TBaseCore).GetProcClassesEnum);
  AddVector4sProperty(Result, 'TransformLocation', Location);
  AddQuaternionProperty(Result, 'TransformOrientation', FOrientation);
{  Angle := ArcTan2(Sqrt(1 - Orientation[0] * Orientation[0]), Orientation[0])*2 * 180/pi;
  Str := 'TransformOrientation';
  Result.Add(Str,            vtString, [poReadOnly], Format('(%3.3F, (%3.3F, %3.3F, %3.3F))', [Angle, Orientation[1], Orientation[2], Orientation[3]]), '');
  Result.Add(Str + 'Angle', vtSingle, [], FloatToStr(Angle), '');
  Result.Add(Str + 'X',     vtSingle, [], FloatToStr(Orientation[1]), '');
  Result.Add(Str + 'Y',     vtSingle, [], FloatToStr(Orientation[2]), '');
  Result.Add(Str + 'Z',     vtSingle, [], FloatToStr(Orientation[3]), '');}
  AddVector3sProperty(Result, 'TransformScale', Scale);
  Result.Add('BoundsTotal volumes', vtInt, [], IntToStr(Length(Colliding.Volumes)), '');
  for i := 0 to High(Colliding.Volumes) do begin
    Str := 'BoundsVolume #' + IntToStr(i+1) + '';
    Result.AddEnumerated(Str + 'Kind', [], Ord(Colliding.Volumes[i].VolumeKind), VolumeKindsEnum);
    AddVector3sProperty(Result, Str + 'Offset', Colliding.Volumes[i].Offset);
    AddVector3sProperty(Result, 'BoundsVolume #' + IntToStr(i+1) + 'Dimensions', Colliding.Volumes[i].Dimensions);
  end;
end;
procedure TProcessing.SetProperties(Properties: Props.TProperties);
var i, TotalVolumes: Integer; Str: string; 
begin
  inherited;
  if SetVector4sProperty(Properties, 'TransformLocation', FLocation) then SetLocation(FLocation);
  if SetQuaternionProperty(Properties, 'TransformOrientation', FOrientation) then SetOrientation(FOrientation);
  if SetVector3sProperty(Properties, 'TransformScale', FScale) then SetScale(FScale);
  if Properties.Valid('BoundsTotal volumes') then begin
    TotalVolumes := Length(Colliding.Volumes);
    SetLength(Colliding.Volumes, StrToIntDef(Properties['BoundsTotal volumes'], Length(Colliding.Volumes)));
    if (TotalVolumes =  0) and (High(Colliding.Volumes) >= 0) then (FManager.Root as TCASTRootItem).AddColliding(Self);
    if (TotalVolumes <> 0) and (High(Colliding.Volumes)  < 0) then (FManager.Root as TCASTRootItem).RemoveColliding(Self);
    for i := TotalVolumes to High(Colliding.Volumes) do begin
      Colliding.Volumes[i].VolumeKind := bvkOOBB;
      Colliding.Volumes[i].Offset     := ScaleVector3s(AddVector3s(BoundingBox.P2, BoundingBox.P1), 0.5);
      Colliding.Volumes[i].Dimensions := ScaleVector3s(SubVector3s(BoundingBox.P2, BoundingBox.P1), 0.5);
    end;
  end;
  for i := 0 to High(Colliding.Volumes) do begin
    Str := 'BoundsVolume #' + IntToStr(i+1) + '';
    if Properties.Valid(Str + 'Kind') then Colliding.Volumes[i].VolumeKind := TBoundingVolumeKind(Properties.GetAsInteger(Str + 'Kind'));
    SetVector3sProperty(Properties, Str + 'Offset', Colliding.Volumes[i].Offset);
    SetVector3sProperty(Properties, 'BoundsVolume #' + IntToStr(i+1) + 'Dimensions', Colliding.Volumes[i].Dimensions);
  end;
end;
function TProcessing.GetAbsLocation: TVector3s;
begin
  Result.X := Transform._41; Result.Y := FTransform._42; Result.Z := FTransform._43;
end;
function TProcessing.GetAbsOrientation: TQuaternion;
// Multiply orientation quaternions upward to first non-processing parent
var ParItem: BaseClasses.TItem;
begin
  Result := Orientation;
  ParItem := Parent;
  while ParItem is TDummyItem do ParItem := ParItem.Parent;                        // Skip dummy items
  if ParItem is TProcessing then Result := MulQuaternion(TProcessing(ParItem).GetAbsOrientation, Result);
end;
procedure TProcessing.SetTransform(const ATransform: TMatrix4s);
begin
  FTransform := ATransform;
  TransformValid := True;
end;
function TProcessing.GetTransform: TMatrix4s;
begin
  if not TransformValid then ComputeTransform;
  Result := FTransform;
end;                     
function TProcessing.GetLocation: TVector4s;
begin
  Result := FLocation;
end;
procedure TProcessing.SetLocation(ALocation: TVector4s);
begin
  FLocation := ALocation;
  InvalidateTransform;
end;
function TProcessing.GetPosition: TVector3s;
begin
  Result := FLocation.XYZ;
end;
procedure TProcessing.SetPosition(const Value: TVector3s);
begin
  SetLocation(GetVector4s(Value.X, Value.Y, Value.Z, FLocation.W));
end;
function TProcessing.GetOrientation: TQuaternion;
begin
  Result := FOrientation;
end;
procedure TProcessing.SetOrientation(AOrientation: TQuaternion);
begin
  FOrientation := AOrientation;
  InvalidateTransform;
end;
function TProcessing.GetScale: TVector3s;
begin
  Result := FScale;
end;
procedure TProcessing.SetScale(const Value: TVector3s);
begin
  FScale := Value;
  InvalidateTransform;
end;
procedure TProcessing.InvalidateTransform;
{  procedure InvalidateChilds(Item: BaseClasses.TItem);
  var i: Integer;
  begin
    for i := 0 to Item.TotalChilds-1 do begin
      if (Item.Childs[i] is TProcessing) then begin
        TProcessing(Item.Childs[i]).TransformValid := False;
        InvalidateChilds(Item.Childs[i]);
      end;
      if (Item.Childs[i] is TDummyItem) then InvalidateChilds(Item.Childs[i]);
    end;
  end;}
  procedure InvalidateChilds(Item: BaseClasses.TItem);
  var i: Integer;
  begin
    for i := 0 to Item.TotalChilds-1 do
      if (Item.Childs[i] is TProcessing) then
        TProcessing(Item.Childs[i]).InvalidateTransform else
          if (Item.Childs[i] is TDummyItem) then InvalidateChilds(Item.Childs[i]);
  end;
begin
  TransformValid := False;
  InvalidateChilds(Self);
end;
procedure TProcessing.ComputeTransform;
var ParItem: BaseClasses.TItem;
begin
  TranslationMatrix4s(FTransform, FLocation.X, FLocation.Y, FLocation.Z);
  Matrix4sByQuat(FTransform, FOrientation);
  MulMatrix4s(FTransform, ScaleMatrix4s(FScale.X, FScale.Y, FScale.Z), FTransform);
  ParItem := Parent;
  while ParItem is TDummyItem do ParItem := ParItem.Parent;                        // Skip dummy items
  if ParItem is TProcessing then FTransform := MulMatrix4s(FTransform, TProcessing(ParItem).Transform);
  TransformValid := True;
end;
function TProcessing.GetForwardVector: TVector3s;
begin
  Result := GetVector3s(Transform._31, Transform._32, Transform._33);
end;
function TProcessing.GetRightVector: TVector3s;
begin
  Result := GetVector3s(Transform._11, Transform._12, Transform._13);
end;
function TProcessing.GetUpVector: TVector3s;
begin
  Result := GetVector3s(Transform._21, Transform._22, Transform._23);
end;
function TProcessing.GetDimensions: TVector3s;
begin
  ScaleVector3s(Result, SubVector3s(BoundingBox.P2, BoundingBox.P1), 0.5);
end;
function TProcessing.GetBoundingSphereRadius: Single;
var D: Single;
begin
  D := MaxS(SqrMagnitude(BoundingBox.P1), SqrMagnitude(BoundingBox.P2));
  Result := Sqrt(D);
end;
function TProcessing.ModelToWorld(const APoint: TVector3s): TVector3s;
begin
  Result := Transform4Vector33s(Transform, APoint);
end;
function TProcessing.WorldToModel(const APoint: TVector3s): TVector3s;
begin
  Result := Transform4Vector33s(InvertAffineMatrix4s(Transform), APoint);
end;
{ TCamera }
constructor TCamera.Create(AManager: TItemsManager);
var i: Integer;
begin
  inherited;
  InitProjMatrix(1, 100000, 90, 1);
  FCurrentAspectRatio := FAspectRatio;
  RenderTargetIndex   := -1;
  FState    := FState + [isVisible];
  GroupMask := gmDefault;
  for i := 0 to MaxClipPlanes-1 do ClipPlanes[i] := nil;
  DefaultFillMode := fmSolid;
  DefaultCullMode := cmCCW;
  ClearSettings.ClearFlags := [ClearFrameBuffer, ClearZBuffer];
  ClearSettings.ClearColor.C := 0;
  ClearSettings.ClearZ       := 1;
end;
destructor TCamera.Destroy;
var i: Integer;
begin
  for i := 0 to MaxClipPlanes-1 do if Assigned(ClipPlanes[i]) then FreeMem(ClipPlanes[i]);
  inherited;
end;
procedure TCamera.AddProperties(const Result: Props.TProperties);
var i: Integer;
begin
  inherited;
  if not Assigned(Result) then Exit;
//  Result.Add('Default', vtBoolean, [], OnOffStr[Default], '');
  for i := 0 to PassGroupsCount-1 do Result.Add(Format('Pass groupsGroup %D', [i+1]), vtBoolean, [], OnOffStr[i in GroupMask], '');
  Result.Add('RenderWidth',  vtInt, [poReadonly, poDerivative], IntToStr(RenderWidth),  '');
  Result.Add('RenderHeight', vtInt, [poReadonly, poDerivative], IntToStr(RenderHeight), '');
  Result.AddEnumerated('RenderColor format', [poReadonly, poDerivative], ColorFormat, PixelFormatsEnum);
  Result.AddEnumerated('RenderDepth format', [poReadonly, poDerivative], DepthFormat, PixelFormatsEnum);
  Result.Add('RenderCurrent aspect ratio', vtSingle,  [poReadonly, poDerivative], FloatToStr(CurrentAspectRatio),  '');
  Result.Add('RenderLOD bias', vtSingle,  [], FloatToStr(LODBias),  '');
  // Render to texture related properties
  Result.Add('RenderRender targetWidth',  vtInt, [], IntToStr(RenderTargetWidth),  '');
  Result.Add('RenderRender targetHeight', vtInt, [], IntToStr(RenderTargetHeight), '');
  Result.AddEnumerated('RenderRender targetColor format',   [], FRTColorFormat, PixelFormatsEnum);
  Result.AddEnumerated('RenderRender targetDepth format',   [], FRTDepthFormat, PixelFormatsEnum);
  Result.Add('RenderRender targetFrame skip', vtInt,        [], IntToStr(FrameSkip), '');
  Result.Add('RenderRender targetDepth texture', vtBoolean, [], OnOffStr[IsDepthTexture], '');
  Result.Add('ProjectionOrthographic', vtBoolean, [], OnOffStr[FOrthographic], '');
  Result.Add('ProjectionZ near',         vtSingle,  [], FloatToStr(FZNear),              '');
  Result.Add('ProjectionZ far',          vtSingle,  [], FloatToStr(FZFar),               '');
  Result.Add('ProjectionHorizontal FoV', vtInt,     [], IntToStr(Round(FHFoV * RadToDeg)), '0-180');
  Result.Add('ProjectionVisible width',  vtSingle,  [], FloatToStr(FWidth), '');
  Result.Add('ProjectionAspect ratio',   vtSingle,  [], FloatToStr(FAspectRatio),        '0.125-8');
  Result.Add('ClearFrame buffer',        vtBoolean, [], OnOffStr[ClearFrameBuffer   in ClearSettings.ClearFlags], '');
  Result.Add('ClearZ buffer',            vtBoolean, [], OnOffStr[ClearZBuffer       in ClearSettings.ClearFlags], '');
  Result.Add('ClearStencil buffer',      vtBoolean, [], OnOffStr[ClearStencilBuffer in ClearSettings.ClearFlags], '');
  AddColorProperty(Result, 'ClearColor value', ClearSettings.ClearColor);
  Result.Add('ClearZ value',             vtSingle,  [], FloatToStr(ClearSettings.ClearZ),            '');
  Result.Add('ClearStencil value',       vtNat,     [], IntToStr(ClearSettings.ClearStencil),        '');
  Result.AddEnumerated('RenderDefault face culling', [], DefaultCullMode, CameraCullModesEnum);
  Result.AddEnumerated('RenderDefault fill mode',    [], DefaultFillMode, CameraFillModesEnum);
end;
procedure TCamera.SetProperties(Properties: Props.TProperties);
var i: Integer;
begin
  inherited;
//  if Properties.Valid('Default') then Default := Properties.GetAsInteger('Default') > 0;
  for i := 0 to PassGroupsCount-1 do
    if Properties.Valid(Format('Pass groupsGroup %D', [i+1])) then
      if Properties.GetAsInteger(Format('Pass groupsGroup %D', [i+1])) > 0 then
        GroupMask := GroupMask + [i] else
          GroupMask := GroupMask - [i];
  if Properties.Valid('RenderRender targetWidth')  then RenderTargetWidth  := StrToIntDef(Properties['RenderRender targetWidth'],  0);
  if Properties.Valid('RenderRender targetHeight') then RenderTargetHeight := StrToIntDef(Properties['RenderRender targetHeight'], 0);
  if Properties.Valid('RenderRender targetColor format')  then FRTColorFormat    := Properties.GetAsInteger('RenderRender targetColor format');
  if Properties.Valid('RenderRender targetDepth format')  then FRTDepthFormat    := Properties.GetAsInteger('RenderRender targetDepth format');
  if Properties.Valid('RenderRender targetFrame skip')    then FrameSkip         := StrToIntDef(Properties['RenderRender targetFrame skip'], 0);
  if Properties.Valid('RenderRender targetDepth texture') then IsDepthTexture      := Properties.GetAsInteger('RenderRender targetDepth texture') > 0;
  if Properties.Valid('ProjectionOrthographic') then FOrthographic := Properties.GetAsInteger('ProjectionOrthographic') > 0;
  if Properties.Valid('ProjectionZ near')         then FZNear := StrToFloatDef(Properties['ProjectionZ near'],        1);
  if Properties.Valid('ProjectionZ far')          then FZFar  := StrToFloatDef(Properties['ProjectionZ far'],         100000);
  if Properties.Valid('ProjectionHorizontal FoV') then FHFoV  := StrToIntDef(Properties['ProjectionHorizontal FoV'], 90) * DegToRad;
  if Properties.Valid('ProjectionVisible width')  then FWidth := StrToFloatDef(Properties['ProjectionVisible width'], 0);
  if Properties.Valid('ProjectionAspect ratio') then begin
    FAspectRatio := StrToFloatDef(Properties['ProjectionAspect ratio'], 1);
    FCurrentAspectRatio := FAspectRatio;
  end;
  if Properties.Valid('RenderLOD bias') then LODBias := StrToFloatDef(Properties['RenderLOD bias'], 0);
  if Properties.Valid('ClearFrame buffer')   then if Properties.GetAsInteger('ClearFrame buffer')   > 0 then
    Include(ClearSettings.ClearFlags, ClearFrameBuffer) else Exclude(ClearSettings.ClearFlags, ClearFrameBuffer);
  if Properties.Valid('ClearZ buffer')       then if Properties.GetAsInteger('ClearZ buffer')       > 0 then
    Include(ClearSettings.ClearFlags, ClearZBuffer) else Exclude(ClearSettings.ClearFlags, ClearZBuffer);
  if Properties.Valid('ClearStencil buffer') then if Properties.GetAsInteger('ClearStencil buffer') > 0 then
    Include(ClearSettings.ClearFlags, ClearStencilBuffer) else Exclude(ClearSettings.ClearFlags, ClearStencilBuffer);
  SetColorProperty(Properties, 'ClearColor value', ClearSettings.ClearColor);
  if Properties.Valid('ClearZ value')        then ClearSettings.ClearZ       := StrToFloatDef(Properties['ClearZ value'], 1);
  if Properties.Valid('ClearStencil value')  then ClearSettings.ClearStencil := Longword(Properties.GetAsInteger('ClearStencil value'));
  if Properties.Valid('RenderDefault face culling') then DefaultCullMode := Properties.GetAsInteger('RenderDefault face culling');
  if Properties.Valid('RenderDefault fill mode')    then DefaultFillMode := Properties.GetAsInteger('RenderDefault fill mode');
  InitProjMatrix(FZNear, FZFar, FHFoV, FAspectRatio);
end;
procedure TCamera.InvalidateTransform;
begin
  inherited;
  ViewValid := False;
end;
procedure TCamera.ComputeViewMatrix;
begin
{  FViewMatrix     :=  ExpandMatrix3s(GetTransposedMatrix3s(CutMatrix3s(Transform)));
  Pos := GetAbsLocation;
  FViewMatrix._41 := -DotProductVector3s(FTransform.ViewRight,   Pos);
  FViewMatrix._42 := -DotProductVector3s(FTransform.ViewUp,      Pos);
  FViewMatrix._43 := -DotProductVector3s(FTransform.ViewForward, Pos);}
  FInvViewMatrix := Transform;
  FViewMatrix := InvertAffineMatrix4s(FInvViewMatrix);
  MulMatrix4s(FTotalMatrix, FViewMatrix, ProjMatrix);
  ComputeFrustumPlanes;
  ViewValid := True;
end;
procedure TCamera.InitProjMatrix(AZNear, AZFar, AHFoV, AAspectRatio: Single);
var w, h, q: Single; Cen: TVector3s;
begin
  FZNear       := AZNear;
  FZFar        := AZFar;
  FHFoV        := AHFoV;
  AspectRatio  := AAspectRatio;
  FillChar(FProjMatrix, SizeOf(FProjMatrix), 0);
  if FOrthographic then begin
    FProjMatrix := IdentityMatrix4s;
    w := FWidth;
    h := w * CurrentAspectRatio;
//    FProjMatrix.m[0, 0] := 2/w; FProjMatrix.m[1, 1] := 2/h; FProjMatrix.m[2, 2] := 2/(FZFar - FZNear);
//    MulMatrix4s(FProjMatrix, ScaleMatrix4s(2/w, 2/h, 2/(FZFar - FZNear)), TranslationMatrix4s(-GetAbsLocation.x, -GetAbsLocation.y, -GetAbsLocation.z));
    Cen := GetAbsLocation;
//    MulMatrix4s(FProjMatrix, TranslationMatrix4s(-Cen.x, -Cen.y, -Cen.z), ScaleMatrix4s(2/w, 2/h, 2/(FZFar - FZNear)));
    FProjMatrix := ScaleMatrix4s(2/w, 2/h, 2/(FZFar - FZNear));
  end else begin
    w := Cos(FHFov * 0.5) / Sin(FHFov * 0.5);
    h := w * CurrentAspectRatio;
    q := FZFar / (FZFar - FZNear);
    FProjMatrix.m[0, 0] := w; FProjMatrix.m[1, 1] := h; FProjMatrix.m[2, 2] := q;
    FProjMatrix.m[3, 2] := -q*FZNear; FProjMatrix.m[2, 3] := 1;
  end;
//  ViewValid := False;
end;
procedure TCamera.InitOrthoProjMatrix(AZNear, AZFar, VisibleWidth, AAspectRatio: Single);
begin
  FOrthographic := True;
  FWidth := VisibleWidth;
  InitProjMatrix(AZNear, AZFar, FHFoV, AAspectRatio);
end;
procedure TCamera.SetClearState(AClearFlags: TClearFlagsSet; AClearColor: BaseTypes.TColor; AClearZ: Single; AClearStencil: Cardinal);
begin
  ClearSettings.ClearFlags   := AClearFlags;
  ClearSettings.ClearColor   := AClearColor;
  ClearSettings.ClearZ       := AClearZ;
  ClearSettings.ClearStencil := AClearStencil;
end;
procedure TCamera.SetScreenDimensions(Width, Height: Integer; AdjustAspectRatio: Boolean);
begin
  if (Width = FRenderWidth) and (Height = FRenderHeight) then Exit;
  FRenderWidth  := Width;
  FRenderHeight := Height;
  if AdjustAspectRatio then begin
    FCurrentAspectRatio := Width / Height * AspectRatio;
  end;
  InitProjMatrix(FZNear, FZFar, FHFoV, FAspectRatio);
end;
procedure TCamera.Rotate(XA, YA, ZA: Single);
begin
  Orientation := MulQuaternion(GetQuaternion(XA, RightVector), MulQuaternion(GetQuaternion(YA, UpVector), MulQuaternion(GetQuaternion(ZA, ForwardVector), Orientation)));
end;
procedure TCamera.Move(XD, YD, ZD: Single);
begin
{  if Core.Renderer.MainCamera is TLookAtCamera then begin
    with (Core.Renderer.MainCamera as TLookAtCamera) do
      LookTarget := AddVector3s(LookTarget, AddVector3s(ScaleVector3s(RightVector, -(NewMouseX - LastMouseX)*0.10), ScaleVector3s(UpVector, (NewMouseY - LastMouseY)*0.10)));}
  Position := AddVector3s(Position, AddVector3s(AddVector3s(ScaleVector3s(RightVector, XD), ScaleVector3s(UpVector, YD)), ScaleVector3s(ForwardVector, ZD)));
end;
function TCamera.GetPickRay(ScreenX, ScreenY: Single): TVector3s;
var d: Single;
begin
  d := 0.5*RenderWidth / Sin(FHFoV/2)*Cos(FHFoV/2);
  Result.X := -0.5*RenderWidth  + ScreenX;
  if RenderHeight > epsilon then
    Result.Y := (0.5*RenderHeight - ScreenY)*RenderWidth/RenderHeight/CurrentAspectRatio else
      Result.Y := 0;
  Result.Z := d;
end;
function TCamera.GetPickRayInWorld(ScreenX, ScreenY: Single): TVector3s;
begin
  Transform3Vector3s(Result, CutMatrix3s(InvertAffineMatrix4s(ViewMatrix)), GetPickRay(ScreenX, ScreenY));
end;
function TCamera.Project(const Vec: TVector3s): TVector4s;
var TRHW: Single;
begin
  Result := Transform4Vector3s(TotalMatrix, Vec);
  TRHW := 1/Result.W;
  Result.X := RenderWidth  shr 1 + Result.X * (RenderWidth  shr 1) * TRHW;
  Result.Y := RenderHeight shr 1 - Result.Y * (RenderHeight shr 1) * TRHW;
//  Result.Z := (ZFar/(ZFar-ZNear))*(1-ZNear/(Result.Z));          // ToFix: Optimize it
end;
function TCamera.GetViewMatrix: TMatrix4s;
begin
  if not ViewValid then ComputeViewMatrix;
  Result := FViewMatrix;
end;
procedure TCamera.SetViewMatrix(const Value: TMatrix4s);
begin
  FViewMatrix := Value;
  FInvViewMatrix := InvertAffineMatrix4s(FViewMatrix);;
  MulMatrix4s(FTotalMatrix, FViewMatrix, ProjMatrix);
  ComputeFrustumPlanes;
  ViewValid := True;
end;
function TCamera.GetInvViewMatrix: TMatrix4s;
begin
  if not ViewValid then ComputeViewMatrix;
  Result := FInvViewMatrix;
end;
function TCamera.GetTotalMatrix: TMatrix4s;
begin
  if not ViewValid then ComputeViewMatrix;
  Result := FTotalMatrix;
end;
function TCamera.GetViewOrigin: TVector3s;
begin
  Result := GetVector3s(InvViewMatrix._41, InvViewMatrix._42, InvViewMatrix._43);
end;
function TCamera.GetLookDir: TVector3s;
begin
  Result := GetVector3s(InvViewMatrix._31, InvViewMatrix._32, InvViewMatrix._33);
end;
function TCamera.GetRightDir: TVector3s;
begin
  Result := GetVector3s(InvViewMatrix._11, InvViewMatrix._12, InvViewMatrix._13);
end;
function TCamera.GetUpDir: TVector3s;
begin
  Result := GetVector3s(InvViewMatrix._21, InvViewMatrix._22, InvViewMatrix._23);
end;
procedure TCamera.SetAspectRatio(const Value: Single);
begin
  FAspectRatio := Value;
  if FRenderHeight <> 0 then
    FCurrentAspectRatio := FRenderWidth / FRenderHeight * FAspectRatio
      else FCurrentAspectRatio := 0;
end;
procedure TCamera.ComputeFrustumPlanes;
var i: Integer; M: Tmatrix4s;
begin
  M := FTotalMatrix;
  // Left clipping plane
  FFrustumPlanes[fpLeft].a := M._14 + M._11;
  FFrustumPlanes[fpLeft].b := M._24 + M._21;
  FFrustumPlanes[fpLeft].c := M._34 + M._31;
  FFrustumPlanes[fpLeft].d := M._44 + M._41;
  // Right clipping plane
  FFrustumPlanes[fpRight].a := M._14 - M._11;
  FFrustumPlanes[fpRight].b := M._24 - M._21;
  FFrustumPlanes[fpRight].c := M._34 - M._31;
  FFrustumPlanes[fpRight].d := M._44 - M._41;
  // Top clipping plane
  FFrustumPlanes[fpTop].a := M._14 - M._12;
  FFrustumPlanes[fpTop].b := M._24 - M._22;
  FFrustumPlanes[fpTop].c := M._34 - M._32;
  FFrustumPlanes[fpTop].d := M._44 - M._42;
  // Bottom clipping plane
  FFrustumPlanes[fpBottom].a := M._14 + M._12;
  FFrustumPlanes[fpBottom].b := M._24 + M._22;
  FFrustumPlanes[fpBottom].c := M._34 + M._32;
  FFrustumPlanes[fpBottom].d := M._44 + M._42;
  // Near clipping plane
  FFrustumPlanes[fpNear].a := M._13;
  FFrustumPlanes[fpNear].b := M._23;
  FFrustumPlanes[fpNear].c := M._33;
  FFrustumPlanes[fpNear].d := M._43;
  // Far clipping plane
  FFrustumPlanes[fpFar].a := M._14 - M._13;
  FFrustumPlanes[fpFar].b := M._24 - M._23;
  FFrustumPlanes[fpFar].c := M._34 - M._33;
  FFrustumPlanes[fpFar].d := M._44 - M._43;
  // Normalize
  for i := Ord(Low(TFrustumPlane)) to Ord(High(TFrustumPlane)) do NormalizePlane(FFrustumPlanes[TFrustumPlane(i)]);
end;
procedure TCamera.OnApply(const OldCamera: TCamera);
begin
  ClipPlanes[0] := nil;
end;
function TCamera.IsSpehereVisible(const Center: TVector3s; Radius: Single): TFrustumCheckResult;
var i: Integer; d: Single;
begin
  if not ViewValid then ComputeViewMatrix;
  Result := fcOutside;
  for i := Ord(Low(TFrustumPlane)) to Ord(High(TFrustumPlane)) do begin
    d := DotProductVector3s(FFrustumPlanes[TFrustumPlane(i)].Normal, Center) + FFrustumPlanes[TFrustumPlane(i)].D;
    if d < -Radius then Exit;                                     // Sphere is out of frustum
    if Abs(d) < Radius then begin                                 // Sphere intersects frustum
      Result := fcPartially; Exit;
    end;
  end;
  Result := fcInside;                                             // Sphere completely inside frustum
end;
{ TBaseCore }
procedure TBaseCore.SetTimer(const Value: Timer.TTimer);
begin
  Assert(Assigned(Value), 'TCore.SetTimer: Timer should be defined');
  if Assigned(FTimer) then RemoveSubsystem(FTimer);
  if (FTimer = DefaultTimer) and (Value <> DefaultTimer) then FreeAndNil(DefaultTimer);
  FTimer := Value;
  if Assigned(FTimer) then AddSubsystem(FTimer);
end;
procedure TBaseCore.SetTotalProcessingClasses(const Value: Integer);
var l, i: Integer;
begin
  l := Length(ProcessingClasses);
  for i := l-1 downto Value do
    FTimer.RemoveRecurringEvent(ProcessingClasses[i].TimerEventID);
  SetLength(ProcessingClasses, Value);
  for i := l to Value-1 do begin
    ProcessingClasses[i].Interval := DefaultProcessingInterval;
    ProcessingClasses[i].Flags    := [];
    ProcessingClasses[i].TimerEventID := Timer.SetRecurringEvent(ProcessingClasses[i].Interval, ProcessingEvent, i);
  end;
end;
procedure TBaseCore.ProcessDeltaTimeBased(const DeltaTime: TTimeUnit);
var i, j: Integer;
begin
  for j := 0 to TotalProcessingItems-1 do begin
    Assert(ProcessingItems[j] is TBaseProcessing, ProcessingItems[j].Name + ' is not a descendant of TBaseProcessing');
    i := TBaseProcessing(ProcessingItems[j]).ProcessingClass;
    if (i >= 0) and (pfDeltaTimeBased in ProcessingClasses[i].Flags) and
       (not Paused or (pfIgnorePause in ProcessingClasses[i].Flags)) then
      TBaseProcessing(ProcessingItems[j]).Process(DeltaTime);
  end;
end;
procedure TBaseCore.ProcessingEvent(EventID: Integer; const ErrorDelta: TTimeUnit);
var j: Integer;
begin
  if Paused and not (pfIgnorePause in ProcessingClasses[EventID].Flags) then Exit;
  for j := 0 to TotalProcessingItems-1 do begin
    Assert(ProcessingItems[j] is TBaseProcessing, ProcessingItems[j].Name + ' is not a descendant of TBaseProcessing');
    if TBaseProcessing(ProcessingItems[j]).ProcessingClass = EventID then
      TBaseProcessing(ProcessingItems[j]).Process((ProcessingClasses[EventID].Interval + ErrorDelta) * TimeScale);
  end;
end;
procedure TBaseCore.OnDestroy;
begin
  Log.Log('Engine shut down');
  FreeAndNil(FTesselatorManager);
  FreeAndNil(FSharedTesselators);
  FreeAndNil(RandomGen);
  FreeAndNil(FPerfProfile);
  inherited;
  Subsystems := nil;
  FreeAndNil(DefaultTimer);
end;
constructor TBaseCore.Create;
begin
  inherited;
  Log.Log('CAST II v' + EngineVersionMajor + '.' + EngineVersionMinor + ' starting up', lkInfo);
  {$IFDEF EDITORMODE}
  FEditorMode := True;
  Log.Log('World editing capabilities are On', lkWarning);
  {$ELSE}
  FEditorMode := False;
  Log.Log('World editing capabilities are Off', lkWarning);
  {$ENDIF}
  DefaultTimer := TTimer.Create({$IFDEF OBJFPCEnable}@{$ENDIF}HandleMessage);
  Timer        := DefaultTimer;
  Timer.MaxInterval := 5;                                    // Process recurring events for 5 last seconds only
  Timer.GetInterval(DeltaTimeBasedTimeMark, True);           // Initialize the time mark
  RegisterItemClass(TCASTRootItem);
  RandomGen := Basics.TRandomGenerator.Create;
  FTesselatorManager := BaseCont.TReferencedItemManager.Create;
  FPerfProfile := TPerfProfile.Create;
  TotalProcessingClasses := 1;
  SetProcessingClass(0, 30/1000, False, True);
  
  TimeScale := 1;
end;
procedure TBaseCore.HandleMessage(const Msg: TMessage);
var i: Integer;
begin
  inherited;
  if Msg.ClassType = TSubsystemMsg then with TSubsystemMsg(Msg) do begin
    case Action of
      saConnect: AddSubsystem(Subsystem);
      saDisconnect: RemoveSubsystem(Subsystem);
    end;  
  end;
  for i := 0 to High(Subsystems) do Subsystems[i].HandleMessage(Msg);
  if Assigned(MessageHandler) then MessageHandler(Msg);
end;
procedure TBaseCore.AddSubsystem(const Subsystem: TSubsystem);
begin
  Assert(Assigned(Subsystem), Format('%S.%S: Subsystem is undefined(nil)', [ClassName, 'AddSubsystem']));
  SetLength(Subsystems, Length(Subsystems)+1);
  Subsystems[High(Subsystems)] := Subsystem;
  Log.Log(Format('Subsystem of class %S connected', [Subsystem.ClassName])); 
end;
procedure TBaseCore.RemoveSubsystem(const Subsystem: TSubsystem);
var i: Integer;
begin
  i := High(Subsystems);
  while (i >= 0) and (Subsystems[i] <> Subsystem) do Dec(i);
  Assert(i >= 0, Format('%S.%S: Subsystem of class %S not found', [ClassName, 'RemoveSubsystem', Subsystem.ClassName]));
  if i >= 0 then begin
    Subsystems[i] := Subsystems[Length(Subsystems)-1];
    SetLength(Subsystems, Length(Subsystems)-1);
  end;
  {$IFDEF LOGGING} Log.Log(Format('Subsystem of class %S disconnected', [Subsystem.ClassName])); {$ENDIF}
end;
function TBaseCore.QuerySubsystem(SubsystemClass: CSubsystem): TSubsystem;
var i: Integer;
begin
  Result := nil;
  i := High(Subsystems);
  while (i >= 0) and not Subsystems[i].InheritsFrom(SubsystemClass) do Dec(i);
  if i >= 0 then Result := Subsystems[i];  
end;
procedure TBaseCore.SetProcessingClass(Index: Integer; Interval: Single; IgnorePause, DeltaTimeBased: Boolean);
var OldFlags: TProcessingFlags;
begin
  if (Index < 0) or (Index >= TotalProcessingClasses) then begin
    Log.Log(ClassName + '.SetProcessingClass: Invalid index', lkError);
    Exit;
  end;
  OldFlags := ProcessingClasses[Index].Flags;
  ProcessingClasses[Index].Interval := Interval;
  ProcessingClasses[Index].Flags := [];
  if IgnorePause    then Include(ProcessingClasses[Index].Flags, pfIgnorePause)    else Exclude(ProcessingClasses[Index].Flags, pfIgnorePause);
  if DeltaTimeBased then Include(ProcessingClasses[Index].Flags, pfDeltaTimeBased) else Exclude(ProcessingClasses[Index].Flags, pfDeltaTimeBased);
  if DeltaTimeBased then begin
    if ProcessingClasses[Index].TimerEventID <> -1 then Timer.RemoveRecurringEvent(ProcessingClasses[Index].TimerEventID);
    ProcessingClasses[Index].TimerEventID := -1;
  end else begin
    if ProcessingClasses[Index].TimerEventID = -1 then
      ProcessingClasses[Index].TimerEventID := Timer.SetRecurringEvent(ProcessingClasses[Index].Interval, ProcessingEvent, Index)
    else
      Timer.SetRecurringEventInterval(ProcessingClasses[Index].TimerEventID, ProcessingClasses[Index].Interval);
  end;
end;
procedure TBaseCore.ClearItems;
begin
  inherited;
  if Assigned(FTesselatorManager) then FTesselatorManager.Clear;
  if Assigned(FSharedTesselators) then FSharedTesselators.Clear;
end;
{procedure TBaseCore.SetRoot(ARoot: TRootItem);
begin
  FRoot := ARoot;
  if Root <> nil then Root.FManager := Self;
end;}
{ TMirrorCamera }
procedure TMirrorCamera.ComputeViewMatrix;
begin
  if Assigned(FOldCamera) and (FOldCamera <> Self) then begin
    FViewMatrix := FOldCamera.GetViewMatrix;
    FViewMatrix := MulMatrix4s(ReflectionMatrix4s(GetAbsLocation, NormalizeVector3s(Transform.ViewForward)), FViewMatrix);
    MulMatrix4s(FTotalMatrix, FViewMatrix, ProjMatrix);
    ViewValid := True;
    FOldCamera := nil;
    ComputeFrustumPlanes;
  end else inherited;
end;
procedure TMirrorCamera.OnApply(const OldCamera: TCamera);
begin
  FOldCamera := OldCamera;
  ViewValid  := False;
  if not Assigned(ClipPlanes[0]) then GetMem(ClipPlanes[0], SizeOf(ClipPlanes[0]^));
  ClipPlanes[0]^ := GetPlaneFromPointNormal(GetAbsLocation, ScaleVector3s(Transform.ViewForward, 1));
end;
{ TItemMoveOp }
procedure TItemMoveOp.DoApply;
var t: TLocation;
begin
  t := Location;
  Location := AffectedProcessing.Location;
  AffectedProcessing.Location := t;
end;
function TItemMoveOp.DoMerge(AOperation: TOperation): Boolean;
begin
  Result := (AOperation is TItemMoveOp) and (TItemMoveOp(AOperation).AffectedProcessing = AffectedProcessing);
  if Result and not (ofApplied in Flags) then Location := TItemMoveOp(AOperation).Location;
end;
function TItemMoveOp.Init(AAffectedProcessing: TProcessing; ALocation: TLocation): Boolean;
begin
  Result := False;
  Assert(Assigned(AAffectedProcessing));
  if EqualLocations(ALocation, AAffectedProcessing.Location) then Exit;
  AffectedProcessing := AAffectedProcessing;
  Location := ALocation;
  Result := True;
end;
{ TItemRotateOp }
procedure TItemRotateOp.DoApply;
var t: TQuaternion;
begin
  t := Orientation;
  Orientation := AffectedProcessing.Orientation;
  AffectedProcessing.Orientation := t;
end;
function TItemRotateOp.DoMerge(AOperation: TOperation): Boolean;
begin
  Result := (AOperation is TItemRotateOp) and (TItemRotateOp(AOperation).AffectedProcessing = AffectedProcessing);
  if Result and not (ofApplied in Flags) then Orientation := TItemRotateOp(AOperation).Orientation;
end;
function TItemRotateOp.Init(AAffectedProcessing: TProcessing; AOrientation: TQuaternion): Boolean;
begin
  Result := False;
  Assert(Assigned(AAffectedProcessing));
  if EqualsQuaternions(AAffectedProcessing.Orientation, AOrientation) then Exit;
  AffectedProcessing := AAffectedProcessing;
  Orientation := AOrientation;
  Result := True;
end;
end.

						