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

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

游戏引擎

开发平台：

Delphi

C2VisItems.pas：源码内容
  1. (*
  2.  @Abstract(CAST II Engine miscellaneous visual items unit)
  3.  (C) 2006-2008 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 some useful visual items
  6. *)
  7. {$Include GDefines.inc}
  8. {$Include C2Defines.inc}
  9. unit C2VisItems;
  11. interface
  13. uses
  14.   TextFile,
  15.   SysUtils,
  16.   BaseTypes, BaseMsg, Basics, Props, Base3D, BaseClasses, Resources,
  17.   C2Types, CAST2, C2Visual, C2Res, C2Core;
  19. type
  20.   TMeshTesselator = class(TTesselator)
  21.     Vertices, Indices: Pointer;
  22.     NumberOfVertices, NumberOfIndices: Integer;
  23.     constructor Create; override;
  24.     procedure Init; override;
  25.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  27.     function GetMaxVertices: Integer; override;
  28.     function GetMaxIndices: Integer; override;
  30.     function GetBoundingBox: TBoundingBox; override;
  31.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  32.     function SetIndices(IBPTR: Pointer): Integer; override;
  33.   protected
  34.     FVertices, FIndices: Pointer;
  35.   end;
  37.   TMesh = class(TVisible)
  38.     function GetTesselatorClass: CTesselator; override;
  39.     procedure OnSceneLoaded; override;
  40.     procedure AddProperties(const Result: Props.TProperties); override;
  41.     procedure SetProperties(Properties: Props.TProperties); override;
  42.   private
  43.     function GetVerticesRes: TVerticesResource;
  44.     function GetIndicesRes: TIndicesResource;
  45.   protected
  46.     procedure SetMesh; override;
  47.   public
  48.     procedure HandleMessage(const Msg: TMessage); override;
  49.     property Vertices: TVerticesResource read GetVerticesRes;
  50.     property Indices:  TIndicesResource  read GetIndicesRes;
  51.   end;
  53.   TPlaneTesselator = class(TTesselator)
  54.   protected
  55.     FColor: BaseTypes.TColor;
  56.     FWidth, FHeight: Single;
  57.   public  
  58.     Color: BaseTypes.TColor;
  59.     Width, Height: Single;
  60.     constructor Create; override;
  61.     function GetBoundingBox: TBoundingBox; override;
  62.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  63.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  64.   end;
  66.   TPlane = class(TVisible)
  67.   public
  68.     TexScaleU, TexScaleV, TexMoveU, TexMoveV: Single;
  69.     constructor Create(AManager: TItemsManager); override;
  70.     function GetTesselatorClass: CTesselator; override;
  71.     procedure AddProperties(const Result: Props.TProperties); override;
  72.     procedure SetProperties(Properties: Props.TProperties); override;
  73.   end;
  75.   TMirrorPlaneTesselator = class(TTesselator)
  76.   private
  77.     vel, arr: array of single;
  78.   protected
  79.     FColor: BaseTypes.TColor;
  80.     FWidth, FHeight: Single;
  81.     FRows, FCols: Integer;
  82.   public
  83.     Color: BaseTypes.TColor;
  84.     Width, Height: Single;
  85.     Rows, Cols: Integer;
  86.     constructor Create; override;
  87.     procedure Init; override;
  88.     function GetBoundingBox: TBoundingBox; override;
  89.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  90.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  91.     function SetIndices(IBPTR: Pointer): Integer; override;
  93.     procedure Iterate;
  94.   end;
  96.   TMirrorPlane = class(TVisible)
  97.   private
  98.     TexMat: TMatrix4s;
  99.   protected
  100.     procedure RetrieveTexMat(TextureStage: Integer; out Mat: TMatrix4s);
  101.   public
  102.     constructor Create(AManager: TItemsManager); override;
  103.     function VisibilityCheck(const Camera: TCamera): Boolean; override;
  104.     function GetTesselatorClass: CTesselator; override;
  105.     procedure AddProperties(const Result: Props.TProperties); override;
  106.     procedure SetProperties(Properties: Props.TProperties); override;
  108.     procedure Process(const DeltaTime: Single); override;
  109.   end;
  111.   TCircleTesselator = class(TTesselator)
  112.   protected
  113.     FCenterColor, FSideColor: BaseTypes.TColor;
  114.     FRadius: Single;
  115.     FSectors: Integer;
  116.   public  
  117.     CenterColor, SideColor: BaseTypes.TColor;
  118.     Radius: Single;
  119.     Sectors: Integer;
  120.     constructor Create; override;
  121.     procedure Init; override;
  122.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  123.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  124.     function GetBoundingBox: TBoundingBox; override;
  125.   end;
  127.   TCircle = class(TVisible)
  128.   private
  129.     function GetCenterColor: BaseTypes.TColor;
  130.     function GetSideColor: BaseTypes.TColor;
  131.     procedure SetCenterColor(const Value: BaseTypes.TColor);
  132.     procedure SetSideColor(const Value: BaseTypes.TColor);
  133.   public
  134.     AttachedToCamera, FixedY: Boolean;
  135.     TexScaleU, TexScaleV, TexMoveU, TexMoveV: Single;
  136.     function GetTesselatorClass: CTesselator; override;
  137.     procedure AddProperties(const Result: Props.TProperties); override;
  138.     procedure SetProperties(Properties: Props.TProperties); override;
  139.     procedure Process(const DeltaT: Float); override;
  140.   
  141.     property CenterColor: BaseTypes.TColor read GetCenterColor write SetCenterColor;
  142.     property SideColor:   BaseTypes.TColor read GetSideColor   write SetSideColor;
  143.   end;
  145.   TDomeTesselator = class(TTesselator)
  146.   protected
  147.     FSectors, FSegments: Integer;
  148.     FRadius, FHeight, FTexScale: Single;
  149.     FColor: BaseTypes.TColor;
  150.     FSkyMap: BaseTypes.PImageBuffer;
  151.   public  
  152.     // Parameters
  153.     Sectors, Segments: Integer;
  154.     Radius, Height, TexScale: Single;
  155.     Color: BaseTypes.TColor;
  156.     SkyMap: BaseTypes.PImageBuffer;
  157.     // Other
  158.     SMWidth, SMHeight: Integer;
  159.     constructor Create; override;
  160.     procedure Init; override;
  161.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  162.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  163.     function SetIndices(IBPTR: Pointer): Integer; override;
  164.     function GetBoundingBox: TBoundingBox; override;
  165.   end;
  167.   TDome = class(TVisible)
  168.     function GetTesselatorClass: CTesselator; override;
  169.     procedure AddProperties(const Result: Props.TProperties); override;
  170.     procedure SetProperties(Properties: Props.TProperties); override;
  171.   end;
  173.   TSky = class(TDome)
  174.   protected
  175.     procedure ResolveLinks; override;
  176.   public  
  177.     procedure AddProperties(const Result: Props.TProperties); override;
  178.     procedure SetProperties(Properties: Props.TProperties); override;
  179.   end;
  181.   TRingMesh = class(TTesselator)
  182.   protected
  183.     FInnerRadius, FOuterRadius, FFactor: Single;
  184.     FSmoothing: Integer;
  185.     FColor1, FColor2: BaseTypes.TColor;
  186.     FUVMapType: Longword;
  187.   public  
  188.     InnerRadius, OuterRadius, Factor: Single;
  189.     Smoothing: Integer;
  190.     Color1, Color2: BaseTypes.TColor;
  191.     UVMapType: Longword;
  192.     UVFrame: TUV;
  193.     constructor Create; override;
  194.     procedure Init; override;
  195.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  196.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  197.     function GetBoundingBox: TBoundingBox; override;
  198.   end;
  200.   TRing = class(TVisible)
  201.   private
  202.     function GetColor: BaseTypes.TColor;
  203.     procedure SetColor(const Value: BaseTypes.TColor);
  204.   public
  205.     YAngle: Single;
  206.     constructor Create(AManager: TItemsManager); override;
  207.     function VisibilityCheck(const Camera: TCamera): Boolean; override;
  208.     function GetTesselatorClass: CTesselator; override;
  209.     procedure AddProperties(const Result: Props.TProperties); override;
  210.     procedure SetProperties(Properties: Props.TProperties); override;
  211.     property Color: BaseTypes.TColor read GetColor write SetColor;
  212.   end;
  214.   // Returns list of classes introduced by the unit
  215.   function GetUnitClassList: TClassArray;
  217. implementation
  219. function GetUnitClassList: TClassArray;
  220. begin
  221.   Result := GetClassList([TVisible, TMappedItem, TMesh, TPlane, TCircle, TDome, TSky]);
  222. end;
  224. { TMeshTesselator }
  226. constructor TMeshTesselator.Create;
  227. begin
  228.   inherited;
  229.   PrimitiveType := ptTRIANGLELIST;
  230.   Vertices      := nil;
  231.   Indices       := nil;
  232.   FVertices     := nil;
  233.   FIndices      := nil;
  234.   InitVertexFormat(GetVertexFormat(False, True, False, False, False, 0, [2]));
  235.   Init;
  236. end;
  238. procedure TMeshTesselator.Init;
  239. begin
  240.   inherited;
  241.   Invalidate([tbVertex, tbIndex], (TotalVertices <> NumberOfVertices) or (TotalIndices <> NumberOfIndices));
  243.   TotalVertices    := NumberOfVertices;
  244.   TotalIndices     := NumberOfIndices;
  245.   IndexingVertices := TotalVertices;
  246.   TotalPrimitives  := TotalIndices div 3;
  247.   FVertices        := Vertices;
  248.   FIndices         := Indices;
  249. end;
  251. function TMeshTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  252. begin
  253.   Result := (2*SizeOf(Pointer)) div 4;
  254.   if Internal then Parameters := @FVertices else Parameters := @Vertices;
  255. end;
  257. function TMeshTesselator.GetMaxVertices: Integer;
  258. begin
  259.   Result := NumberOfVertices;
  260. end;
  262. function TMeshTesselator.GetMaxIndices: Integer;
  263. begin
  264.   Result := NumberOfIndices;
  265. end;
  267. function TMeshTesselator.GetBoundingBox: TBoundingBox;
  268. var i: Integer;
  269. begin
  270.   if FVertices = nil then Exit;
  271.   Result.P1 := GetVector3s(100000, 100000, 100000); Result.P2 := GetVector3s(-100000, -100000, -100000);
  272.   for i := 0 to TotalVertices-1 do with TVector3s((@TByteBuffer(FVertices^)[i*Integer(FVertexSize)])^), Result do begin
  273.     if X < P1.X then P1.X := X; if Y < P1.Y then P1.Y := Y; if Z < P1.Z then P1.Z := Z;
  274.     if X > P2.X then P2.X := X; if Y > P2.Y then P2.Y := Y; if Z > P2.Z then P2.Z := Z;
  275.   end;
  276. end;
  278. function TMeshTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  279. var i: Integer;
  280. begin
  281.   Result := 0;
  282.   if FVertices = nil then Exit;
  283.   if not CompositeMember then begin
  284.     Move(FVertices^, VBPTR^, TotalVertices * FVertexSize);
  285.   end else begin
  286.     Assert(CompositeOffset <> nil, 'Composite object''s offset is nil');
  287.     for i := 0 to TotalVertices-1 do begin
  288.       Move(TByteBuffer(FVertices^)[i*FVertexSize + SizeOf(TVector3s)], TByteBuffer(VBPTR^)[i*FVertexSize + SizeOf(TVector3s)], FVertexSize - SizeOf(TVector3s));
  289.       TVector3s((@TByteBuffer(VBPTR^)[i*FVertexSize])^).X := TVector3s((@TByteBuffer(FVertices^)[i*FVertexSize])^).X + CompositeOffset^.X;
  290.       TVector3s((@TByteBuffer(VBPTR^)[i*FVertexSize])^).Y := TVector3s((@TByteBuffer(FVertices^)[i*FVertexSize])^).Y + CompositeOffset^.Y;
  291.       TVector3s((@TByteBuffer(VBPTR^)[i*FVertexSize])^).Z := TVector3s((@TByteBuffer(FVertices^)[i*FVertexSize])^).Z + CompositeOffset^.Z;
  292.     end;
  293.   end;
  295.   TesselationStatus[tbVertex].Status := tsTesselated;
  296. //  Status := tsChanged;
  297.   LastTotalIndices := TotalIndices;
  298.   LastTotalVertices := TotalVertices;
  299.   Result := LastTotalVertices;
  300. end;
  302. function TMeshTesselator.SetIndices(IBPTR: Pointer): Integer;
  303. begin
  304.   Result := 0;
  305.   if FIndices = nil then Exit;
  306.   Move(TWordBuffer(FIndices^)[0], TWordBuffer(IBPTR^)[0], TotalIndices * IndexSize);
  307.   LastTotalIndices := TotalIndices;
  308.   TesselationStatus[tbIndex].Status := tsTesselated;
  309.   Result := TotalIndices;
  310. end;
  312. { TPlaneTesselator }
  314. constructor TPlaneTesselator.Create;
  315. begin
  316.   inherited;
  317.   PrimitiveType    := ptTRIANGLESTRIP;
  318.   InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
  320.   TotalVertices    := 4;
  321.   TotalPrimitives  := 2;
  323.   Color.C  := $80808080;
  324.   Width  := 1;
  325.   Height := 1;
  327.   Init;
  328. end;
  330. function TPlaneTesselator.GetBoundingBox: TBoundingBox;
  331. begin
  332.   Result.P1 := GetVector3s(-Width, -Height, 0);
  333.   Result.P2 := GetVector3s( Width,  Height, 0);
  334. end;
  336. function TPlaneTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  337. begin
  338.   Result := (1*SizeOf(Longword) + 2*SizeOf(Single)) div 4;
  339.   if Internal then Parameters := @FColor else Parameters := @Color;
  340. end;
  342. function TPlaneTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  343. begin
  344.   SetVertexDataC(-FWidth, FHeight, 0, 0, VBPTR);
  345.   SetVertexDataUV(0, 0, 0, VBPTR);
  346.   SetVertexDataD(FColor, 0, VBPTR);
  348.   SetVertexDataC(FWidth, FHeight, 0, 1, VBPTR);
  349.   SetVertexDataUV(1, 0, 1, VBPTR);
  350.   SetVertexDataD(FColor, 1, VBPTR);
  352.   SetVertexDataC(-FWidth, -FHeight, 0, 2, VBPTR);
  353.   SetVertexDataUV(0, 1, 2, VBPTR);
  354.   SetVertexDataD(FColor, 2, VBPTR);
  356.   SetVertexDataC(FWidth, -FHeight, 0, 3, VBPTR);
  357.   SetVertexDataUV(1, 1, 3, VBPTR);
  358.   SetVertexDataD(FColor, 3, VBPTR);
  360.   TesselationStatus[tbVertex].Status := tsTesselated;
  361.   LastTotalVertices := TotalVertices;
  362.   Result            := TotalVertices;
  363. end;
  365. { TPlane }
  367. constructor TPlane.Create(AManager: TItemsManager);
  368. begin
  369.   inherited;
  370.   TexScaleU := 1; TexScaleV := 1; TexMoveU := 1; TexMoveV := 1;
  371. end;
  373. function TPlane.GetTesselatorClass: CTesselator; begin Result := TPlaneTesselator; end;
  375. procedure TPlane.AddProperties(const Result: Props.TProperties);
  376. var Tesselator: TPlaneTesselator;
  377. begin
  378.   inherited;
  379.   if not Assigned(Result) then Exit;
  381.   Result.Add('Texturescale U', vtSingle, [], FloatToStr(TexScaleU), '');
  382.   Result.Add('Texturescale V', vtSingle, [], FloatToStr(TexScaleV), '');
  383.   Result.Add('Texturemove U',  vtSingle, [], FloatToStr(TexMoveU),  '');
  384.   Result.Add('Texturemove V',  vtSingle, [], FloatToStr(TexMoveV),  '');
  386.   if not (CurrentTesselator is TPlaneTesselator) then Exit;
  387.   Tesselator := CurrentTesselator as TPlaneTesselator;
  389.   AddColorProperty(Result, 'Color', Tesselator.Color);
  390.   Result.Add('GeometryWidth',  vtSingle, [],       FloatToStr(Tesselator.Width),   '');
  391.   Result.Add('GeometryHeight', vtSingle, [],       FloatToStr(Tesselator.Height),  '');
  392. end;
  394. procedure TPlane.SetProperties(Properties: Props.TProperties);
  395. var Tesselator: TPlaneTesselator;
  396. begin
  397.   inherited;
  399.   if Properties.Valid('Texturescale U') then TexScaleU := StrToFloatDef(Properties['Texturescale U'], 1);
  400.   if Properties.Valid('Texturescale V') then TexScaleV := StrToFloatDef(Properties['Texturescale V'], 1);
  401.   if Properties.Valid('Texturemove U')  then TexMoveU  := StrToFloatDef(Properties['Texturemove U'],  1);
  402.   if Properties.Valid('Texturemove V')  then TexMoveV  := StrToFloatDef(Properties['Texturemove V'],  1);
  404.   if not (CurrentTesselator is TPlaneTesselator) then Exit;
  405.   Tesselator := CurrentTesselator as TPlaneTesselator;
  407.   SetColorProperty(Properties, 'Color', Tesselator.Color);
  408.   if Properties.Valid('GeometryWidth')  then Tesselator.Width  := StrToFloatDef(Properties['GeometryWidth'],  1);
  409.   if Properties.Valid('GeometryHeight') then Tesselator.Height := StrToFloatDef(Properties['GeometryHeight'], 1);
  411.   SetMesh;
  412. end;
  414. { TMirrorPlaneTesselator }
  416. constructor TMirrorPlaneTesselator.Create;
  417. begin
  418.   inherited;
  419.   Cols := 1; Rows := 1;
  421.   Color.C  := $80808080;
  422.   Width    := 1;
  423.   Height   := 1;
  425.   Init;
  426. end;
  428. function TMirrorPlaneTesselator.GetBoundingBox: TBoundingBox;
  429. begin
  430.   Result.P1 := GetVector3s(-Width, -Height, 0);
  431.   Result.P2 := GetVector3s( Width,  Height, 0);
  432. end;
  434. procedure TMirrorPlaneTesselator.Init;
  435. begin
  436.   inherited;
  437.   TotalVertices   := (FRows+1)*(FCols+1);
  438.   TotalIndices    :=  FRows * FCols * 6;
  439.   TotalPrimitives :=  FRows * FCols * 2;
  440.   IndexingVertices := TotalVertices;
  441.   PrimitiveType    := ptTRIANGLELIST;
  442.   InitVertexFormat(GetVertexFormat(False, True, True, False, False, 0, []));
  444.   SetLength(arr, TotalVertices);
  445.   SetLength(Vel, TotalVertices);
  446.   FillChar(arr[0], TotalVertices*4, 0);
  447.   FillChar(vel[0], TotalVertices*4, 0);
  449.   arr[Random(FRows) * FCols + Random(FCols)] := 1550;
  450. end;
  452. procedure TMirrorPlaneTesselator.Iterate;
  453. var i, j: Integer;
  454. begin
  455.   arr[Random(FRows) * FCols + Random(FCols)] := 1550;
  456.   for j := 1 to FRows-2 do begin
  457.     for i := 1 to FCols-2 do begin
  458.       vel[j * FCols + i] := vel[j * FCols + i] - arr[j * FCols + i]*4 +
  459.                             arr[(j+1) * FCols + i] + arr[(j-1) * FCols + i] +
  460.                             arr[j * FCols + i + 1] + arr[j * FCols + i - 1];
  461.     end;
  462.   end;
  463.   for j := 0 to FRows-1 do begin
  464.     for i := 0 to FCols-1 do begin
  465.       arr[j * FCols + i] := arr[j * FCols + i] + Vel[j * FCols + i] * 0.5;
  466. //      arr[j * FCols + i] := MinS(255, MaxS(0, arr[j * FCols + i]));
  467.       if arr[j * FCols + i]>255 then arr[j * FCols + i] := 255;
  468.       if arr[j * FCols + i]<0 then arr[j * FCols + i] := 0;
  469.     end;
  470.   end;
  471. end;
  473. function TMirrorPlaneTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  474. begin
  475.   Result := (1*SizeOf(FColor) + 4*SizeOf(FWidth)) div 4;
  476.   if Internal then Parameters := @FColor else Parameters := @Color;
  477. end;
  479. function TMirrorPlaneTesselator.SetIndices(IBPTR: Pointer): Integer;
  480. var i, j: Integer;
  481. begin
  482.   TotalPrimitives := 0;
  483.   for j := 0 to FRows-1 do for i := 0 to FCols-1 do begin
  484.     TWordBuffer(IBPTR^)[TotalPrimitives*3+0] :=  j    * (FCols+1) + i;
  485.     TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * (FCols+1) + i;
  486.     TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := (j+1) * (FCols+1) + i+1;
  487.     TWordBuffer(IBPTR^)[TotalPrimitives*3+3] :=  j    * (FCols+1) + i;
  488.     TWordBuffer(IBPTR^)[TotalPrimitives*3+4] := (j+1) * (FCols+1) + i+1;
  489.     TWordBuffer(IBPTR^)[TotalPrimitives*3+5] :=  j    * (FCols+1) + i+1;
  490.     Inc(TotalPrimitives, 2);
  491.   end;
  492.   TesselationStatus[tbIndex].Status := tsTesselated;
  493.   Result  := TotalIndices;
  494.   LastTotalIndices := TotalIndices;
  495. end;
  497. function TMirrorPlaneTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  498. var i, j: Integer;
  499. begin
  500. {  SetVertexDataC(  -FWidth, FHeight, 0, 0, VBPTR);
  501.   SetVertexDataD(FColor, 0, VBPTR);
  503.   SetVertexDataC(  FWidth, FHeight, 0, 1, VBPTR);
  504.   SetVertexDataD(FColor, 1, VBPTR);
  506.   SetVertexDataC(  -FWidth, -FHeight, 0, 2, VBPTR);
  507.   SetVertexDataD(FColor, 2, VBPTR);
  509.   SetVertexDataC(  FWidth, -FHeight, 0, 3, VBPTR);
  510.   SetVertexDataD(FColor, 3, VBPTR);}
  512.   for j := 0 to FRows do for i := 0 to FCols do begin
  513.     SetVertexDataC((0.5 - i / FCols) * FWidth,
  514.                    Arr[j * FCols + i]/250,
  515.                    (0.5 - j / FRows) * FHeight,
  517.                    j * (FCols+1) + i, VBPTR);
  518.     SetVertexDataD(FColor, j * (FCols+1) + i, VBPTR);
  519.     SetVertexDataN(0, 0, -1, j * (FCols+1) + i, VBPTR);
  520.   end;
  522.   TesselationStatus[tbVertex].Status := tsTesselated;
  523.   Result  := TotalVertices;
  524.   IndexingVertices  := TotalVertices;
  525.   LastTotalVertices := TotalVertices;
  526. end;
  528. { TMirrorPlane }
  530. function TMirrorPlane.VisibilityCheck(const Camera: TCamera): Boolean;
  531. var
  532. //  BiasMat,
  533.   Mat: TMatrix4s; Cam: TCamera;
  534. //  Light: TLight;
  535. //  offset: Single; t: Cardinal;
  536. begin
  537.   Result := inherited VisibilityCheck(Camera);
  538.   Exit;
  539.   // Adjust texture matrix
  540. //  Light := FManager.Root.GetChildByPath('Root itemLight1') as TLight;
  542. //  Cam := Light.Childs[0] as TCamera;
  543. //  Cam := TCore(FManager).Renderer.MainCamera;
  544.   Cam := Childs[0] as TCamera;
  546.   Mat := IdentityMatrix4s;
  548. //  Mat := FTransform;
  550. {//  Mat := MulMatrix4s(Mat, InvertAffineMatrix4s(Camera.ViewMatrix));
  551.   Mat := MulMatrix4s(Mat, Cam.ViewMatrix);
  553.   Mat := MulMatrix4s(Mat, Cam.ProjMatrix);}
  555. //    Mat := MulMatrix4s(Mat, InvertAffineMatrix4s(Cam.ViewMatrix));
  556. //    Mat := MulMatrix4s(Mat, Cam.ViewMatrix);
  558.     Mat := MulMatrix4s(Mat, Cam.ProjMatrix);
  560. (*  offset := 0.5 + (0.5 / Cam.RenderTargetWidth);                                 // +Height ?
  561.   t := 1 shl 24-1;
  562.   biasMat._11:=0.5; biasMat._12:=0.0; biasMat._13:=0.0; biasMat._14:=0.0;
  563.   biasMat._21:=0.0; biasMat._22:=-0.5; biasMat._23:=0.0; biasMat._24:=0.0;
  564.   biasMat._31:=0.0; biasMat._32:=0.0; biasMat._33:=1 shl 24-1{Single((@t)^)}; biasMat._34:=0.0;
  565.   biasMat._41:=offset; biasMat._42:=offset; biasMat._43:=5.00400000; biasMat._44:=1.0;
  567.   Mat := MulMatrix4s(Mat, BiasMat);*)
  569.   Mat := MulMatrix4s(Mat, ScaleMatrix4s(0.5, -0.5, 1));
  570.   Mat := MulMatrix4s(Mat, TranslationMatrix4s(0.5, 0.5, 0));
  572.   TexMat := Mat;
  573. end;
  575. constructor TMirrorPlane.Create(AManager: TItemsManager);
  576. begin
  577.   inherited;
  578. end;
  580. function TMirrorPlane.GetTesselatorClass: CTesselator; begin Result := TMirrorPlaneTesselator; end;
  582. procedure TMirrorPlane.AddProperties(const Result: TProperties);
  583. var Tesselator: TMirrorPlaneTesselator;
  584. begin
  585.   inherited;
  586.   if not Assigned(Result) then Exit;
  588.   if not (CurrentTesselator is TMirrorPlaneTesselator) then Exit;
  589.   Tesselator := CurrentTesselator as TMirrorPlaneTesselator;
  591.   AddColorProperty(Result, 'Color', Tesselator.Color);
  592.   Result.Add('GeometryWidth',  vtSingle, [], FloatToStr(Tesselator.Width),  '');
  593.   Result.Add('GeometryHeight', vtSingle, [], FloatToStr(Tesselator.Height), '');
  594.   Result.Add('GeometryRows',   vtInt,    [], IntToStr(Tesselator.Rows),     '');
  595.   Result.Add('GeometryCols',   vtInt,    [], IntToStr(Tesselator.Cols),     '');
  596. end;
  598. procedure TMirrorPlane.SetProperties(Properties: TProperties);
  599. var Tesselator: TMirrorPlaneTesselator;
  600. begin
  601.   inherited;
  602.   if not (CurrentTesselator is TMirrorPlaneTesselator) then Exit;
  603.   Tesselator := CurrentTesselator as TMirrorPlaneTesselator;
  605.   SetColorProperty(Properties, 'Color', Tesselator.Color);
  606.   if Properties.Valid('GeometryWidth')  then Tesselator.Width  := StrToFloatDef(Properties['GeometryWidth'],  1);
  607.   if Properties.Valid('GeometryHeight') then Tesselator.Height := StrToFloatDef(Properties['GeometryHeight'], 1);
  608.   if Properties.Valid('GeometryRows')   then Tesselator.Rows   := StrToIntDef(Properties['GeometryRows'],     1);
  609.   if Properties.Valid('GeometryCols')   then Tesselator.Cols   := StrToIntDef(Properties['GeometryCols'],     1);
  611.   SetMesh;
  613.   RetrieveTextureMatrix := {$IFDEF OBJFPCEnable}@{$ENDIF}RetrieveTexMat;
  614. end;
  616. procedure TMirrorPlane.RetrieveTexMat(TextureStage: Integer; out Mat: TMatrix4s);
  617. begin
  618.   Mat := TexMat;
  619. end;
  621. procedure TMirrorPlane.Process(const DeltaTime: Single);
  622. begin
  623.   inherited;
  624.   (CurrentTesselator as TMirrorPlaneTesselator).Iterate;
  625. end;
  627. { TCircleTesselator }
  629. constructor TCircleTesselator.Create;
  630. begin
  631.   inherited;
  632.   PrimitiveType := ptTRIANGLEFAN;
  633.   InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
  635.   CenterColor.C := $80808080;
  636.   SideColor.C   := $80808080;
  637.   Sectors       := 6;
  638.   Radius        := 1;
  639.   Init;
  640. end;
  642. procedure TCircleTesselator.Init;
  643. begin
  644.   inherited;
  645.   Invalidate([tbVertex, tbIndex], TotalPrimitives <> FSectors);
  646.   TotalVertices   := 1+FSectors+1;
  647.   TotalPrimitives := FSectors;  
  648. end;
  650. function TCircleTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  651. begin
  652.   Result := (2*SizeOf(Longword) + 1*SizeOf(Integer) + 1*SizeOf(Single)) div 4;
  653.   if Internal then Parameters := @FCenterColor else Parameters := @CenterColor;
  654. end;
  656. function TCircleTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  657. var i: Integer;
  658. begin
  659.   SetVertexDataC(0, 0, 0, 0, VBPTR);
  660.   SetVertexDataUV(0.5, 0.5, 0, VBPTR);
  661.   SetVertexDataD(FCenterColor, 0, VBPTR);
  663.   for i := 0 to FSectors do begin
  664.     SetVertexDataC(FRadius*Cos(i/FSectors*2*pi), 0, FRadius*Sin(i/FSectors*2*pi), i+1, VBPTR);
  665.     SetVertexDataUV(0.5 + 0.5*Cos(i/FSectors*2*pi*1), 0.5 + 0.5*Sin(i/FSectors*2*pi*1), i+1, VBPTR);
  666.     SetVertexDataD(FSideColor, i+1, VBPTR);
  667.   end;
  669.   TesselationStatus[tbVertex].Status := tsTesselated;
  670.   Result            := TotalVertices;
  671.   LastTotalVertices := TotalVertices;
  672. end;
  674. function TCircleTesselator.GetBoundingBox: TBoundingBox;
  675. begin
  676.   Result.P1 := GetVector3s(-Radius, 0, -Radius);
  677.   Result.P2 := GetVector3s( Radius, 0,  Radius);
  678. end;
  680. { TCircle }
  682. function TCircle.GetTesselatorClass: CTesselator; begin Result := TCircleTesselator; end;
  684. procedure TCircle.AddProperties(const Result: Props.TProperties);
  685. var Tesselator: TCircleTesselator;
  686. begin
  687.   inherited;
  688.   if not Assigned(Result) then Exit;
  689.   AddColorProperty(Result, 'ColorCenter', CenterColor);
  690.   AddColorProperty(Result, 'ColorSide',   SideColor);
  692.   Result.Add('TextureScale U', vtSingle, [], FloatToStr(TexScaleU), '');
  693.   Result.Add('TextureScale V', vtSingle, [], FloatToStr(TexScaleV), '');
  694.   Result.Add('TextureMove U',  vtSingle, [], FloatToStr(TexMoveU),  '');
  695.   Result.Add('TextureMove V',  vtSingle, [], FloatToStr(TexMoveV),  '');
  697.   if not (CurrentTesselator is TCircleTesselator) then Exit;
  698.   Tesselator := CurrentTesselator as TCircleTesselator;
  700.   Result.Add('GeometryRadius',  vtSingle, [], FloatToStr(Tesselator.Radius), '');
  701.   Result.Add('GeometrySectors', vtInt,    [], IntToStr(Tesselator.Sectors), '');
  702. end;
  704. procedure TCircle.SetProperties(Properties: Props.TProperties);
  705. var Tesselator: TCircleTesselator; C: BaseTypes.TColor;
  706. begin
  707.   inherited;
  708.   C := CenterColor;
  709.   SetColorProperty(Properties, 'ColorCenter', C);
  710.   CenterColor := C;
  711.   C := SideColor;
  712.   SetColorProperty(Properties, 'ColorSide',   C);
  713.   SideColor := C;
  715.   if Properties.Valid('TextureScale U') then TexScaleU := StrToFloatDef(Properties['TextureScale U'], 1.00);
  716.   if Properties.Valid('TextureScale V') then TexScaleV := StrToFloatDef(Properties['TextureScale V'], 1.00);
  717.   if Properties.Valid('TextureMove U')  then TexMoveU  := StrToFloatDef(Properties['TextureMove U'],  0.01);
  718.   if Properties.Valid('TextureMove V')  then TexMoveV  := StrToFloatDef(Properties['TextureMove V'],  0.00);
  720.   if not (CurrentTesselator is TCircleTesselator) then Exit;
  721.   Tesselator := CurrentTesselator as TCircleTesselator;
  723.   if Properties.Valid('GeometryRadius')  then Tesselator.Radius  := StrToFloatDef(Properties['GeometryRadius'], 1);
  724.   if Properties.Valid('GeometrySectors') then Tesselator.Sectors := StrToIntDef(Properties['GeometrySectors'], 6);
  726.   SetMesh;
  727. end;
  729. procedure TCircle.Process(const DeltaT: Float);
  730. begin
  731.   inherited;
  733. {  Mesh.UOfs := BasicUOfs + CurUOfs;
  734.   CurUOfs := CurUOfs + Mesh.UShift;
  735.   if Mesh.UOfs > 2 then CurUOfs := CurUOfs-2;
  737.   Mesh.VOfs := BasicVOfs + CurVOfs;
  738.   CurVOfs := CurVOfs + Mesh.VShift;
  739.   if Mesh.VOfs > 2 then CurVOfs := CurVOfs-2;}
  740. end;
  742. function TCircle.GetCenterColor: BaseTypes.TColor;
  743. begin
  744.   if CurrentTesselator is TCircleTesselator then
  745.    Result := TCircleTesselator(CurrentTesselator).CenterColor else
  746.     Result.C := 0;
  747. end;
  749. function TCircle.GetSideColor: BaseTypes.TColor;
  750. begin
  751.   if CurrentTesselator is TCircleTesselator then
  752.    Result := TCircleTesselator(CurrentTesselator).SideColor else
  753.     Result.C := 0;
  754. end;
  756. procedure TCircle.SetCenterColor(const Value: BaseTypes.TColor);
  757. begin
  758.   if not (CurrentTesselator is TCircleTesselator) then Exit;
  759.   TCircleTesselator(CurrentTesselator).CenterColor := Value;
  760.   CurrentTesselator.Invalidate([tbVertex], False);
  761. end;
  763. procedure TCircle.SetSideColor(const Value: BaseTypes.TColor);
  764. begin
  765.   if not (CurrentTesselator is TCircleTesselator) then Exit;
  766.   TCircleTesselator(CurrentTesselator).SideColor := Value;
  767.   CurrentTesselator.Invalidate([tbVertex], False);
  768. end;
  770. { TDomeTesselator }
  772. constructor TDomeTesselator.Create;
  773. begin
  774.   inherited;
  775. //  PrimitiveType    := ptTRIANGLESTRIP;
  776.   InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
  778.   Sectors  := 8;
  779.   Segments := 4;
  780.   Radius   := 1;
  781.   Height   := 1;
  782.   TexScale := 1;
  783.   Color.C  := $FF808080;
  784.   SkyMap   := nil;
  785.   Init;
  787.   SMWidth  := 0;
  788.   SMHeight := 0;
  789. end;
  791. procedure TDomeTesselator.Init;
  792. begin
  793.   inherited;
  794.   Invalidate([tbVertex, tbIndex], TotalVertices <> (FSegments+1) * (FSectors+1));
  795.   TotalVertices    := (FSegments+1) * (FSectors+1);
  796.   TotalIndices     := (FSegments  ) * (FSectors  )*2*3;
  797.   TotalPrimitives  := (FSegments  ) * (FSectors  )*2+0*2*(FSegments-1);
  798.   IndexingVertices := TotalVertices;
  799. end;
  801. function TDomeTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  802. begin
  803.   Result := (1*SizeOf(Longword) + 2*SizeOf(Integer) + 3*SizeOf(Single) + 1*SizeOf(Pointer)) div 4;
  804.   if Internal then Parameters := @FSectors else Parameters := @Sectors;
  805. end;
  807. function TDomeTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  808. var i, j, si, sj, SMXI, SMYI: Integer; U, V, SMYO: Single;
  809. begin
  810.   Result := 0;
  811.   if FSegments = 0 then Exit;
  812.   for j := 0 to FSegments do for i := 0 to FSectors do begin
  813. //    X := Radius*Cos(i/Sectors*2*pi)*Cos(j/(Segments)*pi/2);
  814.     si := i*(SinTableSize) div FSectors;
  815.     sj := j*(SinTableSize) div FSegments shr 2;
  817.     SetVertexDataC(FRadius*SinTable[si+CosTabOffs]*SinTable[sj+CosTabOffs],
  818.                    SinTable[sj] * FHeight,
  819.                    FRadius*SinTable[si] * SinTable[sj + CosTabOffs],
  820.                    j*(FSectors+1)+i, VBPTR);
  822.     U := 0.5 + 0.5*(FSegments-j)/FSegments*SinTable[si + CosTabOffs];
  823.     V := 0.5 + 0.5*(FSegments-j)/FSegments*SinTable[si];
  825.     SetVertexDataUV(U * FTexScale, V * FTexScale, j*(FSectors+1)+i, VBPTR);
  827.     if FSkyMap <> nil then begin
  828.       SMXI := Trunc(U * (SMWidth-1));
  829.       SMYI := Trunc(V * (SMHeight-1));
  830.       SMYO := Frac(V * (SMHeight-1));
  831.       SetVertexDataD(BlendColor(BlendColor(FSkyMap^[SMYI*SMWidth+SMXI], FSkyMap^[((SMYI+1) and (SMHeight-1))*SMWidth+SMXI], SMYO),
  832.                                 BlendColor(FSkyMap^[SMYI*SMWidth+(SMXI+1) and (SMWidth-1)], FSkyMap^[((SMYI+1) and (SMHeight-1))*SMWidth+(SMXI+1) and (SMWidth-1)], SMYO),
  833.                                 Frac (U * (SMWidth-1))), j*(FSectors+1)+i, VBPTR);
  834.     end else SetVertexDataD(FColor, j*(FSectors+1)+i, VBPTR);
  835.   end;
  836.   TesselationStatus[tbVertex].Status := tsTesselated;
  837.   Result            := TotalVertices;
  838.   LastTotalVertices := TotalVertices;
  839. end;
  841. function TDomeTesselator.SetIndices(IBPTR: Pointer): Integer;
  842. var i, j: Integer;
  843. begin
  844.   for j := 0 to FSegments-1 do begin
  845.     for i := 0 to FSectors-1 do begin
  846.       TWordBuffer(IBPTR^)[(j*(FSectors+0)+i)*6+0] := (j+0)*(FSectors+1)+i;
  847.       TWordBuffer(IBPTR^)[(j*(FSectors+0)+i)*6+1] := (j+1)*(FSectors+1)+i;
  848.       TWordBuffer(IBPTR^)[(j*(FSectors+0)+i)*6+2] := (j+0)*(FSectors+1)+i+1;
  849.       TWordBuffer(IBPTR^)[(j*(FSectors+0)+i)*6+3] := (j+1)*(FSectors+1)+i;
  850.       TWordBuffer(IBPTR^)[(j*(FSectors+0)+i)*6+4] := (j+1)*(FSectors+1)+i+1;
  851.       TWordBuffer(IBPTR^)[(j*(FSectors+0)+i)*6+5] := (j+0)*(FSectors+1)+i+1
  852.     end;
  853.   end;
  854.   TesselationStatus[tbIndex].Status := tsTesselated;
  855.   Result  := TotalIndices;
  856. end;
  858. function TDomeTesselator.GetBoundingBox: TBoundingBox;
  859. begin
  860.   Result.P1 := GetVector3s(-Radius, 0,      -Radius);
  861.   Result.P2 := GetVector3s( Radius, Height,  Radius);
  862. end;
  864. { TDome }
  866. procedure TDome.AddProperties(const Result: Props.TProperties);
  867. var Tesselator: TDomeTesselator;
  868. begin
  869.   inherited;
  870.   if not Assigned(Result) then Exit;
  872.   if not (CurrentTesselator is TDomeTesselator) then Exit;
  873.   Tesselator := CurrentTesselator as TDomeTesselator;
  875.   AddColorProperty(Result, 'Color', Tesselator.Color);
  876.   Result.Add('GeometrySectors',       vtInt,    [],       IntToStr(Tesselator.Sectors),   '3-256');
  877.   Result.Add('GeometrySegments',      vtInt,    [],       IntToStr(Tesselator.Segments),  '1-16');
  878.   Result.Add('GeometryRadius',        vtSingle, [],       FloatToStr(Tesselator.Radius),   '');
  879.   Result.Add('GeometryHeight',        vtSingle, [],       FloatToStr(Tesselator.Height),   '');
  880.   Result.Add('TextureScale',          vtSingle, [],       FloatToStr(Tesselator.TexScale), '');
  881. end;
  883. function TDome.GetTesselatorClass: CTesselator; begin Result := TDomeTesselator; end;
  885. procedure TDome.SetProperties(Properties: Props.TProperties);
  886. var Tesselator: TDomeTesselator;
  887. begin
  888.   inherited;
  890.   if not (CurrentTesselator is TDomeTesselator) then Exit;
  891.   Tesselator := CurrentTesselator as TDomeTesselator;
  893.   SetColorProperty(Properties, 'Color', Tesselator.Color);
  894.   if Properties.Valid('GeometrySectors')  then Tesselator.Sectors  := StrToIntDef(Properties['GeometrySectors'],        8);
  895.   if Properties.Valid('GeometrySegments') then Tesselator.Segments := StrToIntDef(Properties['GeometrySegments'],       4);
  896.   if Properties.Valid('GeometryRadius')   then Tesselator.Radius   := StrToFloatDef(Properties['GeometryRadius'],        1);
  897.   if Properties.Valid('GeometryHeight')   then Tesselator.Height   := StrToFloatDef(Properties['GeometryHeight'],        1);
  898.   if Properties.Valid('TextureScale')     then Tesselator.TexScale := StrToFloatDef(Properties['TextureScale'],          1);
  900.   SetMesh;
  901. end;
  903. { TSky }
  905. procedure TSky.ResolveLinks;
  906. var Tesselator: TDomeTesselator; SMRes: TItem;
  907. begin
  908.   if not (CurrentTesselator is TDomeTesselator) then Exit;
  909.   Tesselator := CurrentTesselator as TDomeTesselator;
  911.   if ResolveLink('ColorSky map', SMRes) then begin
  912.     Tesselator.SkyMap   := (SMRes as TImageResource).Data;
  913.     Tesselator.SMWidth  := (SMRes as TImageResource).Width;
  914.     Tesselator.SMHeight := (SMRes as TImageResource).Height;
  915.     SetMesh;
  916.   end;
  917.   if SMRes = nil then Tesselator.SkyMap := nil;
  918. end;
  920. procedure TSky.AddProperties(const Result: Props.TProperties);
  921. begin
  922.   inherited;
  923.   AddItemLink(Result, 'ColorSky map', [], 'TImageResource');
  924. end;
  926. procedure TSky.SetProperties(Properties: Props.TProperties);
  927. begin
  928.   inherited;
  929.   if Properties.Valid('ColorSky map') then SetLinkProperty('ColorSky map', Properties['ColorSky map']);
  930.   ResolveLinks;
  931.   SetMesh;
  932. end;
  934. { TMesh }
  936. function TMesh.GetTesselatorClass: CTesselator; begin Result := TMeshTesselator end;
  938. procedure TMesh.OnSceneLoaded;
  939. begin
  940.   inherited;
  941.   SetMesh;
  942. end;
  944. procedure TMesh.SetMesh;
  945. var Tesselator: TMeshTesselator;
  947.   procedure ResetMesh;
  948.   begin
  949.     Tesselator.Vertices         := nil;
  950.     Tesselator.NumberOfVertices := 0;
  951.     Tesselator.Indices          := nil;
  952.     Tesselator.NumberOfIndices  := 0;
  953.   end;
  955. begin
  956.   if (CurrentTesselator is TMeshTesselator) then begin
  957.     Tesselator := CurrentTesselator as TMeshTesselator;
  959.     ResetMesh;
  960.     if Vertices <> nil then begin
  961.       if (Integer(GetVertexSize(Vertices.Format)) * Vertices.TotalElements = Vertices.DataSize) then begin   // Simple validity check
  962.         Tesselator.Vertices         := Vertices.Data;
  963.         Tesselator.VertexFormat     := Vertices.Format;
  964.         Tesselator.NumberOfVertices := Vertices.TotalElements;
  965.       end else Log.Log('TMesh("' + Name + '").SetMesh: Invalid vertices resource "' + Vertices.Name + '"', lkError);
  966.     end;
  968.     if Indices <> nil then begin
  969.       Tesselator.Indices         := Indices.Data;
  970.       Tesselator.NumberOfIndices := Indices.TotalElements;
  971.     end;
  973. (*    if not Tesselator.Validate then begin
  974.       ResetMesh;
  975.       Log.Log(Format('%S("%S").%S: The mesh did not pass validation', [ClassName, Name, 'ResetIndices']), lkError); 
  976.     end;*)
  977.   end;
  978.   inherited;
  979. end;
  981. procedure TMesh.AddProperties(const Result: Props.TProperties);
  982. begin
  983.   inherited;
  985.   AddItemLink(Result, 'GeometryVertices', [], 'TVerticesResource');
  986.   AddItemLink(Result, 'GeometryIndices',  [], 'TIndicesResource');
  987. end;
  989. procedure TMesh.SetProperties(Properties: Props.TProperties);
  990. begin
  991.   inherited;
  993.   if Properties.Valid('GeometryVertices') then SetLinkProperty('GeometryVertices', Properties['GeometryVertices']);
  994.   if Properties.Valid('GeometryIndices')  then SetLinkProperty('GeometryIndices',  Properties['GeometryIndices']);
  996.   SetMesh;
  997. end;
  999. function TMesh.GetVerticesRes: TVerticesResource;
  1000. var Item: TItem;
  1001. begin
  1002.   if ResolveLink('GeometryVertices', Item) then
  1003.     Result := Item as TVerticesResource else
  1004.       if Item is TVerticesResource then
  1005.         Result := Item as TVerticesResource else
  1006.           Result := nil;
  1007. end;
  1009. function TMesh.GetIndicesRes: TIndicesResource;
  1010. var Item: TItem;
  1011. begin
  1012.   if ResolveLink('GeometryIndices', Item) then
  1013.     Result := Item as TIndicesResource else
  1014.       if Item is TIndicesResource then
  1015.         Result := Item as TIndicesResource else
  1016.           Result := nil;
  1017. end;
  1019. procedure TMesh.HandleMessage(const Msg: TMessage);
  1020. begin
  1021.   inherited;
  1022.   if Msg.ClassType = TDataAdressChangeMsg then
  1023.     with TDataAdressChangeMsg(Msg) do SetMesh;
  1024. end;
  1026. { TRingMesh }
  1028. const uvtPlanar = 0; uvtRadial = 1;    // Ring UV mapping types
  1030. constructor TRingMesh.Create;
  1031. begin
  1032.   inherited;
  1033.   PrimitiveType := ptTRIANGLESTRIP;
  1034.   InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
  1036.   InnerRadius := 0.8;
  1037.   OuterRadius := 1;
  1038.   Factor      := 0.5;
  1039.   Smoothing   := 8;
  1040.   Color1.C    := $80FF0000;
  1041.   Color2.C    := $800000FF;
  1042.   UVMapType   := uvtPlanar;
  1043.   UVFrame.U := 0; UVFrame.V := 0; UVFrame.W := 1; UVFrame.H := 1;
  1044.   Init;
  1045. end;
  1047. procedure TRingMesh.Init;
  1048. begin
  1049.   inherited;
  1050.   Invalidate([tbVertex, tbIndex], TotalVertices <> (Smoothing+1)*2);
  1052.   TotalVertices   := (Smoothing+1)*2;
  1053.   TotalIndices    := 0;
  1054.   TotalPrimitives := Smoothing*2;
  1055.   IndexingVertices := TotalVertices;
  1056. end;
  1058. function TRingMesh.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  1059. begin
  1060.   Result := (3*SizeOf(Longword) + 1*SizeOf(Integer) + 3*SizeOf(Single)) div 4;
  1061.   if Internal then Parameters := @FInnerRadius else Parameters := @InnerRadius;
  1062. end;
  1064. function TRingMesh.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  1065. var i: Integer; t, t1, t2, w, oos, sw, f: Single; Col: BaseTypes.TColor;
  1066. begin
  1067.   oos := 1/FSmoothing;
  1068.   if FFactor < 1 then begin
  1069.     sw := 1 - FFactor;
  1070.     f  := 1 / FFactor;
  1071.   end else begin
  1072.     sw := 0;
  1073.     f  := FFactor;
  1074.   end;
  1075.   if Abs(FOuterRadius) > Epsilon then t := 0.5 / FOuterRadius else t := 0;
  1076.   for i := 0 to Smoothing do begin              // Outer edge
  1077. //    w := Abs(Smoothing*0.5 - i)*2*oos * Factor;
  1078.     w := (Abs(FSmoothing*0.5 - i)*2*oos  - sw) * f;
  1079.     Col := BlendColor(FColor2, FColor1, w);
  1080. //   c1 --------- c2 --------- c1
  1081.     t1 := Cos(i/180*pi*360*oos); t2 := Sin(i/180*pi*360*oos);
  1082.     SetVertexDataC(t1*FOuterRadius, 0, t2*FOuterRadius, i*2, VBPTR);
  1083.     SetVertexDataD(Col, i*2, VBPTR);
  1085.     SetVertexDataC(t1*FInnerRadius, 0, t2*FInnerRadius, i*2+1, VBPTR);
  1086.     SetVertexDataD(Col, i*2+1, VBPTR);
  1088.     if FUVMapType = uvtPlanar then begin
  1089.       SetVertexDataUV(UVFrame.U + (i * oos) * UVFrame.W, UVFrame.V, i*2, VBPTR);
  1090.       SetVertexDataUV(UVFrame.U + (i * oos) * UVFrame.W, UVFrame.V + UVFrame.H, i*2+1, VBPTR);
  1091.     end else begin
  1092.       SetVertexDataUV(0.5 + t1 * FOuterRadius * t, 0.5 - t2 * FOuterRadius * t, i*2, VBPTR);
  1093.       SetVertexDataUV(0.5 + t1 * FInnerRadius * t, 0.5 - t2 * FInnerRadius * t, i*2+1, VBPTR);
  1094.     end;
  1095.   end;
  1097.   TesselationStatus[tbVertex].Status := tsTesselated;
  1098.   Result := TotalVertices;
  1099.   LastTotalVertices := TotalVertices;
  1100. end;
  1102. function TRingMesh.GetBoundingBox: TBoundingBox;
  1103. begin
  1104.   Result.P1 := GetVector3s(-OuterRadius, 0, -OuterRadius);
  1105.   Result.P2 := GetVector3s( OuterRadius, 0,  OuterRadius);
  1106. end;
  1108. { TRing }
  1110. function TRing.GetTesselatorClass: CTesselator; begin Result := TRingMesh; end;
  1112. constructor TRing.Create(AManager: TItemsManager);
  1113. begin
  1114.   inherited;
  1115.   YAngle := 0+pi/4;
  1116. end;
  1118. procedure TRing.AddProperties(const Result: Props.TProperties);
  1119. var Mesh: TRingMesh;
  1120. begin
  1121.   inherited;
  1122.   if not Assigned(Result) or not (CurrentTesselator is TRingMesh) then Exit;
  1123.   Mesh := CurrentTesselator as TRingMesh;
  1125.   AddColorProperty(Result, 'Color1', Mesh.Color1);
  1126.   AddColorProperty(Result, 'Color2', Mesh.Color2);
  1127.   Result.Add('ColorFactor',          vtSingle, [], FloatToStr(Mesh.Factor),        '0-1');
  1128.   Result.Add('GeometrySmoothing',    vtInt,    [], IntToStr(Mesh.Smoothing),       '3-32');
  1129.   Result.Add('GeometryInner radius', vtSingle, [], FloatToStr(Mesh.InnerRadius),   '');
  1130.   Result.Add('GeometryOuter radius', vtSingle, [], FloatToStr(Mesh.OuterRadius),   '');
  1131.   Result.AddEnumerated('TextureMap type',  [], Mesh.UVMapType, 'Planar&Radial');
  1132. end;
  1134. procedure TRing.SetProperties(Properties: Props.TProperties);
  1135. var Mesh: TRingMesh;
  1136. begin
  1137.   inherited;
  1138.   if not (CurrentTesselator is TRingMesh) then Exit;
  1139.   Mesh := CurrentTesselator as TRingMesh;
  1141.   SetColorProperty(Properties, 'Color1', Mesh.Color1);
  1142.   SetColorProperty(Properties, 'Color2', Mesh.Color2);
  1144.   if Properties.Valid('ColorFactor')          then Mesh.Factor      := StrToFloatDef(Properties['ColorFactor'],          0);
  1145.   if Properties.Valid('GeometrySmoothing')    then Mesh.Smoothing   := StrToIntDef(Properties['GeometrySmoothing'],     0);
  1146.   if Properties.Valid('GeometryInner radius') then Mesh.InnerRadius := StrToFloatDef(Properties['GeometryInner radius'], 0);
  1147.   if Properties.Valid('GeometryOuter radius') then Mesh.OuterRadius := StrToFloatDef(Properties['GeometryOuter radius'], 0);
  1148.   if Properties.Valid('TextureMap type')      then Mesh.UVMapType   := Properties.GetAsInteger('TextureMap type');
  1149.   SetMesh;
  1150. end;
  1152. function TRing.GetColor: BaseTypes.TColor;
  1153. begin
  1154.   Result := TRingMesh(CurrentTesselator).Color1;
  1155. end;
  1157. procedure TRing.SetColor(const Value: BaseTypes.TColor);
  1158. var Mesh: TRingMesh;
  1159. begin
  1160.   if CurrentTesselator is TRingMesh then Mesh := CurrentTesselator as TRingMesh else Exit;
  1161.   Mesh.Color1 := Value;
  1162.   SetMesh;
  1163. end;
  1165. function TRing.VisibilityCheck(const Camera: TCamera): Boolean;
  1166. var CameraForward, Axis: TVector3s; Angle: Single;
  1167. begin
  1168.   Result := inherited VisibilityCheck(Camera);
  1169.   CameraForward := Transform3Vector3s(GetTransposedMatrix3s(CutMatrix3s(Camera.ViewMatrix)), GetVector3s(0, 0, 1));
  1170.   Axis := NormalizeVector3s(CrossProductVector3s(CameraForward, GetVector3s(0, 1, 0)));
  1171. //  Axis := Transform3Vector3s({TransposeMatrix3s(}CutMatrix3s(Transform), Axis);
  1172.   Angle := ArcTan2(-sqrt(Sqr(CameraForward.X) + Sqr(CameraForward.Z)), -CameraForward.Y);
  1173.   Orientation := MulQuaternion(GetQuaternion(-Angle, Axis), GetQuaternion(YAngle, GetVector3s(0, 1, 0)));
  1174. end;
  1176. begin
  1177.   GlobalClassList.Add('C2VisItems', GetUnitClassList);
  1178. end.