C2Land.pas
上传用户:yj_qiu
上传日期:2022-08-08
资源大小:23636k
文件大小:82k
源码类别:

游戏引擎

开发平台:

Delphi

  1. (*
  2.  @Abstract(CAST II Engine landscapes unit)
  3.  (C) 2006-2007 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.  Created: 29.01.2007 <br>
  6.  Unit contains basic landscape classes
  7. *)
  8. {$Include GDefines.inc}
  9. {$Include C2Defines.inc}
  10. unit C2Land;
  11. interface
  12. uses
  13.   TextFile,
  14.   SysUtils,
  15.   BaseTypes, BaseMsg, Basics, Base2D, Base3D, Props, BaseGraph,
  16.   BaseClasses,
  17.   C2Types, C2Res, CAST2, Resources, C2Visual, C2Maps, C2MapEditMsg,
  18.   C2Render, C2Core;
  19. const
  20.   // Enumeration strings for light map type
  21.   LightmapTypesEnum = 'Light map' + StringDelimiter + 'Normal map';
  22.   MipColors: array[0..15] of TColor = ((C: $00000000), (C: $00000080), (C: $00008000), (C: $00008080),
  23.                                        (C: $00800000), (C: $00800080), (C: $00808000), (C: $00808080),
  24.                                        (C: $00404040), (C: $000000FF), (C: $0000FF00), (C: $0000FFFF),
  25.                                        (C: $00FF0000), (C: $00FF00FF), (C: $00FFFF00), (C: $00FFFFFF));
  26. type
  27.   // Type of texture used for landscape lighting
  28.   TLightmapType = (// Simple lightmap for FFP lighting
  29.                    lmtLightMap,
  30.                    // Texture contains normals to calculate lighting in shader
  31.                    lmtNormalMap);
  32.   THeightMap = class(C2Maps.TMap)
  33.   protected
  34.     FImage: Resources.TImageResource;
  35.     function GetData: Pointer; override;
  36.     procedure ResolveLinks; override;
  37.     function GetRawHeight(XI, ZI: Integer): Integer; override;
  38.     procedure SetRawHeight(XI, ZI: Integer; const Value: Integer); override;
  39.   public
  40.     constructor Create(AManager: TItemsManager); override;
  41.     procedure SwapRectHeights(const ARect: TRect; ABuf: Pointer); override;
  42.     procedure SetDimensions(AWidth, AHeight: Integer); override;
  43.     procedure SetImage(Image: Resources.TImageResource); virtual;
  44.     function IsReady: Boolean; override;
  45.     procedure AddProperties(const Result: Props.TProperties); override;
  46.     procedure SetProperties(Properties: Props.TProperties); override;
  47.     property Image: Resources.TImageResource read FImage;
  48.   end;
  49.   THeightMapTesselator = class(TMappedTesselator)
  50.   protected
  51.     FTextureScale: Single;
  52.   public
  53.     constructor Create; override;
  54.     procedure Init; override;
  55.     procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); override;
  56.     procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); override;
  57.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  58.     function SetIndices(IBPTR: Pointer): Integer; override;
  59.   end;
  60.   THeightMapLandscape = class(C2Visual.TMappedItem)
  61.   public
  62.     function GetTesselatorClass: CTesselator; override;
  63.     procedure AddProperties(const Result: Props.TProperties); override;
  64.     procedure SetProperties(Properties: Props.TProperties); override;
  65.   end;
  66.   TIslandTesselator = class(TMappedTesselator)
  67.   private
  68.     // Params
  69.     FIslandThickness, FTextureScale: Single;
  70.   public
  71.     IslandThickness, TextureScale: Single;
  72.     constructor Create; override;
  73.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  74.     procedure Init; override;
  75.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  76.     function SetIndices(IBPTR: Pointer): Integer; override;
  77.   end;
  78.   TIsland = class(C2Visual.TMappedItem)
  79.   public
  80.     function GetTesselatorClass: CTesselator; override;
  81.     procedure AddProperties(const Result: Props.TProperties); override;
  82.     procedure SetProperties(Properties: Props.TProperties); override;
  83.   end;
  84.   TVertexWaterTesselator = class(THeightMapTesselator)
  85.   private
  86.     // Parameters
  87.     FWaterColor: TColor;
  88.     FWavesSpeed, FWavesFalloff, FViscosity: Single;
  89.     FFullRefAngle: Integer;
  90.     // Other
  91.     Vel, Arr: array of single;
  92.   public
  93.     WaterColor: TColor;
  94.     WavesSpeed, WavesFalloff, Viscosity: Single;
  95.     FullRefAngle: Integer;
  96.     procedure Init; override;
  97.     function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
  98.     procedure Iterate;
  99.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  100.   end;
  101.   TVertexWater = class(THeightMapLandscape)
  102.   private
  103.     Counter: Cardinal;
  104.     WaterColor: TColor;
  105.     WavesSpeed, WavesFalloff, Viscosity: Single;
  106.     FullRefAngle: Integer;
  107.   public
  108.     function GetTesselatorClass: CTesselator; override;
  109.     procedure AddProperties(const Result: Props.TProperties); override;
  110.     procedure SetProperties(Properties: Props.TProperties); override;
  111.     procedure Process(const DeltaTime: Single); override;
  112.   end;
  113.   TQuadPoints = array[0..3] of TVector3s;
  114.   TProjectedLandTesselator = class(THeightMapTesselator)
  115.   private
  116. protected
  117.     // Params
  118.     FGridWidth, FGridHeight, SmoothX, SmoothZ: Integer;
  119.     MipBias, MipScale, DetailBalance, ViewDepth: Single;
  120.     ExcessDist, TrilinearRange: Single;
  121.     // Other
  122.     CameraDir, CameraRight: TVector3s;
  123.     FlipSign: Single;
  124.     NearMip, FarMip: Integer;
  125.     MipDetail: array[0..31] of Integer;
  126.     MipStart:  array[0..31] of Single;
  127.     MipTexture: array[0..31] of Integer;
  128.     FMipZ: array of Single;
  129.     CamOfsX, CamOfsZ: Single;
  130.     LastTexUpdX, LastTexUpdZ: Single;
  131.     FMegaTextureScale: Single;
  132.     FLastClipmapSize, FClipmapSize: Integer;
  133.     Renderer: TRenderer;
  134.     FGrid: array of TVector2s;
  135.   protected
  136.     OldCameraMatrix: TMatrix4s;
  137. //    function GetCameraInModel: TVector3s;
  138.     procedure ProjectGrid(const Params: TTesselationParameters; out PrjPnt: TQuadPoints);
  139.   public
  140.     constructor Create; override;
  141.     destructor Destroy; override;
  142.     function GetMaxVertices: Integer; override;
  143.     procedure Init; override;
  144.     procedure DoManualRender(Item: TItem); override;
  145.     procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); override;
  146.     procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); override;
  147.   end;
  148.   TProjGridTesselator = class(TProjectedLandTesselator)
  149.   private
  150.     Pnt, PrjPnt: TQuadPoints;
  151.   public
  152.     function GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer; override;
  153.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  154.     function SetIndices(IBPTR: Pointer): Integer; override;
  155.   end;
  156.   TRadGridTesselator = class(TProjectedLandTesselator)
  157.   private
  158.     procedure InitGrid;
  159.   public
  160.     procedure Init; override;
  161.     function GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer; override;
  162.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  163.     function SetIndices(IBPTR: Pointer): Integer; override;
  164.   end;
  165.   TProjectedLandscape = class(C2Visual.TMappedItem)
  166.   private
  167.     ShaderConsts: TShaderConstants;
  168.     procedure InitShaderConstants;
  169.     function GetMegaTexture: TMegaImageResource;
  170.   protected
  171.     FLightmapType: TLightmapType;
  172.     FTextureScale: Single;
  173.     procedure OnModify(const ARect: BaseTypes.TRect); override;
  174.   public
  175.     constructor Create(AManager: TItemsManager); override;
  176.     function VisibilityCheck(const Camera: TCamera): Boolean; override;
  177.     procedure OnSceneLoaded; override;
  178.     procedure RetrieveShaderConstants(var ConstList: TShaderConstants); override;
  179.     procedure AddProperties(const Result: Props.TProperties); override;
  180.     procedure SetProperties(Properties: Props.TProperties); override;
  181.     procedure HandleMessage(const Msg: TMessage); override;
  182.     procedure Process(const DeltaTime: Single); override;
  183.     // Returns projected on the landscape four projected camera frustum points 
  184.     procedure ProjectGrid(const Camera: TCamera; out PrjPnt: TQuadPoints);
  185.     procedure RecalcLightMap(ARect: BaseTypes.TRect);
  186.     property MegaTexture: TMegaImageResource read GetMegaTexture;
  187.   end;
  188.   TProjGridLandscape = class(TProjectedLandscape)
  189.   public
  190.     function GetTesselatorClass: CTesselator; override;
  191.   end;
  192.   TRadGridLandscape = class(TProjectedLandscape)
  193.   public
  194.     function GetTesselatorClass: CTesselator; override;
  195.   end;
  196.   // Returns list of classes introduced by the unit
  197.   function GetUnitClassList: TClassArray;
  198. implementation
  199. function GetUnitClassList: TClassArray;
  200. begin
  201.   Result := GetClassList([TMap, THeightMap, THeightMapLandscape, TIsland, TVertexWater, TProjGridLandscape, TRadGridLandscape]);
  202. end;
  203. { TIslandTesselator }
  204. constructor TIslandTesselator.Create;
  205. begin
  206.   inherited;
  207.   IslandThickness := 1;
  208.   TextureScale    := 0.1;
  209. end;
  210. function TIslandTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  211. begin
  212.   Result := 2;
  213.   if Internal then Parameters := @FIslandThickness else Parameters := @IslandThickness;
  214. end;
  215. procedure TIslandTesselator.Init;
  216. begin
  217.   inherited;
  218.   if Assigned(FMap) then begin
  219.     TotalVertices   := FMap.Width*FMap.Height;
  220.     TotalIndices    := MaxI(0, (FMap.Width-1)) * MaxI(0, (FMap.Height-1)) * 6;
  221.     TotalPrimitives := MaxI(0, (FMap.Width-1)) * MaxI(0, (FMap.Height-1)) * 2;
  222.   end else begin
  223.     TotalVertices   := 0;
  224.     TotalIndices    := 0;
  225.     TotalPrimitives := 0;
  226.   end;
  227.   IndexingVertices := TotalVertices;  
  228.   PrimitiveType    := ptTRIANGLELIST;
  229.   InitVertexFormat(GetVertexFormat(False, True, False, False, False, 0, [2]));
  230. end;
  231. function TIslandTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  232. var i, j: Integer; HalfLengthX, HalfLengthZ, y: Single;
  233. begin
  234.   Result := 0;
  235.   if not Assigned(FMap) or not FMap.IsReady then Exit;
  236.   HalfLengthX := (FMap.Width-1)  * FMap.CellWidthScale  * 0.5;
  237.   HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
  238.   for j := 0 to FMap.Height-1 do for i := 0 to FMap.Width-1 do begin
  239.     SetVertexDataUV(i * FTextureScale, j * FTextureScale, j * FMap.Width + i, VBPTR);
  240.     if (i = 0) or (j = 0) or (i = FMap.Width-1) or (j = FMap.Height-1) or
  241. //       (HMap.GetCellHeight(i-1, j-1) = 0) or (HMap.GetCellHeight(i+1, j-1) = 0) or
  242. //       (HMap.GetCellHeight(i-1, j+1) = 0) or (HMap.GetCellHeight(i+1, j+1) = 0) or
  243.        (FMap[i-1, j] = 0) or (FMap[i+1, j] = 0) or
  244.        (FMap[i, j-1] = 0) or (FMap[i, j+1] = 0) then begin
  245.       Y := -FIslandThickness;
  246. //      SetVertexDataD(FMap.GetCellColor(i, j) and $FFFFFF, j * FMap.Width + i, VBPTR);
  247.     end else begin
  248.       Y := FMap[i+Ord(i=0)-Ord(i=FMap.Width-1), j+Ord(j=0)-Ord(j=FMap.Height-1)] * FMap.DepthScale;
  249. //      SetVertexDataD(FMap.GetCellColor(i, j) or $FF000000, j * FMap.Width + i, VBPTR);
  250.     end;
  251.     SetVertexDataC(i * FMap.CellWidthScale - HalfLengthX, Y, j * FMap.CellHeightScale - HalfLengthZ, j * FMap.Width + i, VBPTR);
  252.     SetVertexDataN(FMap.GetCellNormal(i, j), j * FMap.Width + i, VBPTR);
  253. //    SetVertexDataD(GetColor($FFFFFFFF), j * FMap.Width + i, VBPTR);
  254.   end;
  255.   TesselationStatus[tbVertex].Status := tsTesselated;
  256.   Result  := TotalVertices;
  257.   IndexingVertices  := TotalVertices;
  258.   LastTotalVertices := TotalVertices;
  259. end;
  260. function TIslandTesselator.SetIndices(IBPTR: Pointer): Integer;
  261. var i, j: Integer; y11, y12, y21, y22, Points: Integer;
  262. begin
  263. { * *     * * * * * * * *
  264.   * * * * *     * * * * *
  265.   * * * * *     * *   * *
  266.   * * * * * * * * * * * * }
  267.   TotalPrimitives := 0;
  268.   if Assigned(FMap) and FMap.IsReady then for j := 0 to FMap.Height-2 do for i := 0 to FMap.Width-2 do begin
  269.     y11 := FMap[i, j];
  270.     y12 := FMap[i, j+1];
  271.     y21 := FMap[i+1, j];
  272.     y22 := FMap[i+1, j+1];
  273. //                  8                      4                    2                    1
  274.     Points := Ord(y11 > 0) shl 3 + Ord(y12 > 0) shl 2 + Ord(y21 > 0) shl 1 + Ord(y22 > 0);
  275.     case Points of
  276.       7: begin                           // y11 zero
  277.         TWordBuffer(IBPTR^)[TotalPrimitives*3+0] := (j+1) * FMap.Width + i;         //  *
  278.         TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i+1;       // **
  279.         TWordBuffer(IBPTR^)[TotalPrimitives*3+2] :=  j    * FMap.Width + i+1;
  280.         Inc(TotalPrimitives);
  281.       end;
  282.       11: begin                           // y12 zero
  283.         TWordBuffer(IBPTR^)[TotalPrimitives*3+0] :=  j    * FMap.Width + i;         // **
  284.         TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i+1;       //  *
  285.         TWordBuffer(IBPTR^)[TotalPrimitives*3+2] :=  j    * FMap.Width + i + 1;
  286.         Inc(TotalPrimitives);
  287.       end;
  288.       13: begin                           // y21 zero
  289.         TWordBuffer(IBPTR^)[TotalPrimitives*3+0] :=  j    * FMap.Width + i;         // *
  290.         TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i;         // **
  291.         TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := (j+1) * FMap.Width + i+1;
  292.         Inc(TotalPrimitives);
  293.       end;
  294.       14: begin                           // y22 zero
  295.         TWordBuffer(IBPTR^)[TotalPrimitives*3+0] :=  j    * FMap.Width + i;         // **
  296.         TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i;         // *
  297.         TWordBuffer(IBPTR^)[TotalPrimitives*3+2] :=  j    * FMap.Width + i+1;
  298.         Inc(TotalPrimitives);
  299.       end;
  300.       15: begin                           // All points
  301.         TWordBuffer(IBPTR^)[TotalPrimitives*3+0] :=  j    * FMap.Width + i;
  302.         TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i;
  303.         TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := (j+1) * FMap.Width + i+1;
  304.         TWordBuffer(IBPTR^)[TotalPrimitives*3+3] :=  j    * FMap.Width + i;
  305.         TWordBuffer(IBPTR^)[TotalPrimitives*3+4] := (j+1) * FMap.Width + i+1;
  306.         TWordBuffer(IBPTR^)[TotalPrimitives*3+5] :=  j    * FMap.Width + i+1;
  307.         Inc(TotalPrimitives, 2);
  308.       end;
  309.     end;
  310.   end;
  311.   TotalIndices := TotalPrimitives*3;
  312.   TesselationStatus[tbIndex].Status := tsTesselated;
  313.   Result := TotalIndices;
  314.   LastTotalIndices := TotalIndices;
  315. end;
  316. { TIsland }
  317. function TIsland.GetTesselatorClass: CTesselator; begin Result := TIslandTesselator; end;
  318. procedure TIsland.AddProperties(const Result: Props.TProperties);
  319. begin
  320.   inherited;
  321.   if Assigned(Result) and Assigned(CurrentTesselator) then begin
  322.     Result.Add('Thickness',    vtSingle, [], FloatToStr(TIslandTesselator(CurrentTesselator).IslandThickness), '0,1-10');
  323.     Result.Add('TextureScale', vtSingle, [], FloatToStr(TIslandTesselator(CurrentTesselator).TextureScale),    '0,01-10');
  324.   end;
  325. end;
  326. procedure TIsland.SetProperties(Properties: Props.TProperties);
  327. begin
  328.   inherited;
  329.   if Assigned(CurrentTesselator) then begin
  330.     if Properties.Valid('Thickness')    then TIslandTesselator(CurrentTesselator).IslandThickness := StrToFloatDef(Properties['Thickness'],    0);
  331.     if Properties.Valid('TextureScale') then TIslandTesselator(CurrentTesselator).TextureScale    := StrToFloatDef(Properties['TextureScale'], 0);
  332. //    CurrentTesselator.Init;
  333.     SetMesh;
  334.   end;
  335. end;
  336. { THeightMapTesselator }
  337. constructor THeightMapTesselator.Create;
  338. begin
  339.   inherited;
  340.   FTextureScale    := 0.1;
  341. end;
  342. procedure THeightMapTesselator.Init;
  343. begin
  344.   inherited;
  345.   if Assigned(FMap) then begin
  346.     TotalVertices   := FMap.Width*FMap.Height;
  347.     TotalPrimitives := MaxI(0, (FMap.Width-1)) * 2;
  348.     TotalStrips     := MaxI(0, (FMap.Height-1));
  349.     TotalIndices    := FMap.Width * (FMap.Height-1) * 2;
  350.     StripOffset     := FMap.Width;
  351.   end else begin
  352.     TotalVertices   := 0;
  353.     TotalStrips     := 0;
  354.     TotalIndices    := 0;
  355.     TotalPrimitives := 0;
  356.     StripOffset     := 0;
  357.   end;
  358.   PrimitiveType    := ptTRIANGLESTRIP;
  359.   IndexingVertices := TotalPrimitives+2;
  360.   InitVertexFormat(GetVertexFormat(False, True, False, False, False, 0, [2]));
  361. end;
  362. procedure THeightMapTesselator.AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString);
  363. begin
  364.   inherited;
  365.   if Assigned(Result) then begin
  366.     Result.Add(PropNamePrefix + 'TextureScale', vtSingle, [], FloatToStr(FTextureScale), '0,01-4');
  367.   end;
  368. end;
  369. procedure THeightMapTesselator.SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString);
  370. begin
  371.   inherited;
  372.   if Properties.Valid(PropNamePrefix + 'TextureScale') then FTextureScale := StrToFloatDef(Properties[PropNamePrefix + 'TextureScale'], 0.1);
  373. end;
  374. function THeightMapTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  375. var i, j: Integer; HalfLengthX, HalfLengthZ, y: Single;
  376. begin
  377.   Result := 0;
  378.   if not Assigned(FMap) or (FMap.Width = 0) or (FMap.Height = 0) then Exit;
  379.   HalfLengthX := (FMap.Width-1)  * FMap.CellWidthScale  * 0.5;
  380.   HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
  381.   for j := 0 to FMap.Height-1 do for i := 0 to FMap.Width-1 do begin
  382.     SetVertexDataUV(i * FTextureScale, j * FTextureScale, j * FMap.Width + i, VBPTR);
  383.     Y := FMap[i, j] * FMap.DepthScale;
  384.     SetVertexDataC(i * FMap.CellWidthScale - HalfLengthX,
  385.                    Y,
  386.                    j * FMap.CellHeightScale - HalfLengthZ,
  387.                    j * FMap.Width + i, VBPTR);
  388.     SetVertexDataN(FMap.GetCellNormal(i, j), j * FMap.Width + i, VBPTR);
  389.   end;
  390.   TesselationStatus[tbVertex].Status := tsTesselated;
  391.   Result  := TotalVertices;
  392.   LastTotalVertices := TotalVertices;
  393. end;
  394. function THeightMapTesselator.SetIndices(IBPTR: Pointer): Integer;
  395. var i, j: Integer;
  396. begin
  397.   for j := 0 to TotalStrips-1 do for i := 0 to FMap.Width-1 do begin
  398.     TWordBuffer(IBPTR^)[(j * FMap.Width + i)*2]   := (0*j+0) * FMap.Width + i;
  399.     TWordBuffer(IBPTR^)[(j * FMap.Width + i)*2+1] := (0*j+1) * FMap.Width + i;
  400.   end;
  401.   TesselationStatus[tbIndex].Status := tsTesselated;
  402.   Result  := TotalIndices;
  403.   LastTotalIndices := TotalIndices;
  404. end;
  405. { THeightMapLandscape }
  406. function THeightMapLandscape.GetTesselatorClass: CTesselator;
  407. begin
  408.   Result := THeightMapTesselator;
  409. end;
  410. procedure THeightMapLandscape.AddProperties(const Result: Props.TProperties);
  411. begin
  412.   inherited;
  413. end;
  414. procedure THeightMapLandscape.SetProperties(Properties: Props.TProperties);
  415. begin
  416.   inherited;
  417. end;
  418. { THeightMap }
  419. const ImagePropName = 'Image';
  420. function THeightMap.GetData: Pointer;
  421. begin
  422.   if Assigned(FImage) then Result := FImage.Data else Result := nil;
  423. end;
  424. procedure THeightMap.ResolveLinks;
  425. var Item: TItem;
  426. begin
  427.   inherited;
  428.   ResolveLink(ImagePropName, Item);
  429.   if Assigned(Item) then SetImage(Item as Resources.TImageResource);
  430. end;
  431. function THeightMap.GetRawHeight(XI, ZI: Integer): Integer;
  432. begin
  433.   Assert((XI >= 0) and (ZI >= 0) and (XI < Width) and (ZI < Height), ClassName + '.GetCellHeight: Invalid cell index');
  434.   Result := BaseTypes.PByteBuffer(FImage.Data)^[ZI * Width + XI];
  435. end;
  436. procedure THeightMap.SetRawHeight(XI, ZI: Integer; const Value: Integer);
  437. begin
  438.   Assert((XI >= 0) and (ZI >= 0) and (XI < Width) and (ZI < Height), ClassName + '.SetRawHeight: Invalid cell index');
  439.   BaseTypes.PByteBuffer(FImage.Data)^[ZI * Width + XI] := Value;
  440. end;
  441. procedure THeightMap.SwapRectHeights(const ARect: TRect; ABuf: Pointer);
  442. begin
  443.   inherited;
  444.   FImage.GenerateMipLevels(ARect);
  445. end;
  446. procedure THeightMap.SetDimensions(AWidth, AHeight: Integer);
  447. begin
  448.   inherited;
  449. end;
  450. procedure THeightMap.SetImage(Image: Resources.TImageResource);
  451. //var i, j: Integer;
  452. begin
  453.   if Assigned(Image) then begin
  454.     if (GetBytesPerPixel(Image.Format) <> 1) then begin
  455.       Log.Log(Format('%S("%S").%S: a 8 bits per pixel image required', [ClassName, GetFullName, 'SetImage']), lkError);
  456.       Exit;
  457.     end;
  458.     if Image.MipPolicy = mpNoMips then begin
  459.       Log.Log(Format('%S("%S").%S: an image with mipmaps enabled required', [ClassName, GetFullName, 'SetImage']), lkError);
  460. //      Exit;
  461.     end;
  462.   end;
  463.   FImage := Image;
  464. end;
  465. procedure THeightMap.AddProperties(const Result: Props.TProperties);
  466. begin
  467.   inherited;
  468.   if Assigned(Result) then begin
  469.   end;
  470.   AddItemLink(Result, ImagePropName, [], 'TImageResource');
  471. end;
  472. procedure THeightMap.SetProperties(Properties: Props.TProperties);
  473. begin
  474.   inherited;
  475.   if Properties.Valid(ImagePropName) then SetLinkProperty(ImagePropName, Properties[ImagePropName]);
  476.   ResolveLinks;
  477. end;
  478. constructor THeightMap.Create(AManager: TItemsManager);
  479. begin
  480.   inherited;
  481.   FMaxHeight   := 255;                                   // 8-bit heights
  482.   FElementSize := 1;
  483. end;
  484. function THeightMap.IsReady: Boolean;
  485. begin
  486.   Result := inherited IsReady and Assigned(FImage) and Assigned(FImage.Data);
  487. end;
  488. { TVertexWaterTesselator }
  489. procedure TVertexWaterTesselator.Init;
  490. begin
  491.   inherited;
  492.   if Assigned(FMap) then begin
  493.     SetLength(arr, TotalVertices);
  494.     SetLength(Vel, TotalVertices);
  495.     FillChar(arr[0], TotalVertices*4, 0);
  496.     FillChar(vel[0], TotalVertices*4, 0);
  497.   end;
  498.   InitVertexFormat(GetVertexFormat(False, True, True, False, False, 0, [2]));
  499. end;
  500. function TVertexWaterTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
  501. begin
  502.   Result := 5;
  503.   if Internal then Parameters := @FWaterColor else Parameters := @WaterColor;
  504. end;
  505. const MaxArr = 1000000000.0;
  506. procedure TVertexWaterTesselator.Iterate;
  507. //const k = 0.25;  VC = 0.25*1+0*1; FalOff = 1*1+0*0.98; RestoreForce = 1*0+1*0.98;
  508. var i, j: Integer;
  509. begin
  510.   for j := 1 to FMap.Height-2 do
  511.     for i := 1 to FMap.Width-2 do
  512.       vel[j * FMap.Width + i] := (vel[j * FMap.Width + i] +
  513.                                        (-arr[j * FMap.Width + i]*4 +
  514.                                          arr[(j+1) * FMap.Width + i] + arr[(j-1) * FMap.Width + i] +
  515.                                          arr[j * FMap.Width + i + 1] + arr[j * FMap.Width + i - 1]) * FWavesSpeed ) * FWavesFalloff;
  516.   for j := 0 to FMap.Height-1 do begin
  517.     for i := 0 to FMap.Width-1 do begin
  518. //      arr[j * FMap.Width + i] := arr[j * FMap.Width + i] + Vel[j * FMap.Width + i] * 0.5;
  519.       arr[j * FMap.Width + i] := (arr[j * FMap.Width + i] + Vel[j * FMap.Width + i]) * FViscosity;
  520.       if arr[j * FMap.Width + i]>MaxArr then arr[j * FMap.Width + i] := MaxArr;
  521.       if arr[j * FMap.Width + i]<0 then arr[j * FMap.Width + i] := 0;
  522.       FMap[i, j] := Round((arr[(j div 1) * FMap.Width + i div 1]*1) / MaxArr*255);
  523. {      FMap[i, j] := Round((
  524.                                  arr[(j div 1) * FMap.Width + i div 1]*(1-k*4) +
  525.                                  arr[MaxI(0, j-1) * FMap.Width + i]*k +
  526.                                  arr[(j) * FMap.Width + MaxI(0, i-1)]*k +
  527.                                  arr[MinI(FMap.Height-1, j+1) * FMap.Width + i]*k +
  528.                                  arr[(j) * FMap.Width + MinI(FMap.Width-1, i+1)]*k
  529.                                  ) / MaxArr*255);}
  530.     end;
  531.   end;
  532. end;
  533. function TVertexWaterTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  534. var i, j: Integer; HalfLengthX, HalfLengthZ, y, a, MinA, FRACos: Single; c, n: TVector3s;
  535. begin
  536.   Result := 0;
  537.   if not Assigned(FMap) or not FMap.IsReady then Exit;
  538.   if TesselationStatus[tbVertex].Status <> tsTesselated then Iterate;
  539.   MinA := FWaterColor.A / 255;
  540.   FRACos := Sin((FFullRefAngle)/180*pi);
  541.   HalfLengthX := (FMap.Width-1)  * FMap.CellWidthScale  * 0.5;
  542.   HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
  543.   for j := 0 to FMap.Height-1 do for i := 0 to FMap.Width-1 do begin
  544.     SetVertexDataUV(i * FTextureScale, j * FTextureScale, j * FMap.Width + i, VBPTR);
  545.     Y := FMap[i, j] * FMap.DepthScale;
  546.     c := GetVector3s(i * FMap.CellWidthScale - HalfLengthX, Y, j * FMap.CellHeightScale - HalfLengthZ);
  547.     SetVertexDataC(c, j * FMap.Width + i, VBPTR);
  548.     n := FMap.GetCellNormal(i, j);
  549.     SetVertexDataN(n, j * FMap.Width + i, VBPTR);
  550.     n := Transform3Vector3s(CutMatrix3s(Params.ModelMatrix), n);
  551.     c := Transform4Vector33s(Params.ModelMatrix, c);
  552.     c := NormalizeVector3s(SubVector3s(Params.Camera.Position, c));
  553. //    a := MaxS(0, MinA + MinS(1-MinA, (1-Abs(DotProductVector3s(c, n)))/FRACos) );
  554.     a := MaxS(0, MinA + MinS(1-MinA, (1-MinA)*Sqrt(1-Sqr(DotProductVector3s(c, n)))/FRACos ));
  555.     SetVertexDataD(GetColor(FWaterColor.R, FWaterColor.G, FWaterColor.B, Round(a*255)), j * FMap.Width + i, VBPTR);
  556.   end;
  557.   TesselationStatus[tbVertex].Status := tsTesselated;
  558.   Result := TotalVertices;
  559.   LastTotalVertices := TotalVertices;
  560. end;
  561. { TVertexWater}
  562. function TVertexWater.GetTesselatorClass: CTesselator; begin Result := TVertexWaterTesselator; end;
  563. procedure TVertexWater.AddProperties(const Result: TProperties);
  564. begin
  565.   inherited;
  566.   if Assigned(Result) then begin
  567.     AddColorProperty(Result, 'Water color', WaterColor);
  568.     Result.Add('100% reflection angle', vtInt,    [], IntToStr(FullRefAngle), '0-90');
  569.     Result.Add('Waves speed',     vtSingle, [], FloatToStr(WavesSpeed),   '0.1-1');
  570.     Result.Add('Waves falloff',   vtSingle, [], FloatToStr(WavesFalloff), '0.9-1');
  571.     Result.Add('Water viscosity', vtSingle, [], FloatToStr(Viscosity),    '0.8-1');
  572.   end;
  573. end;
  574. procedure TVertexWater.SetProperties(Properties: TProperties);
  575. var Mesh: TVertexWaterTesselator;
  576. begin
  577.   inherited;
  578.   SetColorProperty(Properties, 'Water color', WaterColor);
  579.   if Properties.Valid('100% reflection angle') then FullRefAngle := StrToIntDef(Properties['100% reflection angle'], 30);
  580.   if Properties.Valid('Waves speed')     then WavesSpeed   := StrToFloatDef(Properties['Waves speed'], 0);
  581.   if Properties.Valid('Waves falloff')   then WavesFalloff := StrToFloatDef(Properties['Waves falloff'], 0);
  582.   if Properties.Valid('Water viscosity') then Viscosity    := StrToFloatDef(Properties['Water viscosity'], 0);
  583.   if not (CurrentTesselator is TVertexWaterTesselator) then Exit;
  584.   Mesh := CurrentTesselator as TVertexWaterTesselator;
  585.   Mesh.WaterColor   := WaterColor;
  586.   Mesh.FullRefAngle := FullRefAngle;
  587.   Mesh.WavesSpeed   := WavesSpeed;
  588.   Mesh.WavesFalloff := WavesFalloff;
  589.   Mesh.Viscosity    := Viscosity;
  590.   SetMesh;
  591. end;
  592. procedure TVertexWater.Process(const DeltaTime: Single);
  593.   procedure MakeWave(z, len: Integer; Height, Freq, Radii: Single);
  594.   var i, j: Integer;
  595.   begin
  596.     with (CurrentTesselator as TVertexWaterTesselator) do begin
  597.       for i := 2 to FMap.Width-4 do
  598.         for j := 0 to len-1 do
  599.         arr[MinI(FMap.Height-2, j+z-Round(Sin(pi*((i-2)/(FMap.Width-4))*FReq)*Radii)) * FMap.Width + MinI(FMap.Width-2, i)] := MaxArr*Height * Sin(j/(len-1)*pi);
  600. //        arr[MinI(FMap.Height-2, z+j) * FMap.Width + MinI(FMap.Width-2, i)] := MaxArr*Height * Sin(j/(len-1)*pi);
  601.     end;
  602.   end;
  603.   var w, h: Integer;
  604. begin
  605.   inherited;
  606.   if not Assigned((CurrentTesselator as TVertexWaterTesselator).FMap) or not (CurrentTesselator as TVertexWaterTesselator).FMap.IsReady then Exit;
  607.   CurrentTesselator.Invalidate([tbVertex], False);
  608.   with (CurrentTesselator as TVertexWaterTesselator) do begin
  609.     Inc(Counter);
  610.     w := FMap.Width;
  611.     w := w div 2 + Random(w div 2-2) - Random(w div 2-2);
  612.     h := FMap.Height;
  613.     h := h div 2 + Random(h div 2-2) - Random(h div 2-2);
  614.     if Counter mod 2 = 0 then arr[h * FMap.Width + w] := (MaxArr + Random * MaxArr)/2/2;
  615. //    if Counter mod 2 = 0 then MakeWave(6, 0.03, 4, 4);
  616. //    if Counter mod 6 = 0 then MakeWave(67, 0.08, 4, 4);
  617.     if Counter mod 10 = 0 then MakeWave(126-6, 6, 0.2, 1, 18);
  618.   end;
  619. end;
  620. { TProjectedLandTesselator }
  621. procedure TProjectedLandTesselator.ProjectGrid(const Params: TTesselationParameters; out PrjPnt: TQuadPoints);
  622. var
  623.   ModelInv: TMatrix4s; ModelInv33: TMatrix3s;
  624.   CameraInModel: TVector3s;
  625.   CameraElevation: Single;
  626.   OPnt2, OPnt3: TVector3s;
  627.   procedure SwapVec(var V1, V2: TVector3s);
  628.   var Vec: TVector3s;
  629.   begin
  630.     Vec := V1;
  631.     V1  := V2;
  632.     V2  := Vec;
  633.   end;
  634.   function ProjectOnGrid2(X, Y: Single; out Point: TVector3s): Boolean;
  635.   var PickRay: TVector3s;
  636.   begin
  637.     Result := False;
  638.     PickRay := Transform3Vector3s(CutMatrix3s(InvertAffineMatrix4s(Params.Camera.ViewMatrix)), Params.Camera.GetPickRay(X, Y));
  639.     PickRay := NormalizeVector3s(Transform3Vector3s(ModelInv33, PickRay) );
  640.     if (Abs(PickRay.Y) > epsilon) and (Sign(PickRay.Y) <> Sign(CameraInModel.Y)) and
  641.        (Abs(CameraElevation/PickRay.Y) < ViewDepth) then begin                      // Ray intersects the surface
  642.       SubVector3s(Point, CameraInModel, ScaleVector3s(PickRay, CameraElevation/PickRay.Y));
  643.       Point.Y := 0;
  644.       Result := True;
  645.     end;
  646.   end;
  647.   function ProjectNearEdge(FlipSign: Single): Boolean;
  648.   var TempK, y: Single; Pnt0, Pnt1: TVector3s;
  649.   begin
  650.     Result := False;
  651.     y := Params.Camera.RenderHeight * Ord(FlipSign >= 0);
  652.     if not ProjectOnGrid2(Params.Camera.RenderWidth, y, PrjPnt[2]) then Exit;
  653.     if not ProjectOnGrid2(0,                         y, PrjPnt[3]) then Exit;
  654.     OPnt2 := PrjPnt[2];
  655.     OPnt3 := PrjPnt[3];
  656.     // Near edge with elevation taken in account
  657.     TempK := SqrMagnitude(CameraDir);
  658.     if TempK > epsilon then begin
  659.       ScaleVector3s(CameraDir, CameraDir, InvSqrt(TempK));
  660.       CameraElevation := MaxS(0, CameraInModel.Y-FMap.MaxHeight * FMap.DepthScale);
  661.       if not ProjectOnGrid2(Params.Camera.RenderWidth, y, Pnt1) then Exit;
  662.       if not ProjectOnGrid2(0,                         y, Pnt0) then Exit;
  663.       TempK := MinS(0, MinS(DotProductVector3s(CameraDir, SubVector3s(Pnt1, PrjPnt[2])),
  664.                             DotProductVector3s(CameraDir, SubVector3s(Pnt0, PrjPnt[3]))));
  665.       AddVector3s(PrjPnt[2], PrjPnt[2], ScaleVector3s(CameraDir, TempK));
  666.       AddVector3s(PrjPnt[3], PrjPnt[3], ScaleVector3s(CameraDir, TempK));
  667.       CameraElevation := CameraInModel.Y;
  668.     end;
  669.     Result := True;
  670.   end;
  671.   function ProjectFarEdge(FlipSign: Single): Boolean;
  672.   var y: Single; LeftRail, RightRail: TVector3s;
  673.   begin
  674.     Result := False;
  675.     y := Params.Camera.RenderHeight * Ord(FlipSign >= 0);
  676.     if not ProjectOnGrid2(Params.Camera.RenderWidth, y + 1 - 2*Ord(FlipSign >= 0), PrjPnt[1]) then Exit;
  677.     if not ProjectOnGrid2(0,                         y + 1 - 2*Ord(FlipSign >= 0), PrjPnt[0]) then Exit;
  678.     LeftRail  := NormalizeVector3s(SubVector3s(PrjPnt[0], OPnt3));
  679.     RightRail := NormalizeVector3s(SubVector3s(PrjPnt[1], OPnt2));
  680.     if not ProjectOnGrid2(Params.Camera.RenderWidth, Params.Camera.RenderHeight-y, PrjPnt[1]) then
  681.       PrjPnt[1] := AddVector3s(OPnt2, ScaleVector3s(RightRail, ViewDepth));
  682.     if not ProjectOnGrid2(0, Params.Camera.RenderHeight-y, PrjPnt[0]) then
  683.       PrjPnt[0] := AddVector3s(OPnt3, ScaleVector3s(LeftRail, ViewDepth));
  684.     Result := True;
  685.   end;
  686.   var TempK: Single;
  687. begin
  688.   ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
  689.   ModelInv33 := CutMatrix3s(ModelInv);
  690.   Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
  691.   CameraElevation := CameraInModel.Y;
  692.   FlipSign := Sign(DotProductVector3s(Params.Camera.UpDir, Params.ModelMatrix.ViewUp));// *
  693. //              -DotProductVector3s(Params.Camera.LookDir, Params.ModelMatrix.ViewUp);
  694.   CameraRight := ScaleVector3s(Transform3Vector3s(ModelInv33, Params.Camera.RightVector), FlipSign);
  695.   CameraRight.Y := 0;
  696.   TempK := SqrMagnitude(CameraRight);
  697. //  Assert(TempK > epsilon);
  698.   ScaleVector3s(CameraRight, CameraRight, InvSqrt(TempK));
  699.   CameraDir   := Transform3Vector3s(ModelInv33, Params.Camera.ForwardVector);
  700.   CameraDir.Y := 0;
  701.   if not ProjectNearEdge(FlipSign) then Exit;
  702.   if not ProjectFarEdge(FlipSign) then Exit;
  703.   TempK := SqrMagnitude(CameraDir);
  704.   if TempK <= epsilon then
  705.     CameraDir := CrossProductVector3s(Transform3Vector3s(ModelInv33, Params.Camera.ForwardVector), CameraRight);
  706.   if FlipSign < 0 then begin
  707.     SwapVec(PrjPnt[0], PrjPnt[1]);
  708.     SwapVec(PrjPnt[2], PrjPnt[3]);
  709.     SwapVec(OPnt2, OPnt3);
  710.   end;
  711. end;
  712. constructor TProjectedLandTesselator.Create;
  713. var i: Integer;
  714. begin
  715.   inherited;
  716.   FGridWidth  := 100;
  717.   FGridHeight := 200;
  718.   MipBias     := 100;
  719.   MipScale    := 1;
  720.   SmoothX     := 1;
  721.   SmoothZ     := 1;
  722.   DetailBalance := 0.5;
  723.   TrilinearRange := 0.3;
  724.   FMegaTextureScale := 1;
  725.   FLastClipmapSize  := 0;
  726.   FClipmapSize      := 256;
  727.   for i := 0 to High(MipTexture) do MipTexture[i] := -1;
  728. end;
  729. destructor TProjectedLandTesselator.Destroy;
  730. begin
  731.   SetLength(FGrid, 0);
  732.   SetLength(FMipZ, 0);
  733.   inherited;
  734. end;
  735. function TProjectedLandTesselator.GetMaxVertices: Integer;
  736. begin
  737.   Result := TotalVertices;
  738. end;
  739. procedure TProjectedLandTesselator.Init;
  740. begin
  741.   inherited;
  742.   if Assigned(FMap) then begin
  743.     TotalVertices   := (FGridWidth+1)*(FGridHeight+1);
  744.     TotalIndices    := (FGridWidth+1)*2;    //  - - 89, 1 - 309-315, 2 - 85
  745.     TotalStrips     := FGridHeight;
  746.     TotalPrimitives := FGridWidth*2;
  747.     StripOffset     := FGridWidth+1;
  748. //    StripOffset     := FGridWidth+1;
  749.     SetLength(FMipZ, FGridHeight+1);
  750. //  0  2  4          0 1 2 3 4 5  5 1           P: ??? (w*2)*(h-1)-2 = (3*2)*3-2 = 16
  751. //  1  3  5          1 6 3 7 5 8  8 6           V: w*h = 3*4 = 12
  752. //  6  7  8          6 9 7 A 8 B                I: (2+(w-1)*2+2)*(h-1)-2 = 2*(w+1)*(h-1) = (2+(3-1)*2+2)*3-2 = 8*3-2 = 22
  753. //  9  A  B
  754. {    TotalIndices    := 2*(FGridWidth+2)*(FGridHeight);//-2
  755.     TotalStrips     := 1;
  756.     TotalPrimitives := 2*(FGridWidth+1)*(FGridHeight)-2;//(TotalIndices-2-2);
  757.     StripOffset     := 0;}
  758.   end else begin
  759.     TotalVertices   := 0;
  760.     TotalStrips     := 0;
  761.     TotalIndices    := 0;
  762.     TotalPrimitives := 0;
  763.     StripOffset     := 0;
  764.   end;
  765.   if not ManualRender then Log.Log('TProjectedLandTesselator.Init: Manual render should be turned on for megatextured landscapes', lkWarning);
  766.   PrimitiveType := ptTRIANGLESTRIP;
  767.   TesselationStatus[tbVertex].TesselatorType := ttStatic;
  768.   TesselationStatus[tbIndex].TesselatorType  := ttStatic;
  769. //   IndexingVertices := TotalVertices;
  770.   IndexingVertices := (FGridWidth+1)*2;
  771. //  IndexingVertices := (FGridHeight+1)*2;
  772. //  InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
  773.   InitVertexFormat(GetVertexFormat(False, False, False, False, False, 0, []));
  774.   LastTexUpdX := 0;
  775.   LastTexUpdZ := 0;
  776. end;
  777. procedure TProjectedLandTesselator.DoManualRender(Item: TItem);
  778. var TexI: Integer; MipWorldSize, LandSizeX, LandSizeZ: Single; TexUpd: Boolean;
  779.   procedure ApplyNextMip;
  780.   var LockedData: TLockedRectData; CenX, CenZ: Single;
  781.   begin
  782. //    texofs := texofs - 0.5/TexDim;
  783.     TexI := TexI + 1;
  784.     MipWorldSize := FClipmapSize * (1 shl TexI)/FMegaTextureScale;
  785.     CenX := TProjectedLandscape(Item).MegaTexture.LevelInfo[TexI].Width  * (0.5 + FMegaTextureScale * CamOfsX / TProjectedLandscape(Item).MegaTexture.LevelInfo[0].Width);
  786.     CenZ := TProjectedLandscape(Item).MegaTexture.LevelInfo[TexI].Height * (0.5 + FMegaTextureScale * CamOfsZ / TProjectedLandscape(Item).MegaTexture.LevelInfo[0].Height);
  787.     CenZ := TProjectedLandscape(Item).MegaTexture.LevelInfo[TexI].Height - CenZ;
  788.     if TexUpd or (MipTexture[TexI] = -1) or (FLastClipmapSize <> FClipmapSize) then begin
  789.       if (MipTexture[TexI] = -1) or (FLastClipmapSize <> FClipmapSize) then begin
  790.         if MipTexture[TexI] <> -1 then Renderer.Textures.Delete(MipTexture[TexI]);
  791.         MipTexture[TexI] := Renderer.Textures.NewProceduralTexture(TProjectedLandscape(Item).MegaTexture.Format, FClipmapSize, FClipmapSize, 0, 1, [toProcedural]);
  792.       end;
  793.       Renderer.Textures.Lock(MipTexture[TexI], 0, nil, LockedData, []);
  794.       TProjectedLandscape(Item).MegaTexture.LoadRect(GetRect(Trunc(CenX - FClipmapSize*0.5), Trunc(CenZ - FClipmapSize*0.5),
  795.                                                              Trunc(CenX - FClipmapSize*0.5)+FClipmapSize, Trunc(CenZ - FClipmapSize*0.5)+FClipmapSize), TexI, LockedData.Data, FClipmapSize);
  796.     //      FillDWord(LockedData.Data^, 512*512, MipColors[i]);
  797.       Renderer.Textures.UnLock(MipTexture[TexI], 0);
  798.       LastTexUpdX := CamOfsX;
  799.       LastTexUpdZ := CamOfsZ;
  800.     end;
  801.     CenX := Frac(CenX - FClipmapSize*0.5)/FClipmapSize;
  802.     CenZ := Frac(CenZ - FClipmapSize*0.5)/FClipmapSize;
  803.     Renderer.Textures.Apply(0, MipTexture[TexI]);
  804.     Renderer.APIState.SetShaderConstant(skVertex, 9, GetVector4s(1/MipWorldSize, -1/MipWorldSize, CenX, CenZ));
  805.   end;
  806.   var i, j, k: Integer;
  807. begin
  808.   if not Assigned(TProjectedLandscape(Item).MegaTexture) then Exit;
  809.   TexUpd := (LastTexUpdX <> CamOfsX) or (LastTexUpdZ <> CamOfsZ);
  810.   LandSizeX := FMap.Width * FMap.CellWidthScale;
  811.   LandSizeZ := FMap.Width * FMap.CellWidthScale;
  812.   j := 0;//FGridHeight-1;
  813.   FMipZ[j] := MinS(FMipZ[j], Sqrt(Sqr(LandSizeX)+Sqr(LandSizeZ)));
  814.   TexI := -1;//+1*ClipmapCount-1-1;
  815.   ApplyNextMip;
  816.   for k := 0 to FarMip-NearMip do for i := 0 to MipDetail[k] - 1-Ord(k=FarMip-NearMip) do begin
  817. //    if j > 0 then FMipZ[j] := (ViewDepth + 1*ExcessDist) * (MipStart[k] + i*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
  818.     if FMipZ[j+1] >= MipWorldSize*0.5 - epsilon then ApplyNextMip();
  819.     TCore(TProjectedLandscape(Item).FManager).Renderer.APIRenderIndexedStrip(Self, j);
  820.     Inc(j);
  821.   end;
  822.   FLastClipmapSize := FClipmapSize;
  823. end;
  824. procedure TProjectedLandTesselator.AddProperties(const Result: TProperties; const PropNamePrefix: TNameString);
  825. var RangeStr: ShortString;
  826. begin
  827.   inherited;
  828.   if Assigned(Result) then begin
  829.     Result.Add(PropNamePrefix + 'X resolution',  vtInt,    [], IntToStr(FGridWidth), '1-300');
  830.     Result.Add(PropNamePrefix + 'YZ resolution', vtInt,    [], IntToStr(FGridHeight), '1-600');
  831.     Result.Add(PropNamePrefix + 'Smooth X', vtNat, [], IntToStr(SmoothX-1), '0-15');
  832.     Result.Add(PropNamePrefix + 'Smooth Z', vtNat, [], IntToStr(SmoothZ-1), '0-15');
  833.     Result.Add(PropNamePrefix + 'Trilinear range', vtSingle, [], FloatToStr(TrilinearRange), '0.0001-1');
  834.     Result.Add(PropNamePrefix + 'Excess distance', vtSingle, [], FloatToStr(ExcessDist), '0-128');
  835.     if Assigned(FMap) then
  836.       RangeStr := IntToStr(Round(FMap.CellWidthScale * 50)) + '-' + IntToStr(Round(FMap.CellWidthScale * 5000)) else
  837.         RangeStr := '50-5000';
  838.     Result.Add(PropNamePrefix + 'View depth', vtSingle, [], FloatToStr(ViewDepth), RangeStr);
  839.     Result.Add(PropNamePrefix + 'Mip level bias', vtSingle, [], FloatToStr(MipBias),       '0-512');
  840.     Result.Add(PropNamePrefix + 'Mip scale',      vtSingle, [], FloatToStr(MipScale),      '0.1-4');
  841.     Result.Add(PropNamePrefix + 'Detail balance', vtSingle, [], FloatToStr(DetailBalance), '0-1');
  842.     Result.Add(PropNamePrefix + 'TextureDiffuse scale', vtSingle, [], FloatToStr(FMegaTextureScale), '0.1-10');
  843.     Result.Add(PropNamePrefix + 'TextureClipmap size',  vtNat,    [], IntToStr(FClipmapSize),        '64-2048');
  844.   end;
  845. end;
  846. procedure TProjectedLandTesselator.SetProperties(Properties: TProperties; const PropNamePrefix: TNameString);
  847. begin
  848.   inherited;
  849.   if Properties.Valid(PropNamePrefix + 'X resolution')  then FGridWidth  := StrToIntDef(Properties[PropNamePrefix + 'X resolution'],  0);
  850.   if Properties.Valid(PropNamePrefix + 'YZ resolution') then FGridHeight := StrToIntDef(Properties[PropNamePrefix + 'YZ resolution'], 0);
  851.   if Properties.Valid(PropNamePrefix + 'Smooth X') then SmoothX := StrToIntDef(Properties[PropNamePrefix + 'Smooth X'], 0) + 1;
  852.   if Properties.Valid(PropNamePrefix + 'Smooth Z') then SmoothZ := StrToIntDef(Properties[PropNamePrefix + 'Smooth Z'], 0) + 1;
  853.   if Properties.Valid(PropNamePrefix + 'Trilinear range') then TrilinearRange := StrToFloatDef(Properties[PropNamePrefix + 'Trilinear range'], 0.3);
  854.   if Properties.Valid(PropNamePrefix + 'Excess distance') then ExcessDist := StrToFloatDef(Properties[PropNamePrefix + 'Excess distance'], 0);
  855.   if Properties.Valid(PropNamePrefix + 'View depth') then ViewDepth := StrToFloatDef(Properties[PropNamePrefix + 'View depth'], 500);
  856.   if Properties.Valid(PropNamePrefix + 'Mip level bias') then MipBias       := StrToFloatDef(Properties[PropNamePrefix + 'Mip level bias'], 50);
  857.   if Properties.Valid(PropNamePrefix + 'Mip scale')      then MipScale      := StrToFloatDef(Properties[PropNamePrefix + 'Mip scale'],      0);
  858.   if Properties.Valid(PropNamePrefix + 'Detail balance') then DetailBalance := StrToFloatDef(Properties[PropNamePrefix + 'Detail balance'], 0.5);
  859.   if Properties.Valid(PropNamePrefix + 'TextureDiffuse scale') then FMegaTextureScale := StrToFloatDef(Properties[PropNamePrefix + 'TextureDiffuse scale'], 1);
  860.   if Properties.Valid(PropNamePrefix + 'TextureClipmap size')  then FClipmapSize      := StrToIntDef(Properties[PropNamePrefix + 'TextureClipmap size'],    256);
  861.   Init;
  862. end;
  863. { TProjGridTesselator }
  864. function TProjGridTesselator.GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer;
  865.   function IsInPnts(const Point: TVector3s): Boolean;
  866.   var i: Integer; v1, v2: TVector3s;
  867.   begin
  868.     Result := False;
  869. {    SubVector3s(V1, Pnt[0], Pnt[3]);
  870.     SubVector3s(V2, Point,  Pnt[3]);
  871.     Y := Sign(V1.Z*V2.X - V1.X*V2.Z);}
  872.     for i := 0 to 3 do begin
  873.       SubVector3s(V1, Pnt[(i+1) mod 4], Pnt[i]);
  874.       SubVector3s(V2, Point, Pnt[i]);
  875.       if Sign(V1.Z*V2.X - V1.X*V2.Z)*FlipSign < 0 then Exit;
  876.     end;
  877.     Result := True;
  878.   end;
  879. var i: Integer;
  880. begin
  881.   if Buffer = tbVertex then begin
  882.     Result := TotalVertices;
  883.     if //not EqualsMatrix4s(Params.Camera.Transform, OldCameraMatrix) or
  884.        (TesselationStatus[Buffer].Status <> tsTesselated) then Exit;
  885.     ProjectGrid(Params, PrjPnt);
  886.     for i := 0 to 3 do if not IsInPnts(PrjPnt[i]) then Exit;
  887. //    Result := 0;
  888.   end else Result := inherited GetUpdatedElements(Buffer, Params);
  889. end;
  890. function TProjGridTesselator.SetIndices(IBPTR: Pointer): Integer;
  891. var i: Integer;
  892. begin
  893.   for i := 0 to TotalIndices div 2-1 do begin
  894.     TWordBuffer(IBPTR^)[i * 2 + 0] := i;
  895.     TWordBuffer(IBPTR^)[i * 2 + 1] := i + FGridWidth + 1;
  896.   end;
  897. //  0  1  2          0 3 1 4 2 5  5 3           P: (w*2)*(h-1)-2 = (3*2)*3-2 = 16
  898. //  3  4  5          3 6 4 7 5 8  8 6           V: w*h = 3*4 = 12
  899. //  6  7  8          6 9 7 A 8 B                I: (2+(w-1)*2+2)*(h-1)-2 = 2*(w+1)*(h-1) = (2+(3-1)*2+2)*3-2 = 8*3-2 = 22
  900. //  9  A  B
  901. {  for j := 0 to FGridHeight-1 do begin
  902.     for i := 0 to FGridWidth+1 - 1 do begin
  903.       Assert(j*(FGridWidth+2)*2 + i*2+1 < TotalIndices);
  904.       i1 := j * (FGridWidth+1) + i;
  905.       TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2 + i*2+0] := i1;
  906.       TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2 + i*2+1] := i1 + (FGridWidth+1);
  907.     end;
  908.     TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2+(FGridWidth+1)*2] := i1 + (FGridWidth+1);
  909.     TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2+(FGridWidth+1)*2+1] := (j+1)*(FGridWidth+1);
  910.   end;}
  911.   TesselationStatus[tbIndex].Status := tsTesselated;
  912.   Result  := TotalIndices;
  913.   LastTotalIndices := TotalIndices;
  914. end;
  915. function TProjGridTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  916. var
  917.   HalfLengthX, HalfLengthZ: Single;
  918.   VBuf: ^TVector3s;
  919.   // Returns True if the ray intersects with the grid
  920. (*  function ProjectOnGrid(X, Y: Single; out Point: TVector3s; CorrectOnly: Boolean): Boolean;
  921.   const CosA = 0.7;
  922.   var PickRay: TVector3s; K: Single;
  923.   begin
  924.     PickRay := Transform3Vector3s(CutMatrix3s(InvertAffineMatrix4s(Params.Camera.ViewMatrix)), Params.Camera.GetPickRay2(X, Y));
  925.     PickRay := NormalizeVector3s( Transform3Vector3s(ModelInv33, PickRay) );
  926.     if (CorrectOnly) or
  927.        (Abs(PickRay.Y) > epsilon) and (Sign(PickRay.Y) <> Sign(CameraInModel.Y)) and
  928.        (Abs(CameraElevation/PickRay.Y) < ViewDepth) then begin                      // Ray intersects the surface
  929.       SubVector3s(Point, CameraInModel, ScaleVector3s(PickRay, CameraElevation/PickRay.Y));
  930.       Point.Y := 0;
  931.       Result := True;
  932.     end else begin
  933.       PickRay.Y := 0;
  934.       PickRay := NormalizeVector3s(PickRay);
  935.       ScaleVector3s(PickRay, PickRay, ViewDepth);
  936.       Point := PickRay;
  937.       Point.Y := 0;
  938. //      K := Sqrt(SqrMagnitude(Point))/ViewDepth;
  939. //      if K < CosA then
  940.       K := 1;
  941.       AddVector3s(Point, CameraInModel, ScaleVector3s(PickRay, 1/K));
  942.       Point.Y := 0;
  943.       Result := False;
  944.     end;
  945.   end;
  946.   procedure RestrictGrid;
  947.   var i, i2, cnt: Integer;
  948.     function IsInLandscape(const Point: TVector3s): Boolean;
  949.     begin
  950.       Result := (Point.X > -HalfLengthX) and (Point.X < HalfLengthX) and
  951.                 (Point.Z > -HalfLengthZ) and (Point.Z < HalfLengthZ);
  952.     end;
  953.   begin
  954.     i := 0;
  955.     while (i < 4) and not IsInLandscape(Pnt[i]) do Inc(i);
  956.     if i < 4 then begin
  957.       i2 := (i + 1) mod 4;
  958.       for cnt := 0 to 3 do begin
  959.         if not IsInLandscape(Pnt[i2]) then begin
  960.           P := Pnt[i];
  961.           ClipLine(P.X, P.Z, Pnt[i2].X, Pnt[i2].Z, -HalfLengthX, -HalfLengthZ, HalfLengthX, HalfLengthZ);
  962.         end;
  963.         i  := i2;
  964.         i2 := (i + 1) mod 4;
  965.       end;
  966.     end else begin
  967.       Pnt[0] := GetVector3s(-HalfLengthX, 0,  HalfLengthZ);
  968.       Pnt[1] := GetVector3s( HalfLengthX, 0,  HalfLengthZ);
  969.       Pnt[2] := GetVector3s( HalfLengthX, 0, -HalfLengthZ);
  970.       Pnt[3] := GetVector3s(-HalfLengthX, 0, -HalfLengthZ);
  971.     end;
  972.   end;
  973.   function ProjectBottomEdge(var Pnt1, Pnt2: TVector3s): Integer;
  974.   var Proj: TVector4s;
  975.   begin
  976.     Result := 0;
  977.     if ProjectOnGrid(Params.Camera.RenderWidth, Params.Camera.RenderHeight, Pnt1, False) then
  978.     Inc(Result) else begin                                                                      // ToDo: Syncronize this case with Pnt2?
  979.       Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt1));
  980.       if (Proj.X < Params.Camera.RenderWidth-1) then ProjectOnGrid(Params.Camera.RenderWidth, Proj.Y, Pnt1, True);
  981.     end;
  982.     if ProjectOnGrid(0,                         Params.Camera.RenderHeight, Pnt2, False) then
  983.     Inc(Result) else begin
  984.       Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt2));
  985.       if (Proj.X > 0) then ProjectOnGrid(0, Proj.Y, Pnt2, True);
  986.     end;
  987.   end;
  988.   function ProjectTopEdge(var Pnt1, Pnt2: TVector3s): Integer;
  989.   var Proj: TVector4s;
  990.   begin
  991.     Result := 0;
  992.     if ProjectOnGrid(0,                         0,                          Pnt1, False) then
  993.       Inc(Result) else begin                                                                    // ToDo: Syncronize this case with Pnt2?
  994.         Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt1));
  995.         if (Proj.X > 0) then ProjectOnGrid(0, Proj.Y, Pnt1, True);
  996.       end;
  997.     if ProjectOnGrid(Params.Camera.RenderWidth, 0,                          Pnt2, False) then
  998.       Inc(Result) else begin
  999.         Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt2));
  1000.        if (Proj.X < Params.Camera.RenderWidth-1) then ProjectOnGrid(Params.Camera.RenderWidth, Proj.Y, Pnt2, True);
  1001.       end;
  1002.   end;
  1003.   *)
  1004. var
  1005.   P, P1, P2, P1Incr, P2Incr, PIncr: TVector3s;
  1006.   OneOverCellWidthScale, OneOverCellHeightScale: Single;
  1007.   i, k, l, X1, Z1, Addr: Integer;
  1008.   Data, Data2: Pointer;
  1009.   LastY, CurY, xo, zo: Single;
  1010. //  LastLine: array[0..1023] of Single;
  1011.   a, MinA, FRACos: Single;
  1012.   OutP: TVector3s;
  1013.   DistIncr, FarDist, NearDist, TempK, Error: Single;
  1014.   FirstPartK, LastPartK, LightMapScaleX, LightMapScaleZ, MipK, MipDivider, TempX, TempZ: Single;
  1015.   MipW, MipH, MipW2, MipH2, Index: Integer;
  1016.   IndI, IndJ: Cardinal;
  1017. {  function GetHeight(AData: Pointer; Offs: Integer): Single;
  1018.   const k1 = 0.25; k2 = 0.0;
  1019.   var X, Y: Integer;
  1020.   begin
  1021.     X := Offs mod MipW;
  1022.     Y := Offs div MipW;
  1023.     Result :=
  1024.                PByteBuffer(AData)^[Offs-MipW*2] * K2 +
  1025.                PByteBuffer(AData)^[Offs-MipW] * K1 +
  1026.                PByteBuffer(AData)^[Offs-2] * K2 +
  1027.                PByteBuffer(AData)^[Offs-1] * K1 +
  1028.                PByteBuffer(AData)^[Offs] * (1-K1*4-k2*4)+
  1029.                PByteBuffer(AData)^[Offs+MipW] * K1+
  1030.                PByteBuffer(AData)^[Offs+2*MipW] * K2+
  1031.                PByteBuffer(AData)^[Offs+2] * K2+
  1032.                PByteBuffer(AData)^[Offs+1] * K1 ;
  1033. //    Result := MaxI(0, Round((Sin(X * pi*2*4)*0+Sin(Y*0.01 * pi*2)) * 40));
  1034.   end;}
  1035.   type
  1036.     PBB = PByteBuffer;
  1037.     TData = record
  1038.       case Boolean of
  1039.         True: (a, b, c, d: Byte);
  1040.         False: (d32: Longword);
  1041.     end;
  1042.     TData2 = record
  1043.       case Boolean of
  1044.         True: (a, b: Byte);
  1045.         False: (d16: longword);
  1046.     end;
  1047.   var
  1048.     d0, d1, d2, d3: TData;
  1049.     ModelInv: TMatrix4s; CameraInModel: TVector3s;
  1050.     j: Integer;
  1051. begin
  1052.   Result := 0;
  1053.   if not Assigned(FMap) or not FMap.IsReady then Exit;
  1054.   OldCameraMatrix := Params.Camera.Transform;
  1055.   ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
  1056.   Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
  1057.   CamOfsX := CameraInModel.X;
  1058.   CamOfsZ := CameraInModel.Z;
  1059.   HalfLengthX := (FMap.Width-1)  * FMap.CellWidthScale  * 0.5;
  1060.   HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
  1061.   LightMapScaleX := 0.5/HalfLengthX;
  1062.   LightMapScaleZ := 0.5/HalfLengthZ;
  1063.   OneOverCellWidthScale  := 1/FMap.CellWidthScale;
  1064.   OneOverCellHeightScale := 1/FMap.CellHeightScale;
  1065.   ProjectGrid(Params, PrjPnt);
  1066.   AddVector3s(Pnt[0], PrjPnt[0], Vec3s(ExcessDist*(-CameraRight.X + CameraDir.X), 0, ExcessDist*(-CameraRight.Z + CameraDir.Z)));
  1067.   AddVector3s(Pnt[1], PrjPnt[1], Vec3s(ExcessDist*( CameraRight.X + CameraDir.X), 0, ExcessDist*( CameraRight.Z + CameraDir.Z)));
  1068.   AddVector3s(Pnt[2], PrjPnt[2], Vec3s(ExcessDist*( CameraRight.X - CameraDir.X), 0, ExcessDist*( CameraRight.Z - CameraDir.Z)));
  1069.   AddVector3s(Pnt[3], PrjPnt[3], Vec3s(ExcessDist*(-CameraRight.X - CameraDir.X), 0, ExcessDist*(-CameraRight.Z - CameraDir.Z)));
  1070. //  FillChar(LastLine[0], SizeOf(LastLine), 0);
  1071. //  LastLine[0] := FMap.GetHeight((Pnt[3].X+Pnt[2].X)*0.5, (Pnt[3].Z+Pnt[2].Z)*0.5);
  1072. //  FillDword(LastLine[1], FGridWidth, Cardinal(Pointer(@LastLine[0])^));
  1073.   NearDist := Sqrt(SqrMagnitude(SubVector3s(Pnt[2], Pnt[3])));
  1074.   FarDist  := Sqrt(SqrMagnitude(SubVector3s(Pnt[1], Pnt[0])));
  1075.   DistIncr := FarDist - NearDist;
  1076.   if DistIncr < 0 then Exit;
  1077. //  if not FInfinite then RestrictGrid;
  1078.   NearMip := 0;
  1079.   while (NearMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
  1080.         (FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
  1081.     Inc(NearMip);
  1082.   FarMip := 0;
  1083.   while (FarMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
  1084.         (FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
  1085.     Inc(FarMip);
  1086.   for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
  1087.   if MipStart[FarMip-NearMip+1] < 1 then begin
  1088.     Assert(MipStart[FarMip-NearMip+1] >= 1);
  1089.   end;
  1090.   if FarMip-NearMip >= 1 then begin
  1091.     MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
  1092.     FirstPartK  := MipStart[1]/(MipStart[1] - MipStart[0]);
  1093.     LastPartK   := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
  1094.     TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
  1095.     MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
  1096.     Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
  1097.     for i := NearMip+1 to FarMip-1 do begin
  1098.       MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
  1099.       Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
  1100.     end;
  1101.     MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
  1102.     Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
  1103.     if Error >= 0.5 then Inc(MipDetail[0]);
  1104.     if MipDetail[FarMip-NearMip] <= 1 then begin
  1105.       Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
  1106.       Dec(FarMip);
  1107.     end;
  1108.     Error := 0;
  1109.     for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
  1110.     Assert(Error = (FGridHeight+1));
  1111.   end else begin
  1112.     MipDetail[0] := (FGridHeight+1);
  1113.   end;
  1114.   MipStart[0] := 0;
  1115.   MipStart[FarMip-NearMip+1] := 1;
  1116.   P1Incr := ScaleVector3s(NormalizeVector3s(SubVector3s(Pnt[0], Pnt[3])), MinS(FMap.CellWidthScale, FMap.CellHeightScale));
  1117.   P2Incr := ScaleVector3s(NormalizeVector3s(SubVector3s(Pnt[1], Pnt[2])), MinS(FMap.CellWidthScale, FMap.CellHeightScale));
  1118.   VBuf := VBPTR;
  1119.   j := 0;
  1120.   for k := 0 to FarMip-NearMip do begin
  1121.     P1 := Pnt[3];
  1122.     P2 := Pnt[2];
  1123.     SubVector3s(OutP, Pnt[0], Pnt[3]);
  1124.     AddVector3s(P1, Pnt[3], ScaleVector3s(OutP, MipStart[k]));
  1125.     ScaleVector3s(P1Incr, OutP, (MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
  1126.     SubVector3s(OutP, Pnt[1], Pnt[2]);
  1127.     AddVector3s(P2, Pnt[2], ScaleVector3s(OutP, MipStart[k]));
  1128.     ScaleVector3s(P2Incr, OutP, (MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
  1129.     Data  := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip].Offset);
  1130.     Data2 := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip+1].Offset);
  1131.     MipDivider := 1/(1 shl (k + NearMip));
  1132.     MipW  := FMap.Width  shr (k + NearMip);
  1133.     MipH  := FMap.Height shr (k + NearMip);
  1134.     MipW2 := FMap.Width  shr (k + NearMip+1);
  1135.     MipH2 := FMap.Height shr (k + NearMip+1);
  1136.     for l := 0 to MipDetail[k]-1 do begin
  1137.       FMipZ[j] := Sqrt(SqrMagnitude(SubVector3s(Pnt[3], P1)));
  1138. //      Sqrt(SqrMagnitude(GetVector3s(P1.X - CamOfsX, 0, P1.Z - CamOfsZ)));
  1139.       Inc(j);
  1140.       ScaleVector3s(PIncr, SubVector3s(P2, P1), 1 / FGridWidth);
  1141.       P := P1;
  1142.       MipK := MaxS(0, l/MipDetail[k] - (1-TrilinearRange))/TrilinearRange;
  1143.       if MipK < epsilon then begin
  1144.         for i := 0 to FGridWidth do begin       // _/_
  1145.           TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale  * MipDivider;
  1146.           TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
  1147.           X1 := FastTrunc(TempX);
  1148.           Z1 := FastTrunc(TempZ);
  1149.           xo := (TempX - X1);// * Ord(X1 >= 0) * Ord(X1 < MipW);
  1150.           zo := (TempZ - Z1);// * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  1151.           X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
  1152.           Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  1153.           Addr := Z1 * MipW + X1;
  1154. //          ti1 := Addr + MipW * Ord(Z1 < MipH-1);
  1155. //          ti2 := Ord(X1 < MipW-1);
  1156.           // May read 2 bytes outside texture data. It's safe because these 2 bytes will go from next mipmap.
  1157.           d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
  1158.           d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
  1159.           d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
  1160.           d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
  1161.           P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  1162.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  1163.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  1164.                             ( d1.c + d2.b + d2.d + d3.c ) * zo)) * FMap.DepthScale * 0.25;
  1165. {         0   1   2   3
  1166.           4   5   6   7
  1167.           8   9   A   B
  1168.           C   D   E   F}
  1169. {          P.Y := ((1-xo) * (PByteBuffer(Data)^[Addr] * (1-zo) +
  1170.                              PByteBuffer(Data)^[ti1] * zo ) +
  1171.                       xo  * (PByteBuffer(Data)^[Addr + ti2] * (1-zo) +
  1172.                              PByteBuffer(Data)^[ti1 + ti2] * zo)) * FMap.DepthScale;}
  1173. //          P.Y := (LastLine[i]*0 + 2*CurY)*0.5;
  1174. //          LastLine[i] := CurY;
  1175.           VBuf^ := P;
  1176. //          TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
  1177.           Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
  1178.           Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
  1179.           VBuf := Pointer(Integer(VBuf) + FVertexSize);
  1180.           P.X := P.X + PIncr.X;
  1181.           P.Z := P.Z + PIncr.Z;
  1182.         end;
  1183.       end else begin
  1184.         for i := 0 to FGridWidth do begin       // _/_
  1185.           TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale  * MipDivider;
  1186.           TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
  1187.           X1 := FastTrunc(TempX);
  1188.           Z1 := FastTrunc(TempZ);
  1189.           xo := (TempX - X1){ * Ord(X1 >= 0) * Ord(X1 < MipW)};
  1190.           zo := (TempZ - Z1){ * Ord(Z1 >= 0) * Ord(Z1 < MipH)};
  1191.           X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
  1192.           Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  1193.           Addr := Z1 * MipW + X1;
  1194. //          ti1 := Addr + MipW * Ord(Z1 < MipH-1);
  1195. //          ti2 := Ord(X1 < MipW-1);
  1196. {          T1 := Addr - MipW * Ord(Z1 > 0);
  1197.           T2 := T1 + Ord(X1 < MipW-1);
  1198.           T4 := Addr - Ord(X1 > 0);
  1199.           T5 := Addr;
  1200.           T6 := Addr + Ord(X1 < MipW-1);
  1201.           T7 := T6 + Ord(X1 < MipW-2);
  1202.           T9 := Addr + MipW * Ord(Z1 < MipH-1);
  1203.           T8 := T9 - Ord(X1 > 1);
  1204.           TA := T9 + Ord(X1 < MipW-1);
  1205.           TB := TA + Ord(X1 < MipW-2);
  1206.           TD := T9 + MipW * Ord(Z1 < MipH-2);
  1207.           TE := TD + Ord(X1 < MipW-1);
  1208.           P.Y := ((1-xo) * (( PBB(Data)^[T1] + PBB(Data)^[T4] + PBB(Data)^[T6] + PBB(Data)^[T9] ) * (1-zo) +
  1209.                              ( PBB(Data)^[T5] + PBB(Data)^[T8] + PBB(Data)^[TA] + PBB(Data)^[TD] ) * zo ) +
  1210.                       xo  * (( PBB(Data)^[T2] + PBB(Data)^[T5] + PBB(Data)^[T7] + PBB(Data)^[TA] ) * (1-zo) +
  1211.                              ( PBB(Data)^[T6] + PBB(Data)^[T9] + PBB(Data)^[TB] + PBB(Data)^[TE] ) * zo));}
  1212.           d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
  1213.           d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
  1214.           d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
  1215.           d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
  1216.           P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  1217.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  1218.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  1219.                             ( d1.c + d2.b + d2.d + d3.c ) * zo));
  1220.  {         P.Y := ((1-xo) * (PByteBuffer(Data)^[Addr] * (1-zo) +
  1221.                              PByteBuffer(Data)^[ti1] * zo ) +
  1222.                       xo  * (PByteBuffer(Data)^[Addr + ti2] * (1-zo) +
  1223.                              PByteBuffer(Data)^[ti1 + ti2] * zo));}
  1224.           // Second mip
  1225.           xo := (xo + X1 and 1)*0.5;
  1226.           zo := (zo + Z1 and 1)*0.5;
  1227.           X1 := X1 shr 1;
  1228.           Z1 := Z1 shr 1;
  1229.           Addr := Z1 * MipW2 + X1;
  1230. //          ti1 := Addr + MipW2 * Ord(Z1 < MipH2-1);
  1231. //          ti2 := Ord(X1 < MipW2-1);
  1232.           d0.d32 := PLongword(Integer(Data2) + Addr - MipW2 * Ord(Z1 > 0) - Ord(X1 > 0))^;
  1233.           d1.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0))^;
  1234.           d2.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1))^;
  1235.           d3.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1) + MipW2 * Ord(Z1 < MipH2-2))^;
  1236.           P.Y := 0.25*(P.Y * (1 - MipK) + MipK * (
  1237.                   (1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  1238.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  1239.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  1240.                             ( d1.c + d2.b + d2.d + d3.c ) * zo)) ) * FMap.DepthScale;
  1241. {          P.Y := (P.Y * (1 - MipK) + MipK * (
  1242.                           (1-xo) * (PByteBuffer(Data2)^[Addr] * (1-zo) +
  1243.                                     PByteBuffer(Data2)^[ti1] * zo ) +
  1244.                              xo  * (PByteBuffer(Data2)^[Addr + ti2] * (1-zo) +
  1245.                                     PByteBuffer(Data2)^[ti1 + ti2] * zo) )) * FMap.DepthScale;}
  1246. //          P.Y := (LastLine[i]*1 + 1*CurY)*0.5;
  1247. //          LastLine[i] := CurY;
  1248.           VBuf^ := P;
  1249. //          TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
  1250.           Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
  1251.           Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
  1252.           VBuf := Pointer(Integer(VBuf) + FVertexSize);
  1253.           P.X := P.X + PIncr.X;
  1254.           P.Z := P.Z + PIncr.Z;
  1255.         end;
  1256.       end;
  1257.       P1.X := P1.X + P1Incr.X;
  1258.       P1.Z := P1.Z + P1Incr.Z;
  1259.       P2.X := P2.X + P2Incr.X;
  1260.       P2.Z := P2.Z + P2Incr.Z;
  1261.     end;
  1262.   end;
  1263.   TesselationStatus[tbVertex].Status := tsTesselated;
  1264. //  TesselationStatus[tbVertex].Status := tsChanged;
  1265.   Result  := TotalVertices;
  1266. //  Assert((FGridWidth+1)*jj = Result);
  1267.   LastTotalVertices := TotalVertices;
  1268. end;
  1269. { TProjectedLandscape }
  1270. procedure TProjectedLandscape.InitShaderConstants;
  1271. begin
  1272.   if Assigned(FMap) then begin
  1273.     SetLength(ShaderConsts, 2);
  1274.     ShaderConsts[0].ShaderKind     := skVertex;
  1275.     ShaderConsts[0].ShaderRegister := 10;
  1276.     ShaderConsts[0].Value          := Vec4s(FTextureScale, FTextureScale, 0, -1);
  1277.     ShaderConsts[1].ShaderKind     := skVertex;
  1278.     ShaderConsts[1].ShaderRegister := 11;
  1279.     ShaderConsts[1].Value          := Vec4s(1/(FMap.Width*FMap.CellWidthScale), 1/(FMap.Height*FMap.CellHeightScale), 0.5*FMap.Width*FMap.CellWidthScale, 0.5*FMap.Height*FMap.CellHeightScale);
  1280.   end;
  1281. end;
  1282. function TProjectedLandscape.GetMegaTexture: TMegaImageResource;
  1283. var Item: TItem;
  1284. begin
  1285.   ResolveLink('Megatexture', Item);
  1286.   Result := Item as TMegaImageResource;
  1287. end;
  1288. procedure TProjectedLandscape.OnModify(const ARect: BaseTypes.TRect);
  1289. begin
  1290.   inherited;
  1291.   RecalcLightMap(ARect);
  1292. end;
  1293. constructor TProjectedLandscape.Create(AManager: TItemsManager);
  1294. begin
  1295.   inherited;
  1296.   SetLength(FTesselators, 3);
  1297.   FTextureScale := 0.1;
  1298.   FLightmapType := lmtLightMap;
  1299. end;
  1300. procedure TProjectedLandscape.OnSceneLoaded;
  1301. begin
  1302.   inherited;
  1303.   InitShaderConstants;
  1304. end;
  1305. procedure TProjectedLandscape.RetrieveShaderConstants(var ConstList: TShaderConstants);
  1306. var CamInModel: TVector2s;
  1307. begin
  1308.   if CurrentTesselator is TProjectedLandTesselator then
  1309.     CamInModel := Vec2s(TProjectedLandTesselator(CurrentTesselator).CamOfsX, TProjectedLandTesselator(CurrentTesselator).CamOfsZ)
  1310.   else
  1311.     CamInModel := Vec2s(0, 0);
  1312.   ShaderConsts[0].Value.Z := CamInModel.X;
  1313.   ShaderConsts[0].Value.W := CamInModel.Y;
  1314.   ConstList := ShaderConsts;
  1315. end;
  1316. const
  1317.   LightmapBasePropName  = 'Lightmap recalc';
  1318.   LightmapTexPropName   = LightmapBasePropName + 'Texture';
  1319.   LightmapLightPropName = LightmapBasePropName + 'Light source';
  1320.   LightmapTypePropName  = LightmapBasePropName + 'Type';
  1321. procedure TProjectedLandscape.AddProperties(const Result: Props.TProperties);
  1322. begin
  1323.   inherited;
  1324.   AddItemLink(Result, LightmapTexPropName,   [], 'TImageResource');
  1325.   AddItemLink(Result, LightmapLightPropName, [], 'TLight');
  1326.   AddItemLink(Result, 'Megatexture',         [], 'TMegaImageResource');
  1327.   if Assigned(Result) then begin
  1328.     Result.AddEnumerated(LightmapTypePropName,  [], Ord(FLightmapType), LightmapTypesEnum);
  1329.     Result.Add(LightmapBasePropName, vtBoolean, [], OnOffStr[False], '');
  1330.     Result.Add('Texture scale', vtSingle, [], FloatToStr(FTextureScale),    '0,01-10');
  1331.   end;
  1332. end;
  1333. procedure TProjectedLandscape.SetProperties(Properties: Props.TProperties);
  1334. var i: Integer;
  1335. begin
  1336.   inherited;
  1337.   if Properties.Valid(LightmapTexPropName)   then SetLinkProperty(LightmapTexPropName,   Properties[LightmapTexPropName]);
  1338.   if Properties.Valid(LightmapLightPropName) then SetLinkProperty(LightmapLightPropName, Properties[LightmapLightPropName]);
  1339.   if Properties.Valid(LightmapTypePropName) then FLightmapType := TLightmapType(Properties.GetAsInteger(LightmapTypePropName));
  1340.   if Properties.Valid('Megatexture') then SetLinkProperty('Megatexture', Properties['Megatexture']);
  1341.   if Properties.Valid('Texture scale')       then FTextureScale := StrToFloatDef(Properties['Texture scale'], 0);
  1342.   if Assigned(FMap) and
  1343.      Properties.Valid(LightmapBasePropName) and (Properties.GetAsInteger(LightmapBasePropName) > 0) then
  1344.     RecalcLightMap(GetRect(0, 0, FMap.Width, FMap.Height));
  1345.   InitShaderConstants;
  1346.   for i := 0 to High(FTesselators) do (FTesselators[i] as TProjectedLandTesselator).Renderer := TCore(FManager).Renderer;
  1347. end;
  1348. procedure TProjectedLandscape.Process(const DeltaTime: Single);
  1349. begin
  1350.   inherited;
  1351. //  if Assigned(CurrentTesselator) then CurrentTesselator.Invalidate(False);
  1352. end;
  1353. procedure TProjectedLandscape.ProjectGrid(const Camera: TCamera; out PrjPnt: TQuadPoints);
  1354. var Params: TTesselationParameters;
  1355. begin
  1356.   if not (CurrentTesselator is TProjectedLandTesselator) then Exit;
  1357.   Params.Camera := Camera;
  1358.   Params.ModelMatrix := Transform;
  1359.   TProjectedLandTesselator(CurrentTesselator).ProjectGrid(Params, PrjPnt);
  1360. end;
  1361. procedure TProjectedLandscape.RecalcLightMap(ARect: BaseTypes.TRect);
  1362. var
  1363.   Item: TItem; Image: TImageResource; Light: TLight; N: TVector3s;
  1364.   tmp, i, j, k, l, w, h: Integer;
  1365.   oneoverwh, LPower: Single;
  1366.   LightColor: TColor;
  1367.   Buffer: Pointer;
  1368. begin
  1369.   ResolveLink(LightmapTexPropName, Item);
  1370.   if not Assigned(Item) or not Assigned(FMap) then Exit;
  1371.   Image := Item as TImageResource;
  1372.   ResolveLink(LightmapLightPropName, Item);
  1373.   if not Assigned(Item) and (FLightmapType = lmtLightmap) then Exit;
  1374.   Light := Item as TLight;
  1375. //  FillChar(Image.Data^, Image.DataSize, 0);
  1376.   w := FMap.Width  div Image.Width;
  1377.   h := FMap.Height div Image.Height;
  1378.   if (w = 0) or (h = 0) then begin
  1379.     Log.Log('TProjectedLandscape.RecalcLightMap: Lightmap should be same size as heightmap or less', lkError);
  1380.     Exit;
  1381.   end;
  1382.   ARect.Left   := ClampI(ARect.Left,   0, FMap.Width-1)  div w;
  1383.   ARect.Right  := ClampI(ARect.Right,  0, FMap.Width-1)  div w;
  1384.   ARect.Top    := ClampI(ARect.Top,    0, FMap.Height-1) div h;
  1385.   ARect.Bottom := ClampI(ARect.Bottom, 0, FMap.Height-1) div h;
  1386.   oneoverwh := 1 / (w*h);
  1387.   if FLightmapType = lmtLightmap then begin
  1388.     LightColor := GetColorFrom4s(Light.Diffuse);
  1389.     GetMem(Buffer, Image.Width{ * Image.Height} * ProcessingFormatBpP);
  1390.     for j := ARect.Top to ARect.Bottom-1 do begin
  1391.       for i := ARect.Left to ARect.Right-1 do begin
  1392.         LPower := 0;
  1393.         for k := i*w to MinI(FMap.Width, (i+1)*w)-1 do for l := j*h to MinI(FMap.Width, (j+1)*h)-1 do
  1394.           LPower := LPower + MaxS(0, -DotProductVector3s(FMap.GetCellNormal(k, l), Light.ForwardVector));
  1395.         LPower := LPower * oneoverwh;
  1396.         PImageBuffer(Buffer)^[i] := ScaleColorS(LightColor, MinS(LPower, 1));
  1397.       end;
  1398.       ConvertFromProcessing(Image.Format, ARect.Right - ARect.Left, PtrOffs(Buffer, ARect.Left * ProcessingFormatBpP), tmp, nil, PtrOffs(Image.Data, (j * Image.Width + ARect.Left) * GetBytesPerPixel(Image.Format)));
  1399.     end;
  1400.     FreeMem(Buffer);
  1401.   end else if FLightmapType = lmtNormalmap then begin
  1402.     if GetBytesPerPixel(Image.Format) <> 4 then begin
  1403.       Log.Log('TProjectedLandscape.RecalcLightMap: Normal map should be of 4 bytes per pixel format', lkError);
  1404.       Exit;
  1405.     end;
  1406.     for j := ARect.Top to ARect.Bottom-1 do for i := ARect.Left to ARect.Right-1 do begin
  1407.       N := ZeroVector3s;
  1408.       for k := i*w to MinI(FMap.Width, (i+1)*w)-1 do for l := j*h to MinI(FMap.Width, (j+1)*h)-1 do
  1409.         AddVector3s(N, N, FMap.GetCellNormal(k, l));
  1410.       N.Y := N.Y * 0.7;  
  1411. //      ScaleVector3s(N, N, oneoverwh);
  1412.       NormalizeVector3s(N, N);
  1413.       PImageBuffer(Image.Data)^[j * Image.Width + i] := VectorToColor(N);
  1414.     end;
  1415.   end;
  1416.   SendMessage(TResourceModifyMsg.Create(Image), nil, [mfCore]);
  1417. end;
  1418. procedure TProjectedLandscape.HandleMessage(const Msg: TMessage);
  1419. begin
  1420.   inherited;
  1421.   {$IFDEF EDITORMODE}
  1422. //  if Msg.ClassType = TMapDrawCursorMsg then with TMapDrawCursorMsg(Msg) do DrawCursor(Cursor, Cursor.Camera, Cursor.Screen);
  1423. //  if (Msg.ClassType = TMapModifyBeginMsg) or (Msg.ClassType = TMapModifyMsg) then with TMapEditorMessage(Msg) do Modify(Cursor, Cursor.Camera);
  1424.   {$ENDIF}
  1425. end;
  1426. function TProjectedLandscape.VisibilityCheck(const Camera: TCamera): Boolean;
  1427. var d: Single; LOD: Integer; CameraPos: TVector3s;
  1428. begin
  1429.   Result := Assigned(FTesselators[0]) and (Camera.IsSpehereVisible(GetAbsLocation, BoundingSphereRadius) <> fcOutside);
  1430.   if Result then begin
  1431.     CameraPos := Camera.GetAbsLocation;
  1432.     CameraPos := Transform4Vector33s(InvertAffineMatrix4s(Transform), CameraPos);
  1433.     d := (CameraPos.Y - FMap.GetHeight(CameraPos.X, CameraPos.Z))/(FTesselators[0] as TProjectedLandTesselator).ViewDepth;
  1434.     LOD := ClampI(Round(High(FTesselators) * d + Camera.LODBias), 0, High(FTesselators));
  1435.     FCurrentTesselator := FTesselators[LOD];
  1436.   end;
  1437. end;
  1438. { TProjGridLandscape }
  1439. function TProjGridLandscape.GetTesselatorClass: CTesselator; begin Result := TProjGridTesselator; end;
  1440. { TRadGridLandscape }
  1441. function TRadGridLandscape.GetTesselatorClass: CTesselator; begin Result := TRadGridTesselator; end;
  1442. { TRadGridTesselator }
  1443. procedure TRadGridTesselator.InitGrid;
  1444. var
  1445.   i, k, l: Integer;
  1446.   DistIncr, FarDist, NearDist, TempK, Error: Single;
  1447.   MipStart: array[0..31] of Single;
  1448.   FirstPartK, LastPartK: Single;
  1449.   j: Integer;
  1450.   Rad: Single;
  1451. begin
  1452.   if not Assigned(FMap) or not FMap.IsReady then Exit;
  1453.   SetLength(FGrid, TotalVertices);
  1454.   Rad := 0;
  1455.   NearDist := 2*pi * Rad;
  1456.   FarDist  := 2*pi * (ViewDepth + 1*ExcessDist);
  1457.   DistIncr := FarDist - NearDist;
  1458.   if DistIncr < 0 then Exit;
  1459.   NearMip := 0;
  1460.   while (NearMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
  1461.         (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
  1462.     Inc(NearMip);
  1463.   FarMip := 0;
  1464.   while (FarMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
  1465.         (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
  1466.     Inc(FarMip);
  1467.   for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
  1468.   if MipStart[FarMip-NearMip+1] < 1 then begin
  1469. //    Assert(MipStart[FarMip-NearMip+1] >= 1);
  1470.   end;
  1471.   if FarMip-NearMip >= 1 then begin
  1472.     MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
  1473.     FirstPartK  := MipStart[1]/(MipStart[1] - MipStart[0]);
  1474.     LastPartK   := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
  1475.     TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
  1476.     MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
  1477.     Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
  1478.     for i := NearMip+1 to FarMip-1 do begin
  1479.       MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
  1480.       Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
  1481.     end;
  1482.     MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
  1483.     Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
  1484.     if Error >= 0.5 then Inc(MipDetail[0]);
  1485.     if MipDetail[FarMip-NearMip] <= 1 then begin
  1486.       Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
  1487.       Dec(FarMip);
  1488.     end;
  1489.     Error := 0;
  1490.     for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
  1491.     Assert(Error = (FGridHeight+1));
  1492.   end else begin
  1493.     MipDetail[0] := (FGridHeight+1);
  1494.   end;
  1495.   MipStart[0] := 0;
  1496.   MipStart[FarMip-NearMip+1] := 1;
  1497.   j := 0;
  1498.   for k := 0 to FarMip-NearMip do begin
  1499.     for l := 0 to MipDetail[k]-1 do begin
  1500.       Rad := (ViewDepth + 1*ExcessDist) * (MipStart[k] + l*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
  1501.       FMipZ[j] := Rad;
  1502.       for i := 0 to FGridWidth do begin       // _/_
  1503.         SinCos(2*pi*i/(FGridWidth-1), FGrid[j*(FGridWidth+1)+i].Y, FGrid[j*(FGridWidth+1)+i].X);
  1504.         FGrid[j*(FGridWidth+1)+i].X := Rad * FGrid[j*(FGridWidth+1)+i].X;
  1505.         FGrid[j*(FGridWidth+1)+i].Y := Rad * FGrid[j*(FGridWidth+1)+i].Y;
  1506.       end;
  1507.       Inc(j);
  1508.     end;
  1509.   end;
  1510. end;
  1511. procedure TRadGridTesselator.Init;
  1512. begin
  1513.   inherited;
  1514.   InitGrid;
  1515. end;
  1516. function TRadGridTesselator.GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer;
  1517. var LCameraInModel, LOldCameraInModel: TVector3s; ModelInv: TMatrix4s;
  1518. begin
  1519.   if Buffer = tbVertex then begin
  1520.     ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
  1521.     Transform4Vector33s(LCameraInModel, ModelInv, Params.Camera.GetAbsLocation);
  1522.     Transform4Vector33s(LOldCameraInModel, ModelInv, OldCameraMatrix.ViewTranslate);
  1523.     Result := TotalVertices * Ord( (Sqr(LCameraInModel.X - LOldCameraInModel.X)+Sqr(LCameraInModel.Z - LOldCameraInModel.Z)) > Sqr(ExcessDist));
  1524.   end else Result := inherited GetUpdatedElements(Buffer, Params);
  1525. end;
  1526. function TRadGridTesselator.SetIndices(IBPTR: Pointer): Integer;
  1527. var i: Integer;
  1528. begin
  1529.   for i := 0 to TotalIndices div 2-1 do begin
  1530. //    TWordBuffer(IBPTR^)[i * 2 + 0] := i * (FGridHeight+1) + 0;
  1531. //    TWordBuffer(IBPTR^)[i * 2 + 1] := i * (FGridHeight+1) + 1;
  1532.     TWordBuffer(IBPTR^)[i * 2 + 0] := i;
  1533.     TWordBuffer(IBPTR^)[i * 2 + 1] := i + (FGridWidth+1);
  1534.   end;
  1535.   TesselationStatus[tbIndex].Status := tsTesselated;
  1536.   Result  := TotalIndices;
  1537.   LastTotalIndices := TotalIndices;
  1538. end;
  1539. function TRadGridTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  1540. var
  1541.   HalfLengthX, HalfLengthZ: Single;
  1542.   VBuf: PVector3s;
  1543.   TVBuf: PVector2s;
  1544.   P, P1, P2, P1Incr, P2Incr, PIncr: TVector3s;
  1545.   OneOverCellWidthScale, OneOverCellHeightScale: Single;
  1546.   i, k, l, X1, Z1, Addr: Integer;
  1547.   Data, Data2: Pointer;
  1548.   LastY, CurY, xo, zo: Single;
  1549. //  LastLine: array[0..1023] of Single;
  1550.   OutP: TVector3s;
  1551.   DistIncr, FarDist, NearDist, TempK, Error: Single;
  1552.   FirstPartK, LastPartK, LightMapScaleX, LightMapScaleZ, MipK, MipDivider, TempX, TempZ: Single;
  1553.   MipW, MipH, MipW2, MipH2, Index: Integer;
  1554.   IndI, IndJ: Cardinal;
  1555.   type
  1556.     TData = record
  1557.       case Boolean of
  1558.         True: (a, b, c, d: Byte);
  1559.         False: (d32: Longword);
  1560.     end;
  1561.   var
  1562.     d0, d1, d2, d3: TData;
  1563.     ModelInv: TMatrix4s;
  1564.     CameraInModel: TVector3s;
  1565.     j: Integer;
  1566.     Rad: Single;
  1567. begin
  1568.   Result := 0;
  1569.   if not Assigned(FMap) or not FMap.IsReady then Exit;
  1570.   OldCameraMatrix := Params.Camera.Transform;
  1571.   ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
  1572.   Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
  1573.   CamOfsX := CameraInModel.X;
  1574.   CamOfsZ := CameraInModel.Z;
  1575.   HalfLengthX := (FMap.Width-1)  * FMap.CellWidthScale  * 0.5;
  1576.   HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
  1577.   LightMapScaleX := 0.5/HalfLengthX;
  1578.   LightMapScaleZ := 0.5/HalfLengthZ;
  1579.   OneOverCellWidthScale  := 1/FMap.CellWidthScale;
  1580.   OneOverCellHeightScale := 1/FMap.CellHeightScale;
  1581.   Rad := 0;
  1582.   NearDist := 2*pi * Rad;
  1583.   FarDist  := 2*pi * (ViewDepth + 1*ExcessDist);
  1584.   DistIncr := FarDist - NearDist;
  1585.   if DistIncr < 0 then Exit;
  1586.   NearMip := 0;
  1587.   while (NearMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
  1588.         (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
  1589.     Inc(NearMip);
  1590.   FarMip := 0;
  1591.   while (FarMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
  1592.         (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
  1593.     Inc(FarMip);
  1594.   for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
  1595.   if MipStart[FarMip-NearMip+1] < 1 then begin
  1596. //    Assert(MipStart[FarMip-NearMip+1] >= 1);
  1597.   end;
  1598.   if FarMip-NearMip >= 1 then begin
  1599.     MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
  1600.     FirstPartK  := MipStart[1]/(MipStart[1] - MipStart[0]);
  1601.     LastPartK   := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
  1602.     TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
  1603.     MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
  1604.     Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
  1605.     for i := NearMip+1 to FarMip-1 do begin
  1606.       MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
  1607.       Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
  1608.     end;
  1609.     MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
  1610.     Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
  1611.     if Error >= 0.5 then Inc(MipDetail[0]);
  1612.     if MipDetail[FarMip-NearMip] <= 1 then begin
  1613.       Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
  1614.       Dec(FarMip);
  1615.     end;
  1616.     Error := 0;
  1617.     for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
  1618.     Assert(Error = (FGridHeight+1));
  1619.   end else begin
  1620.     MipDetail[0] := (FGridHeight+1);
  1621.   end;
  1622.   MipStart[0] := 0;
  1623.   MipStart[FarMip-NearMip+1] := 1;
  1624.   VBuf := VBPTR;
  1625.   TVBuf := @FGrid[0];
  1626.   j := 0;
  1627.   for k := 0 to FarMip-NearMip do begin
  1628.     Data  := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip].Offset);
  1629.     Data2 := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip+1].Offset);
  1630.     MipDivider := 1/(1 shl (k + NearMip));
  1631.     MipW  := FMap.Width  shr (k + NearMip);
  1632.     MipH  := FMap.Height shr (k + NearMip);
  1633.     MipW2 := FMap.Width  shr (k + NearMip+1);
  1634.     MipH2 := FMap.Height shr (k + NearMip+1);
  1635.     for l := 0 to MipDetail[k]-1 do begin
  1636. //      Rad := (ViewDepth + ExcessDist) * (MipStart[k] + l*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
  1637. //      FMipZ[j] := Rad;
  1638. //      Sqrt(SqrMagnitude(GetVector3s(P1.X - CamOfsX, 0, P1.Z - CamOfsZ)));
  1639. //      Inc(j);
  1640. //      ScaleVector3s(PIncr, SubVector3s(P2, P1), 1 / FGridWidth);
  1641. //      P := P1;
  1642.       MipK := MaxS(0, l/MipDetail[k] - (1-TrilinearRange))/TrilinearRange;
  1643.       if MipK < epsilon then begin
  1644.         for i := 0 to FGridWidth do begin
  1645.           P.X := CamOfsX - TVBuf^.X;
  1646.           P.Z := CamOfsZ + TVBuf^.Y;
  1647.           TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale  * MipDivider;
  1648.           TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
  1649.           X1 := FastTrunc(TempX);
  1650.           Z1 := FastTrunc(TempZ);
  1651.           xo := (TempX - X1);// * Ord(X1 >= 0) * Ord(X1 < MipW);
  1652.           zo := (TempZ - Z1);// * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  1653.           X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
  1654.           Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  1655.           Addr := Z1 * MipW + X1;
  1656.           // May read 2 bytes outside texture data. It's safe because these 2 bytes will go from next mipmap.
  1657.           d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
  1658.           d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
  1659.           d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
  1660.           d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
  1661.           P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  1662.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  1663.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  1664.                             ( d1.c + d2.b + d2.d + d3.c ) * zo)) * FMap.DepthScale * 0.25;
  1665.           VBuf^ := P;
  1666. //          TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
  1667. //          Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
  1668. //          Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
  1669.           VBuf := Pointer(Integer(VBuf) + FVertexSize);
  1670.           TVBuf := Pointer(Integer(TVBuf) + SizeOf(TVector2s));
  1671.         end;
  1672.       end else begin
  1673.         for i := 0 to FGridWidth do begin
  1674.           P.X := CamOfsX - TVBuf^.X;
  1675.           P.Z := CamOfsZ + TVBuf^.Y;
  1676.           TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale  * MipDivider;
  1677.           TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
  1678.           X1 := FastTrunc(TempX);
  1679.           Z1 := FastTrunc(TempZ);
  1680.           xo := (TempX - X1){ * Ord(X1 >= 0) * Ord(X1 < MipW)};
  1681.           zo := (TempZ - Z1){ * Ord(Z1 >= 0) * Ord(Z1 < MipH)};
  1682.           X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
  1683.           Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  1684.           Addr := Z1 * MipW + X1;
  1685.           d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
  1686.           d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
  1687.           d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
  1688.           d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
  1689.           P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  1690.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  1691.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  1692.                             ( d1.c + d2.b + d2.d + d3.c ) * zo));
  1693.           // Second mip
  1694.           xo := (xo + X1 and 1)*0.5;
  1695.           zo := (zo + Z1 and 1)*0.5;
  1696.           X1 := X1 shr 1;
  1697.           Z1 := Z1 shr 1;
  1698.           Addr := Z1 * MipW2 + X1;
  1699.           d0.d32 := PLongword(Integer(Data2) + Addr - MipW2 * Ord(Z1 > 0) - Ord(X1 > 0))^;
  1700.           d1.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0))^;
  1701.           d2.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1))^;
  1702.           d3.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1) + MipW2 * Ord(Z1 < MipH2-2))^;
  1703.           P.Y := 0.25*(P.Y * (1 - MipK) + MipK * (
  1704.                   (1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  1705.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  1706.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  1707.                             ( d1.c + d2.b + d2.d + d3.c ) * zo)) ) * FMap.DepthScale;
  1708.           VBuf^ := P;
  1709. //          TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
  1710. //          Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
  1711. //          Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
  1712.           VBuf := Pointer(Integer(VBuf) + FVertexSize);
  1713.           TVBuf := Pointer(Integer(TVBuf) + SizeOf(TVector2s));
  1714.         end;
  1715.       end;
  1716.     end;
  1717.   end;
  1718.   TesselationStatus[tbVertex].Status := tsTesselated;
  1719. //  TesselationStatus[tbVertex].Status := tsChanged;
  1720.   Result  := TotalVertices;
  1721. //  Assert((FGridWidth+1)*jj = Result);
  1722.   LastTotalVertices := TotalVertices;
  1723. end;
  1724. begin
  1725.   GlobalClassList.Add('C2Land', GetUnitClassList);
  1726. end.