开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 游戏 > 游戏引擎 > 查看源码
C2Visual.pas
资源名称：CAST2SDK.rar　[点击查看]
上传用户：yj_qiu
上传日期：2022-08-08
资源大小：23636k
文件大小：77k
源码类别：

游戏引擎

开发平台：

Delphi

C2Visual.pas：源码内容
  1. (*
  2.  @Abstract(CAST II Engine visual items unit)
  3.  (C) 2006 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
  4.  The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
  5.  Unit contains basic classes of visual items
  6. *)
  7. {$Include GDefines.inc}
  8. {$Include C2Defines.inc}
  9. unit C2Visual;
  11. interface
  13. uses
  14.   SysUtils,
  15.   TextFile,
  16.   BaseTypes, Basics, Base3D, BaseMsg, ItemMsg, Props, Models, BaseCont, BaseClasses,
  17.   {$IFDEF EDITORMODE} BaseGraph, C2MapEditMsg, {$ENDIF}
  18.   C2Types, C2Msg, CAST2, C2Materials, C2Maps;
  20. const
  21.   // Vertex format
  22.   vwIndexedBlending = $8;
  23.   //Light source types
  24.   ltDirectional = 0; ltPoint = 1; ltSpot = 2;
  25.   //Light source types enumeration string
  26.   LightKindsEnum = 'Directional&Point&Spot';
  28.   // Size of data in index buffers
  29.   IndexSize = 2;
  31.   // Default capacity of technique => item hash map
  32.   DefaultTechToItemMapCapacity = 8;
  34.   // Max size of mapped item edit cursor size
  35.   MaxCursorSize = 64;
  36.   // Map edit mode: adjust heights
  37.   hmemAdjust = 0;
  38.   // Map edit mode: smooth heights
  39.   hmemSmooth = 1;
  40.   // Map edit modes string enumeration
  41.   MapEditModesEnum = 'Adjust' + StringDelimiter + 'Smooth';
  43. type
  44.   //  Tesselation status
  45.   TTesselationState = (// Tesselator was cardinally changed, including maximum number of vertices and/or indices
  46.                        tsMaxSizeChanged,
  47.                        // Tesselator data was changed
  48.                        tsChanged,
  49.                        // Tesselator data was not changed so no reason to tesselate it again
  50.                        tsTesselated);
  52.   // Type of tesselator used to render an item
  53.   TTesselatorType = (// Triangulated data of the tesselator rarely or never changes
  54.                      ttStatic,
  55.                      // Triangulated data changes nearly every frame (particle system, etc)
  56.                      ttDynamic);
  58.   { Current tesselation status data structure
  59.     <b>BufferIndex</b>      - index of buffer in API-independent buffers
  60.     <b>Offset</b>           - offset within the buffer in elements (vertices, indices, etc)
  61.     <b>Status</b>           - current tesselation state
  62.     <b>LastResetCounter</b> - reset counter
  63.     should not be modified manually }
  64.   TTesselationStatus = record
  65.     TesselatorType: TTesselatorType;
  66.     BufferIndex, Offset: Integer;
  67.     Status: TTesselationState;
  68.     LastResetCounter, LastBufferResetCounter: Integer;
  69.   end;
  71.   // Kind of tesselator
  72.   TTesselatorKind = (// Null tesselator. Used when the item is tesselated by other shared tesselator (GUI, impostors, etc)
  73.                      tkNone,
  74.                      // The item is tesselated by its own tesselator (default)
  75.                      tkOwn,
  76.                      // a shared tesselator used for items of several classes (2D primitives, particles, etc)
  77.                      tkShared);
  79.   { The delegate used to retrieve a custom texture matrix. See @Link(tmCustom).
  80.     <b>TextureSet</b> is an index of texture set to which the retrieved matrix will applied }
  81.   TTextureMatrixDelegate = procedure(TextureStage: Integer; out Matrix: TMatrix4s) of object;
  83.   // @Abstract(Camera which looks at a specified target point)
  84.   TLookAtCamera = class(CAST2.TCamera)
  85.   private
  86.     FRange: Single;
  87.     FFixedUp: Boolean;
  88.     FLookTarget, FixedUpVector: TVector3s;
  89.     procedure SetRange(const Value: Single);
  90.     procedure SetFixedUp(const Value: Boolean);
  91.     procedure SetLookTarget(const Value: TVector3s);
  92.   protected
  93.     procedure ComputeTransform; override;
  94.   public
  95.     procedure Move(XD, YD, ZD: Single); override;
  97.     procedure AddProperties(const Result: Props.TProperties); override;
  98.     procedure SetProperties(Properties: Props.TProperties); override;
  100.     // Look range
  101.     property Range: Single read FRange write SetRange;
  102.     // Setting this to True will fix the camera's UP vector
  103.     property FixedUp: Boolean read FFixedUp write SetFixedUp;
  104.     // Look target
  105.     property LookTarget: TVector3s read FLookTarget write SetLookTarget;
  106.   end;
  108.   // @Abstract(Light source)
  109.   TLight = class(CAST2.TProcessing)
  110.   private
  111.     function GetEnabled: Boolean;
  112.     procedure SetEnabled(const Value: Boolean);
  113.   protected
  114.     procedure SetState(const Value: TSet32); override;
  115.   public
  116.     // Determines which passes can be affected by the light source
  117.     GroupMask: TPassGroupSet;
  118.     // Kind of the light source
  119.     Kind: Integer;
  120.     // Diffuse color of the light source
  121.     Diffuse,
  122.     // Specular color of the light source
  123.     Specular,
  124.     // Ambient color of the light source
  125.     Ambient: BaseTypes.TColor4s;
  126.     // Effective range of the light source
  127.     Range: Single;
  128.     Falloff: Single;
  129.     // Constant attenuation
  130.     Attenuation0,
  131.     // Linear attenuation
  132.     Attenuation1,
  133.     // Quadratic attenuation
  134.     Attenuation2: Single;
  135.     // Inner angle of spotlight cone
  136.     Theta,
  137.     // Outer angle of spotlight cone
  138.     Phi: Single;
  139.     constructor Create(AManager: TItemsManager); override;
  141.     procedure HandleMessage(const Msg: TMessage); override;
  143.     procedure AddProperties(const Result: Props.TProperties); override;
  144.     procedure SetProperties(Properties: Props.TProperties); override;
  145.     // Setting <b>Enabled</b> to @True/@False turns on/off the light source
  146.     property Enabled: Boolean read GetEnabled write SetEnabled;
  147.   end;
  149.   { Data structure passed to tesselator buffer filling methods <br>
  150.     <b>Camera</b>      - currently applied camera <br>
  151.     <b>ModelMatrix</b> - model transform of visible items being rendered }
  152.   TTesselationParameters = record
  153.     Camera: TCamera;
  154.     ModelMatrix: TMatrix4s;
  155.   end;
  157.   CTesselator = class of TTesselator;
  158.   { @Abstract(Performs triangulation of visible items)
  159.     Visible items are different - GUI elements, 3D meshes, procedural models, etc. [b]TTesselator[/b] contains methods to
  160.     convert an item to its triangulated representation. }
  161.   TTesselator = class(TReferencedItem)
  162.   private
  163.     LastMaxAmount: array[TTesselationBuffer] of Integer;
  164.     Manager: TItemsManager;                   // For message sending
  165.   protected
  166.     // Informs engine core about bounding box change
  167.     procedure InvalidateBoundingBox;
  168.   public
  169.     // Total primitives in each strip
  170.     TotalPrimitives: Integer;
  171.     // Primitive type
  172.     PrimitiveType: TPrimitiveType;
  173.     // Total vetices in all strips
  174.     TotalVertices,
  175.     // Total indices in all strips
  176.     TotalIndices: Integer;
  177.     // Total strips
  178.     TotalStrips,
  179.     // Offset in vertex buffer for each strip
  180.     StripOffset: Integer;
  181.     // Number of vertices referenced by indices
  182.     IndexingVertices: Integer;
  184.     // Current tesselation status
  185.     TesselationStatus: array[TTesselationBuffer] of TTesselationStatus;
  187.     // If set to True a manual render method through @Link(DoManualRender) will be used instead of regular render
  188.     ManualRender: Boolean;
  189. // Old
  190. //    Index: Integer;
  192.     LastTotalIndices, LastTotalVertices: Integer;
  194.     // Command block ID For render speedup. E.g. OpenGL display list ID.
  195.     CommandBlock: Integer;
  196.     // Determines if command block is a currently valid ID
  197.     CommandBlockValid: Boolean;
  199.     VerticesRes, IndicesRes: Integer;
  201.     CompositeMember: Boolean;
  202.     CompositeOffset: ^TVector3s;
  204. //    {$IFDEF DEBUGMODE} LastMaxVertices: Integer; {$ENDIF}                 // Used only for debugging
  206.     constructor Create; virtual;
  207.     procedure Init; virtual;
  208.     { Can be overridden to add some properties in addition to ones of a visible item which uses the tesselator.
  209.       Called from AddProperties of @Link(TVisible). Object links can not be used or resolved here. }
  210.     procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); virtual;
  211.     { Can be overridden to set some properties in addition to ones of a visible item which uses the tesselator.
  212.       Called from SetProperties of @Link(TVisible). Object links can not be used or resolved here. }
  213.     procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); virtual;
  215.     { Returns number of elements in the specified buffer type which needs to be updated in an API buffers.
  216.       This function called by engine static buffers management routine to determine if lock/fill/unlock procedure needed
  217.       for each tesselator.
  218.       If the function returns 0 no update needed. }
  219.     function GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer; virtual;
  220.     // Returns maximum amount of elements in the specified buffer type
  221.     function GetMaxAmount(Buffer: TTesselationBuffer): Integer;
  223.     // Invalidates contents of buffers used by the tesselator at the API side. If <b>EntireBuffer</b> is True entire API buffer will become invalid so use only if necessary.
  224.     procedure Invalidate(ABuffer: TTesselationBufferSet; EntireBuffer: Boolean);
  226. // ToDo: Move these methods to protected:
  227.     // Returns True if mesh is valid. The basic implemetation simply tests all indices to point within correct vertices range.
  228.     function Validate: Boolean; virtual;
  229.     // Manual lighting begin
  230.     procedure BeginLighting; virtual; abstract;
  231.     // Perform manual lighting
  232.     function CalculateLighting(const ALight: TLight; const ALightToItem: TMatrix4s): Boolean; virtual; abstract;
  234.     // Bounding box containing
  235.     function GetBoundingBox: TBoundingBox; virtual;
  237.     function SetIndices(IBPTR: Pointer): Integer; virtual;
  238.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; virtual;
  239.   protected
  240.     // Vertex format as specified by @Link(GetVertexFormat)
  241.     FVertexFormat: Cardinal;
  242.     // Size of each vertex in bytes
  243.     FVertexSize: Integer;
  244.     // Offset of each element within a vertex in bytes
  245.     ElementOffs: array[vfiXYZ..vfiTEX7] of Integer;
  246.     // Init internal variables for the specified vertex format
  247.     procedure InitVertexFormat(Format: Cardinal); virtual;
  248.     { Should return a maximum possible amount of vertices for the tesselator object to reserve place in buffers. <br>
  249.       For rarely updated tesselators which still can have a variable number of vertices it's reasonable to use a static tesselator
  250.       with <b>GetMaxVertices</b> the maximum amount of vertices.
  251.       The return value of this function can vary but its change should be indicated with the @Link(tsMaxSizeChanged) teselation status and
  252.       will cause discarding of a buffer which may cause performance penalty at lest for static buffers. }
  253.     function GetMaxVertices: Integer; virtual;
  254.     { Should return a maximum possible amount of indices for the tesselator object to reserve place in buffers. <br>
  255.       For rarely updated tesselators which still can have a variable number of indices it's reasonable to use a static tesselator
  256.       with <b>GetMaxVertices</b> the maximum amount of indices.
  257.       The return value of this function can vary but its change should be indicated with the @Link(tsMaxSizeChanged) teselation status and
  258.       will cause discarding of a buffer which may cause performance penalty at lest for static buffers. }
  259.     function GetMaxIndices: Integer; virtual;
  260.     // Set a coordinate set in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  261.     procedure SetVertexDataC(x, y, z: Single; Index: Integer; VBuf: Pointer); overload;
  262.     // Set a coordinate set in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  263.     procedure SetVertexDataC(const Vec: TVector3s; Index: Integer; VBuf: Pointer); overload;
  264.     // Set a transformed coordinate set in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  265.     procedure SetVertexDataCRHW(x, y, z, RHW: Single; Index: Integer; VBuf: Pointer);
  266.     // Set a normal in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  267.     procedure SetVertexDataN(nx, ny, nz: Single; Index: Integer; VBuf: Pointer); overload;
  268.     // Set a normal in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  269.     procedure SetVertexDataN(const Vec: TVector3s; Index: Integer; VBuf: Pointer); overload;
  270.     // Set a weight in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  271.     procedure SetVertexDataW(w: Single; Index: Integer; VBuf: Pointer);
  272.     // Set a diffuse color (color 1) in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  273.     procedure SetVertexDataD(Color: TColor; Index: Integer; VBuf: Pointer);
  274.     // Set a specular color (color 2) in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  275.     procedure SetVertexDataS(Color: TColor; Index: Integer; VBuf: Pointer);
  276.     // Set first 2D-texture coordinates set in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  277.     procedure SetVertexDataUV(u, v: Single; Index: Integer; VBuf: Pointer);
  278.     // Set first 3D-texture coordinates set in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  279.     procedure SetVertexDataUV3(u, v, w: Single; Index: Integer; VBuf: Pointer);
  280.     // Set second 2D-texture coordinates set in vertex buffer. [b]Index[/b] - element index, [b]VBuf[/b] - pointer to vertex buffer. Should be called from @Link(Tesselate) only
  281.     procedure SetVertexData2UV(u, v: Single; Index: Integer; VBuf: Pointer);
  282.     // Sets an index in index buffer
  283.     procedure SetIndex(AValue, AOffset: Integer; AIBuf: Pointer);
  284.   public
  285.     // Returns an index from index buffer
  286.     function GetIndex(AOffset: Integer; AIBuf: Pointer): Integer;
  287.     // Get a coordinate set from vertex buffer. [b]AIndex[/b] - element index, [b]AVBuf[/b] - pointer to vertex buffer.
  288.     function GetVertexDataC(AIndex: Integer; AVBuf: Pointer): TVector3s;
  289.     // Performs render manually if ManualRender is True. Default implementation does nothing so the method should be overridden if manual render needed.
  290.     procedure DoManualRender(Item: TItem); virtual;
  291.     // Output format of vertices
  292.     property VertexFormat: Cardinal read FVertexFormat write InitVertexFormat;
  293.     // Size of each vertex
  294.     property VertexSize: Integer read FVertexSize;
  295.   end;
  297.   // This message informs all visible items that tesselator has changed its bounding box
  298.   TTessBBoxUpdateMsg = class(TMessage)
  299.     Tesselator: TTesselator;
  300.     constructor Create(ATesselator: TTesselator);
  301.   end;
  303.   // Base class of tesselator which used to tesselate several different items
  304.   TSharedTesselator = class(TTesselator)
  305.     // Clear tesselation
  306.     procedure Clear; virtual; abstract;
  307.   end;
  309. //  TVisibilityCheckerDelegate = function(const Camera: TCamera): Boolean of object;
  311.   TVisible = class(CAST2.TProcessing)
  312.   private
  313.     VisibilityFlag: Boolean;
  314.     FCurrentLOD: Single;
  315.     procedure SetTesselatorKind(const Value: TTesselatorKind);
  316.   protected
  317.     // A set of tesselators used to geometrically represent the item in various LOD's
  318.     FTesselators: array of TTesselator;
  319.     // True if the item should be lit by its own code
  320.     FCustomLighting: Boolean;
  321.     // Current render technique
  322.     FCurTechnique: TTechnique;
  323.     // Index in TRenderPass.Items array
  324.     IndexInPass: array of Int32;
  325.     // Determines what kind tesselator will be used to tesselated the item
  326.     FTesselatorKind: TTesselatorKind;
  327.     // Reference to current tesselator
  328.     FCurrentTesselator: TTesselator;
  329.     procedure SetParent(NewParent: TItem); override;
  330.     procedure SetState(const Value: TSet32); override;
  331.     procedure AddToPasses;
  332.     procedure RemoveFromPasses;
  333.     procedure DoShow;
  334.     procedure DoHide;
  335.     // Returns <b>True</b> if visibility mask of all parents has @Link(isVisible) flag included
  336.     function isParentsVisible: Boolean;
  337.     // Returns <b>True</b> if visibility mask of the item and all its parents has @Link(isVisible) flag included
  338.     function isActuallyVisible: Boolean;
  339.     function GetMaterial: TMaterial;
  340.     procedure SetMaterial(Value: TMaterial);
  341.     procedure SetCurTechnique(const Value: TTechnique);
  342.     procedure SetMesh; virtual;
  343.     procedure SetCurrentLOD(const Value: Single); virtual;
  344.   public
  345.     // This value is calculated every frame for any item which should be rendered. Override @Link(CalcSortValue) to change it.
  346.     SortValue: Single;
  347.     BlendMatrices: array of TMatrix4s;  // ToDO: optimize
  348.     RetrieveTextureMatrix: TTextureMatrixDelegate;
  350.     constructor Create(AManager: TItemsManager); override;
  351.     destructor Destroy; override;
  352.     class function IsAbstract: Boolean; override;
  353.     // Returns class of tesselator which will represent the item geometrically
  354.     function GetTesselatorClass: CTesselator; virtual;
  356.     procedure HandleMessage(const Msg: TMessage); override;
  358.     procedure OnInit; override;
  359.     procedure OnSceneAdd; override;
  360.     procedure OnSceneRemove; override;
  362.     // Shows the item
  363.     procedure Show; virtual;
  364.     // Hides the item
  365.     procedure Hide; virtual;
  367.     // To specify shader constants an item class should override this method
  368.     procedure RetrieveShaderConstants(var ConstList: TShaderConstants); virtual;
  369.     // Returns value by which to sort items containing sorted order passes in material
  370.     function CalcSortValue(const Camera: TCamera): Single; virtual;
  372.     // If the item is visible through the given camera returns True and sets current tesselator according to needed detail level
  373.     function VisibilityCheck(const Camera: TCamera): Boolean; virtual;
  374.     // Should be overriden to render item indirectly or other custom rendering mode
  375.     procedure Render; virtual;
  376.     // Prepares the item and tesselator for manual lighting. Called automatically.
  377.     procedure BeginLighting;
  378.     // Calls tesselator to perform manual lighting calculation
  379.     function CalculateLighting(const ALight: TLight): Boolean;
  381.     procedure AddProperties(const Result: Props.TProperties); override;
  382.     procedure SetProperties(Properties: Props.TProperties); override;
  383.   public
  384.     // True if the item should be lit by its own code
  385.     property CustomLighting: Boolean read FCustomLighting;
  386.     property Material: TMaterial read GetMaterial write SetMaterial;
  387.     property CurrentTesselator: TTesselator read FCurrentTesselator;
  388.     property CurTechnique: TTechnique read FCurTechnique{ write SetCurTechnique};
  389.     property TesselatorKind: TTesselatorKind read FTesselatorKind write SetTesselatorKind;
  390.     property CurrentLOD: Single read FCurrentLOD write SetCurrentLOD;
  391.   end;
  393.   TClassRec = record
  394.     TessClass: CTesselator;
  395.     TessMap: BaseCont.TPointerPointerMap;                 // Maps a technique to a visible item
  396.   end;
  398.   TTemporaryVisible = class(TVisible)
  399.   public
  400.     constructor Create(AManager: TItemsManager); override;
  401.     destructor Destroy; override;
  402.     procedure Clear;
  403.     function VisibilityCheck(const Camera: TCamera): Boolean; override;
  404.   end;
  406.   TSharedTesselators = class(CAST2.TBaseSharedTesselators)
  407.   private
  408.     Items: array of TVisible; TotalItems: Integer;
  410.     TessClasses: array of TClassRec;
  412.     function GetItemIndex(const AItem: TVisible): Integer;
  414.     function GetTesselatorIndex(const TessClass: CTesselator): Integer;
  415.     function AddTesselatorClass(const TessClass: CTesselator): Integer;
  417.     function GetTesselator(const TessClass: CTesselator; const Technique: TTechnique): TTesselator;
  419.     function DrawTechMap(Key, Value: Pointer): Boolean;
  420.     function DelTechMap(Key, Value: Pointer): Boolean;
  421.     function FreeTechMap(Key, Value: Pointer): Boolean;
  422.   public
  423.     procedure AddItem(const AItem: TVisible);
  424.     procedure RemoveItem(const AItem: TVisible);
  425.     procedure Clear; override;
  427.     procedure Reset; override;
  428.     procedure Render; override;
  430.     destructor Destroy; override;
  432.     property Tesselator[const TessClass: CTesselator; const Technique: TTechnique]: TTesselator read GetTesselator; default;
  433.   end;
  435.   TMappedTesselator = class(TTesselator)
  436.   protected
  437.     Item: CAST2.TProcessing;
  438.     FMap: C2Maps.TMap;
  439.   // Other
  440.     OldWidth, OldHeight: Integer;
  441.     OldCellWidthScale, OldCellHeightScale, OldDepthScale: Single;
  442.   public
  443.     procedure Init; override;
  444.     function GetMaxVertices: Integer; override;
  445.     function GetBoundingBox: TBoundingBox; override;
  446.     procedure SetMap(const AMap: C2Maps.TMap); virtual;
  447.   end;
  449.   THeighTMapEditOp = class(C2Maps.TMapEditOp)
  450.     // Inits the operation and returns True if it's valid and can be applied
  451.     function Init(AMap: TMap; ACellX, ACellZ, ACursorSize: Integer; AValueDelta: Single): Boolean; virtual; abstract;
  452.   end;
  454.   THeighTMapEditOpAdjust = class(THeighTMapEditOp)
  455.   private
  456.     Scale: Single;
  457.   public
  458.     function Init(AMap: TMap; ACellX, ACellZ, ACursorSize: Integer; AValueDelta: Single): Boolean; override;
  459.   end;
  461.   THeighTMapEditOpSmooth = class(THeighTMapEditOp)
  462.   private
  463.     Scale: Single;
  464.   public
  465.     function Init(AMap: TMap; ACellX, ACellZ, ACursorSize: Integer; AValueDelta: Single): Boolean; override;
  466.   end;
  468.   TMappedItem = class(TVisible)
  469.   protected
  470.     FMap: C2Maps.TMap;
  471.     {$IFDEF EDITORMODE}
  472.     EditCellX, EditCellZ: Integer;
  473.     EditMouseX, EditMouseY: Integer;
  474.     EditCursorSize: Integer;
  475.     EditMode: Boolean;
  476.     {$ENDIF}
  477.     procedure ResolveLinks; override;
  478.     procedure OnModify(const ARect: BaseTypes.TRect); virtual;
  480.     // Returns True if the specified cursor coordinates points to a map cell through the specified camera. Also returns the cell indices.
  481.     function PickCell(Camera: TCamera; MouseX, MouseY: Integer; out CellX, CellZ: Integer): Boolean; virtual;
  482.     {$IFDEF EDITORMODE}
  483.     function DrawCursor(Cursor: C2MapEditMsg.TMapCursor; Camera: TCamera; Screen: TScreen): Boolean; virtual;
  484.     procedure ModifyBegin(Cursor: TMapCursor; Camera: TCamera); virtual;
  485.     procedure Modify(Cursor: TMapCursor; Camera: TCamera); virtual;
  486.     procedure ModifyEnd(Cursor: TMapCursor; Camera: TCamera); virtual;
  487.     {$ENDIF}
  488.   public
  489.     class function IsAbstract: Boolean; override;
  490.     procedure SetMesh; override;
  491.     procedure AddProperties(const Result: Props.TProperties); override;
  492.     procedure SetProperties(Properties: Props.TProperties); override;
  494.     procedure HandleMessage(const Msg: TMessage); override;
  496.     property Map: C2Maps.TMap read FMap;
  497.   end;
  499.   /// Determines a vertex format which can include variuos components. VertexWeight can be OR'ed with vwIndexedBlending to indicate that last weight is actually a dword with indices
  500.   function GetVertexFormat(Transformed, Normals, Diffuse, Specular, PointSize: Boolean; VertexWeights: Word; TextureSets: array of Integer): Longword;
  501.   function GetVertexSize(VertexFormat: Longword): Cardinal;
  502.   function VertexContains(VertexFormat, ElementIndex: Longword): Boolean;
  503.   function GetVertexElementOffset(VertexFormat, ElementIndex: Longword): Integer;
  504.   function GetVertexTextureSetsCount(VertexFormat: Longword): Integer;
  505.   function GetVertexTextureCoordsCount(VertexFormat, TextureSetIndex: Longword): Integer;
  506.   function GetVertexWeightsCount(VertexFormat: Longword): Integer;
  507.   function GetVertexIndexedBlending(VertexFormat: Longword): Boolean;
  508.   procedure ConvertVertices(SrcFormat, DestFormat: Longword; TotalVertices: Integer; Src: Pointer; Dest: Pointer);
  510. var RGBA: Boolean;            // Determines whether is needed to swap R and B color components. Must be True for OpenGL renderer due to difference in OpenGL and DirectX color representation
  512. implementation
  514. function GetVertexFormat(Transformed, Normals, Diffuse, Specular, PointSize: Boolean; VertexWeights: Word; TextureSets: array of Integer): Longword;
  515. var i, TotalTextureSets: Integer; TextureBits: Integer;
  516. begin
  517.   Assert(((VertexWeights and $7) + Ord(VertexWeights and vwIndexedBlending > 0)<= 5) and
  518.          ((VertexWeights and $7 > 0) or (VertexWeights and vwIndexedBlending = 0)), 'GetVertexFormat: Invalid weights count');
  519.   Assert(not Transformed or (VertexWeights = 0), 'GetVertexFormat: Transformed vertices should not have weights');
  521.   TextureBits := 0;
  522.   TotalTextureSets := Length(TextureSets);
  523.   for i := 0 to TotalTextureSets-1 do begin
  524.     Assert((i < 8) and (TextureSets[i] > 0) and (TextureSets[i] <= 4), 'GetVertexFormat: Invalid texture sets');
  525.     TextureBits := TextureBits or ((TextureSets[i]-1) and 3) shl (i*2);
  526.   end;
  528.   Result := VertexWeights shl 28 + Cardinal(TotalTextureSets) shl 24 + Cardinal(TextureBits) shl 8 +
  529.             Cardinal(Ord(Transformed) * vfTRANSFORMED + Ord(Normals)  * vfNORMALS +
  530.                      Ord(Diffuse)     * vfDIFFUSE     + Ord(Specular) * vfSPECULAR + Ord(PointSize) * vfPOINTSIZE);
  531. end;
  533. function GetVertexSize(VertexFormat: Longword): Cardinal;
  534. var i, TextureSets: Integer; TextureBits: Cardinal;
  535. begin
  536.   Result := (3 + VertexFormat and vfTRANSFORMED    +
  537.              Cardinal(3*Ord(VertexFormat and vfNORMALS   > 0)  +
  538.                         Ord(VertexFormat and vfDIFFUSE   > 0)  + Ord(VertexFormat and vfSPECULAR > 0) +
  539.                         Ord(VertexFormat and vfPOINTSIZE > 0)) +
  540.              Cardinal(GetVertexWeightsCount(VertexFormat) + Ord(GetVertexIndexedBlending(VertexFormat))) ) shl 2;
  542.   TextureBits := (VertexFormat shr 8) and $FFFF;
  543.   TextureSets := (VertexFormat shr 24) and $F;
  544.   for i := 0 to TextureSets-1 do Result := Result + (TextureBits shr (i*2) and 3 + 1) shl 2;
  545. end;
  547. function VertexContains(VertexFormat, ElementIndex: Longword): Boolean;
  548. begin
  549.   Result := VertexFormat and ElementIndex > 0;
  550. end;
  552. function GetVertexElementOffset(VertexFormat, ElementIndex: Longword): Integer;
  553. var i, TextureSets: Integer; TextureBits: Cardinal;
  554. begin
  555.   Result := 0;
  556.   if ElementIndex = vfiXYZ then Exit;
  558.   if VertexFormat and vfTRANSFORMED > 0 then Result := 4*4 else Result := 3*4;
  560.   if (GetVertexWeightsCount(VertexFormat) > 0) and GetVertexIndexedBlending(VertexFormat) then Inc(Result, 4);
  562.   for i := 0 to GetVertexWeightsCount(VertexFormat)-1 do begin              // Through weights
  563.     if ElementIndex = vfiWEIGHT1 + Cardinal(i) then Exit;
  564.     Inc(Result, 4);
  565.   end;
  567.   if VertexFormat and vfNORMALS > 0 then begin
  568.     if ElementIndex = vfiNORM then Exit;
  569.     Inc(Result, 3*4);
  570.   end;
  571.   if VertexFormat and vfPOINTSIZE > 0 then begin
  572.     if ElementIndex = vfiPOINTSIZE then Exit;
  573.     Inc(Result, 4);
  574.   end;
  575.   if VertexFormat and vfDIFFUSE > 0 then begin
  576.     if ElementIndex = vfiDIFF then Exit;
  577.     Inc(Result, 4);
  578.   end;
  579.   if VertexFormat and vfSPECULAR > 0 then begin
  580.     if ElementIndex = vfiSPEC then Exit;
  581.     Inc(Result, 4);
  582.   end;
  584.   TextureBits := (VertexFormat shr 8) and $FFFF;
  585.   TextureSets := (VertexFormat shr 24) and $F;
  586.   for i := 0 to TextureSets-1 do begin       // Through texture sets
  587.     if ElementIndex = vfiTEX0 + Cardinal(i) then Exit;
  588.     Inc(Result, (TextureBits shr (i*2) and 3 + 1) shl 2);
  589.   end;
  591.   Result := -1;
  592. //  Assert(False, 'GetVertexElementOffset: Element not found');
  593. end;
  595. function GetVertexTextureSetsCount(VertexFormat: Longword): Integer;
  596. begin
  597.   Result := (VertexFormat shr 24) and $F;
  598. end;
  600. function GetVertexTextureCoordsCount(VertexFormat, TextureSetIndex: Longword): Integer;
  601. begin
  602.   Result := ((VertexFormat shr 8) and $FFFF) shr (TextureSetIndex*2) and 3 + 1;
  603. end;
  605. function GetVertexWeightsCount(VertexFormat: Longword): Integer;
  606. begin
  607.   Result := (VertexFormat shr 28) and $7;
  608. end;
  610. function GetVertexIndexedBlending(VertexFormat: Longword): Boolean;
  611. begin
  612.   Result := (GetVertexWeightsCount(VertexFormat) > 0) and ((VertexFormat shr 28) and vwIndexedBlending > 0);
  613. end;
  615. procedure ConvertVertices(SrcFormat, DestFormat: Longword; TotalVertices: Integer; Src: Pointer; Dest: Pointer);
  616. type TVBuf = array[0..$FFFFFF] of Byte;
  617. const
  618.   veiNorm = 0; veiDiff = 1; veiSpec = 2; veiWeight = 3; veiTex = 4;
  619.   riSrc = 0; riDest = 1;
  620.   elSize = 4;         // Element size (float)
  621. var
  622.   SVSize, DVSize, i: Integer; CoordsSize: Cardinal;
  623.   EOffset: array[riSrc..riDest, veiNorm..veiTex] of Integer;
  625. //  vfiXYZ = 0; vfiWEIGHT1 = 1; vfiWEIGHT2 = 2; vfiWEIGHT3 = 3; vfiNORM = 4; vfiPointSize = 5; vfiDIFF = 6; vfiSPEC = 7;
  626. //  vfiTEX0 = 8; vfiTEX1 = 9; vfiTEX2 = 10; vfiTEX3 = 11; vfiTEX4 = 12; vfiTEX5 = 13; vfiTEX6 = 14; v
  628. procedure CalcOffsets(Format, Res: Cardinal);
  629. begin
  630.   EOffset[Res, veiNorm]   := MaxI(0, GetVertexElementOffset(Format, vfiNorm));
  631.   EOffset[Res, veiDiff]   := MaxI(0, GetVertexElementOffset(Format, vfiDiff));
  632.   EOffset[Res, veiSpec]   := MaxI(0, GetVertexElementOffset(Format, vfiSpec));
  633.   EOffset[Res, veiWeight] := MaxI(0, GetVertexElementOffset(Format, vfiWeight1));
  634.   EOffset[Res, veiTex]    := MaxI(0, GetVertexElementOffset(Format, vfiTex0));
  635. end;
  637. function GetTextureSetsSize(Format: Longword): Integer;
  638. var i: Integer;
  639. begin
  640.   Result := 0;
  641.   for i := 0 to GetVertexTextureSetsCount(Format)-1 do Inc(Result, GetVertexTextureCoordsCount(Format, i) * elSize);
  642. end;
  644. begin
  645.   CalcOffsets(SrcFormat,  riSrc);
  646.   CalcOffsets(DestFormat, riDest);
  647.   SVSize := GetVertexSize(SrcFormat);
  648.   DVSize := GetVertexSize(DestFormat);
  649.   CoordsSize := 3*ElSize;                                         // XYZ compoments
  650.   if VertexContains(SrcFormat, vfTransformed) and VertexContains(DestFormat, vfTransformed) then CoordsSize := 4*ElSize;
  651.   if TotalVertices > 0 then FillChar(Dest^, TotalVertices * DVSize, 0);
  653.   for i := 0 to TotalVertices-1 do begin
  654.     Move(TVBuf(Src^)[i*SVSize], TVBuf(Dest^)[i*DVSize], CoordsSize);
  655.     // Move weights
  656.     Move(TVBuf(Src^)[i*SVSize + EOffset[riSrc, veiWeight]], TVBuf(Dest^)[i*DVSize + EOffset[riDest, veiWeight]],
  657.          MinI(GetVertexWeightsCount(SrcFormat)  + Ord(GetVertexIndexedBlending(SrcFormat)),
  658.               GetVertexWeightsCount(DestFormat) + Ord(GetVertexIndexedBlending(DestFormat)) ) * ElSize);
  660.     if VertexContains(SrcFormat, vfNormals) and VertexContains(DestFormat, vfNormals) then
  661.       Move(TVBuf(Src^)[i*SVSize + EOffset[riSrc, veiNorm]], TVBuf(Dest^)[i*DVSize + EOffset[riDest, veiNorm]], 3*ElSize);
  662.     if VertexContains(SrcFormat, vfDiffuse) and VertexContains(DestFormat, vfDiffuse) then
  663.       Move(TVBuf(Src^)[i*SVSize + EOffset[riSrc, veiDiff]], TVBuf(Dest^)[i*DVSize + EOffset[riDest, veiDiff]], ElSize);
  664.     if VertexContains(SrcFormat, vfSpecular) and VertexContains(DestFormat, vfSpecular) then
  665.       Move(TVBuf(Src^)[i*SVSize + EOffset[riSrc, veiSpec]], TVBuf(Dest^)[i*DVSize + EOffset[riDest, veiSpec]], ElSize);
  667.     Move(TVBuf(Src^)[i*SVSize + EOffset[riSrc, veiTex]], TVBuf(Dest^)[i*DVSize + EOffset[riDest, veiTex]],
  668.          MinI(GetTextureSetsSize(SrcFormat), GetTextureSetsSize(DestFormat)));
  669.     
  670.   end;
  671. end;
  673. { TLookAtCamera }
  675. procedure TLookAtCamera.SetRange(const Value: Single);
  676. begin
  677.   FRange := Value;
  678.   Position := SubVector3s(FLookTarget, ScaleVector3s(ForwardVector, Exp(FRange)));
  679. end;
  681. procedure TLookAtCamera.SetFixedUp(const Value: Boolean);
  682. begin
  683.   FFixedUp := Value;
  684.   if Value then FixedUpVector := UpVector;
  685. end;
  687. procedure TLookAtCamera.SetLookTarget(const Value: TVector3s);
  688. begin
  689.   FLookTarget := Value;
  690.   SetRange(Range);
  691. end;
  693. procedure TLookAtCamera.ComputeTransform;
  694. begin
  695.   inherited;
  696.   SetRange(Range);
  697. //  inherited;
  698. end;
  700. {function TLookAtCamera.GetPosition: TVector3s;
  701. begin
  702.   Result := inherited GetPosition;
  703.   Result := SubVector3s(Result, ScaleVector3s(ForwardVector, Exp(FRange)));
  704. end;}
  706. procedure TLookAtCamera.AddProperties(const Result: Props.TProperties);
  707. begin
  708.   inherited;
  709.   if not Assigned(Result) then Exit;
  710.   Result.Add('Range', vtSingle, [], FloatToStr(FRange), '');
  711.   Result.Add('Fixed up vector', vtBoolean, [], OnOffStr[FixedUp], '');
  712.   AddVector3sProperty(Result, 'Target', FLookTarget);
  713. end;
  715. procedure TLookAtCamera.SetProperties(Properties: Props.TProperties);
  716. begin
  717.   inherited;
  718.   if Properties.Valid('Range') then FRange := StrToFloatDef(Properties['Range'], 0);
  719.   if Properties.Valid('Fixed up vector') then FixedUp := Properties.GetAsInteger('Fixed up vector') > 0;
  720.   if SetVector3sProperty(Properties, 'Target', FLookTarget) then SetLookTarget(FLookTarget);
  721. end;
  723. procedure TLookAtCamera.Move(XD, YD, ZD: Single);
  724. begin
  725.   LookTarget := AddVector3s(LookTarget, AddVector3s(AddVector3s(ScaleVector3s(RightVector, XD), ScaleVector3s(UpVector, YD)), ScaleVector3s(ForwardVector, ZD)));
  726. end;
  728. { TTessBBoxUpdateMsg }
  730. constructor TTessBBoxUpdateMsg.Create(ATesselator: TTesselator);
  731. begin
  732.   Tesselator := ATesselator;
  733. end;
  735. { TTesselator }
  737. procedure TTesselator.InvalidateBoundingBox;
  738. begin
  739.   if Assigned(Manager) then Manager.SendMessage(TTessBBoxUpdateMsg.Create(Self), nil, [mfBroadcast]);
  740. end;
  742. constructor TTesselator.Create;
  743. var i: TTesselationBuffer;
  744. begin
  745.   InitVertexFormat(GetVertexFormat(False, True, False, False, False, 0, [2]));
  746.   PrimitiveType := ptTRIANGLELIST;
  748.   for i := Low(TTesselationBuffer) to High(TTesselationBuffer) do begin
  749.     TesselationStatus[i].BufferIndex            := -1;
  750.     TesselationStatus[i].Offset                 := 0;
  751.     TesselationStatus[i].Status                 := tsChanged;
  752.     TesselationStatus[i].LastResetCounter       := 0;
  753.     TesselationStatus[i].LastBufferResetCounter := 0;
  754.     TesselationStatus[i].TesselatorType         := ttStatic;
  756.     LastMaxAmount[i] := MaxInt;
  757.   end;
  759.   LastTotalIndices  := 0;
  760.   LastTotalVertices := 0;
  762.   TotalIndices      := 0;
  763.   IndexingVertices  := 0;
  764.   TotalStrips       := 1;
  765.   StripOffset       := 0;
  767.   VerticesRes       := -1;
  768.   IndicesRes        := -1;
  770.   CompositeOffset   := nil;
  771.   CompositeMember   := False;
  773.   CommandBlock := -1;
  774.   CommandBlockValid := False;
  775. end;
  777. procedure TTesselator.Init;
  778. var ParNum: Integer; Par1, Par2: Pointer;
  779. begin
  780.   ParNum := RetrieveParameters(Par1, False);
  781.   RetrieveParameters(Par2, True);
  782.   if ParNum > 0 then Move(Par1^, Par2^, ParNum * SizeOf(Cardinal));                        // Fill internal parameters with public ones
  783.   Invalidate([tbVertex, tbIndex], False);
  784. end;
  786. procedure TTesselator.AddProperties(const Result: TProperties; const PropNamePrefix: TNameString);
  787. begin
  788.   if Assigned(Result) then begin
  789.     Result.Add(PropNamePrefix + 'Manual render', vtBoolean, [], OnOffStr[ManualRender], '');
  790.   end;
  791. end;
  793. procedure TTesselator.SetProperties(Properties: TProperties; const PropNamePrefix: TNameString);
  794. begin
  795.   if Properties.Valid(PropNamePrefix + 'Manual render') then ManualRender := Properties.GetAsInteger(PropNamePrefix + 'Manual render') > 0;
  796. end;
  798. procedure TTesselator.InitVertexFormat(Format: Cardinal);
  799. var i: Integer;
  800. begin
  801.   FVertexFormat := Format;
  802.   FVertexSize   := GetVertexSize(FVertexFormat);
  803.   for i := vfiXYZ to vfiTEX7 do ElementOffs[i] := GetVertexElementOffset(FVertexFormat, i);
  804. end;
  806. procedure TTesselator.Invalidate(ABuffer: TTesselationBufferSet; EntireBuffer: Boolean);
  807. var BType: TTesselationBuffer;
  808. begin
  809.   for BType := Low(BType) to High(BType) do if BType in ABuffer then                                            
  810.     if TesselationStatus[BType].TesselatorType = ttStatic then begin
  811.       if EntireBuffer then
  812.         TesselationStatus[BType].Status := tsMaxSizeChanged else
  813.           TesselationStatus[BType].Status := tsChanged;
  814.     end;
  815.   CommandBlockValid := False;
  816. end;
  818. function TTesselator.GetMaxVertices: Integer;
  819. begin
  820.   Result := TotalVertices;
  821. end;
  823. function TTesselator.GetMaxIndices: Integer;
  824. begin
  825.   Result := TotalIndices;
  826. end;
  828. function TTesselator.GetBoundingBox: TBoundingBox;
  829. begin
  830.   Result.P1 := GetVector3s(-1, -1, -1);
  831.   Result.P2 := GetVector3s( 1,  1,  1);
  832. end;
  834. procedure TTesselator.SetIndex(AValue, AOffset: Integer; AIBuf: Pointer);
  835. begin
  836.   TWordBuffer(AIBuf^)[AOffset] := AValue;
  837. end;
  839. function TTesselator.GetIndex(AOffset: Integer; AIBuf: Pointer): Integer;
  840. begin
  841.   case IndexSize of
  842.     2: Result := TWordBuffer(AIBuf^)[AOffset];
  843.   end;
  844. end;
  846. function TTesselator.GetVertexDataC(AIndex: Integer; AVBuf: Pointer): TVector3s;
  847. begin
  848.   Assert(VertexFormat and vfTRANSFORMED = 0, ClassName + '.SetVertexDataC: This call is not allowed with existing vertex format');
  849.   {$IFDEF DEBUGMODE}
  850.   Assert(AIndex < GetMaxVertices, Format('%S.%S: Vertice index (%D) is greater than max vertices (%D)', [ClassName, 'GetVertexDataC', AIndex, GetMaxVertices]));
  851.   {$ENDIF}
  853.   Result := TVector3s(PtrOffs(AVBuf, AIndex * FVertexSize)^);
  854. end;
  856. function TTesselator.SetIndices(IBPTR: Pointer): Integer;
  857. begin
  858.   Result := 0;
  859. end;
  861. function TTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  862. begin
  863.   Result := 0;
  864.   LastTotalVertices := TotalVertices;
  865. end;
  867. procedure TTesselator.SetVertexDataC(x, y, z: Single; Index: Integer; VBuf: Pointer);
  868. begin
  869.   Assert(VertexFormat and vfTRANSFORMED = 0, ClassName + '.SetVertexDataC: This call is not allowed with existing vertex format');
  870.   {$IFDEF DEBUGMODE}
  871.   Assert(Index < GetMaxVertices, Format('%S.%S: Vertice index (%D) is greater than max vertices (%D)', [ClassName, 'SetVertexDataC', Index, GetMaxVertices]));
  872.   {$ENDIF}
  874.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize)^).X := x;
  875.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize)^).Y := y;
  876.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize)^).Z := z;
  877. end;
  879. procedure TTesselator.SetVertexDataC(const Vec: TVector3s; Index: Integer; VBuf: Pointer);
  880. begin
  881.   Assert(VertexFormat and vfTRANSFORMED = 0, ClassName + '.SetVertexDataC: This call is not allowed with existing vertex format');
  882.   {$IFDEF DEBUGMODE}
  883.   Assert(Index < GetMaxVertices, Format('%S.%S: Vertice index (%D) is greater than max vertices (%D)', [ClassName, 'SetVertexDataC', Index, GetMaxVertices]));
  884.   {$ENDIF}
  885.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize)^) := Vec;
  886. end;
  888. procedure TTesselator.SetVertexDataCRHW(x, y, z, RHW: Single; Index: Integer; VBuf: Pointer);
  889. begin
  890.   Assert(VertexFormat and vfTRANSFORMED = vfTRANSFORMED, ClassName + '.SetVertexDataCRHW: This call is not allowed with existing vertex format');
  891.   TVector4s(Pointer(Integer(VBuf) + Index * FVertexSize)^).X := x;
  892.   TVector4s(Pointer(Integer(VBuf) + Index * FVertexSize)^).Y := y;
  893.   TVector4s(Pointer(Integer(VBuf) + Index * FVertexSize)^).Z := z;
  894.   TVector4s(Pointer(Integer(VBuf) + Index * FVertexSize)^).W := RHW;
  895. end;
  897. procedure TTesselator.SetVertexDataD(Color: TColor; Index: Integer; VBuf: Pointer);
  898. begin
  899.   Assert(VertexFormat and vfDIFFUSE = vfDIFFUSE, ClassName + '.SetVertexDataD: This call is not allowed with existing vertex format');
  900.   {$IFDEF DEBUGMODE}
  901.   Assert(Index < GetMaxVertices, Format('%S.%S: Vertice index (%D) is greater than max vertices (%D)', [ClassName, 'SetVertexDataD', Index, GetMaxVertices]));
  902.   {$ENDIF}
  903.   if RGBA then asm        // Swap R and B components in Color
  904.   end;
  905.   TColor(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiDIFF])^) := Color;
  906. end;
  908. procedure TTesselator.SetVertexDataN(nx, ny, nz: Single; Index: Integer; VBuf: Pointer);
  909. begin
  910.   Assert(VertexFormat and vfNORMALS = vfNORMALS, ClassName + '.SetVertexDataN: This call is not allowed with existing vertex format');
  911.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiNORM])^).X := nx;
  912.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiNORM])^).Y := ny;
  913.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiNORM])^).Z := nz;
  914. end;
  916. procedure TTesselator.SetVertexDataN(const Vec: TVector3s; Index: Integer; VBuf: Pointer);
  917. begin
  918.   Assert(VertexFormat and vfNORMALS = vfNORMALS, ClassName + '.SetVertexDataN: This call is not allowed with existing vertex format');
  919.   TVector3s(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiNORM])^) := Vec;
  920. end;
  922. procedure TTesselator.SetVertexDataS(Color: TColor; Index: Integer; VBuf: Pointer);
  923. begin
  924.   Assert(VertexFormat and vfSPECULAR = vfSPECULAR, ClassName + '.SetVertexDataS: This call is not allowed with existing vertex format');
  925.   if RGBA then asm        // Swap R and B components in Color
  926.   end;
  927.   TColor(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiSPEC])^) := Color;
  928. end;
  930. procedure TTesselator.SetVertexDataUV(u, v: Single; Index: Integer; VBuf: Pointer);
  931. begin
  932.   Assert(GetVertexElementOffset(VertexFormat, vfiTEX0) <> -1, ClassName + '.SetVertexDataUV: This call is not allowed with existing vertex format');
  933.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX0])^) := u;
  934.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX0] + 4)^) := v;
  935. end;
  937. procedure TTesselator.SetVertexDataUV3(u, v, w: Single; Index: Integer; VBuf: Pointer);
  938. begin
  939.   Assert(GetVertexElementOffset(VertexFormat, vfiTEX0) <> -1, ClassName + '.SetVertexDataUV: This call is not allowed with existing vertex format');
  940.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX0])^) := u;
  941.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX0] + 4)^) := v;
  942.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX0] + 8)^) := w;
  943. end;
  945. procedure TTesselator.SetVertexData2UV(u, v: Single; Index: Integer; VBuf: Pointer);
  946. begin
  947.   Assert(GetVertexElementOffset(VertexFormat, vfiTEX1) <> -1, ClassName + '.SetVertexDataUV2: This call is not allowed with existing vertex format');
  948.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX1])^) := u;
  949.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiTEX1] + 4)^) := v;
  950. end;
  952. procedure TTesselator.SetVertexDataW(w: Single; Index: Integer; VBuf: Pointer);
  953. begin
  954.   Assert(GetVertexElementOffset(VertexFormat, vfiWEIGHT1) <> -1, ClassName + '.SetVertexDataW: This call is not allowed with existing vertex format');
  955.   Single(Pointer(Integer(VBuf) + Index * FVertexSize + ElementOffs[vfiWEIGHT1])^) := w;
  956. end;
  958. function TTesselator.Validate: Boolean;
  959. var i, MaxVertices, LTotalIndices: Integer; IBuf: Pointer;
  960. begin
  961.   Result := True;
  962.   if GetMaxIndices = 0 then Exit;
  964.   GetMem(IBuf, GetMaxIndices * IndexSize);
  965.   MaxVertices   := GetMaxVertices;
  966.   LTotalIndices := SetIndices(IBuf);
  968.   i := 0;
  969.   while (i < LTotalIndices) and (TWordBuffer(IBuf^)[i] < MaxVertices) do Inc(i);
  971.   if (i < LTotalIndices) then begin
  972.     {$IFDEF LOGGING} Log.Log(Format('%S.%S: Index #%D = %D (exceedes total vertices = %D)', [ClassName, 'Validate', i, TWordBuffer(IBuf^)[i], MaxVertices]), lkWarning); {$ENDIF}
  973.     Result := False;
  974.   end;
  976.   FreeMem(IBuf);
  977. end;
  979. function TTesselator.GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer;
  980. begin
  981.   Result := 0;
  982.   case Buffer of
  983.     tbVertex: Result := TotalVertices * Ord(TesselationStatus[Buffer].Status <> tsTesselated);
  984.     tbIndex:  Result := TotalIndices  * Ord(TesselationStatus[Buffer].Status <> tsTesselated);
  985.   end;  
  986. end;
  988. function TTesselator.GetMaxAmount(Buffer: TTesselationBuffer): Integer;
  989. begin
  990.   case Buffer of
  991.     tbVertex: Result := GetMaxVertices;
  992.     tbIndex:  Result := GetMaxIndices;
  993.     else Result := 0;
  994.   end;
  995.   LastMaxAmount[Buffer] := Result;
  996. {  Assert((TesselationStatus[Buffer].TesselatorType <> ttStatic) or (Result <= LastMaxAmount[Buffer]),
  997.          Format('%S.%S: Maximum amount of vertices or indices should not increase for tesselators placed in a static buffer',
  998.                 [ClassName, 'GetMaxAmount']));
  999.   Result := Result * Ord((TesselationStatus[Buffer].TesselatorType <> ttStatic) or (Result <= LastMaxAmount[Buffer]));}
  1000. end;
  1002. procedure TTesselator.DoManualRender(Item: TItem);
  1003. begin
  1004. end;
  1006. { TVisible }
  1008. constructor TVisible.Create(AManager: TItemsManager);
  1009. begin
  1010.   inherited;
  1011.   FState := FState + [isVisible];
  1012.   BlendMatrices := nil;
  1013.   IndexInPass   := nil;
  1015.   SetLength(FTesselators, 1);
  1016.   FTesselatorKind := tkOwn;
  1017.   
  1018. //  SetMesh;
  1019. end;
  1021. destructor TVisible.Destroy;
  1022. begin
  1023.   BlendMatrices := nil;
  1024.   IndexInPass   := nil;
  1025.   inherited;
  1026. end;
  1028. class function TVisible.IsAbstract: Boolean;
  1029. begin
  1030.   Result := Self = TVisible;
  1031. end;
  1033. function TVisible.GetTesselatorClass: CTesselator;
  1034. begin
  1035.   Result := nil;
  1036. end;
  1038. procedure TVisible.HandleMessage(const Msg: TMessage);
  1039. var i: Integer; OldCurTechnique: TTechnique;
  1040. begin
  1041.   inherited;
  1043.   if Msg.ClassType = TSceneLoadedMsg then begin
  1044.     GetMaterial;
  1045.   end else if Msg.ClassType = TTechniqueModificationBeginMsg then begin
  1046.     if TTechniqueModificationBeginMsg(Msg).Item = FCurTechnique then
  1047.       RemoveFromPasses;
  1048.   end else if Msg.ClassType = TTechniqueModificationEndMsg then begin
  1049.     if TTechniqueModificationBeginMsg(Msg).Item = FCurTechnique then begin
  1050.       OldCurTechnique := FCurTechnique;
  1051.       SetCurTechnique(nil);
  1052.       SetCurTechnique(OldCurTechnique);
  1053.     end;  
  1054. {  end else if Msg.ClassType = TParentStateChangeMsg then with TParentStateChangeMsg(Msg) do begin
  1055.     if not (isVisible in OldValue) and (isVisible in NewValue) then DoShow;
  1056.     if (isVisible in OldValue) and not (isVisible in NewValue) then DoHide;}
  1057.   end else if Msg.ClassType = ItemMsg.TReplaceMsg then begin
  1058.     with ItemMsg.TReplaceMsg(Msg) do if (OldItem = Self) then begin
  1059.       if VisibilityFlag then RemoveFromPasses;
  1060.       if NewItem is TVisible then begin
  1061.         SetLength(TVisible(NewItem).BlendMatrices, Length(BlendMatrices));
  1062.         for i := 0 to High(TVisible(NewItem).BlendMatrices) do TVisible(NewItem).BlendMatrices[i] := BlendMatrices[i];
  1063.         BlendMatrices := nil;
  1064. //        TVisible(NewItem).DoShow;
  1065.       end;
  1066.     end;
  1067.   end else if Msg.ClassType = C2Msg.TValidationResultChangedMsg then begin
  1068.     if TValidationResultChangedMsg(Msg).Item = Material then SetCurrentLOD(CurrentLOD);
  1069.   end else if Msg.ClassType = TTessBBoxUpdateMsg then begin
  1070.     if TTessBBoxUpdateMsg(Msg).Tesselator = FCurrentTesselator then
  1071.       BoundingBox := TTessBBoxUpdateMsg(Msg).Tesselator.GetBoundingBox;
  1072.   end;
  1073. end;
  1075. function TVisible.isParentsVisible: Boolean;
  1076. // Returns True if isVisible state is on for the item and all its predecessors which are TVisible
  1077. var Item: TItem;
  1078. begin
  1079.   Item := Self.Parent;
  1080.   while Assigned(Item) and
  1081.        ( not (Item is TVisible) or (isVisible in Item.State) ) do
  1082.     Item := Item.Parent;
  1084.   Result := not Assigned(Item);
  1085. end;
  1087. function TVisible.isActuallyVisible: Boolean;
  1088. begin
  1089.   Result := (isVisible in State) and isParentsVisible;
  1090. end;
  1092. procedure TVisible.OnInit;
  1093. begin
  1094.   inherited;
  1095.   SetMesh;
  1096. end;
  1098. procedure TVisible.OnSceneAdd;
  1099. begin
  1100.   inherited;
  1101.   if Assigned(IndexInPass) and (IndexInPass[0] = -1) then AddToPasses;
  1102. end;
  1104. procedure TVisible.OnSceneRemove;
  1105. begin
  1106.   inherited;
  1107.   RemoveFromPasses;
  1108. end;
  1110. procedure TVisible.Show;
  1111. begin
  1112.   State := FState + [isVisible];
  1113. end;
  1115. procedure TVisible.Hide;
  1116. begin
  1117.   State := FState - [isVisible];
  1118. end;
  1120. procedure TVisible.RetrieveShaderConstants(var ConstList: TShaderConstants);
  1121. begin
  1122.   ConstList := nil;
  1123. end;
  1125. function TVisible.CalcSortValue(const Camera: TCamera): Single;
  1126. begin
  1127.   SortValue := SqrMagnitude(SubVector3s(Camera.GetAbsLocation, GetAbsLocation));
  1128.   Result    := SortValue;
  1129. end;
  1131. procedure TVisible.SetMesh;
  1133.   procedure SetTesselator(var Tess: TTesselator);
  1134.   var NewTesselator: TTesselator;
  1135.   begin
  1136.     Assert(GetTesselatorClass() <> nil);
  1137.     if GetTesselatorClass() = nil then Exit;
  1139.     if Assigned(Tess) then begin
  1140.       if Tess.RefCount > 1 then begin                                   // tesselator defined and used by another item. Duplication may need.
  1141.         Tess.DecRef;
  1142.         if GetTesselatorClass() = Tess.ClassType then
  1143.           Tess := (FManager as CAST2.TBaseCore).TesselatorManager.FindSameItem(Tess) as TTesselator
  1144.         else
  1145.           Tess := nil;
  1146.       end else if GetTesselatorClass() <> Tess.ClassType then Tess := nil;
  1147.     end;  
  1148.     if not Assigned(Tess) then begin
  1149.       NewTesselator := GetTesselatorClass.Create;                                                    // Create a new tesselator
  1150.       Tess := (FManager as CAST2.TBaseCore).TesselatorManager.AddItem(NewTesselator) as TTesselator; // Try to add it to manager
  1151.       if Tess <> NewTesselator then NewTesselator.Free;                                              // Release it if the same found in manager
  1152.     end;  
  1154. (*    if (Tess <> nil) then begin
  1155.       if Tess.RefCount > 1 then begin                                   // tesselator defined and used by another item. Duplication may need.
  1156.         Tess.DecRef;
  1157.         Tess := (FManager as CAST2.TBaseCore).TesselatorManager.FindSameItem(Tess) as TTesselator;
  1158.         if Tess = nil then Tess := GetTesselatorClass.Create;
  1159.       end;
  1160.     end else if (GetTesselatorClass <> nil) then begin
  1161.       NewTesselator := GetTesselatorClass.Create;                                         // Create a new tesselator
  1162.       Tess := (FManager as CAST2.TBaseCore).TesselatorManager.AddItem(NewTesselator) as TTesselator; // Try to add it to manager
  1163.       if Tess <> NewTesselator then NewTesselator.Free;                             // Release it if the same found in manager
  1164.     end;*)
  1166.     if Tess <> nil then begin
  1167.       Tess.Manager := FManager;
  1168.       Tess.Init;
  1169.     end;
  1170.   end;
  1172. var i: Integer;
  1173. begin
  1174.   if (FManager = nil) or (FManager.Root = nil) then Exit;
  1176.   Assert(High(FTesselators) >= 0);
  1178.   if GetTesselatorClass <> nil then begin
  1179.     for i := 0 to High(FTesselators) do begin
  1180. //      if GetTesselatorClass <> FTesselators[i].ClassType then FTesselators[i] := nil;
  1181.       SetTesselator(FTesselators[i]);
  1182.     end;
  1183.     FCurrentTesselator := FTesselators[0];
  1184.   end;  
  1186. //  SetTesselator(FCurrentTesselator);
  1188.   if Assigned(FCurrentTesselator) then BoundingBox := FCurrentTesselator.GetBoundingBox;
  1189. end;
  1191. procedure TVisible.SetCurrentLOD(const Value: Single);
  1192. var Tech: TTechnique;
  1193. begin
  1194.   FCurrentLOD := Value;
  1195.   Tech := Material.GetTechniqueByLOD(Value);
  1196.   if Tech <> FCurTechnique then SetCurTechnique(Tech);
  1197. end;
  1199. procedure TVisible.AddProperties(const Result: Props.TProperties);
  1200. var i: Integer;
  1201. begin
  1202.   inherited;
  1203.   AddItemLink(Result, 'Material', [], 'TMaterial');
  1204.   if Assigned(CurrentTesselator) then CurrentTesselator.AddProperties(Result, '');
  1205.   for i := 0 to High(FTesselators) do if Assigned(FTesselators[i]) then
  1206.     FTesselators[i].AddProperties(Result, 'Tesselator #' + IntToStr(i) + '');
  1207. end;
  1209. procedure TVisible.SetProperties(Properties: Props.TProperties);
  1210. var i: Integer;
  1211. begin
  1212.   inherited;
  1213.   if Properties.Valid('Material') then SetLinkProperty('Material', Properties['Material']);
  1214.   GetMaterial;
  1215.   if Assigned(CurrentTesselator) then CurrentTesselator.SetProperties(Properties, '');
  1216.   for i := 0 to High(FTesselators) do if Assigned(FTesselators[i]) then
  1217.     FTesselators[i].SetProperties(Properties, 'Tesselator #' + IntToStr(i) + '');  
  1218. end;
  1220. function TVisible.VisibilityCheck(const Camera: TCamera): Boolean;
  1221. var d: Single; LOD: Integer;
  1222. begin
  1223.   Result := Camera.IsSpehereVisible(GetAbsLocation, BoundingSphereRadius) <> fcOutside;
  1224.   if Result then begin
  1225.     d := Sqrt(SqrMagnitude(SubVector3s(Camera.GetAbsLocation, GetAbsLocation)))/Camera.ZFar;
  1226.     LOD := ClampI(Round(High(FTesselators) * d), 0, High(FTesselators));
  1227.     FCurrentTesselator := FTesselators[LOD];
  1228.   end;
  1229. end;
  1231. procedure TVisible.Render;
  1232. begin
  1233. end;
  1235. procedure TVisible.BeginLighting;
  1236. begin
  1237.   if Assigned(FCurrentTesselator) then FCurrentTesselator.BeginLighting;
  1238. end;
  1240. function TVisible.CalculateLighting(const ALight: TLight): Boolean;
  1241. var LightToItem: TMatrix4s;
  1242. begin
  1243.   Assert(CustomLighting, Format('%S.%S: CustomLighting should be True', [ClassName, 'CalculateLighting']));
  1244.   if Assigned(FCurrentTesselator) then begin
  1245.     MulMatrix4s(LightToItem, InvertMatrix4s(Transform), ALight.Transform);
  1246.     Result := FCurrentTesselator.CalculateLighting(ALight, LightToItem);
  1247.   end else Result := False;
  1248. end;
  1250. procedure TVisible.AddToPasses;
  1251. var i: Integer;
  1252. begin
  1253.   if not isActuallyVisible then Exit;
  1254.   case TesselatorKind of
  1255.     tkOwn: if FCurTechnique <> nil then for i := 0 to FCurTechnique.TotalPasses-1 do begin
  1256.       Assert(IndexInPass[i] = -1, ClassName + '("' + GetFullName + '").DoShow: IndexInPass should be -1');
  1257.       if (IndexInPass[i] = -1) and (FCurTechnique.Passes[i] <> nil) then IndexInPass[i] := FCurTechnique.Passes[i].AddItem(Self);
  1258.     end;
  1259.     tkShared: ((FManager as CAST2.TBaseCore).SharedTesselators as TSharedTesselators).AddItem(Self);
  1260.   end;
  1261. end;
  1263. procedure TVisible.RemoveFromPasses;
  1264. var i: Integer;
  1265. begin
  1266.   case TesselatorKind of
  1267.     tkOwn: if FCurTechnique <> nil then for i := 0 to High(IndexInPass) do begin
  1268.       if IndexInPass[i] <> -1 then begin
  1269.         Assert((FCurTechnique.Passes[i].Items[IndexInPass[i]] = Self), ClassName + '("' + GetFullName + '").DoHide: Item do not match');
  1270.         if FCurTechnique.Passes[i].RemoveItem(IndexInPass[i]) then
  1271.           TVisible(FCurTechnique.Passes[i].Items[IndexInPass[i]]).IndexInPass[i] := IndexInPass[i];   // ToDo: try to remove
  1272.         IndexInPass[i] := -1;
  1273.       end;
  1274.     end;
  1275.     tkShared: if Assigned((FManager as CAST2.TBaseCore).SharedTesselators) then
  1276.       ((FManager as CAST2.TBaseCore).SharedTesselators as TSharedTesselators).RemoveItem(Self);
  1277.   end;
  1278. end;
  1280. procedure TVisible.DoShow;
  1281. begin
  1282.   VisibilityFlag := True;
  1283.   AddToPasses;
  1284. end;
  1286. procedure TVisible.DoHide;
  1287. begin
  1288.   VisibilityFlag := False;
  1289.   RemoveFromPasses;  
  1290. end;
  1292. procedure TVisible.SetState(const Value: TSet32);
  1294.   procedure PropagateToChilds(Item: TItem; NewState: Boolean);
  1295.   var i: Integer;
  1296.   begin
  1297.     for i := 0 to Item.TotalChilds-1 do begin
  1298.       if (Item.Childs[i] is TVisible) then
  1299. //        if (TVisible(Item.Childs[i]).VisibilityFlag = NewState) then Continue else begin            // No neeed to propagate
  1300.           if NewState then TVisible(Item.Childs[i]).DoShow else TVisible(Item.Childs[i]).DoHide;
  1301. //        end;
  1302.       PropagateToChilds(Item.Childs[i], NewState);
  1303.     end;
  1304.   end;
  1306. var OldState: TItemFlags;
  1307. begin
  1308.   OldState := State;
  1309.   inherited;
  1310.   if isParentsVisible then begin
  1311.     if not (isVisible in OldState) and (isVisible in Value) then begin
  1312.       DoShow;
  1313.       PropagateToChilds(Self, True);
  1314.     end;
  1315.     if (isVisible in OldState) and not (isVisible in Value) then begin
  1316.       DoHide;
  1317.       PropagateToChilds(Self, False);
  1318.     end;
  1319.   end;
  1320. end;
  1322. function TVisible.GetMaterial: TMaterial;
  1323. var LMaterial: TMaterial; Item: TItem;
  1324. begin
  1325.   if ResolveLink('Material', Item) then ;
  1326.   if Assigned(Item) then begin
  1327.     LMaterial := Item as TMaterial;
  1328.     SetCurTechnique(LMaterial.GetTechniqueByLOD(CurrentLOD));
  1329.   end;
  1330.   Result := Item as TMaterial;
  1331. end;
  1333. procedure TVisible.SetMaterial(Value: TMaterial);
  1334. begin
  1335.   SetLinkedObject('Material', Value);
  1336. end;
  1338. procedure TVisible.SetCurTechnique(const Value: TTechnique);
  1339. begin
  1340.   if FCurTechnique = Value then Exit;
  1341.   RemoveFromPasses;
  1342.   FCurTechnique := Value;
  1343.   if Assigned(FCurTechnique) and (FCurTechnique.TotalPasses > Length(IndexInPass)) then begin
  1344.     SetLength(IndexInPass, FCurTechnique.TotalPasses);
  1345.     FillDWord(IndexInPass[0], FCurTechnique.TotalPasses, Cardinal(-1));
  1346.   end;
  1347.   AddToPasses;
  1348. end;
  1350. procedure TVisible.SetTesselatorKind(const Value: TTesselatorKind);
  1351. begin
  1352.   if FTesselatorKind = Value then Exit;
  1353.   RemoveFromPasses;
  1354.   FTesselatorKind := Value;
  1355.   AddToPasses;
  1356. end;
  1358. procedure TVisible.SetParent(NewParent: TItem);
  1359. begin
  1360. //  if isActuallyVisible then DoHide;
  1361.   inherited;
  1362. //  if isActuallyVisible then DoShow;
  1363. end;
  1365. { TTemporaryVisible }
  1367. function TTemporaryVisible.VisibilityCheck(const Camera: TCamera): Boolean;
  1368. begin
  1369.   Result := True;
  1370. end;
  1372. procedure TTemporaryVisible.Clear;
  1373. var i: Integer;
  1374. begin
  1375.   for i := FTotalChilds-1 downto 0 do TVisible(Childs[i]).ClearParent;
  1376.   FTotalChilds := 0;
  1377. end;
  1379. constructor TTemporaryVisible.Create(AManager: TItemsManager);
  1380. begin
  1381.   inherited;
  1382. end;
  1384. destructor TTemporaryVisible.Destroy;
  1385. begin
  1386.   Clear;
  1387.   inherited;
  1388. end;
  1390. { TSharedTesselators }
  1392. function TSharedTesselators.GetItemIndex(const AItem: TVisible): Integer;
  1393. begin
  1394.   Result := TotalItems-1;
  1395.   while (Result >= 0) and (Items[Result] <> AItem) do Dec(Result);
  1396. end;
  1398. function TSharedTesselators.GetTesselatorIndex(const TessClass: CTesselator): Integer;
  1399. begin
  1400.   Result := High(TessClasses);
  1401.   while (Result >= 0) and (TessClasses[Result].TessClass <> TessClass) do Dec(Result);
  1402. end;
  1404. function TSharedTesselators.AddTesselatorClass(const TessClass: CTesselator): Integer;
  1405. begin
  1406.   Assert(GetTesselatorIndex(TessClass) = -1, ClassName + '.AddTesselatorClass: Class already exists');
  1407.   Result := Length(TessClasses);
  1408.   SetLength(TessClasses, Result+1);
  1409.   TessClasses[Result].TessClass := TessClass;
  1410.   TessClasses[Result].TessMap   := BaseCont.TPointerPointerMap.Create(DefaultTechToItemMapCapacity);
  1411. end;
  1413. function TSharedTesselators.GetTesselator(const TessClass: CTesselator; const Technique: TTechnique): TTesselator;
  1414. var ClassIndex: Integer; Item: TVisible;
  1415. begin
  1416.   ClassIndex := GetTesselatorIndex(TessClass);
  1417.   if ClassIndex = -1 then ClassIndex := AddTesselatorClass(TessClass);
  1418.   Item := TVisible(TessClasses[ClassIndex].TessMap[Technique]);
  1419.   if Item = nil then begin
  1420.     Item := TTemporaryVisible.Create(Core);
  1421.     Item.Name := 'Temp visible';
  1422.     Result := TessClass.Create;
  1423.     Item.FCurrentTesselator := Result;
  1424.     TessClasses[ClassIndex].TessMap[Technique] := Item;
  1425.   end else Result := Item.CurrentTesselator;
  1426. end;
  1428. function TSharedTesselators.DrawTechMap(Key, Value: Pointer): Boolean;
  1429. var Technique: TTechnique; Item: TVisible;
  1430. begin
  1431.   Result := False;
  1432.   if (Key = nil) or (Value = nil) then Exit;
  1434.   Technique := TTechnique(Key);
  1435.   Item      := TVisible(Value);
  1437.   Item.SetCurTechnique(Technique);
  1438.   Core.TempItems.AddChild(Item);
  1439. end;
  1441. function TSharedTesselators.DelTechMap(Key, Value: Pointer): Boolean;
  1442. begin
  1443.   Result := False;
  1444.   if (Key = nil) or (Value = nil) then Exit;
  1446.   if Assigned(TVisible(Value).CurrentTesselator) then
  1447.   TSharedTesselator(TVisible(Value).CurrentTesselator).Clear;
  1448. end;
  1450. function TSharedTesselators.FreeTechMap(Key, Value: Pointer): Boolean;
  1451. begin
  1452.   Result := False;
  1453.   if (Key = nil) or (Value = nil) then Exit;
  1455.   TSharedTesselator(TVisible(Value).CurrentTesselator).Free;
  1456. //  Assert(Value <> nil);
  1457.   TVisible(Value).Free;
  1458. end;
  1460. procedure TSharedTesselators.AddItem(const AItem: TVisible);
  1461. begin
  1462.   Assert(GetItemIndex(AItem) = -1, ClassName + '.AddItem: Item already exists');
  1463.   if Length(Items) <= TotalItems then SetLength(Items, Length(Items) + ItemsCapacityStep);
  1464.   Items[TotalItems] := AItem;
  1465.   SetLength(AItem.IndexInPass, 1);
  1466.   AItem.IndexInPass[0] := TotalItems;
  1467.   Inc(TotalItems);
  1468. end;
  1470. procedure TSharedTesselators.RemoveItem(const AItem: TVisible);
  1471. var Index: Integer;
  1472. begin
  1473.   if AItem.IndexInPass = nil then Exit;                                  { TODO -cDebug : Figure out why RemoveItem can be called when IndexInPass = nil }
  1474.   if (AItem.IndexInPass[0] = -1) or (Items[AItem.IndexInPass[0]] = AItem) then Index := AItem.IndexInPass[0] else Index := GetItemIndex(AItem);
  1475.   if Index = -1 then Exit;
  1476.   Assert(TotalItems > 0, ClassName + '.RemoveItem: No items');
  1477. //  Assert(Index <> -1, ClassName + '.RemoveItem: Item not found');
  1479.   while Index < TotalItems-1 do begin
  1480.     Items[Index] := Items[Index+1];
  1481.     Items[Index].IndexInPass[0] := Index;
  1482.     Inc(Index);
  1483.   end;
  1485.   AItem.IndexInPass[0] := -1;
  1487.   Dec(TotalItems);
  1488. end;
  1490. procedure TSharedTesselators.Clear;
  1491. begin
  1492.   TotalItems := 0;
  1493. end;
  1495. procedure TSharedTesselators.Reset;
  1496. var i: Integer;
  1497. begin
  1498.   for i := 0 to High(TessClasses) do TessClasses[i].TessMap.DoForEach({$IFDEF OBJFPCEnable}@{$ENDIF}DelTechMap);
  1499. end;
  1501. procedure TSharedTesselators.Render;
  1502. var i: Integer;
  1503. begin
  1504. //  Items[0].Render;
  1505.   for i := 0 to TotalItems-1 do Items[i].Render;                      // Fill tesselators with commands
  1506.   for i := 0 to High(TessClasses) do TessClasses[i].TessMap.DoForEach({$IFDEF OBJFPCEnable}@{$ENDIF}DrawTechMap);
  1507. end;
  1509. destructor TSharedTesselators.Destroy;
  1510. var i: Integer;
  1511. begin
  1512.   Reset;
  1513.   for i := 0 to High(TessClasses) do begin
  1514.     TessClasses[i].TessMap.DoForEach({$IFDEF OBJFPCEnable}@{$ENDIF}FreeTechMap);
  1515.     FreeAndNil(TessClasses[i].TessMap);
  1516.   end;
  1517.   Clear;
  1518.   Items := nil;
  1519.   TessClasses := nil;
  1520.   inherited;
  1521. end;
  1523. { TLight }
  1525. constructor TLight.Create(AManager: TItemsManager);
  1526. begin
  1527.   inherited;
  1528.   Ambient   := GetColor4S(0.5, 0.5, 0.5, 0.5);
  1529.   Diffuse   := GetColor4S(0.5, 0.5, 0.5, 0.5);
  1530.   Specular  := GetColor4S(0.0, 0.0, 0.0, 0.0);
  1531.   Range     := 1;
  1532.   Theta     := pi/4;
  1533.   Phi       := pi/3;
  1534.   GroupMask := gmDefault
  1535. end;
  1537. procedure TLight.AddProperties(const Result: Props.TProperties);
  1538. var i: Integer;
  1539. begin
  1540.   inherited;
  1541.   if not Assigned(Result) then Exit;
  1543.   Result.AddEnumerated('Type',  [], Ord(Kind), LightKindsEnum);
  1545.   for i := 0 to PassGroupsCount-1 do Result.Add(Format('Pass groupsGroup %D', [i+1]), vtBoolean, [], OnOffStr[i in GroupMask], '');
  1547.   AddColor4sProperty(Result, 'ColorAmbient',  Ambient);
  1548.   AddColor4sProperty(Result, 'ColorDiffuse',  Diffuse);
  1549.   AddColor4sProperty(Result, 'ColorSpecular', Specular);
  1551.   Result.Add('Range',   vtSingle, [], FloatToStr(Range),   '0-100');
  1552.   Result.Add('Falloff', vtSingle, [], FloatToStr(Falloff), '');
  1554.   Result.Add('Constant attenuation',  vtSingle, [], FloatToStr(Attenuation0), '0-10');
  1555.   Result.Add('Linear attenuation',    vtSingle, [], FloatToStr(Attenuation1), '0-10');
  1556.   Result.Add('Quadratic attenuation', vtSingle, [], FloatToStr(Attenuation2), '0-10');
  1558.   Result.Add('Cone inner angle', vtSingle, [], FloatToStr(Theta * 180/pi), '0-180');
  1559.   Result.Add('Cone outer angle', vtSingle, [], FloatToStr(Phi * 180/pi),   '0-180');
  1560. end;
  1562. procedure TLight.SetProperties(Properties: Props.TProperties);
  1563. var i: Integer;
  1564. begin
  1565.   inherited;
  1567.   for i := 0 to PassGroupsCount-1 do
  1568.     if Properties.Valid(Format('Pass groupsGroup %D', [i+1])) then
  1569.       if Properties.GetAsInteger(Format('Pass groupsGroup %D', [i+1])) > 0 then
  1570.         GroupMask := GroupMask + [i] else
  1571.           GroupMask := GroupMask - [i];
  1573.   if Properties.Valid('Type')  then Kind  := Properties.GetAsInteger('Type');
  1575.   SetColor4sProperty(Properties, 'ColorAmbient',  Ambient);
  1576.   SetColor4sProperty(Properties, 'ColorDiffuse',  Diffuse);
  1577.   SetColor4sProperty(Properties, 'ColorSpecular', Specular);
  1579.   if Properties.Valid('Range')   then Range   := StrToFloatDef(Properties['Range'],   0);
  1580.   if Properties.Valid('Falloff') then Falloff := StrToFloatDef(Properties['Falloff'], 0);
  1582.   if Properties.Valid('Constant attenuation')  then Attenuation0 := StrToFloatDef(Properties['Constant attenuation'],  0);
  1583.   if Properties.Valid('Linear attenuation')    then Attenuation1 := StrToFloatDef(Properties['Linear attenuation'],    0);
  1584.   if Properties.Valid('Quadratic attenuation') then Attenuation2 := StrToFloatDef(Properties['Quadratic attenuation'], 0);
  1586.   if Properties.Valid('Cone inner angle') then Theta := StrToFloatDef(Properties['Cone inner angle'], 0) / 180*pi;
  1587.   if Properties.Valid('Cone outer angle') then Phi   := StrToFloatDef(Properties['Cone outer angle'], 0) / 180*pi;
  1588. end;
  1590. function TLight.GetEnabled: Boolean;
  1591. begin
  1592.   Result := isVisible in FState;
  1593. end;
  1595. procedure TLight.SetEnabled(const Value: Boolean);
  1596. begin
  1597.   if Value then FState := FState + [isVisible] else FState := FState - [isVisible];
  1598. end;
  1600. procedure TLight.HandleMessage(const Msg: TMessage);
  1601. begin
  1602.   inherited;
  1603.   if Msg.ClassType = ItemMsg.TReplaceMsg then with ItemMsg.TReplaceMsg(Msg) do if (OldItem = Self) then begin
  1604.   end;
  1605. end;
  1607. procedure TLight.SetState(const Value: TSet32);
  1608. begin
  1609.   if not (isVisible in FState) and (isVisible in Value) then Enabled := True;
  1610.   if (isVisible in FState) and not (isVisible in Value) then Enabled := False;
  1611.   inherited;
  1612. end;
  1614. { TMappedTesselator }
  1616. function TMappedTesselator.GetBoundingBox: TBoundingBox;
  1617. begin
  1618.   Result := EmptyBoundingBox;
  1619.   if not Assigned(FMap) or (FMap.Width = 0) or (FMap.Height = 0) then Exit;
  1620.   Result.P1 := GetVector3s(-(FMap.Width-1)  * FMap.CellWidthScale * 0.5,
  1621.                             0,
  1622.                            -(FMap.Height-1) * FMap.CellHeightScale * 0.5);
  1623.   Result.P2 := GetVector3s( (FMap.Width-1)  * FMap.CellWidthScale * 0.5,
  1624.                             FMap.MaxHeight * FMap.DepthScale,
  1625.                             (FMap.Height-1) * FMap.CellHeightScale * 0.5);
  1626. end;
  1628. procedure TMappedTesselator.SetMap(const AMap: TMap);
  1629. begin
  1630.   FMap := AMap;
  1631. end;
  1633. function TMappedTesselator.GetMaxVertices: Integer;
  1634. begin
  1635.   Result := 0;
  1636.   if not Assigned(FMap) then Exit;
  1637. //  Result := (FMap.Width) * (FMap.Height);
  1638.   if (FMap.Width <> OldWidth) or (FMap.Height <> OldHeight) or
  1639.      (FMap.CellWidthScale <> OldCellWidthScale) or (FMap.CellHeightScale <> OldCellHeightScale) or
  1640.      (FMap.DepthScale <> OldDepthScale) then Init;
  1641.   Result := inherited GetMaxVertices;
  1642. end;
  1644. procedure TMappedTesselator.Init;
  1645. begin
  1646.   inherited;
  1647.   if Assigned(FMap) then begin
  1648.     OldWidth           := FMap.Width;
  1649.     OldHeight          := FMap.Height;
  1650.     OldCellWidthScale  := FMap.CellWidthScale;
  1651.     OldCellHeightScale := FMap.CellHeightScale;
  1652.     OldDepthScale      := FMap.DepthScale;
  1653.   end else begin
  1654.     TotalVertices   := 0;
  1655.     TotalIndices    := 0;
  1656.     TotalPrimitives := 0;
  1657.   end;
  1658.   InvalidateBoundingBox;
  1659.   Invalidate([tbVertex, tbIndex], True);
  1660. end;
  1662. { TMappedItem }
  1664. const MapPropName = 'Map';
  1666. procedure TMappedItem.ResolveLinks;
  1667. var i: Integer; Item: TItem;
  1668. begin
  1669.   inherited;
  1670.   ResolveLink(MapPropName, Item);
  1672.   if Assigned(Item) then begin
  1673.     FMap := Item as C2Maps.TMap;
  1674.     for i := 0 to High(FTesselators) do if FTesselators[i] is TMappedTesselator then begin
  1675.       (FTesselators[i] as TMappedTesselator).SetMap(Item as C2Maps.TMap);
  1676.       FTesselators[i].Init;
  1677.     end;
  1678.   end;
  1679. end;
  1681. procedure TMappedItem.OnModify(const ARect: TRect);
  1682. begin
  1683. end;
  1685. class function TMappedItem.IsAbstract: Boolean;
  1686. begin
  1687.   Result := Self = TMappedItem;
  1688. end;
  1690. procedure TMappedItem.SetMesh;
  1691. begin
  1692.   inherited;
  1693.   (CurrentTesselator as TMappedTesselator).Item := Self;
  1694. end;
  1696. procedure TMappedItem.AddProperties(const Result: Props.TProperties);
  1697. begin
  1698.   inherited;
  1699.   if Assigned(Result) then begin
  1700.   end;
  1702.   AddItemLink(Result, MapPropName, [], 'TMap');
  1703. end;
  1705. procedure TMappedItem.SetProperties(Properties: Props.TProperties);
  1706. begin
  1707.   inherited;
  1708.   if Properties.Valid(MapPropName) then SetLinkProperty(MapPropName, Properties[MapPropName]);
  1710.   ResolveLinks;
  1711. end;
  1713. procedure TMappedItem.HandleMessage(const Msg: TMessage);
  1714. begin
  1715.   inherited;
  1716.   {$IFDEF EDITORMODE}
  1717.   if Msg.ClassType = TMapDrawCursorMsg  then with TMapDrawCursorMsg(Msg) do DrawCursor(Cursor, Cursor.Camera, Cursor.Screen);
  1718.   if Msg.ClassType = TMapModifyBeginMsg then with TMapEditorMessage(Msg) do ModifyBegin(Cursor, Cursor.Camera);
  1719.   if Msg.ClassType = TMapModifyMsg      then with TMapEditorMessage(Msg) do Modify(Cursor, Cursor.Camera);
  1720.   if Msg.ClassType = TMapModifyEndMsg   then with TMapEditorMessage(Msg) do ModifyEnd(Cursor, Cursor.Camera);
  1722.   if Msg.ClassType = TRequestMapEditVisuals then with TRequestMapEditVisuals(Msg) do begin
  1723.     Cursor.Params.Add('Size', vtNat, [], '1', '1-64', '');
  1724.     Cursor.Params.AddEnumerated('Mode', [], 0, 'Heights&Smooth');
  1725.   end;
  1727.   {$ENDIF}
  1728.   if (Msg.ClassType = TItemModifiedMsg) and (TItemModifiedMsg(Msg).Item = Map) then CurrentTesselator.Invalidate([tbVertex, tbIndex], False);
  1729. end;
  1732. function TMappedItem.PickCell(Camera: TCamera; MouseX, MouseY: Integer; out CellX, CellZ: Integer): Boolean;
  1733. var CameraPos, PickRay, PickPos: TVector3s; M: TMatrix4s;
  1734. begin
  1735.   Result := False;
  1736.   if not Assigned(FMap) then Exit;
  1738.   // Transform camera position and pick ray to model space
  1739.   M := InvertMatrix4s(Transform);
  1740.   CameraPos := Transform4Vector33s(M, Camera.Position);
  1741.   PickRay := Camera.GetPickRay(MouseX, MouseY);
  1742.   PickRay := Transform3Vector3s(CutMatrix3s(InvertAffineMatrix4s(Camera.ViewMatrix)), PickRay);
  1743.   PickRay.Y := PickRay.Y;
  1744.   PickRay := NormalizeVector3s(Transform3Vector3s(CutMatrix3s(M), PickRay));
  1745.   Result := FMap.TraceRay(CameraPos, PickRay, PickPos);
  1746.   if Result then Map.ObtainCell(PickPos.X, PickPos.Z, CellX, CellZ);
  1747. end;
  1749. {$IFDEF EDITORMODE}
  1750. function TMappedItem.DrawCursor(Cursor: TMapCursor; Camera: TCamera; Screen: TScreen): Boolean;
  1752.   procedure DrawCell(CellX, CellZ: Integer);
  1753.     function CalcLinePos: TVector3s;
  1754.     begin
  1755.       Result.X := (CellX - (FMap.Width -1) * 0.5) * FMap.CellWidthScale;
  1756.       Result.Y := FMap[CellX, CellZ] * FMap.DepthScale;
  1757.       Result.Z := (CellZ - (FMap.Height-1) * 0.5) * FMap.CellHeightScale;
  1758.       Result := Transform4Vector33s(Transform, Result);
  1759.     end;
  1760.     
  1761.   begin
  1762.     if (CellX < 1) or (CellZ < 1) or (CellX > FMap.Width-2) or (CellZ > FMap.Height-2) then Exit;
  1763.     Screen.MoveToVec(Camera.Project(CalcLinePos).xyz);
  1764.     Inc(CellX);
  1765.     Screen.LineToVec(Camera.Project(CalcLinePos).xyz);
  1766.     Inc(CellZ);
  1767.     Screen.LineToVec(Camera.Project(CalcLinePos).xyz);
  1768.     Dec(CellX);
  1769.     Screen.LineToVec(Camera.Project(CalcLinePos).xyz);
  1770.     Dec(CellZ);
  1771.     Screen.LineToVec(Camera.Project(CalcLinePos).xyz);
  1772.   end;
  1774.   procedure DrawCursorAt(CellX, CellZ, Size: Integer);
  1775.   var i, j: Integer;
  1776.   begin
  1777. //    Screen.MoveTo(0, 0);
  1778. //    Screen.LineTo(0, 0);
  1779.     for i := CellX - Size div 2 to CellX + Size div 2 do
  1780.       for j := CellZ - Size div 2 to CellZ + Size div 2 do DrawCell(i, j);
  1781.   end;
  1783. begin
  1784.   Result := False;
  1785.   if not Assigned(FMap) or not EditMode and not PickCell(Camera, Cursor.MouseX, Cursor.MouseY, EditCellX, EditCellZ) then Exit;
  1787.   DrawCursorAt(EditCellX, EditCellZ, Cursor.Params.GetAsInteger('Size'));
  1789.   Result := True;
  1790. end;
  1792. procedure TMappedItem.ModifyBegin(Cursor: TMapCursor; Camera: TCamera);
  1793. var Op: THeighTMapEditOp;
  1794. begin
  1795.   if FMap.Data = nil then Exit;
  1797.   EditMouseX     := Cursor.MouseX;
  1798.   EditMouseY     := Cursor.MouseY;
  1799.   EditCursorSize := ClampI(Cursor.Params.GetAsInteger('Size'), 1, MaxCursorSize);
  1801.   case Cursor.Params.GetAsInteger('Mode') of
  1802.     hmemSmooth: begin
  1803.       EditMode := True;
  1804.       Modify(Cursor, Camera);      
  1805.       Exit;
  1806.     end;
  1807.   end;
  1809.   if PickCell(Camera, Cursor.MouseX, Cursor.MouseY, EditCellX, EditCellZ) then begin
  1810.     EditMode := True;
  1811.     case Cursor.Params.GetAsInteger('Mode') of
  1812.       hmemAdjust: begin
  1813.         Op := THeighTMapEditOpAdjust.Create;
  1814.         Include(Op.Flags, ofIntermediate);
  1815.         Cursor.Operation := Op;
  1816.       end;
  1817.     end;
  1818.   end else EditMode := False;
  1819. end;
  1821. procedure TMappedItem.Modify(Cursor: TMapCursor; Camera: TCamera);
  1822. var Op: THeighTMapEditOp;
  1823. begin
  1824.   if not EditMode or (FMap.Data = nil) then Exit;
  1826.   case Cursor.Params.GetAsInteger('Mode') of
  1827.     hmemAdjust: begin
  1828.       Assert(Cursor.Operation is THeighTMapEditOpAdjust);
  1829.       with THeighTMapEditOpAdjust(Cursor.Operation) do begin
  1830.         OnModify(GetRect(EditCellX - EditCursorSize, EditCellZ - EditCursorSize, EditCellX + EditCursorSize+1, EditCellZ + EditCursorSize+1));
  1831.         Apply;                                       // Undo previous iteration
  1832.         Init(FMap, EditCellX, EditCellZ, EditCursorSize, Cursor.MouseY - EditMouseY);
  1833.       end;
  1834.     end;
  1835.     hmemSmooth: if PickCell(Camera, Cursor.MouseX, Cursor.MouseY, EditCellX, EditCellZ) then begin
  1836.       Op := THeighTMapEditOpSmooth.Create;
  1837.       if Op.Init(FMap, EditCellX, EditCellZ, EditCursorSize, Cursor.MouseY - EditMouseY) then
  1838.         Cursor.Operation := Op else
  1839.           Op.Free;
  1840.       OnModify(GetRect(EditCellX - EditCursorSize, EditCellZ - EditCursorSize, EditCellX + EditCursorSize+1, EditCellZ + EditCursorSize+1));
  1841.     end;
  1842.     else Assert(False);
  1843.   end;
  1844. end;
  1846. procedure TMappedItem.ModifyEnd(Cursor: TMapCursor; Camera: TCamera);
  1847. begin
  1848.   EditMode := False;
  1849.   case Cursor.Params.GetAsInteger('Mode') of
  1850.     hmemAdjust: begin
  1851.       Assert(Cursor.Operation is THeighTMapEditOpAdjust);
  1852.       with THeighTMapEditOpAdjust(Cursor.Operation) do begin
  1853.         Apply;                                       // Undo previous iteration
  1854.         if Init(FMap, EditCellX, EditCellZ, EditCursorSize, Cursor.MouseY - EditMouseY) then
  1855.           Exclude(Cursor.Operation.Flags, ofIntermediate) else
  1856.             FreeAndNil(Cursor.Operation);
  1857.       end;
  1858.     end;
  1859.     else OnModify(GetRect(EditCellX - EditCursorSize, EditCellZ - EditCursorSize, EditCellX + EditCursorSize+1, EditCellZ + EditCursorSize+1));
  1860.   end;
  1862. end;
  1864. {$ENDIF}
  1866. { THeighTMapEditOpAdjust }
  1868. function THeighTMapEditOpAdjust.Init(AMap: TMap; ACellX, ACellZ, ACursorSize: Integer; AValueDelta: Single): Boolean;
  1869. var i, j, StartI, StartJ, OfsI, OfsJ: Integer; Value, norm: Single;
  1870. begin
  1871.   Result := False;
  1872.   if (ACursorSize = 0) or not Assigned(AMap) or (Abs(AValueDelta) < epsilon) then Exit;
  1873.   Scale      := -1;
  1874.   Map        := AMap;
  1875.   CellX      := ACellX;
  1876.   CellZ      := ACellZ;
  1877.   CursorSize := ACursorSize;
  1878.   GetMem(Buffer, CursorSize * CursorSize * Map.ElementSize);
  1879.   Result := True;
  1881.   StartI := CellX - CursorSize div 2;
  1882.   if StartI < 0 then begin
  1883.     OfsI   := -StartI;
  1884.     StartI := 0;
  1885.   end else OfsI := 0;
  1886.   StartJ := CellZ - CursorSize div 2;
  1887.   if StartJ < 0 then begin
  1888.     OfsJ   := -StartJ;
  1889.     StartJ := 0;
  1890.   end else OfsJ := 0;
  1892.   norm := 1 / Sqr(CursorSize*0.5);
  1894.   case Map.ElementSize of
  1895.     1: for j := StartJ to MinI(Map.Height-1, CellZ - CursorSize div 2 + CursorSize-1) do
  1896.          for i := StartI to MinI(Map.Width-1, CellX - CursorSize div 2 + CursorSize-1) do begin
  1897.       Value := PByteBuffer (Map.Data)^[(j * Map.Width + i)];
  1898.       Value := ClampS(Value + AValueDelta * Scale * MaxS(0, (1-(Sqr(i-CellX) + Sqr(j-CellZ)) * norm)), 0, Map.MaxHeight);
  1899.       PByteBuffer (Buffer)^[((j-StartJ + OfsJ) * CursorSize + i - StartI + OfsI)]     := Round(Value);
  1900.     end;
  1901.     2: for j := StartJ to MinI(Map.Height-1, CellZ - CursorSize div 2 + CursorSize-1) do
  1902.          for i := StartI to MinI(Map.Width-1, CellX - CursorSize div 2 + CursorSize-1) do begin
  1903.       Value := PWordBuffer (Map.Data)^[(j * Map.Width + i) * 2];
  1904.       Value := ClampS(Value + AValueDelta * Scale * MaxS(0, (1-(Sqr(i-CellX) + Sqr(j-CellZ)) * norm)), 0, Map.MaxHeight);
  1905.       PWordBuffer (Buffer)^[((j-StartJ + OfsJ) * CursorSize + i - StartI + OfsI) * 2] := Round(Value);
  1906.     end;
  1907.     4: for j := StartJ to MinI(Map.Height-1, CellZ - CursorSize div 2 + CursorSize-1) do
  1908.          for i := StartI to MinI(Map.Width-1, CellX - CursorSize div 2 + CursorSize-1) do begin
  1909.       Value := PDWordBuffer(Map.Data)^[(j * Map.Width + i) * 4];
  1910.       Value := ClampS(Value + AValueDelta * Scale * MaxS(0, (1-(Sqr(i-CellX) + Sqr(j-CellZ)) * norm)), 0, Map.MaxHeight);
  1911.       PDWordBuffer(Buffer)^[((j-StartJ + OfsJ) * CursorSize + i - StartI + OfsI) * 4] := Round(Value);
  1912.     end;
  1913.   end;
  1914. end;
  1916. { THeighTMapEditOpSmooth }
  1918. function THeighTMapEditOpSmooth.Init(AMap: TMap; ACellX, ACellZ, ACursorSize: Integer; AValueDelta: Single): Boolean;
  1919. var i, j, i1, i2, j1, j2, StartI, StartJ, OfsI, OfsJ: Integer; Value, norm, k: Single;
  1920. begin
  1921.   Result := False;
  1922.   if (ACursorSize = 0) or not Assigned(AMap) then Exit;
  1923.   Scale      := -1;
  1924.   Map        := AMap;
  1925.   CellX      := ACellX;
  1926.   CellZ      := ACellZ;
  1927.   CursorSize := ACursorSize;
  1928.   GetMem(Buffer, CursorSize * CursorSize * Map.ElementSize);
  1929.   Result := True;
  1931.   StartI := CellX - CursorSize div 2;
  1932.   if StartI < 0 then begin
  1933.     OfsI   := -StartI;
  1934.     StartI := 0;
  1935.   end else OfsI := 0;
  1936.   StartJ := CellZ - CursorSize div 2;
  1937.   if StartJ < 0 then begin
  1938.     OfsJ   := -StartJ;
  1939.     StartJ := 0;
  1940.   end else OfsJ := 0;
  1942.   norm := 1 / {Sqr}(CursorSize*0.5);
  1944.   case Map.ElementSize of
  1945.     1: for j := StartJ to MinI(Map.Height-1, CellZ - CursorSize div 2 + CursorSize-1) do
  1946.          for i := StartI to MinI(Map.Width-1, CellX - CursorSize div 2 + CursorSize-1) do begin
  1947.       i1 := MaxI(i-1, 0);
  1948.       j1 := MaxI(j-1, 0);
  1949.       i2 := MinI(i+1, Map.Width-1);
  1950.       j2 := MinI(j+1, Map.Height-1);
  1951.       Value := (PByteBuffer (Map.Data)^[j1 * Map.Width + i1] +
  1952.                 PByteBuffer (Map.Data)^[j1 * Map.Width + i] +
  1953.                 PByteBuffer (Map.Data)^[j1 * Map.Width + i2] +
  1954.                 PByteBuffer (Map.Data)^[j * Map.Width + i1] +
  1955. //                PByteBuffer (Map.Data)^[(j * Map.Width + i)] +
  1956.                 PByteBuffer (Map.Data)^[j * Map.Width + i2] +
  1957.                 PByteBuffer (Map.Data)^[j2 * Map.Width + i1] +
  1958.                 PByteBuffer (Map.Data)^[j2 * Map.Width + i] +
  1959.                 PByteBuffer (Map.Data)^[j2 * Map.Width + i2]) div 8;
  1960. //      Value := ClampS(Value, 0, Map.MaxHeight);
  1961.       k := MaxS(0, (1-Sqrt(Sqr(i-CellX) + Sqr(j-CellZ)) * norm));
  1962.       Value := ClampS(PByteBuffer (Map.Data)^[(j * Map.Width + i)] * (1-k) +
  1963.                       Value * k, 0, Map.MaxHeight);
  1964.       PByteBuffer (Buffer)^[((j-StartJ + OfsJ) * CursorSize + i - StartI + OfsI)]     := Round(Value);
  1965.     end;
  1966.     2: ;//Value := PWordBuffer (Map.Data)^[(j * Map.Width + i) * 2];
  1967.     4: ;//Value := PDWordBuffer(Map.Data)^[(j * Map.Width + i) * 4];
  1968.   end;
  1971. {      case Map.ElementSize of
  1972.         1:
  1973.         2: PWordBuffer (Buffer)^[((j-StartJ + OfsJ) * CursorSize + i - StartI + OfsI) * 2] := Round(Value);
  1974.         4: PDWordBuffer(Buffer)^[((j-StartJ + OfsJ) * CursorSize + i - StartI + OfsI) * 4] := Round(Value);
  1975.       end;
  1976.     end;}
  1977. end;
  1979. end.