C2Land.pas
资源名称:CAST2SDK.rar [点击查看]
上传用户:yj_qiu
上传日期:2022-08-08
资源大小:23636k
文件大小:82k
源码类别:
游戏引擎
开发平台:
Delphi
- (*
- @Abstract(CAST II Engine landscapes unit)
- (C) 2006-2007 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
- The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
- Created: 29.01.2007 <br>
- Unit contains basic landscape classes
- *)
- {$Include GDefines.inc}
- {$Include C2Defines.inc}
- unit C2Land;
- interface
- uses
- TextFile,
- SysUtils,
- BaseTypes, BaseMsg, Basics, Base2D, Base3D, Props, BaseGraph,
- BaseClasses,
- C2Types, C2Res, CAST2, Resources, C2Visual, C2Maps, C2MapEditMsg,
- C2Render, C2Core;
- const
- // Enumeration strings for light map type
- LightmapTypesEnum = 'Light map' + StringDelimiter + 'Normal map';
- MipColors: array[0..15] of TColor = ((C: $00000000), (C: $00000080), (C: $00008000), (C: $00008080),
- (C: $00800000), (C: $00800080), (C: $00808000), (C: $00808080),
- (C: $00404040), (C: $000000FF), (C: $0000FF00), (C: $0000FFFF),
- (C: $00FF0000), (C: $00FF00FF), (C: $00FFFF00), (C: $00FFFFFF));
- type
- // Type of texture used for landscape lighting
- TLightmapType = (// Simple lightmap for FFP lighting
- lmtLightMap,
- // Texture contains normals to calculate lighting in shader
- lmtNormalMap);
- THeightMap = class(C2Maps.TMap)
- protected
- FImage: Resources.TImageResource;
- function GetData: Pointer; override;
- procedure ResolveLinks; override;
- function GetRawHeight(XI, ZI: Integer): Integer; override;
- procedure SetRawHeight(XI, ZI: Integer; const Value: Integer); override;
- public
- constructor Create(AManager: TItemsManager); override;
- procedure SwapRectHeights(const ARect: TRect; ABuf: Pointer); override;
- procedure SetDimensions(AWidth, AHeight: Integer); override;
- procedure SetImage(Image: Resources.TImageResource); virtual;
- function IsReady: Boolean; override;
- procedure AddProperties(const Result: Props.TProperties); override;
- procedure SetProperties(Properties: Props.TProperties); override;
- property Image: Resources.TImageResource read FImage;
- end;
- THeightMapTesselator = class(TMappedTesselator)
- protected
- FTextureScale: Single;
- public
- constructor Create; override;
- procedure Init; override;
- procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); override;
- procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); override;
- function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
- function SetIndices(IBPTR: Pointer): Integer; override;
- end;
- THeightMapLandscape = class(C2Visual.TMappedItem)
- public
- function GetTesselatorClass: CTesselator; override;
- procedure AddProperties(const Result: Props.TProperties); override;
- procedure SetProperties(Properties: Props.TProperties); override;
- end;
- TIslandTesselator = class(TMappedTesselator)
- private
- // Params
- FIslandThickness, FTextureScale: Single;
- public
- IslandThickness, TextureScale: Single;
- constructor Create; override;
- function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
- procedure Init; override;
- function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
- function SetIndices(IBPTR: Pointer): Integer; override;
- end;
- TIsland = class(C2Visual.TMappedItem)
- public
- function GetTesselatorClass: CTesselator; override;
- procedure AddProperties(const Result: Props.TProperties); override;
- procedure SetProperties(Properties: Props.TProperties); override;
- end;
- TVertexWaterTesselator = class(THeightMapTesselator)
- private
- // Parameters
- FWaterColor: TColor;
- FWavesSpeed, FWavesFalloff, FViscosity: Single;
- FFullRefAngle: Integer;
- // Other
- Vel, Arr: array of single;
- public
- WaterColor: TColor;
- WavesSpeed, WavesFalloff, Viscosity: Single;
- FullRefAngle: Integer;
- procedure Init; override;
- function RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer; override;
- procedure Iterate;
- function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
- end;
- TVertexWater = class(THeightMapLandscape)
- private
- Counter: Cardinal;
- WaterColor: TColor;
- WavesSpeed, WavesFalloff, Viscosity: Single;
- FullRefAngle: Integer;
- public
- function GetTesselatorClass: CTesselator; override;
- procedure AddProperties(const Result: Props.TProperties); override;
- procedure SetProperties(Properties: Props.TProperties); override;
- procedure Process(const DeltaTime: Single); override;
- end;
- TQuadPoints = array[0..3] of TVector3s;
- TProjectedLandTesselator = class(THeightMapTesselator)
- private
- protected
- // Params
- FGridWidth, FGridHeight, SmoothX, SmoothZ: Integer;
- MipBias, MipScale, DetailBalance, ViewDepth: Single;
- ExcessDist, TrilinearRange: Single;
- // Other
- CameraDir, CameraRight: TVector3s;
- FlipSign: Single;
- NearMip, FarMip: Integer;
- MipDetail: array[0..31] of Integer;
- MipStart: array[0..31] of Single;
- MipTexture: array[0..31] of Integer;
- FMipZ: array of Single;
- CamOfsX, CamOfsZ: Single;
- LastTexUpdX, LastTexUpdZ: Single;
- FMegaTextureScale: Single;
- FLastClipmapSize, FClipmapSize: Integer;
- Renderer: TRenderer;
- FGrid: array of TVector2s;
- protected
- OldCameraMatrix: TMatrix4s;
- // function GetCameraInModel: TVector3s;
- procedure ProjectGrid(const Params: TTesselationParameters; out PrjPnt: TQuadPoints);
- public
- constructor Create; override;
- destructor Destroy; override;
- function GetMaxVertices: Integer; override;
- procedure Init; override;
- procedure DoManualRender(Item: TItem); override;
- procedure AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString); override;
- procedure SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString); override;
- end;
- TProjGridTesselator = class(TProjectedLandTesselator)
- private
- Pnt, PrjPnt: TQuadPoints;
- public
- function GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer; override;
- function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
- function SetIndices(IBPTR: Pointer): Integer; override;
- end;
- TRadGridTesselator = class(TProjectedLandTesselator)
- private
- procedure InitGrid;
- public
- procedure Init; override;
- function GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer; override;
- function Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer; override;
- function SetIndices(IBPTR: Pointer): Integer; override;
- end;
- TProjectedLandscape = class(C2Visual.TMappedItem)
- private
- ShaderConsts: TShaderConstants;
- procedure InitShaderConstants;
- function GetMegaTexture: TMegaImageResource;
- protected
- FLightmapType: TLightmapType;
- FTextureScale: Single;
- procedure OnModify(const ARect: BaseTypes.TRect); override;
- public
- constructor Create(AManager: TItemsManager); override;
- function VisibilityCheck(const Camera: TCamera): Boolean; override;
- procedure OnSceneLoaded; override;
- procedure RetrieveShaderConstants(var ConstList: TShaderConstants); override;
- procedure AddProperties(const Result: Props.TProperties); override;
- procedure SetProperties(Properties: Props.TProperties); override;
- procedure HandleMessage(const Msg: TMessage); override;
- procedure Process(const DeltaTime: Single); override;
- // Returns projected on the landscape four projected camera frustum points
- procedure ProjectGrid(const Camera: TCamera; out PrjPnt: TQuadPoints);
- procedure RecalcLightMap(ARect: BaseTypes.TRect);
- property MegaTexture: TMegaImageResource read GetMegaTexture;
- end;
- TProjGridLandscape = class(TProjectedLandscape)
- public
- function GetTesselatorClass: CTesselator; override;
- end;
- TRadGridLandscape = class(TProjectedLandscape)
- public
- function GetTesselatorClass: CTesselator; override;
- end;
- // Returns list of classes introduced by the unit
- function GetUnitClassList: TClassArray;
- implementation
- function GetUnitClassList: TClassArray;
- begin
- Result := GetClassList([TMap, THeightMap, THeightMapLandscape, TIsland, TVertexWater, TProjGridLandscape, TRadGridLandscape]);
- end;
- { TIslandTesselator }
- constructor TIslandTesselator.Create;
- begin
- inherited;
- IslandThickness := 1;
- TextureScale := 0.1;
- end;
- function TIslandTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
- begin
- Result := 2;
- if Internal then Parameters := @FIslandThickness else Parameters := @IslandThickness;
- end;
- procedure TIslandTesselator.Init;
- begin
- inherited;
- if Assigned(FMap) then begin
- TotalVertices := FMap.Width*FMap.Height;
- TotalIndices := MaxI(0, (FMap.Width-1)) * MaxI(0, (FMap.Height-1)) * 6;
- TotalPrimitives := MaxI(0, (FMap.Width-1)) * MaxI(0, (FMap.Height-1)) * 2;
- end else begin
- TotalVertices := 0;
- TotalIndices := 0;
- TotalPrimitives := 0;
- end;
- IndexingVertices := TotalVertices;
- PrimitiveType := ptTRIANGLELIST;
- InitVertexFormat(GetVertexFormat(False, True, False, False, False, 0, [2]));
- end;
- function TIslandTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
- var i, j: Integer; HalfLengthX, HalfLengthZ, y: Single;
- begin
- Result := 0;
- if not Assigned(FMap) or not FMap.IsReady then Exit;
- HalfLengthX := (FMap.Width-1) * FMap.CellWidthScale * 0.5;
- HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
- for j := 0 to FMap.Height-1 do for i := 0 to FMap.Width-1 do begin
- SetVertexDataUV(i * FTextureScale, j * FTextureScale, j * FMap.Width + i, VBPTR);
- if (i = 0) or (j = 0) or (i = FMap.Width-1) or (j = FMap.Height-1) or
- // (HMap.GetCellHeight(i-1, j-1) = 0) or (HMap.GetCellHeight(i+1, j-1) = 0) or
- // (HMap.GetCellHeight(i-1, j+1) = 0) or (HMap.GetCellHeight(i+1, j+1) = 0) or
- (FMap[i-1, j] = 0) or (FMap[i+1, j] = 0) or
- (FMap[i, j-1] = 0) or (FMap[i, j+1] = 0) then begin
- Y := -FIslandThickness;
- // SetVertexDataD(FMap.GetCellColor(i, j) and $FFFFFF, j * FMap.Width + i, VBPTR);
- end else begin
- Y := FMap[i+Ord(i=0)-Ord(i=FMap.Width-1), j+Ord(j=0)-Ord(j=FMap.Height-1)] * FMap.DepthScale;
- // SetVertexDataD(FMap.GetCellColor(i, j) or $FF000000, j * FMap.Width + i, VBPTR);
- end;
- SetVertexDataC(i * FMap.CellWidthScale - HalfLengthX, Y, j * FMap.CellHeightScale - HalfLengthZ, j * FMap.Width + i, VBPTR);
- SetVertexDataN(FMap.GetCellNormal(i, j), j * FMap.Width + i, VBPTR);
- // SetVertexDataD(GetColor($FFFFFFFF), j * FMap.Width + i, VBPTR);
- end;
- TesselationStatus[tbVertex].Status := tsTesselated;
- Result := TotalVertices;
- IndexingVertices := TotalVertices;
- LastTotalVertices := TotalVertices;
- end;
- function TIslandTesselator.SetIndices(IBPTR: Pointer): Integer;
- var i, j: Integer; y11, y12, y21, y22, Points: Integer;
- begin
- { * * * * * * * * * *
- * * * * * * * * * *
- * * * * * * * * *
- * * * * * * * * * * * * }
- TotalPrimitives := 0;
- if Assigned(FMap) and FMap.IsReady then for j := 0 to FMap.Height-2 do for i := 0 to FMap.Width-2 do begin
- y11 := FMap[i, j];
- y12 := FMap[i, j+1];
- y21 := FMap[i+1, j];
- y22 := FMap[i+1, j+1];
- // 8 4 2 1
- Points := Ord(y11 > 0) shl 3 + Ord(y12 > 0) shl 2 + Ord(y21 > 0) shl 1 + Ord(y22 > 0);
- case Points of
- 7: begin // y11 zero
- TWordBuffer(IBPTR^)[TotalPrimitives*3+0] := (j+1) * FMap.Width + i; // *
- TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i+1; // **
- TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := j * FMap.Width + i+1;
- Inc(TotalPrimitives);
- end;
- 11: begin // y12 zero
- TWordBuffer(IBPTR^)[TotalPrimitives*3+0] := j * FMap.Width + i; // **
- TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i+1; // *
- TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := j * FMap.Width + i + 1;
- Inc(TotalPrimitives);
- end;
- 13: begin // y21 zero
- TWordBuffer(IBPTR^)[TotalPrimitives*3+0] := j * FMap.Width + i; // *
- TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i; // **
- TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := (j+1) * FMap.Width + i+1;
- Inc(TotalPrimitives);
- end;
- 14: begin // y22 zero
- TWordBuffer(IBPTR^)[TotalPrimitives*3+0] := j * FMap.Width + i; // **
- TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i; // *
- TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := j * FMap.Width + i+1;
- Inc(TotalPrimitives);
- end;
- 15: begin // All points
- TWordBuffer(IBPTR^)[TotalPrimitives*3+0] := j * FMap.Width + i;
- TWordBuffer(IBPTR^)[TotalPrimitives*3+1] := (j+1) * FMap.Width + i;
- TWordBuffer(IBPTR^)[TotalPrimitives*3+2] := (j+1) * FMap.Width + i+1;
- TWordBuffer(IBPTR^)[TotalPrimitives*3+3] := j * FMap.Width + i;
- TWordBuffer(IBPTR^)[TotalPrimitives*3+4] := (j+1) * FMap.Width + i+1;
- TWordBuffer(IBPTR^)[TotalPrimitives*3+5] := j * FMap.Width + i+1;
- Inc(TotalPrimitives, 2);
- end;
- end;
- end;
- TotalIndices := TotalPrimitives*3;
- TesselationStatus[tbIndex].Status := tsTesselated;
- Result := TotalIndices;
- LastTotalIndices := TotalIndices;
- end;
- { TIsland }
- function TIsland.GetTesselatorClass: CTesselator; begin Result := TIslandTesselator; end;
- procedure TIsland.AddProperties(const Result: Props.TProperties);
- begin
- inherited;
- if Assigned(Result) and Assigned(CurrentTesselator) then begin
- Result.Add('Thickness', vtSingle, [], FloatToStr(TIslandTesselator(CurrentTesselator).IslandThickness), '0,1-10');
- Result.Add('TextureScale', vtSingle, [], FloatToStr(TIslandTesselator(CurrentTesselator).TextureScale), '0,01-10');
- end;
- end;
- procedure TIsland.SetProperties(Properties: Props.TProperties);
- begin
- inherited;
- if Assigned(CurrentTesselator) then begin
- if Properties.Valid('Thickness') then TIslandTesselator(CurrentTesselator).IslandThickness := StrToFloatDef(Properties['Thickness'], 0);
- if Properties.Valid('TextureScale') then TIslandTesselator(CurrentTesselator).TextureScale := StrToFloatDef(Properties['TextureScale'], 0);
- // CurrentTesselator.Init;
- SetMesh;
- end;
- end;
- { THeightMapTesselator }
- constructor THeightMapTesselator.Create;
- begin
- inherited;
- FTextureScale := 0.1;
- end;
- procedure THeightMapTesselator.Init;
- begin
- inherited;
- if Assigned(FMap) then begin
- TotalVertices := FMap.Width*FMap.Height;
- TotalPrimitives := MaxI(0, (FMap.Width-1)) * 2;
- TotalStrips := MaxI(0, (FMap.Height-1));
- TotalIndices := FMap.Width * (FMap.Height-1) * 2;
- StripOffset := FMap.Width;
- end else begin
- TotalVertices := 0;
- TotalStrips := 0;
- TotalIndices := 0;
- TotalPrimitives := 0;
- StripOffset := 0;
- end;
- PrimitiveType := ptTRIANGLESTRIP;
- IndexingVertices := TotalPrimitives+2;
- InitVertexFormat(GetVertexFormat(False, True, False, False, False, 0, [2]));
- end;
- procedure THeightMapTesselator.AddProperties(const Result: Props.TProperties; const PropNamePrefix: TNameString);
- begin
- inherited;
- if Assigned(Result) then begin
- Result.Add(PropNamePrefix + 'TextureScale', vtSingle, [], FloatToStr(FTextureScale), '0,01-4');
- end;
- end;
- procedure THeightMapTesselator.SetProperties(Properties: Props.TProperties; const PropNamePrefix: TNameString);
- begin
- inherited;
- if Properties.Valid(PropNamePrefix + 'TextureScale') then FTextureScale := StrToFloatDef(Properties[PropNamePrefix + 'TextureScale'], 0.1);
- end;
- function THeightMapTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
- var i, j: Integer; HalfLengthX, HalfLengthZ, y: Single;
- begin
- Result := 0;
- if not Assigned(FMap) or (FMap.Width = 0) or (FMap.Height = 0) then Exit;
- HalfLengthX := (FMap.Width-1) * FMap.CellWidthScale * 0.5;
- HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
- for j := 0 to FMap.Height-1 do for i := 0 to FMap.Width-1 do begin
- SetVertexDataUV(i * FTextureScale, j * FTextureScale, j * FMap.Width + i, VBPTR);
- Y := FMap[i, j] * FMap.DepthScale;
- SetVertexDataC(i * FMap.CellWidthScale - HalfLengthX,
- Y,
- j * FMap.CellHeightScale - HalfLengthZ,
- j * FMap.Width + i, VBPTR);
- SetVertexDataN(FMap.GetCellNormal(i, j), j * FMap.Width + i, VBPTR);
- end;
- TesselationStatus[tbVertex].Status := tsTesselated;
- Result := TotalVertices;
- LastTotalVertices := TotalVertices;
- end;
- function THeightMapTesselator.SetIndices(IBPTR: Pointer): Integer;
- var i, j: Integer;
- begin
- for j := 0 to TotalStrips-1 do for i := 0 to FMap.Width-1 do begin
- TWordBuffer(IBPTR^)[(j * FMap.Width + i)*2] := (0*j+0) * FMap.Width + i;
- TWordBuffer(IBPTR^)[(j * FMap.Width + i)*2+1] := (0*j+1) * FMap.Width + i;
- end;
- TesselationStatus[tbIndex].Status := tsTesselated;
- Result := TotalIndices;
- LastTotalIndices := TotalIndices;
- end;
- { THeightMapLandscape }
- function THeightMapLandscape.GetTesselatorClass: CTesselator;
- begin
- Result := THeightMapTesselator;
- end;
- procedure THeightMapLandscape.AddProperties(const Result: Props.TProperties);
- begin
- inherited;
- end;
- procedure THeightMapLandscape.SetProperties(Properties: Props.TProperties);
- begin
- inherited;
- end;
- { THeightMap }
- const ImagePropName = 'Image';
- function THeightMap.GetData: Pointer;
- begin
- if Assigned(FImage) then Result := FImage.Data else Result := nil;
- end;
- procedure THeightMap.ResolveLinks;
- var Item: TItem;
- begin
- inherited;
- ResolveLink(ImagePropName, Item);
- if Assigned(Item) then SetImage(Item as Resources.TImageResource);
- end;
- function THeightMap.GetRawHeight(XI, ZI: Integer): Integer;
- begin
- Assert((XI >= 0) and (ZI >= 0) and (XI < Width) and (ZI < Height), ClassName + '.GetCellHeight: Invalid cell index');
- Result := BaseTypes.PByteBuffer(FImage.Data)^[ZI * Width + XI];
- end;
- procedure THeightMap.SetRawHeight(XI, ZI: Integer; const Value: Integer);
- begin
- Assert((XI >= 0) and (ZI >= 0) and (XI < Width) and (ZI < Height), ClassName + '.SetRawHeight: Invalid cell index');
- BaseTypes.PByteBuffer(FImage.Data)^[ZI * Width + XI] := Value;
- end;
- procedure THeightMap.SwapRectHeights(const ARect: TRect; ABuf: Pointer);
- begin
- inherited;
- FImage.GenerateMipLevels(ARect);
- end;
- procedure THeightMap.SetDimensions(AWidth, AHeight: Integer);
- begin
- inherited;
- end;
- procedure THeightMap.SetImage(Image: Resources.TImageResource);
- //var i, j: Integer;
- begin
- if Assigned(Image) then begin
- if (GetBytesPerPixel(Image.Format) <> 1) then begin
- Log.Log(Format('%S("%S").%S: a 8 bits per pixel image required', [ClassName, GetFullName, 'SetImage']), lkError);
- Exit;
- end;
- if Image.MipPolicy = mpNoMips then begin
- Log.Log(Format('%S("%S").%S: an image with mipmaps enabled required', [ClassName, GetFullName, 'SetImage']), lkError);
- // Exit;
- end;
- end;
- FImage := Image;
- end;
- procedure THeightMap.AddProperties(const Result: Props.TProperties);
- begin
- inherited;
- if Assigned(Result) then begin
- end;
- AddItemLink(Result, ImagePropName, [], 'TImageResource');
- end;
- procedure THeightMap.SetProperties(Properties: Props.TProperties);
- begin
- inherited;
- if Properties.Valid(ImagePropName) then SetLinkProperty(ImagePropName, Properties[ImagePropName]);
- ResolveLinks;
- end;
- constructor THeightMap.Create(AManager: TItemsManager);
- begin
- inherited;
- FMaxHeight := 255; // 8-bit heights
- FElementSize := 1;
- end;
- function THeightMap.IsReady: Boolean;
- begin
- Result := inherited IsReady and Assigned(FImage) and Assigned(FImage.Data);
- end;
- { TVertexWaterTesselator }
- procedure TVertexWaterTesselator.Init;
- begin
- inherited;
- if Assigned(FMap) then begin
- SetLength(arr, TotalVertices);
- SetLength(Vel, TotalVertices);
- FillChar(arr[0], TotalVertices*4, 0);
- FillChar(vel[0], TotalVertices*4, 0);
- end;
- InitVertexFormat(GetVertexFormat(False, True, True, False, False, 0, [2]));
- end;
- function TVertexWaterTesselator.RetrieveParameters(out Parameters: Pointer; Internal: Boolean): Integer;
- begin
- Result := 5;
- if Internal then Parameters := @FWaterColor else Parameters := @WaterColor;
- end;
- const MaxArr = 1000000000.0;
- procedure TVertexWaterTesselator.Iterate;
- //const k = 0.25; VC = 0.25*1+0*1; FalOff = 1*1+0*0.98; RestoreForce = 1*0+1*0.98;
- var i, j: Integer;
- begin
- for j := 1 to FMap.Height-2 do
- for i := 1 to FMap.Width-2 do
- vel[j * FMap.Width + i] := (vel[j * FMap.Width + i] +
- (-arr[j * FMap.Width + i]*4 +
- arr[(j+1) * FMap.Width + i] + arr[(j-1) * FMap.Width + i] +
- arr[j * FMap.Width + i + 1] + arr[j * FMap.Width + i - 1]) * FWavesSpeed ) * FWavesFalloff;
- for j := 0 to FMap.Height-1 do begin
- for i := 0 to FMap.Width-1 do begin
- // arr[j * FMap.Width + i] := arr[j * FMap.Width + i] + Vel[j * FMap.Width + i] * 0.5;
- arr[j * FMap.Width + i] := (arr[j * FMap.Width + i] + Vel[j * FMap.Width + i]) * FViscosity;
- if arr[j * FMap.Width + i]>MaxArr then arr[j * FMap.Width + i] := MaxArr;
- if arr[j * FMap.Width + i]<0 then arr[j * FMap.Width + i] := 0;
- FMap[i, j] := Round((arr[(j div 1) * FMap.Width + i div 1]*1) / MaxArr*255);
- { FMap[i, j] := Round((
- arr[(j div 1) * FMap.Width + i div 1]*(1-k*4) +
- arr[MaxI(0, j-1) * FMap.Width + i]*k +
- arr[(j) * FMap.Width + MaxI(0, i-1)]*k +
- arr[MinI(FMap.Height-1, j+1) * FMap.Width + i]*k +
- arr[(j) * FMap.Width + MinI(FMap.Width-1, i+1)]*k
- ) / MaxArr*255);}
- end;
- end;
- end;
- function TVertexWaterTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
- var i, j: Integer; HalfLengthX, HalfLengthZ, y, a, MinA, FRACos: Single; c, n: TVector3s;
- begin
- Result := 0;
- if not Assigned(FMap) or not FMap.IsReady then Exit;
- if TesselationStatus[tbVertex].Status <> tsTesselated then Iterate;
- MinA := FWaterColor.A / 255;
- FRACos := Sin((FFullRefAngle)/180*pi);
- HalfLengthX := (FMap.Width-1) * FMap.CellWidthScale * 0.5;
- HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
- for j := 0 to FMap.Height-1 do for i := 0 to FMap.Width-1 do begin
- SetVertexDataUV(i * FTextureScale, j * FTextureScale, j * FMap.Width + i, VBPTR);
- Y := FMap[i, j] * FMap.DepthScale;
- c := GetVector3s(i * FMap.CellWidthScale - HalfLengthX, Y, j * FMap.CellHeightScale - HalfLengthZ);
- SetVertexDataC(c, j * FMap.Width + i, VBPTR);
- n := FMap.GetCellNormal(i, j);
- SetVertexDataN(n, j * FMap.Width + i, VBPTR);
- n := Transform3Vector3s(CutMatrix3s(Params.ModelMatrix), n);
- c := Transform4Vector33s(Params.ModelMatrix, c);
- c := NormalizeVector3s(SubVector3s(Params.Camera.Position, c));
- // a := MaxS(0, MinA + MinS(1-MinA, (1-Abs(DotProductVector3s(c, n)))/FRACos) );
- a := MaxS(0, MinA + MinS(1-MinA, (1-MinA)*Sqrt(1-Sqr(DotProductVector3s(c, n)))/FRACos ));
- SetVertexDataD(GetColor(FWaterColor.R, FWaterColor.G, FWaterColor.B, Round(a*255)), j * FMap.Width + i, VBPTR);
- end;
- TesselationStatus[tbVertex].Status := tsTesselated;
- Result := TotalVertices;
- LastTotalVertices := TotalVertices;
- end;
- { TVertexWater}
- function TVertexWater.GetTesselatorClass: CTesselator; begin Result := TVertexWaterTesselator; end;
- procedure TVertexWater.AddProperties(const Result: TProperties);
- begin
- inherited;
- if Assigned(Result) then begin
- AddColorProperty(Result, 'Water color', WaterColor);
- Result.Add('100% reflection angle', vtInt, [], IntToStr(FullRefAngle), '0-90');
- Result.Add('Waves speed', vtSingle, [], FloatToStr(WavesSpeed), '0.1-1');
- Result.Add('Waves falloff', vtSingle, [], FloatToStr(WavesFalloff), '0.9-1');
- Result.Add('Water viscosity', vtSingle, [], FloatToStr(Viscosity), '0.8-1');
- end;
- end;
- procedure TVertexWater.SetProperties(Properties: TProperties);
- var Mesh: TVertexWaterTesselator;
- begin
- inherited;
- SetColorProperty(Properties, 'Water color', WaterColor);
- if Properties.Valid('100% reflection angle') then FullRefAngle := StrToIntDef(Properties['100% reflection angle'], 30);
- if Properties.Valid('Waves speed') then WavesSpeed := StrToFloatDef(Properties['Waves speed'], 0);
- if Properties.Valid('Waves falloff') then WavesFalloff := StrToFloatDef(Properties['Waves falloff'], 0);
- if Properties.Valid('Water viscosity') then Viscosity := StrToFloatDef(Properties['Water viscosity'], 0);
- if not (CurrentTesselator is TVertexWaterTesselator) then Exit;
- Mesh := CurrentTesselator as TVertexWaterTesselator;
- Mesh.WaterColor := WaterColor;
- Mesh.FullRefAngle := FullRefAngle;
- Mesh.WavesSpeed := WavesSpeed;
- Mesh.WavesFalloff := WavesFalloff;
- Mesh.Viscosity := Viscosity;
- SetMesh;
- end;
- procedure TVertexWater.Process(const DeltaTime: Single);
- procedure MakeWave(z, len: Integer; Height, Freq, Radii: Single);
- var i, j: Integer;
- begin
- with (CurrentTesselator as TVertexWaterTesselator) do begin
- for i := 2 to FMap.Width-4 do
- for j := 0 to len-1 do
- 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);
- // arr[MinI(FMap.Height-2, z+j) * FMap.Width + MinI(FMap.Width-2, i)] := MaxArr*Height * Sin(j/(len-1)*pi);
- end;
- end;
- var w, h: Integer;
- begin
- inherited;
- if not Assigned((CurrentTesselator as TVertexWaterTesselator).FMap) or not (CurrentTesselator as TVertexWaterTesselator).FMap.IsReady then Exit;
- CurrentTesselator.Invalidate([tbVertex], False);
- with (CurrentTesselator as TVertexWaterTesselator) do begin
- Inc(Counter);
- w := FMap.Width;
- w := w div 2 + Random(w div 2-2) - Random(w div 2-2);
- h := FMap.Height;
- h := h div 2 + Random(h div 2-2) - Random(h div 2-2);
- if Counter mod 2 = 0 then arr[h * FMap.Width + w] := (MaxArr + Random * MaxArr)/2/2;
- // if Counter mod 2 = 0 then MakeWave(6, 0.03, 4, 4);
- // if Counter mod 6 = 0 then MakeWave(67, 0.08, 4, 4);
- if Counter mod 10 = 0 then MakeWave(126-6, 6, 0.2, 1, 18);
- end;
- end;
- { TProjectedLandTesselator }
- procedure TProjectedLandTesselator.ProjectGrid(const Params: TTesselationParameters; out PrjPnt: TQuadPoints);
- var
- ModelInv: TMatrix4s; ModelInv33: TMatrix3s;
- CameraInModel: TVector3s;
- CameraElevation: Single;
- OPnt2, OPnt3: TVector3s;
- procedure SwapVec(var V1, V2: TVector3s);
- var Vec: TVector3s;
- begin
- Vec := V1;
- V1 := V2;
- V2 := Vec;
- end;
- function ProjectOnGrid2(X, Y: Single; out Point: TVector3s): Boolean;
- var PickRay: TVector3s;
- begin
- Result := False;
- PickRay := Transform3Vector3s(CutMatrix3s(InvertAffineMatrix4s(Params.Camera.ViewMatrix)), Params.Camera.GetPickRay(X, Y));
- PickRay := NormalizeVector3s(Transform3Vector3s(ModelInv33, PickRay) );
- if (Abs(PickRay.Y) > epsilon) and (Sign(PickRay.Y) <> Sign(CameraInModel.Y)) and
- (Abs(CameraElevation/PickRay.Y) < ViewDepth) then begin // Ray intersects the surface
- SubVector3s(Point, CameraInModel, ScaleVector3s(PickRay, CameraElevation/PickRay.Y));
- Point.Y := 0;
- Result := True;
- end;
- end;
- function ProjectNearEdge(FlipSign: Single): Boolean;
- var TempK, y: Single; Pnt0, Pnt1: TVector3s;
- begin
- Result := False;
- y := Params.Camera.RenderHeight * Ord(FlipSign >= 0);
- if not ProjectOnGrid2(Params.Camera.RenderWidth, y, PrjPnt[2]) then Exit;
- if not ProjectOnGrid2(0, y, PrjPnt[3]) then Exit;
- OPnt2 := PrjPnt[2];
- OPnt3 := PrjPnt[3];
- // Near edge with elevation taken in account
- TempK := SqrMagnitude(CameraDir);
- if TempK > epsilon then begin
- ScaleVector3s(CameraDir, CameraDir, InvSqrt(TempK));
- CameraElevation := MaxS(0, CameraInModel.Y-FMap.MaxHeight * FMap.DepthScale);
- if not ProjectOnGrid2(Params.Camera.RenderWidth, y, Pnt1) then Exit;
- if not ProjectOnGrid2(0, y, Pnt0) then Exit;
- TempK := MinS(0, MinS(DotProductVector3s(CameraDir, SubVector3s(Pnt1, PrjPnt[2])),
- DotProductVector3s(CameraDir, SubVector3s(Pnt0, PrjPnt[3]))));
- AddVector3s(PrjPnt[2], PrjPnt[2], ScaleVector3s(CameraDir, TempK));
- AddVector3s(PrjPnt[3], PrjPnt[3], ScaleVector3s(CameraDir, TempK));
- CameraElevation := CameraInModel.Y;
- end;
- Result := True;
- end;
- function ProjectFarEdge(FlipSign: Single): Boolean;
- var y: Single; LeftRail, RightRail: TVector3s;
- begin
- Result := False;
- y := Params.Camera.RenderHeight * Ord(FlipSign >= 0);
- if not ProjectOnGrid2(Params.Camera.RenderWidth, y + 1 - 2*Ord(FlipSign >= 0), PrjPnt[1]) then Exit;
- if not ProjectOnGrid2(0, y + 1 - 2*Ord(FlipSign >= 0), PrjPnt[0]) then Exit;
- LeftRail := NormalizeVector3s(SubVector3s(PrjPnt[0], OPnt3));
- RightRail := NormalizeVector3s(SubVector3s(PrjPnt[1], OPnt2));
- if not ProjectOnGrid2(Params.Camera.RenderWidth, Params.Camera.RenderHeight-y, PrjPnt[1]) then
- PrjPnt[1] := AddVector3s(OPnt2, ScaleVector3s(RightRail, ViewDepth));
- if not ProjectOnGrid2(0, Params.Camera.RenderHeight-y, PrjPnt[0]) then
- PrjPnt[0] := AddVector3s(OPnt3, ScaleVector3s(LeftRail, ViewDepth));
- Result := True;
- end;
- var TempK: Single;
- begin
- ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
- ModelInv33 := CutMatrix3s(ModelInv);
- Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
- CameraElevation := CameraInModel.Y;
- FlipSign := Sign(DotProductVector3s(Params.Camera.UpDir, Params.ModelMatrix.ViewUp));// *
- // -DotProductVector3s(Params.Camera.LookDir, Params.ModelMatrix.ViewUp);
- CameraRight := ScaleVector3s(Transform3Vector3s(ModelInv33, Params.Camera.RightVector), FlipSign);
- CameraRight.Y := 0;
- TempK := SqrMagnitude(CameraRight);
- // Assert(TempK > epsilon);
- ScaleVector3s(CameraRight, CameraRight, InvSqrt(TempK));
- CameraDir := Transform3Vector3s(ModelInv33, Params.Camera.ForwardVector);
- CameraDir.Y := 0;
- if not ProjectNearEdge(FlipSign) then Exit;
- if not ProjectFarEdge(FlipSign) then Exit;
- TempK := SqrMagnitude(CameraDir);
- if TempK <= epsilon then
- CameraDir := CrossProductVector3s(Transform3Vector3s(ModelInv33, Params.Camera.ForwardVector), CameraRight);
- if FlipSign < 0 then begin
- SwapVec(PrjPnt[0], PrjPnt[1]);
- SwapVec(PrjPnt[2], PrjPnt[3]);
- SwapVec(OPnt2, OPnt3);
- end;
- end;
- constructor TProjectedLandTesselator.Create;
- var i: Integer;
- begin
- inherited;
- FGridWidth := 100;
- FGridHeight := 200;
- MipBias := 100;
- MipScale := 1;
- SmoothX := 1;
- SmoothZ := 1;
- DetailBalance := 0.5;
- TrilinearRange := 0.3;
- FMegaTextureScale := 1;
- FLastClipmapSize := 0;
- FClipmapSize := 256;
- for i := 0 to High(MipTexture) do MipTexture[i] := -1;
- end;
- destructor TProjectedLandTesselator.Destroy;
- begin
- SetLength(FGrid, 0);
- SetLength(FMipZ, 0);
- inherited;
- end;
- function TProjectedLandTesselator.GetMaxVertices: Integer;
- begin
- Result := TotalVertices;
- end;
- procedure TProjectedLandTesselator.Init;
- begin
- inherited;
- if Assigned(FMap) then begin
- TotalVertices := (FGridWidth+1)*(FGridHeight+1);
- TotalIndices := (FGridWidth+1)*2; // - - 89, 1 - 309-315, 2 - 85
- TotalStrips := FGridHeight;
- TotalPrimitives := FGridWidth*2;
- StripOffset := FGridWidth+1;
- // StripOffset := FGridWidth+1;
- SetLength(FMipZ, FGridHeight+1);
- // 0 2 4 0 1 2 3 4 5 5 1 P: ??? (w*2)*(h-1)-2 = (3*2)*3-2 = 16
- // 1 3 5 1 6 3 7 5 8 8 6 V: w*h = 3*4 = 12
- // 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
- // 9 A B
- { TotalIndices := 2*(FGridWidth+2)*(FGridHeight);//-2
- TotalStrips := 1;
- TotalPrimitives := 2*(FGridWidth+1)*(FGridHeight)-2;//(TotalIndices-2-2);
- StripOffset := 0;}
- end else begin
- TotalVertices := 0;
- TotalStrips := 0;
- TotalIndices := 0;
- TotalPrimitives := 0;
- StripOffset := 0;
- end;
- if not ManualRender then Log.Log('TProjectedLandTesselator.Init: Manual render should be turned on for megatextured landscapes', lkWarning);
- PrimitiveType := ptTRIANGLESTRIP;
- TesselationStatus[tbVertex].TesselatorType := ttStatic;
- TesselationStatus[tbIndex].TesselatorType := ttStatic;
- // IndexingVertices := TotalVertices;
- IndexingVertices := (FGridWidth+1)*2;
- // IndexingVertices := (FGridHeight+1)*2;
- // InitVertexFormat(GetVertexFormat(False, False, True, False, False, 0, [2]));
- InitVertexFormat(GetVertexFormat(False, False, False, False, False, 0, []));
- LastTexUpdX := 0;
- LastTexUpdZ := 0;
- end;
- procedure TProjectedLandTesselator.DoManualRender(Item: TItem);
- var TexI: Integer; MipWorldSize, LandSizeX, LandSizeZ: Single; TexUpd: Boolean;
- procedure ApplyNextMip;
- var LockedData: TLockedRectData; CenX, CenZ: Single;
- begin
- // texofs := texofs - 0.5/TexDim;
- TexI := TexI + 1;
- MipWorldSize := FClipmapSize * (1 shl TexI)/FMegaTextureScale;
- CenX := TProjectedLandscape(Item).MegaTexture.LevelInfo[TexI].Width * (0.5 + FMegaTextureScale * CamOfsX / TProjectedLandscape(Item).MegaTexture.LevelInfo[0].Width);
- CenZ := TProjectedLandscape(Item).MegaTexture.LevelInfo[TexI].Height * (0.5 + FMegaTextureScale * CamOfsZ / TProjectedLandscape(Item).MegaTexture.LevelInfo[0].Height);
- CenZ := TProjectedLandscape(Item).MegaTexture.LevelInfo[TexI].Height - CenZ;
- if TexUpd or (MipTexture[TexI] = -1) or (FLastClipmapSize <> FClipmapSize) then begin
- if (MipTexture[TexI] = -1) or (FLastClipmapSize <> FClipmapSize) then begin
- if MipTexture[TexI] <> -1 then Renderer.Textures.Delete(MipTexture[TexI]);
- MipTexture[TexI] := Renderer.Textures.NewProceduralTexture(TProjectedLandscape(Item).MegaTexture.Format, FClipmapSize, FClipmapSize, 0, 1, [toProcedural]);
- end;
- Renderer.Textures.Lock(MipTexture[TexI], 0, nil, LockedData, []);
- TProjectedLandscape(Item).MegaTexture.LoadRect(GetRect(Trunc(CenX - FClipmapSize*0.5), Trunc(CenZ - FClipmapSize*0.5),
- Trunc(CenX - FClipmapSize*0.5)+FClipmapSize, Trunc(CenZ - FClipmapSize*0.5)+FClipmapSize), TexI, LockedData.Data, FClipmapSize);
- // FillDWord(LockedData.Data^, 512*512, MipColors[i]);
- Renderer.Textures.UnLock(MipTexture[TexI], 0);
- LastTexUpdX := CamOfsX;
- LastTexUpdZ := CamOfsZ;
- end;
- CenX := Frac(CenX - FClipmapSize*0.5)/FClipmapSize;
- CenZ := Frac(CenZ - FClipmapSize*0.5)/FClipmapSize;
- Renderer.Textures.Apply(0, MipTexture[TexI]);
- Renderer.APIState.SetShaderConstant(skVertex, 9, GetVector4s(1/MipWorldSize, -1/MipWorldSize, CenX, CenZ));
- end;
- var i, j, k: Integer;
- begin
- if not Assigned(TProjectedLandscape(Item).MegaTexture) then Exit;
- TexUpd := (LastTexUpdX <> CamOfsX) or (LastTexUpdZ <> CamOfsZ);
- LandSizeX := FMap.Width * FMap.CellWidthScale;
- LandSizeZ := FMap.Width * FMap.CellWidthScale;
- j := 0;//FGridHeight-1;
- FMipZ[j] := MinS(FMipZ[j], Sqrt(Sqr(LandSizeX)+Sqr(LandSizeZ)));
- TexI := -1;//+1*ClipmapCount-1-1;
- ApplyNextMip;
- for k := 0 to FarMip-NearMip do for i := 0 to MipDetail[k] - 1-Ord(k=FarMip-NearMip) do begin
- // if j > 0 then FMipZ[j] := (ViewDepth + 1*ExcessDist) * (MipStart[k] + i*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
- if FMipZ[j+1] >= MipWorldSize*0.5 - epsilon then ApplyNextMip();
- TCore(TProjectedLandscape(Item).FManager).Renderer.APIRenderIndexedStrip(Self, j);
- Inc(j);
- end;
- FLastClipmapSize := FClipmapSize;
- end;
- procedure TProjectedLandTesselator.AddProperties(const Result: TProperties; const PropNamePrefix: TNameString);
- var RangeStr: ShortString;
- begin
- inherited;
- if Assigned(Result) then begin
- Result.Add(PropNamePrefix + 'X resolution', vtInt, [], IntToStr(FGridWidth), '1-300');
- Result.Add(PropNamePrefix + 'YZ resolution', vtInt, [], IntToStr(FGridHeight), '1-600');
- Result.Add(PropNamePrefix + 'Smooth X', vtNat, [], IntToStr(SmoothX-1), '0-15');
- Result.Add(PropNamePrefix + 'Smooth Z', vtNat, [], IntToStr(SmoothZ-1), '0-15');
- Result.Add(PropNamePrefix + 'Trilinear range', vtSingle, [], FloatToStr(TrilinearRange), '0.0001-1');
- Result.Add(PropNamePrefix + 'Excess distance', vtSingle, [], FloatToStr(ExcessDist), '0-128');
- if Assigned(FMap) then
- RangeStr := IntToStr(Round(FMap.CellWidthScale * 50)) + '-' + IntToStr(Round(FMap.CellWidthScale * 5000)) else
- RangeStr := '50-5000';
- Result.Add(PropNamePrefix + 'View depth', vtSingle, [], FloatToStr(ViewDepth), RangeStr);
- Result.Add(PropNamePrefix + 'Mip level bias', vtSingle, [], FloatToStr(MipBias), '0-512');
- Result.Add(PropNamePrefix + 'Mip scale', vtSingle, [], FloatToStr(MipScale), '0.1-4');
- Result.Add(PropNamePrefix + 'Detail balance', vtSingle, [], FloatToStr(DetailBalance), '0-1');
- Result.Add(PropNamePrefix + 'TextureDiffuse scale', vtSingle, [], FloatToStr(FMegaTextureScale), '0.1-10');
- Result.Add(PropNamePrefix + 'TextureClipmap size', vtNat, [], IntToStr(FClipmapSize), '64-2048');
- end;
- end;
- procedure TProjectedLandTesselator.SetProperties(Properties: TProperties; const PropNamePrefix: TNameString);
- begin
- inherited;
- if Properties.Valid(PropNamePrefix + 'X resolution') then FGridWidth := StrToIntDef(Properties[PropNamePrefix + 'X resolution'], 0);
- if Properties.Valid(PropNamePrefix + 'YZ resolution') then FGridHeight := StrToIntDef(Properties[PropNamePrefix + 'YZ resolution'], 0);
- if Properties.Valid(PropNamePrefix + 'Smooth X') then SmoothX := StrToIntDef(Properties[PropNamePrefix + 'Smooth X'], 0) + 1;
- if Properties.Valid(PropNamePrefix + 'Smooth Z') then SmoothZ := StrToIntDef(Properties[PropNamePrefix + 'Smooth Z'], 0) + 1;
- if Properties.Valid(PropNamePrefix + 'Trilinear range') then TrilinearRange := StrToFloatDef(Properties[PropNamePrefix + 'Trilinear range'], 0.3);
- if Properties.Valid(PropNamePrefix + 'Excess distance') then ExcessDist := StrToFloatDef(Properties[PropNamePrefix + 'Excess distance'], 0);
- if Properties.Valid(PropNamePrefix + 'View depth') then ViewDepth := StrToFloatDef(Properties[PropNamePrefix + 'View depth'], 500);
- if Properties.Valid(PropNamePrefix + 'Mip level bias') then MipBias := StrToFloatDef(Properties[PropNamePrefix + 'Mip level bias'], 50);
- if Properties.Valid(PropNamePrefix + 'Mip scale') then MipScale := StrToFloatDef(Properties[PropNamePrefix + 'Mip scale'], 0);
- if Properties.Valid(PropNamePrefix + 'Detail balance') then DetailBalance := StrToFloatDef(Properties[PropNamePrefix + 'Detail balance'], 0.5);
- if Properties.Valid(PropNamePrefix + 'TextureDiffuse scale') then FMegaTextureScale := StrToFloatDef(Properties[PropNamePrefix + 'TextureDiffuse scale'], 1);
- if Properties.Valid(PropNamePrefix + 'TextureClipmap size') then FClipmapSize := StrToIntDef(Properties[PropNamePrefix + 'TextureClipmap size'], 256);
- Init;
- end;
- { TProjGridTesselator }
- function TProjGridTesselator.GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer;
- function IsInPnts(const Point: TVector3s): Boolean;
- var i: Integer; v1, v2: TVector3s;
- begin
- Result := False;
- { SubVector3s(V1, Pnt[0], Pnt[3]);
- SubVector3s(V2, Point, Pnt[3]);
- Y := Sign(V1.Z*V2.X - V1.X*V2.Z);}
- for i := 0 to 3 do begin
- SubVector3s(V1, Pnt[(i+1) mod 4], Pnt[i]);
- SubVector3s(V2, Point, Pnt[i]);
- if Sign(V1.Z*V2.X - V1.X*V2.Z)*FlipSign < 0 then Exit;
- end;
- Result := True;
- end;
- var i: Integer;
- begin
- if Buffer = tbVertex then begin
- Result := TotalVertices;
- if //not EqualsMatrix4s(Params.Camera.Transform, OldCameraMatrix) or
- (TesselationStatus[Buffer].Status <> tsTesselated) then Exit;
- ProjectGrid(Params, PrjPnt);
- for i := 0 to 3 do if not IsInPnts(PrjPnt[i]) then Exit;
- // Result := 0;
- end else Result := inherited GetUpdatedElements(Buffer, Params);
- end;
- function TProjGridTesselator.SetIndices(IBPTR: Pointer): Integer;
- var i: Integer;
- begin
- for i := 0 to TotalIndices div 2-1 do begin
- TWordBuffer(IBPTR^)[i * 2 + 0] := i;
- TWordBuffer(IBPTR^)[i * 2 + 1] := i + FGridWidth + 1;
- end;
- // 0 1 2 0 3 1 4 2 5 5 3 P: (w*2)*(h-1)-2 = (3*2)*3-2 = 16
- // 3 4 5 3 6 4 7 5 8 8 6 V: w*h = 3*4 = 12
- // 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
- // 9 A B
- { for j := 0 to FGridHeight-1 do begin
- for i := 0 to FGridWidth+1 - 1 do begin
- Assert(j*(FGridWidth+2)*2 + i*2+1 < TotalIndices);
- i1 := j * (FGridWidth+1) + i;
- TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2 + i*2+0] := i1;
- TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2 + i*2+1] := i1 + (FGridWidth+1);
- end;
- TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2+(FGridWidth+1)*2] := i1 + (FGridWidth+1);
- TWordBuffer(IBPTR^)[j*(FGridWidth+2)*2+(FGridWidth+1)*2+1] := (j+1)*(FGridWidth+1);
- end;}
- TesselationStatus[tbIndex].Status := tsTesselated;
- Result := TotalIndices;
- LastTotalIndices := TotalIndices;
- end;
- function TProjGridTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
- var
- HalfLengthX, HalfLengthZ: Single;
- VBuf: ^TVector3s;
- // Returns True if the ray intersects with the grid
- (* function ProjectOnGrid(X, Y: Single; out Point: TVector3s; CorrectOnly: Boolean): Boolean;
- const CosA = 0.7;
- var PickRay: TVector3s; K: Single;
- begin
- PickRay := Transform3Vector3s(CutMatrix3s(InvertAffineMatrix4s(Params.Camera.ViewMatrix)), Params.Camera.GetPickRay2(X, Y));
- PickRay := NormalizeVector3s( Transform3Vector3s(ModelInv33, PickRay) );
- if (CorrectOnly) or
- (Abs(PickRay.Y) > epsilon) and (Sign(PickRay.Y) <> Sign(CameraInModel.Y)) and
- (Abs(CameraElevation/PickRay.Y) < ViewDepth) then begin // Ray intersects the surface
- SubVector3s(Point, CameraInModel, ScaleVector3s(PickRay, CameraElevation/PickRay.Y));
- Point.Y := 0;
- Result := True;
- end else begin
- PickRay.Y := 0;
- PickRay := NormalizeVector3s(PickRay);
- ScaleVector3s(PickRay, PickRay, ViewDepth);
- Point := PickRay;
- Point.Y := 0;
- // K := Sqrt(SqrMagnitude(Point))/ViewDepth;
- // if K < CosA then
- K := 1;
- AddVector3s(Point, CameraInModel, ScaleVector3s(PickRay, 1/K));
- Point.Y := 0;
- Result := False;
- end;
- end;
- procedure RestrictGrid;
- var i, i2, cnt: Integer;
- function IsInLandscape(const Point: TVector3s): Boolean;
- begin
- Result := (Point.X > -HalfLengthX) and (Point.X < HalfLengthX) and
- (Point.Z > -HalfLengthZ) and (Point.Z < HalfLengthZ);
- end;
- begin
- i := 0;
- while (i < 4) and not IsInLandscape(Pnt[i]) do Inc(i);
- if i < 4 then begin
- i2 := (i + 1) mod 4;
- for cnt := 0 to 3 do begin
- if not IsInLandscape(Pnt[i2]) then begin
- P := Pnt[i];
- ClipLine(P.X, P.Z, Pnt[i2].X, Pnt[i2].Z, -HalfLengthX, -HalfLengthZ, HalfLengthX, HalfLengthZ);
- end;
- i := i2;
- i2 := (i + 1) mod 4;
- end;
- end else begin
- Pnt[0] := GetVector3s(-HalfLengthX, 0, HalfLengthZ);
- Pnt[1] := GetVector3s( HalfLengthX, 0, HalfLengthZ);
- Pnt[2] := GetVector3s( HalfLengthX, 0, -HalfLengthZ);
- Pnt[3] := GetVector3s(-HalfLengthX, 0, -HalfLengthZ);
- end;
- end;
- function ProjectBottomEdge(var Pnt1, Pnt2: TVector3s): Integer;
- var Proj: TVector4s;
- begin
- Result := 0;
- if ProjectOnGrid(Params.Camera.RenderWidth, Params.Camera.RenderHeight, Pnt1, False) then
- Inc(Result) else begin // ToDo: Syncronize this case with Pnt2?
- Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt1));
- if (Proj.X < Params.Camera.RenderWidth-1) then ProjectOnGrid(Params.Camera.RenderWidth, Proj.Y, Pnt1, True);
- end;
- if ProjectOnGrid(0, Params.Camera.RenderHeight, Pnt2, False) then
- Inc(Result) else begin
- Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt2));
- if (Proj.X > 0) then ProjectOnGrid(0, Proj.Y, Pnt2, True);
- end;
- end;
- function ProjectTopEdge(var Pnt1, Pnt2: TVector3s): Integer;
- var Proj: TVector4s;
- begin
- Result := 0;
- if ProjectOnGrid(0, 0, Pnt1, False) then
- Inc(Result) else begin // ToDo: Syncronize this case with Pnt2?
- Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt1));
- if (Proj.X > 0) then ProjectOnGrid(0, Proj.Y, Pnt1, True);
- end;
- if ProjectOnGrid(Params.Camera.RenderWidth, 0, Pnt2, False) then
- Inc(Result) else begin
- Proj := Params.Camera.Project(Transform4Vector33s(Params.ModelMatrix, Pnt2));
- if (Proj.X < Params.Camera.RenderWidth-1) then ProjectOnGrid(Params.Camera.RenderWidth, Proj.Y, Pnt2, True);
- end;
- end;
- *)
- var
- P, P1, P2, P1Incr, P2Incr, PIncr: TVector3s;
- OneOverCellWidthScale, OneOverCellHeightScale: Single;
- i, k, l, X1, Z1, Addr: Integer;
- Data, Data2: Pointer;
- LastY, CurY, xo, zo: Single;
- // LastLine: array[0..1023] of Single;
- a, MinA, FRACos: Single;
- OutP: TVector3s;
- DistIncr, FarDist, NearDist, TempK, Error: Single;
- FirstPartK, LastPartK, LightMapScaleX, LightMapScaleZ, MipK, MipDivider, TempX, TempZ: Single;
- MipW, MipH, MipW2, MipH2, Index: Integer;
- IndI, IndJ: Cardinal;
- { function GetHeight(AData: Pointer; Offs: Integer): Single;
- const k1 = 0.25; k2 = 0.0;
- var X, Y: Integer;
- begin
- X := Offs mod MipW;
- Y := Offs div MipW;
- Result :=
- PByteBuffer(AData)^[Offs-MipW*2] * K2 +
- PByteBuffer(AData)^[Offs-MipW] * K1 +
- PByteBuffer(AData)^[Offs-2] * K2 +
- PByteBuffer(AData)^[Offs-1] * K1 +
- PByteBuffer(AData)^[Offs] * (1-K1*4-k2*4)+
- PByteBuffer(AData)^[Offs+MipW] * K1+
- PByteBuffer(AData)^[Offs+2*MipW] * K2+
- PByteBuffer(AData)^[Offs+2] * K2+
- PByteBuffer(AData)^[Offs+1] * K1 ;
- // Result := MaxI(0, Round((Sin(X * pi*2*4)*0+Sin(Y*0.01 * pi*2)) * 40));
- end;}
- type
- PBB = PByteBuffer;
- TData = record
- case Boolean of
- True: (a, b, c, d: Byte);
- False: (d32: Longword);
- end;
- TData2 = record
- case Boolean of
- True: (a, b: Byte);
- False: (d16: longword);
- end;
- var
- d0, d1, d2, d3: TData;
- ModelInv: TMatrix4s; CameraInModel: TVector3s;
- j: Integer;
- begin
- Result := 0;
- if not Assigned(FMap) or not FMap.IsReady then Exit;
- OldCameraMatrix := Params.Camera.Transform;
- ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
- Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
- CamOfsX := CameraInModel.X;
- CamOfsZ := CameraInModel.Z;
- HalfLengthX := (FMap.Width-1) * FMap.CellWidthScale * 0.5;
- HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
- LightMapScaleX := 0.5/HalfLengthX;
- LightMapScaleZ := 0.5/HalfLengthZ;
- OneOverCellWidthScale := 1/FMap.CellWidthScale;
- OneOverCellHeightScale := 1/FMap.CellHeightScale;
- ProjectGrid(Params, PrjPnt);
- AddVector3s(Pnt[0], PrjPnt[0], Vec3s(ExcessDist*(-CameraRight.X + CameraDir.X), 0, ExcessDist*(-CameraRight.Z + CameraDir.Z)));
- AddVector3s(Pnt[1], PrjPnt[1], Vec3s(ExcessDist*( CameraRight.X + CameraDir.X), 0, ExcessDist*( CameraRight.Z + CameraDir.Z)));
- AddVector3s(Pnt[2], PrjPnt[2], Vec3s(ExcessDist*( CameraRight.X - CameraDir.X), 0, ExcessDist*( CameraRight.Z - CameraDir.Z)));
- AddVector3s(Pnt[3], PrjPnt[3], Vec3s(ExcessDist*(-CameraRight.X - CameraDir.X), 0, ExcessDist*(-CameraRight.Z - CameraDir.Z)));
- // FillChar(LastLine[0], SizeOf(LastLine), 0);
- // LastLine[0] := FMap.GetHeight((Pnt[3].X+Pnt[2].X)*0.5, (Pnt[3].Z+Pnt[2].Z)*0.5);
- // FillDword(LastLine[1], FGridWidth, Cardinal(Pointer(@LastLine[0])^));
- NearDist := Sqrt(SqrMagnitude(SubVector3s(Pnt[2], Pnt[3])));
- FarDist := Sqrt(SqrMagnitude(SubVector3s(Pnt[1], Pnt[0])));
- DistIncr := FarDist - NearDist;
- if DistIncr < 0 then Exit;
- // if not FInfinite then RestrictGrid;
- NearMip := 0;
- while (NearMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
- (FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
- Inc(NearMip);
- FarMip := 0;
- while (FarMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
- (FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
- Inc(FarMip);
- for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
- if MipStart[FarMip-NearMip+1] < 1 then begin
- Assert(MipStart[FarMip-NearMip+1] >= 1);
- end;
- if FarMip-NearMip >= 1 then begin
- MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
- FirstPartK := MipStart[1]/(MipStart[1] - MipStart[0]);
- LastPartK := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
- TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
- MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
- Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
- for i := NearMip+1 to FarMip-1 do begin
- MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
- Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
- end;
- MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
- Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
- if Error >= 0.5 then Inc(MipDetail[0]);
- if MipDetail[FarMip-NearMip] <= 1 then begin
- Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
- Dec(FarMip);
- end;
- Error := 0;
- for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
- Assert(Error = (FGridHeight+1));
- end else begin
- MipDetail[0] := (FGridHeight+1);
- end;
- MipStart[0] := 0;
- MipStart[FarMip-NearMip+1] := 1;
- P1Incr := ScaleVector3s(NormalizeVector3s(SubVector3s(Pnt[0], Pnt[3])), MinS(FMap.CellWidthScale, FMap.CellHeightScale));
- P2Incr := ScaleVector3s(NormalizeVector3s(SubVector3s(Pnt[1], Pnt[2])), MinS(FMap.CellWidthScale, FMap.CellHeightScale));
- VBuf := VBPTR;
- j := 0;
- for k := 0 to FarMip-NearMip do begin
- P1 := Pnt[3];
- P2 := Pnt[2];
- SubVector3s(OutP, Pnt[0], Pnt[3]);
- AddVector3s(P1, Pnt[3], ScaleVector3s(OutP, MipStart[k]));
- ScaleVector3s(P1Incr, OutP, (MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
- SubVector3s(OutP, Pnt[1], Pnt[2]);
- AddVector3s(P2, Pnt[2], ScaleVector3s(OutP, MipStart[k]));
- ScaleVector3s(P2Incr, OutP, (MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
- Data := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip].Offset);
- Data2 := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip+1].Offset);
- MipDivider := 1/(1 shl (k + NearMip));
- MipW := FMap.Width shr (k + NearMip);
- MipH := FMap.Height shr (k + NearMip);
- MipW2 := FMap.Width shr (k + NearMip+1);
- MipH2 := FMap.Height shr (k + NearMip+1);
- for l := 0 to MipDetail[k]-1 do begin
- FMipZ[j] := Sqrt(SqrMagnitude(SubVector3s(Pnt[3], P1)));
- // Sqrt(SqrMagnitude(GetVector3s(P1.X - CamOfsX, 0, P1.Z - CamOfsZ)));
- Inc(j);
- ScaleVector3s(PIncr, SubVector3s(P2, P1), 1 / FGridWidth);
- P := P1;
- MipK := MaxS(0, l/MipDetail[k] - (1-TrilinearRange))/TrilinearRange;
- if MipK < epsilon then begin
- for i := 0 to FGridWidth do begin // _/_
- TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale * MipDivider;
- TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
- X1 := FastTrunc(TempX);
- Z1 := FastTrunc(TempZ);
- xo := (TempX - X1);// * Ord(X1 >= 0) * Ord(X1 < MipW);
- zo := (TempZ - Z1);// * Ord(Z1 >= 0) * Ord(Z1 < MipH);
- X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
- Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
- Addr := Z1 * MipW + X1;
- // ti1 := Addr + MipW * Ord(Z1 < MipH-1);
- // ti2 := Ord(X1 < MipW-1);
- // May read 2 bytes outside texture data. It's safe because these 2 bytes will go from next mipmap.
- d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
- d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
- d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
- d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
- P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
- ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
- xo * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
- ( d1.c + d2.b + d2.d + d3.c ) * zo)) * FMap.DepthScale * 0.25;
- { 0 1 2 3
- 4 5 6 7
- 8 9 A B
- C D E F}
- { P.Y := ((1-xo) * (PByteBuffer(Data)^[Addr] * (1-zo) +
- PByteBuffer(Data)^[ti1] * zo ) +
- xo * (PByteBuffer(Data)^[Addr + ti2] * (1-zo) +
- PByteBuffer(Data)^[ti1 + ti2] * zo)) * FMap.DepthScale;}
- // P.Y := (LastLine[i]*0 + 2*CurY)*0.5;
- // LastLine[i] := CurY;
- VBuf^ := P;
- // TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
- Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
- Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
- VBuf := Pointer(Integer(VBuf) + FVertexSize);
- P.X := P.X + PIncr.X;
- P.Z := P.Z + PIncr.Z;
- end;
- end else begin
- for i := 0 to FGridWidth do begin // _/_
- TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale * MipDivider;
- TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
- X1 := FastTrunc(TempX);
- Z1 := FastTrunc(TempZ);
- xo := (TempX - X1){ * Ord(X1 >= 0) * Ord(X1 < MipW)};
- zo := (TempZ - Z1){ * Ord(Z1 >= 0) * Ord(Z1 < MipH)};
- X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
- Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
- Addr := Z1 * MipW + X1;
- // ti1 := Addr + MipW * Ord(Z1 < MipH-1);
- // ti2 := Ord(X1 < MipW-1);
- { T1 := Addr - MipW * Ord(Z1 > 0);
- T2 := T1 + Ord(X1 < MipW-1);
- T4 := Addr - Ord(X1 > 0);
- T5 := Addr;
- T6 := Addr + Ord(X1 < MipW-1);
- T7 := T6 + Ord(X1 < MipW-2);
- T9 := Addr + MipW * Ord(Z1 < MipH-1);
- T8 := T9 - Ord(X1 > 1);
- TA := T9 + Ord(X1 < MipW-1);
- TB := TA + Ord(X1 < MipW-2);
- TD := T9 + MipW * Ord(Z1 < MipH-2);
- TE := TD + Ord(X1 < MipW-1);
- P.Y := ((1-xo) * (( PBB(Data)^[T1] + PBB(Data)^[T4] + PBB(Data)^[T6] + PBB(Data)^[T9] ) * (1-zo) +
- ( PBB(Data)^[T5] + PBB(Data)^[T8] + PBB(Data)^[TA] + PBB(Data)^[TD] ) * zo ) +
- xo * (( PBB(Data)^[T2] + PBB(Data)^[T5] + PBB(Data)^[T7] + PBB(Data)^[TA] ) * (1-zo) +
- ( PBB(Data)^[T6] + PBB(Data)^[T9] + PBB(Data)^[TB] + PBB(Data)^[TE] ) * zo));}
- d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
- d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
- d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
- d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
- P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
- ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
- xo * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
- ( d1.c + d2.b + d2.d + d3.c ) * zo));
- { P.Y := ((1-xo) * (PByteBuffer(Data)^[Addr] * (1-zo) +
- PByteBuffer(Data)^[ti1] * zo ) +
- xo * (PByteBuffer(Data)^[Addr + ti2] * (1-zo) +
- PByteBuffer(Data)^[ti1 + ti2] * zo));}
- // Second mip
- xo := (xo + X1 and 1)*0.5;
- zo := (zo + Z1 and 1)*0.5;
- X1 := X1 shr 1;
- Z1 := Z1 shr 1;
- Addr := Z1 * MipW2 + X1;
- // ti1 := Addr + MipW2 * Ord(Z1 < MipH2-1);
- // ti2 := Ord(X1 < MipW2-1);
- d0.d32 := PLongword(Integer(Data2) + Addr - MipW2 * Ord(Z1 > 0) - Ord(X1 > 0))^;
- d1.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0))^;
- d2.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1))^;
- d3.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1) + MipW2 * Ord(Z1 < MipH2-2))^;
- P.Y := 0.25*(P.Y * (1 - MipK) + MipK * (
- (1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
- ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
- xo * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
- ( d1.c + d2.b + d2.d + d3.c ) * zo)) ) * FMap.DepthScale;
- { P.Y := (P.Y * (1 - MipK) + MipK * (
- (1-xo) * (PByteBuffer(Data2)^[Addr] * (1-zo) +
- PByteBuffer(Data2)^[ti1] * zo ) +
- xo * (PByteBuffer(Data2)^[Addr + ti2] * (1-zo) +
- PByteBuffer(Data2)^[ti1 + ti2] * zo) )) * FMap.DepthScale;}
- // P.Y := (LastLine[i]*1 + 1*CurY)*0.5;
- // LastLine[i] := CurY;
- VBuf^ := P;
- // TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
- Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
- Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
- VBuf := Pointer(Integer(VBuf) + FVertexSize);
- P.X := P.X + PIncr.X;
- P.Z := P.Z + PIncr.Z;
- end;
- end;
- P1.X := P1.X + P1Incr.X;
- P1.Z := P1.Z + P1Incr.Z;
- P2.X := P2.X + P2Incr.X;
- P2.Z := P2.Z + P2Incr.Z;
- end;
- end;
- TesselationStatus[tbVertex].Status := tsTesselated;
- // TesselationStatus[tbVertex].Status := tsChanged;
- Result := TotalVertices;
- // Assert((FGridWidth+1)*jj = Result);
- LastTotalVertices := TotalVertices;
- end;
- { TProjectedLandscape }
- procedure TProjectedLandscape.InitShaderConstants;
- begin
- if Assigned(FMap) then begin
- SetLength(ShaderConsts, 2);
- ShaderConsts[0].ShaderKind := skVertex;
- ShaderConsts[0].ShaderRegister := 10;
- ShaderConsts[0].Value := Vec4s(FTextureScale, FTextureScale, 0, -1);
- ShaderConsts[1].ShaderKind := skVertex;
- ShaderConsts[1].ShaderRegister := 11;
- 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);
- end;
- end;
- function TProjectedLandscape.GetMegaTexture: TMegaImageResource;
- var Item: TItem;
- begin
- ResolveLink('Megatexture', Item);
- Result := Item as TMegaImageResource;
- end;
- procedure TProjectedLandscape.OnModify(const ARect: BaseTypes.TRect);
- begin
- inherited;
- RecalcLightMap(ARect);
- end;
- constructor TProjectedLandscape.Create(AManager: TItemsManager);
- begin
- inherited;
- SetLength(FTesselators, 3);
- FTextureScale := 0.1;
- FLightmapType := lmtLightMap;
- end;
- procedure TProjectedLandscape.OnSceneLoaded;
- begin
- inherited;
- InitShaderConstants;
- end;
- procedure TProjectedLandscape.RetrieveShaderConstants(var ConstList: TShaderConstants);
- var CamInModel: TVector2s;
- begin
- if CurrentTesselator is TProjectedLandTesselator then
- CamInModel := Vec2s(TProjectedLandTesselator(CurrentTesselator).CamOfsX, TProjectedLandTesselator(CurrentTesselator).CamOfsZ)
- else
- CamInModel := Vec2s(0, 0);
- ShaderConsts[0].Value.Z := CamInModel.X;
- ShaderConsts[0].Value.W := CamInModel.Y;
- ConstList := ShaderConsts;
- end;
- const
- LightmapBasePropName = 'Lightmap recalc';
- LightmapTexPropName = LightmapBasePropName + 'Texture';
- LightmapLightPropName = LightmapBasePropName + 'Light source';
- LightmapTypePropName = LightmapBasePropName + 'Type';
- procedure TProjectedLandscape.AddProperties(const Result: Props.TProperties);
- begin
- inherited;
- AddItemLink(Result, LightmapTexPropName, [], 'TImageResource');
- AddItemLink(Result, LightmapLightPropName, [], 'TLight');
- AddItemLink(Result, 'Megatexture', [], 'TMegaImageResource');
- if Assigned(Result) then begin
- Result.AddEnumerated(LightmapTypePropName, [], Ord(FLightmapType), LightmapTypesEnum);
- Result.Add(LightmapBasePropName, vtBoolean, [], OnOffStr[False], '');
- Result.Add('Texture scale', vtSingle, [], FloatToStr(FTextureScale), '0,01-10');
- end;
- end;
- procedure TProjectedLandscape.SetProperties(Properties: Props.TProperties);
- var i: Integer;
- begin
- inherited;
- if Properties.Valid(LightmapTexPropName) then SetLinkProperty(LightmapTexPropName, Properties[LightmapTexPropName]);
- if Properties.Valid(LightmapLightPropName) then SetLinkProperty(LightmapLightPropName, Properties[LightmapLightPropName]);
- if Properties.Valid(LightmapTypePropName) then FLightmapType := TLightmapType(Properties.GetAsInteger(LightmapTypePropName));
- if Properties.Valid('Megatexture') then SetLinkProperty('Megatexture', Properties['Megatexture']);
- if Properties.Valid('Texture scale') then FTextureScale := StrToFloatDef(Properties['Texture scale'], 0);
- if Assigned(FMap) and
- Properties.Valid(LightmapBasePropName) and (Properties.GetAsInteger(LightmapBasePropName) > 0) then
- RecalcLightMap(GetRect(0, 0, FMap.Width, FMap.Height));
- InitShaderConstants;
- for i := 0 to High(FTesselators) do (FTesselators[i] as TProjectedLandTesselator).Renderer := TCore(FManager).Renderer;
- end;
- procedure TProjectedLandscape.Process(const DeltaTime: Single);
- begin
- inherited;
- // if Assigned(CurrentTesselator) then CurrentTesselator.Invalidate(False);
- end;
- procedure TProjectedLandscape.ProjectGrid(const Camera: TCamera; out PrjPnt: TQuadPoints);
- var Params: TTesselationParameters;
- begin
- if not (CurrentTesselator is TProjectedLandTesselator) then Exit;
- Params.Camera := Camera;
- Params.ModelMatrix := Transform;
- TProjectedLandTesselator(CurrentTesselator).ProjectGrid(Params, PrjPnt);
- end;
- procedure TProjectedLandscape.RecalcLightMap(ARect: BaseTypes.TRect);
- var
- Item: TItem; Image: TImageResource; Light: TLight; N: TVector3s;
- tmp, i, j, k, l, w, h: Integer;
- oneoverwh, LPower: Single;
- LightColor: TColor;
- Buffer: Pointer;
- begin
- ResolveLink(LightmapTexPropName, Item);
- if not Assigned(Item) or not Assigned(FMap) then Exit;
- Image := Item as TImageResource;
- ResolveLink(LightmapLightPropName, Item);
- if not Assigned(Item) and (FLightmapType = lmtLightmap) then Exit;
- Light := Item as TLight;
- // FillChar(Image.Data^, Image.DataSize, 0);
- w := FMap.Width div Image.Width;
- h := FMap.Height div Image.Height;
- if (w = 0) or (h = 0) then begin
- Log.Log('TProjectedLandscape.RecalcLightMap: Lightmap should be same size as heightmap or less', lkError);
- Exit;
- end;
- ARect.Left := ClampI(ARect.Left, 0, FMap.Width-1) div w;
- ARect.Right := ClampI(ARect.Right, 0, FMap.Width-1) div w;
- ARect.Top := ClampI(ARect.Top, 0, FMap.Height-1) div h;
- ARect.Bottom := ClampI(ARect.Bottom, 0, FMap.Height-1) div h;
- oneoverwh := 1 / (w*h);
- if FLightmapType = lmtLightmap then begin
- LightColor := GetColorFrom4s(Light.Diffuse);
- GetMem(Buffer, Image.Width{ * Image.Height} * ProcessingFormatBpP);
- for j := ARect.Top to ARect.Bottom-1 do begin
- for i := ARect.Left to ARect.Right-1 do begin
- LPower := 0;
- 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
- LPower := LPower + MaxS(0, -DotProductVector3s(FMap.GetCellNormal(k, l), Light.ForwardVector));
- LPower := LPower * oneoverwh;
- PImageBuffer(Buffer)^[i] := ScaleColorS(LightColor, MinS(LPower, 1));
- end;
- 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)));
- end;
- FreeMem(Buffer);
- end else if FLightmapType = lmtNormalmap then begin
- if GetBytesPerPixel(Image.Format) <> 4 then begin
- Log.Log('TProjectedLandscape.RecalcLightMap: Normal map should be of 4 bytes per pixel format', lkError);
- Exit;
- end;
- for j := ARect.Top to ARect.Bottom-1 do for i := ARect.Left to ARect.Right-1 do begin
- N := ZeroVector3s;
- 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
- AddVector3s(N, N, FMap.GetCellNormal(k, l));
- N.Y := N.Y * 0.7;
- // ScaleVector3s(N, N, oneoverwh);
- NormalizeVector3s(N, N);
- PImageBuffer(Image.Data)^[j * Image.Width + i] := VectorToColor(N);
- end;
- end;
- SendMessage(TResourceModifyMsg.Create(Image), nil, [mfCore]);
- end;
- procedure TProjectedLandscape.HandleMessage(const Msg: TMessage);
- begin
- inherited;
- {$IFDEF EDITORMODE}
- // if Msg.ClassType = TMapDrawCursorMsg then with TMapDrawCursorMsg(Msg) do DrawCursor(Cursor, Cursor.Camera, Cursor.Screen);
- // if (Msg.ClassType = TMapModifyBeginMsg) or (Msg.ClassType = TMapModifyMsg) then with TMapEditorMessage(Msg) do Modify(Cursor, Cursor.Camera);
- {$ENDIF}
- end;
- function TProjectedLandscape.VisibilityCheck(const Camera: TCamera): Boolean;
- var d: Single; LOD: Integer; CameraPos: TVector3s;
- begin
- Result := Assigned(FTesselators[0]) and (Camera.IsSpehereVisible(GetAbsLocation, BoundingSphereRadius) <> fcOutside);
- if Result then begin
- CameraPos := Camera.GetAbsLocation;
- CameraPos := Transform4Vector33s(InvertAffineMatrix4s(Transform), CameraPos);
- d := (CameraPos.Y - FMap.GetHeight(CameraPos.X, CameraPos.Z))/(FTesselators[0] as TProjectedLandTesselator).ViewDepth;
- LOD := ClampI(Round(High(FTesselators) * d + Camera.LODBias), 0, High(FTesselators));
- FCurrentTesselator := FTesselators[LOD];
- end;
- end;
- { TProjGridLandscape }
- function TProjGridLandscape.GetTesselatorClass: CTesselator; begin Result := TProjGridTesselator; end;
- { TRadGridLandscape }
- function TRadGridLandscape.GetTesselatorClass: CTesselator; begin Result := TRadGridTesselator; end;
- { TRadGridTesselator }
- procedure TRadGridTesselator.InitGrid;
- var
- i, k, l: Integer;
- DistIncr, FarDist, NearDist, TempK, Error: Single;
- MipStart: array[0..31] of Single;
- FirstPartK, LastPartK: Single;
- j: Integer;
- Rad: Single;
- begin
- if not Assigned(FMap) or not FMap.IsReady then Exit;
- SetLength(FGrid, TotalVertices);
- Rad := 0;
- NearDist := 2*pi * Rad;
- FarDist := 2*pi * (ViewDepth + 1*ExcessDist);
- DistIncr := FarDist - NearDist;
- if DistIncr < 0 then Exit;
- NearMip := 0;
- while (NearMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
- (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
- Inc(NearMip);
- FarMip := 0;
- while (FarMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
- (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
- Inc(FarMip);
- for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
- if MipStart[FarMip-NearMip+1] < 1 then begin
- // Assert(MipStart[FarMip-NearMip+1] >= 1);
- end;
- if FarMip-NearMip >= 1 then begin
- MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
- FirstPartK := MipStart[1]/(MipStart[1] - MipStart[0]);
- LastPartK := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
- TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
- MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
- Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
- for i := NearMip+1 to FarMip-1 do begin
- MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
- Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
- end;
- MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
- Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
- if Error >= 0.5 then Inc(MipDetail[0]);
- if MipDetail[FarMip-NearMip] <= 1 then begin
- Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
- Dec(FarMip);
- end;
- Error := 0;
- for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
- Assert(Error = (FGridHeight+1));
- end else begin
- MipDetail[0] := (FGridHeight+1);
- end;
- MipStart[0] := 0;
- MipStart[FarMip-NearMip+1] := 1;
- j := 0;
- for k := 0 to FarMip-NearMip do begin
- for l := 0 to MipDetail[k]-1 do begin
- Rad := (ViewDepth + 1*ExcessDist) * (MipStart[k] + l*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
- FMipZ[j] := Rad;
- for i := 0 to FGridWidth do begin // _/_
- SinCos(2*pi*i/(FGridWidth-1), FGrid[j*(FGridWidth+1)+i].Y, FGrid[j*(FGridWidth+1)+i].X);
- FGrid[j*(FGridWidth+1)+i].X := Rad * FGrid[j*(FGridWidth+1)+i].X;
- FGrid[j*(FGridWidth+1)+i].Y := Rad * FGrid[j*(FGridWidth+1)+i].Y;
- end;
- Inc(j);
- end;
- end;
- end;
- procedure TRadGridTesselator.Init;
- begin
- inherited;
- InitGrid;
- end;
- function TRadGridTesselator.GetUpdatedElements(Buffer: TTesselationBuffer; const Params: TTesselationParameters): Integer;
- var LCameraInModel, LOldCameraInModel: TVector3s; ModelInv: TMatrix4s;
- begin
- if Buffer = tbVertex then begin
- ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
- Transform4Vector33s(LCameraInModel, ModelInv, Params.Camera.GetAbsLocation);
- Transform4Vector33s(LOldCameraInModel, ModelInv, OldCameraMatrix.ViewTranslate);
- Result := TotalVertices * Ord( (Sqr(LCameraInModel.X - LOldCameraInModel.X)+Sqr(LCameraInModel.Z - LOldCameraInModel.Z)) > Sqr(ExcessDist));
- end else Result := inherited GetUpdatedElements(Buffer, Params);
- end;
- function TRadGridTesselator.SetIndices(IBPTR: Pointer): Integer;
- var i: Integer;
- begin
- for i := 0 to TotalIndices div 2-1 do begin
- // TWordBuffer(IBPTR^)[i * 2 + 0] := i * (FGridHeight+1) + 0;
- // TWordBuffer(IBPTR^)[i * 2 + 1] := i * (FGridHeight+1) + 1;
- TWordBuffer(IBPTR^)[i * 2 + 0] := i;
- TWordBuffer(IBPTR^)[i * 2 + 1] := i + (FGridWidth+1);
- end;
- TesselationStatus[tbIndex].Status := tsTesselated;
- Result := TotalIndices;
- LastTotalIndices := TotalIndices;
- end;
- function TRadGridTesselator.Tesselate(const Params: TTesselationParameters; VBPTR: Pointer): Integer;
- var
- HalfLengthX, HalfLengthZ: Single;
- VBuf: PVector3s;
- TVBuf: PVector2s;
- P, P1, P2, P1Incr, P2Incr, PIncr: TVector3s;
- OneOverCellWidthScale, OneOverCellHeightScale: Single;
- i, k, l, X1, Z1, Addr: Integer;
- Data, Data2: Pointer;
- LastY, CurY, xo, zo: Single;
- // LastLine: array[0..1023] of Single;
- OutP: TVector3s;
- DistIncr, FarDist, NearDist, TempK, Error: Single;
- FirstPartK, LastPartK, LightMapScaleX, LightMapScaleZ, MipK, MipDivider, TempX, TempZ: Single;
- MipW, MipH, MipW2, MipH2, Index: Integer;
- IndI, IndJ: Cardinal;
- type
- TData = record
- case Boolean of
- True: (a, b, c, d: Byte);
- False: (d32: Longword);
- end;
- var
- d0, d1, d2, d3: TData;
- ModelInv: TMatrix4s;
- CameraInModel: TVector3s;
- j: Integer;
- Rad: Single;
- begin
- Result := 0;
- if not Assigned(FMap) or not FMap.IsReady then Exit;
- OldCameraMatrix := Params.Camera.Transform;
- ModelInv := InvertAffineMatrix4s(Params.ModelMatrix);
- Transform4Vector33s(CameraInModel, ModelInv, Params.Camera.GetAbsLocation);
- CamOfsX := CameraInModel.X;
- CamOfsZ := CameraInModel.Z;
- HalfLengthX := (FMap.Width-1) * FMap.CellWidthScale * 0.5;
- HalfLengthZ := (FMap.Height-1) * FMap.CellHeightScale * 0.5;
- LightMapScaleX := 0.5/HalfLengthX;
- LightMapScaleZ := 0.5/HalfLengthZ;
- OneOverCellWidthScale := 1/FMap.CellWidthScale;
- OneOverCellHeightScale := 1/FMap.CellHeightScale;
- Rad := 0;
- NearDist := 2*pi * Rad;
- FarDist := 2*pi * (ViewDepth + 1*ExcessDist);
- DistIncr := FarDist - NearDist;
- if DistIncr < 0 then Exit;
- NearMip := 0;
- while (NearMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
- (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl NearMip) * MipScale <= NearDist) do
- Inc(NearMip);
- FarMip := 0;
- while (FarMip < THeightMap(FMap).FImage.SuggestedLevels-1) and
- (2*pi*FMap.CellWidthScale * (FGridWidth+1) * (1 shl FarMip) * MipScale <= FarDist) do
- Inc(FarMip);
- for i := NearMip to FarMip do MipStart[i-NearMip+1] := (FMap.CellWidthScale * (FGridWidth+1) * (1 shl i) * MipScale-NearDist) / DistIncr;
- if MipStart[FarMip-NearMip+1] < 1 then begin
- // Assert(MipStart[FarMip-NearMip+1] >= 1);
- end;
- if FarMip-NearMip >= 1 then begin
- MipStart[0] := -(MipStart[2] - 3*MipStart[1])/2;
- FirstPartK := MipStart[1]/(MipStart[1] - MipStart[0]);
- LastPartK := (1-MipStart[FarMip-NearMip])/(MipStart[FarMip-NearMip+1] - MipStart[FarMip-NearMip]);
- TempK := 1/(FirstPartK + FarMip - NearMip - 1 + LastPartK);
- MipDetail[0] := Round(FirstPartK * TempK * (FGridHeight+1));
- Error := FirstPartK * TempK * (FGridHeight+1) - MipDetail[0];
- for i := NearMip+1 to FarMip-1 do begin
- MipDetail[i-NearMip] := Round(TempK * (FGridHeight+1) + Error);
- Error := (TempK * (FGridHeight+1) + Error) - MipDetail[i-NearMip];
- end;
- MipDetail[FarMip-NearMip] := Round(LastPartK * TempK * (FGridHeight+1) + Error);
- Error := (LastPartK * TempK * (FGridHeight+1) + Error) - MipDetail[FarMip-NearMip];
- if Error >= 0.5 then Inc(MipDetail[0]);
- if MipDetail[FarMip-NearMip] <= 1 then begin
- Inc(MipDetail[FarMip-NearMip-1], MipDetail[FarMip-NearMip]);
- Dec(FarMip);
- end;
- Error := 0;
- for i := 0 to FarMip-NearMip do Error := Error + MipDetail[i];
- Assert(Error = (FGridHeight+1));
- end else begin
- MipDetail[0] := (FGridHeight+1);
- end;
- MipStart[0] := 0;
- MipStart[FarMip-NearMip+1] := 1;
- VBuf := VBPTR;
- TVBuf := @FGrid[0];
- j := 0;
- for k := 0 to FarMip-NearMip do begin
- Data := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip].Offset);
- Data2 := PtrOffs(FMap.Data, THeightMap(FMap).FImage.LevelInfo[k + NearMip+1].Offset);
- MipDivider := 1/(1 shl (k + NearMip));
- MipW := FMap.Width shr (k + NearMip);
- MipH := FMap.Height shr (k + NearMip);
- MipW2 := FMap.Width shr (k + NearMip+1);
- MipH2 := FMap.Height shr (k + NearMip+1);
- for l := 0 to MipDetail[k]-1 do begin
- // Rad := (ViewDepth + ExcessDist) * (MipStart[k] + l*(MipStart[k+1] - MipStart[k])/(MipDetail[k]-Ord(k = FarMip-NearMip)));
- // FMipZ[j] := Rad;
- // Sqrt(SqrMagnitude(GetVector3s(P1.X - CamOfsX, 0, P1.Z - CamOfsZ)));
- // Inc(j);
- // ScaleVector3s(PIncr, SubVector3s(P2, P1), 1 / FGridWidth);
- // P := P1;
- MipK := MaxS(0, l/MipDetail[k] - (1-TrilinearRange))/TrilinearRange;
- if MipK < epsilon then begin
- for i := 0 to FGridWidth do begin
- P.X := CamOfsX - TVBuf^.X;
- P.Z := CamOfsZ + TVBuf^.Y;
- TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale * MipDivider;
- TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
- X1 := FastTrunc(TempX);
- Z1 := FastTrunc(TempZ);
- xo := (TempX - X1);// * Ord(X1 >= 0) * Ord(X1 < MipW);
- zo := (TempZ - Z1);// * Ord(Z1 >= 0) * Ord(Z1 < MipH);
- X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
- Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
- Addr := Z1 * MipW + X1;
- // May read 2 bytes outside texture data. It's safe because these 2 bytes will go from next mipmap.
- d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
- d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
- d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
- d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
- P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
- ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
- xo * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
- ( d1.c + d2.b + d2.d + d3.c ) * zo)) * FMap.DepthScale * 0.25;
- VBuf^ := P;
- // TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
- // Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
- // Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
- VBuf := Pointer(Integer(VBuf) + FVertexSize);
- TVBuf := Pointer(Integer(TVBuf) + SizeOf(TVector2s));
- end;
- end else begin
- for i := 0 to FGridWidth do begin
- P.X := CamOfsX - TVBuf^.X;
- P.Z := CamOfsZ + TVBuf^.Y;
- TempX := (ClampS(P.X, -HalfLengthX, HalfLengthX) + HalfLengthX) * OneOverCellWidthScale * MipDivider;
- TempZ := (ClampS(P.Z, -HalfLengthZ, HalfLengthZ) + HalfLengthZ) * OneOverCellHeightScale * MipDivider;
- X1 := FastTrunc(TempX);
- Z1 := FastTrunc(TempZ);
- xo := (TempX - X1){ * Ord(X1 >= 0) * Ord(X1 < MipW)};
- zo := (TempZ - Z1){ * Ord(Z1 >= 0) * Ord(Z1 < MipH)};
- X1 := X1 * Ord(X1 >= 0) * Ord(X1 < MipW);
- Z1 := Z1 * Ord(Z1 >= 0) * Ord(Z1 < MipH);
- Addr := Z1 * MipW + X1;
- d0.d32 := PLongword(Integer(Data) + Addr - MipW * Ord(Z1 > 0) - Ord(X1 > 0))^;
- d1.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0))^;
- d2.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1))^;
- d3.d32 := PLongword(Integer(Data) + Addr - Ord(X1 > 0) + MipW * Ord(Z1 < MipH-1) + MipW * Ord(Z1 < MipH-2))^;
- P.Y := ((1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
- ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
- xo * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
- ( d1.c + d2.b + d2.d + d3.c ) * zo));
- // Second mip
- xo := (xo + X1 and 1)*0.5;
- zo := (zo + Z1 and 1)*0.5;
- X1 := X1 shr 1;
- Z1 := Z1 shr 1;
- Addr := Z1 * MipW2 + X1;
- d0.d32 := PLongword(Integer(Data2) + Addr - MipW2 * Ord(Z1 > 0) - Ord(X1 > 0))^;
- d1.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0))^;
- d2.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1))^;
- d3.d32 := PLongword(Integer(Data2) + Addr - Ord(X1 > 0) + MipW2 * Ord(Z1 < MipH2-1) + MipW2 * Ord(Z1 < MipH2-2))^;
- P.Y := 0.25*(P.Y * (1 - MipK) + MipK * (
- (1-xo) * (( d0.b + d1.a + d1.c + d2.b ) * (1-zo) +
- ( d1.b + d2.a + d2.c + d3.b ) * zo ) +
- xo * (( d0.c + d1.b + d1.d + d2.c ) * (1-zo) +
- ( d1.c + d2.b + d2.d + d3.c ) * zo)) ) * FMap.DepthScale;
- VBuf^ := P;
- // TColor(Pointer(Integer(VBuf) + 12)^).C := MipColors[k+NearMip];
- // Single(Pointer(Integer(VBuf) + 12)^) := P.X - CameraInModel.X;
- // Single(Pointer(Integer(VBuf) + 16)^) := P.Z - CameraInModel.Z;
- VBuf := Pointer(Integer(VBuf) + FVertexSize);
- TVBuf := Pointer(Integer(TVBuf) + SizeOf(TVector2s));
- end;
- end;
- end;
- end;
- TesselationStatus[tbVertex].Status := tsTesselated;
- // TesselationStatus[tbVertex].Status := tsChanged;
- Result := TotalVertices;
- // Assert((FGridWidth+1)*jj = Result);
- LastTotalVertices := TotalVertices;
- end;
- begin
- GlobalClassList.Add('C2Land', GetUnitClassList);
- end.