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

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

游戏引擎

开发平台：

Delphi

C2Grass.pas：源码内容
  1. (*
  2.  CAST II Engine grass vegetation unit
  3.  (C) 2006-2008 George "Mirage" Bakhtadze. avagames@gmail.com
  4.  Created: Jul 20, 2008
  5.  Unit contains grass visualisation class
  6. *)
  7. {$Include GDefines.inc}
  8. {$Include C2Defines.inc}
  9. unit C2Grass;
  11. interface
  13. uses
  14.   SysUtils, TextFile, Basics, BaseTypes, Base3D, Props, BaseMsg, ItemMsg, BaseClasses,
  15.   {$IFDEF EDITORMODE} BaseGraph, C2MapEditMsg, {$ENDIF}
  16.   C2Types, C2Visual, C2VisItems, CAST2, C2Land, C2Maps;
  18. type
  19.   TGrassTesselator = class(TMappedTesselator)
  20.   private
  21.     FDensity, FThreshold, FOscillationIrregularity: Single;
  22.     FRandoms: TRandomGenerator;
  23.     FHeightMap: C2Maps.TMap;
  24.     BoundingBox: TBoundingBox;
  25.   public
  26.     constructor Create; override;
  27.     destructor Destroy; override;
  29.     procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); override;
  30.     procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); override;
  32.     procedure Init; override;
  33.     function GetBoundingBox: TBoundingBox; override;
  34.     
  35.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  36.   end;
  38.   TGrass = class(C2Visual.TMappedItem)
  39.   private
  40.     FHeightMap: C2Maps.TMap;
  41.     ShaderConsts: TShaderConstants;
  42.     FOscillationFreq, FOscillationAmplitude: Single;
  43.   protected
  44.     procedure ResolveLinks; override;
  45.     {$IFDEF EDITORMODE}
  46.     function PickCell(Camera: TCamera; MouseX, MouseY: Integer; out CellX, CellZ: Integer): Boolean; override;
  47.     function DrawCursor(Cursor: C2MapEditMsg.TMapCursor; Camera: TCamera; Screen: TScreen): Boolean; override;
  48.     {$ENDIF}
  49.     procedure InitShaderConstants;
  50.   public
  51.     function GetTesselatorClass: CTesselator; override;
  53.     procedure RetrieveShaderConstants(var ConstList: TShaderConstants); override;
  54.     procedure OnSceneLoaded; override;
  56.     procedure HandleMessage(const Msg: TMessage); override;
  58.     procedure AddProperties(const Result: Props.TProperties); override;
  59.     procedure SetProperties(Properties: Props.TProperties); override;
  60.   end;
  62.   TRadGridGrassTesselator = class(TRadGridTesselator)
  63.   private
  64.     FGrassHeight, FSampleSize: Single;
  65.   public
  66.     procedure Init; override;
  67.     function GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer; override;
  69.     procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); override;
  70.     procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); override;
  72.     function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
  73.   end;
  75.   TRadGridGrass = class(TProjectedLandscape)
  76.   public
  77.     function GetTesselatorClass: CTesselator; override;
  78.   end;
  80.   // Returns list of classes introduced by the unit
  81.   function GetUnitClassList: TClassArray;
  83. implementation
  85. function GetUnitClassList: TClassArray;
  86. begin
  87.   Result := GetClassList([TGrass, TRadGridGrass]);
  88. end;
  90. { TRadGridGrassTesselator }
  92. const VerticesPerPoint = 6;
  94. procedure TRadGridGrassTesselator.Init;
  95. begin
  96.   inherited;
  98.   if Assigned(FMap) then begin
  99.     TotalVertices   := (FGridWidth+1)*(FGridHeight+1) * VerticesPerPoint;
  101.     TotalIndices    := 0;//(FGridWidth+1)*2;    //  - - 89, 1 - 309-315, 2 - 85
  102.     TotalStrips     := 1;//FGridHeight;
  103.     TotalPrimitives := (FGridWidth+1)*(FGridHeight+1);
  104.     StripOffset     := 0;//FGridWidth+1;
  105. //    StripOffset     := FGridWidth+1;
  107.     SetLength(FMipZ, FGridHeight+1);
  108. //  0  2  4          0 1 2 3 4 5  5 1           P: ??? (w*2)*(h-1)-2 = (3*2)*3-2 = 16
  109. //  1  3  5          1 6 3 7 5 8  8 6           V: w*h = 3*4 = 12
  110. //  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
  111. //  9  A  B
  113. {    TotalIndices    := 2*(FGridWidth+2)*(FGridHeight);//-2
  114.     TotalStrips     := 1;
  115.     TotalPrimitives := 2*(FGridWidth+1)*(FGridHeight)-2;//(TotalIndices-2-2);
  116.     StripOffset     := 0;}
  117.   end else begin
  118.     TotalVertices   := 0;
  119.     TotalStrips     := 0;
  120.     TotalIndices    := 0;
  121.     TotalPrimitives := 0;
  122.     StripOffset     := 0;
  123.   end;
  125.   ManualRender := False;
  127.   PrimitiveType := ptTRIANGLELIST;
  128.   TesselationStatus[tbVertex].TesselatorType := ttStatic;
  129.   TesselationStatus[tbIndex].TesselatorType  := ttStatic;
  131.    IndexingVertices := TotalVertices;
  133. //  InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
  134.   InitVertexFormat(GetVertexFormat(False, False, False, False, False, 0, [2]));
  136.   LastTexUpdX := 0;
  137.   LastTexUpdZ := 0;
  138. end;
  140. function TRadGridGrassTesselator.GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer;
  141. begin
  142.   Result := inherited GetUpdatedElements(Buffer, Params) * VerticesPerPoint;
  143. end;
  145. function TRadGridGrassTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  146. var
  147.   HalfLengthX, HalfLengthZ: Single;
  148.   VBuf: PVector3s;
  149.   TVBuf: PVector2s;
  151.   P, P1, P2, P1Incr, P2Incr, PIncr: TVector3s;
  152.   OneOverCellWidthScale, OneOverCellHeightScale: Single;
  153.   i, k, l, X1, Z1, Addr: Integer;
  154.   Data, Data2: Pointer;
  155.   LastY, CurY, xo, zo: Single;
  156. //  LastLine: array[0..1023] of Single;
  157.   OutP: TVector3s;
  158.   DistIncr, FarDist, NearDist, TempK, Error: Single;
  159.   FirstPartK, LastPartK, LightMapScaleX, LightMapScaleZ, MipK, MipDivider, TempX, TempZ: Single;
  160.   MipW, MipH, MipW2, MipH2, Index: Integer;
  161.   IndI, IndJ: Cardinal;
  163.   type
  164.     TData = record
  165.       case Boolean of
  166.         True: (a, b, c, d: Byte);
  167.         False: (d32: Longword);
  168.     end;
  169.   var
  170.     d0, d1, d2, d3: TData;
  171.     ModelInv: TMatrix4s;
  172.     CameraInModel: TVector3s;
  173.     j: Integer;
  174.     Rad, TriSize: Single;
  176.   procedure PutStamp(P: TVector3s);
  177.   begin
  178.     P.X := Round(P.X) div 4 * 4;
  179.     P.Z := Round(P.Z) div 4 * 4;
  181.     P.Y := P.Y + Random * FGrassHeight;
  183.     VBuf^.X := P.X-TriSize;
  184.     VBuf^.Z := P.Z;
  185.     VBuf^.Y := P.Y;
  186.     Single(Pointer(Integer(VBuf) + 12)^) := 0;
  187.     Single(Pointer(Integer(VBuf) + 16)^) := 1;
  188.     VBuf := Pointer(Integer(VBuf) + FVertexSize);
  190.     VBuf^.X := P.X+TriSize;
  191.     VBuf^.Z := P.Z;
  192.     VBuf^.Y := P.Y;
  193.     Single(Pointer(Integer(VBuf) + 12)^) := 1;
  194.     Single(Pointer(Integer(VBuf) + 16)^) := 1;
  195.     VBuf := Pointer(Integer(VBuf) + FVertexSize);
  197.     VBuf^.X := P.X;
  198.     VBuf^.Z := P.Z;
  199.     VBuf^.Y := P.Y+FGrassHeight;
  200.     Single(Pointer(Integer(VBuf) + 12)^) := 0.5;
  201.     Single(Pointer(Integer(VBuf) + 16)^) := 0;
  202.     VBuf := Pointer(Integer(VBuf) + FVertexSize);
  204.     VBuf^.X := P.X;
  205.     VBuf^.Z := P.Z-TriSize;
  206.     VBuf^.Y := P.Y;
  207.     Single(Pointer(Integer(VBuf) + 12)^) := 0;
  208.     Single(Pointer(Integer(VBuf) + 16)^) := 1;
  209.     VBuf := Pointer(Integer(VBuf) + FVertexSize);
  211.     VBuf^.X := P.X;
  212.     VBuf^.Z := P.Z+TriSize;
  213.     VBuf^.Y := P.Y;
  214.     Single(Pointer(Integer(VBuf) + 12)^) := 1;
  215.     Single(Pointer(Integer(VBuf) + 16)^) := 1;
  216.     VBuf := Pointer(Integer(VBuf) + FVertexSize);
  218.     VBuf^.X := P.X;
  219.     VBuf^.Z := P.Z;
  220.     VBuf^.Y := P.Y+FGrassHeight;
  221.     Single(Pointer(Integer(VBuf) + 12)^) := 0.5;
  222.     Single(Pointer(Integer(VBuf) + 16)^) := 0;
  223.     VBuf := Pointer(Integer(VBuf) + FVertexSize);
  225.   //          TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
  227.   end;
  229. begin
  230.   Result := 0;
  231.   if not Assigned(FMap) or not FMap.IsReady then Exit;
  233.   OldCameraMatrix := Params.Camera.Transform;
  235.   ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
  236.   Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
  238.   CamOfsX := CameraInModel.X;
  239.   CamOfsZ := CameraInModel.Z;
  241.   HalfLengthX := (FMap.Width-1)  * FMap.CellWidthScale  * 0.5;
  242.   HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
  243.   LightMapScaleX := 0.5/HalfLengthX;
  244.   LightMapScaleZ := 0.5/HalfLengthZ;
  245.   OneOverCellWidthScale  := 1/FMap.CellWidthScale;
  246.   OneOverCellHeightScale := 1/FMap.CellHeightScale;
  248.   Rad := 0;
  249.   NearDist := 2*pi * Rad;
  250.   FarDist  := 2*pi * (ViewDepth + 1*ExcessDist);
  252.   DistIncr := FarDist - NearDist;
  253.   if DistIncr < 0 then Exit;
  255.   NearMip := 0;
  256.   while (NearMip < THeightMap(FMap).Image.SuggestedLevels-1) and
  257.         (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
  258.     Inc(NearMip);
  260.   FarMip := 0;
  261.   while (FarMip < THeightMap(FMap).Image.SuggestedLevels-1) and
  262.         (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
  263.     Inc(FarMip);
  265.   for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
  266.   if MipStart[FarMip-NearMip+1] < 1 then begin
  267. //    Assert(MipStart[FarMip-NearMip+1] >= 1);
  268.   end;
  269.   if FarMip-NearMip >= 1 then begin
  270.     MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
  271.     FirstPartK  := MipStart[1]/(MipStart[1] - MipStart[0]);
  272.     LastPartK   := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
  273.     TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
  274.     MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
  275.     Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
  276.     for i := NearMip+1 to FarMip-1 do begin
  277.       MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
  278.       Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
  279.     end;
  280.     MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
  281.     Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
  282.     if Error >= 0.5 then Inc(MipDetail[0]);
  284.     if MipDetail[FarMip-NearMip] <= 1 then begin
  285.       Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
  286.       Dec(FarMip);
  287.     end;
  289.     Error := 0;
  290.     for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
  291.     Assert(Error = (FGridHeight+1));
  292.   end else begin
  293.     MipDetail[0] := (FGridHeight+1);
  294.   end;
  296.   MipStart[0] := 0;
  297.   MipStart[FarMip-NearMip+1] := 1;
  299.   VBuf := VBPTR;
  300.   TVBuf := @FGrid[0];
  302.   j := 0;
  304.   for k := 0 to FarMip-NearMip do begin
  305.     Data  := PtrOffs(FMap.Data, THeightMap(FMap).Image.LevelInfo[k + NearMip].Offset);
  306.     Data2 := PtrOffs(FMap.Data, THeightMap(FMap).Image.LevelInfo[k + NearMip+1].Offset);
  308.     MipDivider := 1/(1 shl (k + NearMip));
  309.     MipW  := FMap.Width  shr (k + NearMip);
  310.     MipH  := FMap.Height shr (k + NearMip);
  311.     MipW2 := FMap.Width  shr (k + NearMip+1);
  312.     MipH2 := FMap.Height shr (k + NearMip+1);
  314.     for l := 0 to MipDetail[k]-1 do begin
  315. //      Rad := (ViewDepth + ExcessDist) * (MipStart[k] + l*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
  316. //      FMipZ[j] := Rad;
  317. //      Sqrt(SqrMagnitude(GetVector3s(P1.X - CamOfsX, 0, P1.Z - CamOfsZ)));
  318.       TriSize := (1+FMipZ[j])*FSampleSize;
  319.       Inc(j);
  321. //      ScaleVector3s(PIncr, SubVector3s(P2, P1), 1 / FGridWidth);
  322. //      P := P1;
  324.       MipK := MaxS(0, l/MipDetail[k] - (1-TrilinearRange))/TrilinearRange;
  326.       if MipK < epsilon then begin
  327.         for i := 0 to FGridWidth do begin
  328.           P.X := CamOfsX - TVBuf^.X;
  329.           P.Z := CamOfsZ + TVBuf^.Y;
  331.           TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale  * MipDivider;
  332.           TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
  334.           X1 := FastTrunc(TempX);
  335.           Z1 := FastTrunc(TempZ);
  337.           xo := (TempX - X1);// * Ord(X1 >= 0) * Ord(X1 < MipW);
  338.           zo := (TempZ - Z1);// * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  340.           X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
  341.           Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  343.           Addr := Z1 * MipW + X1;
  344.           // May read 2 bytes outside texture data. It's safe because these 2 bytes will go from next mipmap.
  345.           d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
  346.           d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
  347.           d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
  348.           d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
  350.           P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  351.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  352.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  353.                             ( d1.c + d2.b + d2.d + d3.c ) * zo)) * FMap.DepthScale * 0.25;
  355.           PutStamp(P);
  357.           TVBuf := Pointer(Integer(TVBuf) + SizeOf(TVector2s));
  358.         end;
  359.       end else begin
  360.         for i := 0 to FGridWidth do begin
  361.           P.X := CamOfsX - TVBuf^.X;
  362.           P.Z := CamOfsZ + TVBuf^.Y;
  364.           TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale  * MipDivider;
  365.           TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
  367.           X1 := FastTrunc(TempX);
  368.           Z1 := FastTrunc(TempZ);
  370.           xo := (TempX - X1){ * Ord(X1 >= 0) * Ord(X1 < MipW)};
  371.           zo := (TempZ - Z1){ * Ord(Z1 >= 0) * Ord(Z1 < MipH)};
  373.           X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
  374.           Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
  376.           Addr := Z1 * MipW + X1;
  377.           d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
  378.           d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
  379.           d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
  380.           d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
  382.           P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  383.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  384.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  385.                             ( d1.c + d2.b + d2.d + d3.c ) * zo));
  386.           // Second mip
  387.           xo := (xo + X1 and 1)*0.5;
  388.           zo := (zo + Z1 and 1)*0.5;
  389.           X1 := X1 shr 1;
  390.           Z1 := Z1 shr 1;
  392.           Addr := Z1 * MipW2 + X1;
  394.           d0.d32 := PLongword(Integer(Data2) + Addr - MipW2 * Ord(Z1 > 0) - Ord(X1 > 0))^;
  395.           d1.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0))^;
  396.           d2.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1))^;
  397.           d3.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1) + MipW2 * Ord(Z1 < MipH2-2))^;
  399.           P.Y := 0.25*(P.Y * (1 - MipK) + MipK * (
  400.                   (1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
  401.                             ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
  402.                      xo  * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
  403.                             ( d1.c + d2.b + d2.d + d3.c ) * zo)) ) * FMap.DepthScale;
  405.           PutStamp(P);
  407.           TVBuf := Pointer(Integer(TVBuf) + SizeOf(TVector2s));
  408.         end;
  409.       end;
  410.     end;
  411.   end;
  413.   TesselationStatus[tbVertex].Status := tsTesselated;
  414. //  TesselationStatus[tbVertex].Status := tsChanged;
  415.   Result  := TotalVertices;
  416. //  Assert((FGridWidth+1)*jj = Result);
  417.   LastTotalVertices := TotalVertices;
  418. end;
  420. procedure TRadGridGrassTesselator.AddProperties(const Result: TProperties; const PropNamePrefix: TNameString);
  421. begin
  422.   inherited;
  423.   if Assigned(Result) then begin
  424.     Result.Add(PropNamePrefix + 'Height',      vtSingle, [], FloatToStr(FGrassHeight), '0.1-4');
  425.     Result.Add(PropNamePrefix + 'Sample size', vtSingle, [], FloatToStr(FSampleSize),  '0.03-3');
  426.   end;
  427. end;
  429. procedure TRadGridGrassTesselator.SetProperties(Properties: TProperties; const PropNamePrefix: TNameString);
  430. begin
  431.   inherited;
  432.   if Properties.Valid(PropNamePrefix + 'Height')      then FGrassHeight := StrToFloatDef(Properties[PropNamePrefix + 'Height'], 1);
  433.   if Properties.Valid(PropNamePrefix + 'Sample size') then FSampleSize  := StrToFloatDef(Properties[PropNamePrefix + 'Sample size'], 0.1);
  434. end;
  436. { TRadGridGrass }
  438. function TRadGridGrass.GetTesselatorClass: CTesselator; begin Result := TRadGridGrassTesselator; end;
  440. { TGrass }
  442. procedure TGrass.ResolveLinks;
  443. var Item: TItem;
  444. begin
  445.   inherited;
  447.   if CurrentTesselator is TGrassTesselator then begin
  448.     ResolveLink('Height map', Item);
  449.     if Assigned(Item) then begin
  450.       FHeightMap := Item as C2Maps.TMap;
  451.       (CurrentTesselator as TGrassTesselator).FHeightMap := FHeightMap;
  452.       CurrentTesselator.Init;
  453.     end;
  454.   end;
  455. end;
  457. {$IFDEF EDITORMODE}
  458. function TGrass.PickCell(Camera: TCamera; MouseX, MouseY: Integer; out CellX, CellZ: Integer): Boolean;
  459. var CameraPos, PickRay, PickPos: TVector3s; M: TMatrix4s;
  460. begin
  461.   Result := False;
  462.   if not Assigned(FHeightMap) then Exit;
  463.   // Transform camera position and pick ray to model space
  464.   M := InvertMatrix4s(Transform);
  465.   CameraPos := Transform4Vector33s(M, Camera.Position);
  466.   PickRay := Camera.GetPickRay(MouseX, MouseY);
  467.   PickRay := Transform3Vector3s(CutMatrix3s(InvertAffineMatrix4s(Camera.ViewMatrix)), PickRay);
  468.   PickRay.Y := PickRay.Y;
  469.   PickRay := NormalizeVector3s(Transform3Vector3s(CutMatrix3s(M), PickRay));
  470.   Result := FHeightMap.TraceRay(CameraPos, PickRay, PickPos);
  471.   if Result then Map.ObtainCell(PickPos.X, PickPos.Z, CellX, CellZ);
  472. end;
  474. function TGrass.DrawCursor(Cursor: TMapCursor; Camera: TCamera; Screen: TScreen): Boolean;
  476.   procedure DrawCell(CellX, CellZ: Integer);
  477.   var v: TVector3s;
  478.   begin
  479.     if (CellX < 1) or (CellZ < 1) or (CellX > FMap.Width-2) or (CellZ > FMap.Height-2) then Exit;
  481.     v.x := (CellX - (FMap.Width -1) * 0.5) * FMap.CellWidthScale;
  482.     v.z := (CellZ - (FMap.Height-1) * 0.5) * FMap.CellHeightScale;
  483.     v.y := FHeightMap.GetHeight(v.x, v.z);
  484.     Screen.MoveToVec(Camera.Project(Transform4Vector33s(Transform, v)).xyz);
  485.     v.y := v.y + (FMap[CellX, CellZ]+1) * FMap.DepthScale * 0.5;
  486.     Screen.LineToVec(Camera.Project(Transform4Vector33s(Transform, v)).xyz);
  487.   end;
  489.   procedure DrawCursorAt(CellX, CellZ, Size: Integer);
  490.   var i, j: Integer;
  491.   begin
  492. //    Screen.MoveTo(0, 0);
  493. //    Screen.LineTo(0, 0);
  494.     for i := CellX - Size div 2 to CellX + Size div 2 do
  495.       for j := CellZ - Size div 2 to CellZ + Size div 2 do DrawCell(i, j);
  496.   end;
  498. begin
  499.   Result := False;
  500.   if not EditMode and not PickCell(Camera, Cursor.MouseX, Cursor.MouseY, EditCellX, EditCellZ) then Exit;
  502.   DrawCursorAt(EditCellX, EditCellZ, Cursor.Params.GetAsInteger('Size'));
  504.   Result := True;
  505. end;
  506. {$ENDIF}
  508. procedure TGrass.InitShaderConstants;
  509. begin
  510.   SetLength(ShaderConsts, 2);
  511.   ShaderConsts[0].ShaderKind     := skVertex;
  512.   ShaderConsts[0].ShaderRegister := 8;
  513.   ShaderConsts[0].Value          := Vec4s(FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi),      FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi+pi/4),
  514.                                           FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi+pi/2), FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi+3*pi/4));
  515.   ShaderConsts[1].ShaderKind     := skVertex;
  516.   ShaderConsts[1].ShaderRegister := 9;
  517.   ShaderConsts[1].Value          := Vec4s(1/(FHeightMap.Width*FHeightMap.CellWidthScale), 1/(FHeightMap.Height*FHeightMap.CellHeightScale), 0.5*FHeightMap.Width*FHeightMap.CellWidthScale, 0.5*FHeightMap.Height*FHeightMap.CellHeightScale);
  518. end;
  520. function TGrass.GetTesselatorClass: CTesselator; begin Result := TGrassTesselator; end;
  522. procedure TGrass.RetrieveShaderConstants(var ConstList: TShaderConstants);
  523. begin
  524.   ShaderConsts[0].Value := Vec4s(FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi),      FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi+pi/4),
  525.                                  FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi+pi/2), FOscillationAmplitude * Sin(TimeProcessed*FOscillationFreq*2*pi+3*pi/4));
  526.   ShaderConsts[1].Value := Vec4s(1/(FHeightMap.Width*FHeightMap.CellWidthScale), 1/(FHeightMap.Height*FHeightMap.CellHeightScale), 0.5*FHeightMap.Width*FHeightMap.CellWidthScale, 0.5*FHeightMap.Height*FHeightMap.CellHeightScale);
  527.   ConstList := ShaderConsts;
  528. end;
  530. procedure TGrass.OnSceneLoaded;
  531. begin
  532.   InitShaderConstants;
  533. end;
  535. procedure TGrass.AddProperties(const Result: TProperties);
  536. begin
  537.   inherited;
  538.   AddItemLink(Result, 'Height map', [], 'TMap');
  539.   if Result <> nil then begin
  540.     Result.Add('Oscillation frequency',    vtSingle, [], FloatToStr(FOscillationFreq),         '0.1-2');
  541.     Result.Add('Oscillation amplitude',    vtSingle, [], FloatToStr(FOscillationAmplitude),    '0.1-2');
  542.   end;
  543. end;
  545. procedure TGrass.SetProperties(Properties: TProperties);
  546. begin
  547.   inherited;
  548.   if Properties.Valid('Height map') then SetLinkProperty('Height map', Properties['Height map']);
  549.   if Properties.Valid('Oscillation frequency')    then FOscillationFreq         := StrToFloatDef(Properties['Oscillation frequency'], 0.1);
  550.   if Properties.Valid('Oscillation amplitude')    then FOscillationAmplitude    := StrToFloatDef(Properties['Oscillation amplitude'], 0.1);
  552.   ResolveLinks;
  553. end;
  555. procedure TGrass.HandleMessage(const Msg: TMessage);
  556. begin
  557.   inherited;
  558.   if (Msg.ClassType = TItemModifiedMsg) and (TItemModifiedMsg(Msg).Item = FHeightMap) and Assigned(FCurrentTesselator) then
  559.     FCurrentTesselator.Invalidate([tbVertex, tbIndex], False);
  560. end;
  562. { TGrassTesselator }
  564. constructor TGrassTesselator.Create;
  565. begin
  566.   inherited;
  567.   FRandoms := TRandomGenerator.Create;
  568.   FRandoms.InitSequence(0, 195);
  569. end;
  571. destructor TGrassTesselator.Destroy;
  572. begin
  573.   FreeAndNil(FRandoms);
  574.   inherited;
  575. end;
  577. procedure TGrassTesselator.AddProperties(const Result: TProperties; const PropNamePrefix: TNameString);
  578. begin
  579.   inherited;
  580.   if Assigned(Result) then begin
  581.     Result.Add(PropNamePrefix + 'Density',   vtSingle, [], FloatToStr(FDensity),     '0.05-10');
  582.     Result.Add(PropNamePrefix + 'Threshold', vtSingle, [], FloatToStr(FThreshold),   '0.01-1');
  584.     Result.Add(PropNamePrefix + 'Oscillation irregularity', vtSingle, [], FloatToStr(FOscillationIrregularity), '0-1');
  585.   end;
  586. end;
  588. procedure TGrassTesselator.SetProperties(Properties: TProperties; const PropNamePrefix: TNameString);
  589. begin
  590.   inherited;
  591.   if Properties.Valid(PropNamePrefix + 'Density')   then FDensity     := StrToFloatDef(Properties[PropNamePrefix + 'Density'], 1);
  592.   if Properties.Valid(PropNamePrefix + 'Threshold') then FThreshold   := StrToFloatDef(Properties[PropNamePrefix + 'Threshold'], 0.1);
  594.   if Properties.Valid(PropNamePrefix + 'Oscillation irregularity') then FOscillationIrregularity := StrToFloatDef(Properties[PropNamePrefix + 'Oscillation irregularity'], 0.5);
  595.   Init;
  596. end;
  598. procedure TGrassTesselator.Init;
  599. begin
  600.   inherited;
  601.   if Assigned(FMap) then begin
  602.     TotalVertices   := FMap.Width*FMap.Height*2*3*2;
  603. //    TotalIndices    := MaxI(0, (FMap.Width-1)) * MaxI(0, (FMap.Height-1)) * 6;
  604.     TotalPrimitives := FMap.Width * FMap.Height * 2*2;
  605.   end else begin
  606.     TotalVertices   := 0;
  607.     TotalIndices    := 0;
  608.     TotalPrimitives := 0;
  609.   end;
  610.   IndexingVertices := TotalVertices;
  611.   PrimitiveType    := ptTRIANGLELIST;
  612.   InitVertexFormat(GetVertexFormat(False, False, False, False, False, 0, [3]));
  613.   BoundingBox := EmptyBoundingBox;
  614. end;
  616. function TGrassTesselator.GetBoundingBox: TBoundingBox;
  617. begin
  618.   Result := BoundingBox;
  619. {  Result.P2 := ZeroVector3s;
  620.   if not Assigned(FMap) or (FMap.Width = 0) or (FMap.Height = 0) then Exit;
  621.   Result.P1 := GetVector3s(-(FMap.Width-1)  * FMap.CellWidthScale * 0.5,
  622.                             0,
  623.                            -(FMap.Height-1) * FMap.CellHeightScale * 0.5);
  624.   Result.P2 := GetVector3s( (FMap.Width-1)  * FMap.CellWidthScale * 0.5,
  625.                             FMap.MaxHeight * FMap.DepthScale,
  626.                             (FMap.Height-1) * FMap.CellHeightScale * 0.5);
  628.   if Assigned(FHeightMap) then Result.P2.Y := Result.P2.Y + FHeightMap.MaxHeight * FHeightMap.DepthScale;}
  629. end;
  631. function TGrassTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
  632. const RndOffs: array[0..15] of Single =
  633.   (0.00, 0.05, 0.01, 0.15,
  634.    0.02, 0.25, 0.03, 0.35,
  635.    0.65, 0.70, 0.75, 0.80,
  636.    0.85, 0.90, 0.95, 1.0);
  638. var
  639.   VBuf: PVector3s;
  640.   Scattering: Single;
  642.   procedure PutStamp(PX, PZ, H: Single);
  643.   var d, u1, u2, y: Single; Osc: Cardinal;
  644.     procedure AddVertex(X, Y, Z, U, V: Single);
  645.     begin
  646.       VBuf^.X := X;
  647.       VBuf^.Z := Z;
  648.       VBuf^.Y := Y;
  649.       Single(Pointer(Integer(VBuf) + 12)^) := U*0.25;
  650.       Single(Pointer(Integer(VBuf) + 16)^) := V;
  651.       Single(Pointer(Integer(VBuf) + 20)^) := RndOffs[Osc];
  652.       VBuf := Pointer(Integer(VBuf) + FVertexSize);
  653.       Inc(Result);
  654.     end;
  655.   begin
  656. //    P.X := Round(P.X) div 4 * 4;
  657. //    P.Z := Round(P.Z) div 4 * 4;            //  (0,0) l /l (1,0)
  658. //    P.Y := P.Y + Random * FGrassHeight;     //  (0,1) l/_l (1,1)
  660.     u1 := FRandoms.RndI(4);
  661.     u2 := FRandoms.RndI(4);
  662.     Osc := FRandoms.RndI(1+Round(High(RndOffs)*FOscillationIrregularity));
  664. //    if u1 = 1 then u1 := 2;
  665. //    if u2 = 1 then u2 := 0;
  666. //    if FRandoms.RndI(30)=0 then u1 := 1;
  668.     d := Scattering * (0.5 + FRandoms.Rnd(1));
  670.     if h < FThreshold*255 then Exit;
  672.     h := h * FMap.DepthScale;
  674.     y := FHeightMap.GetHeight(PX, PZ);
  676.     ExpandBBox(BoundingBox, PX, y+h, PZ);
  678.     AddVertex(PX-d, y,   PZ, u1,   1);
  679.     AddVertex(PX+d, y,   PZ, u1+1, 1);
  680.     AddVertex(PX+d, y+h, PZ, u1+1, 0);
  681.     AddVertex(PX-d, y,   PZ, u1,   1);
  682.     AddVertex(PX+d, y+h, PZ, u1+1, 0);
  683.     AddVertex(PX-d, y+h, PZ, u1,   0);
  685.     AddVertex(PX, y,   PZ-d, u2,   1);
  686.     AddVertex(PX, y,   PZ+d, u2+1, 1);
  687.     AddVertex(PX, y+h, PZ+d, u2+1, 0);
  688.     AddVertex(PX, y,   PZ-d, u2,   1);
  689.     AddVertex(PX, y+h, PZ+d, u2+1, 0);
  690.     AddVertex(PX, y+h, PZ-d, u2,   0);
  691.   end;
  693. var i, j: Integer;
  694. begin
  695.   Result := 0;
  696.   if not Assigned(FMap) or not Assigned(FHeightMap) or not FMap.IsReady then Exit;
  698.   BoundingBox := EmptyBoundingBox;
  699.   BoundingBox.P1.Y := BoundingBox.P1.Y + FHeightMap.MaxHeight * FHeightMap.DepthScale;
  701.   FRandoms.InitSequence(0, 195);
  703.   Scattering := 1/Sqrt(FDensity);
  705.   FMap.CellWidthScale  := Scattering;
  706.   FMap.CellHeightScale := Scattering;
  708.   VBuf := VBPTR;
  710.   for i := 0 to FMap.Width-1 do
  711.     for j := 0 to FMap.Height-1 do
  712.       PutStamp((i-FMap.Width *0.5 + FRandoms.RndSymm(0.5))*Scattering,
  713.                (j-FMap.Height*0.5 + FRandoms.RndSymm(0.5))*Scattering, FMap[i, j]);
  715.   TesselationStatus[tbVertex].Status := tsTesselated;
  716.   LastTotalVertices := Result;
  717.   TotalPrimitives := Result div 3;
  718.   InvalidateBoundingBox
  719. end;
  721. begin
  722.   GlobalClassList.Add('C2Grass', GetUnitClassList);
  723. end.