// // The graphics engine GLScene // unit GLS.Imposter; (* Imposter building and rendering implementation for GLScene *) interface {$I Stage.Defines.inc} uses Winapi.OpenGL, Winapi.OpenGLext, System.Types, System.Classes, System.SysUtils, System.Math, Stage.OpenGLTokens, GLS.Scene, GLS.Context, Stage.VectorTypes, Stage.VectorGeometry, GLS.PersistentClasses, Stage.PipelineTransform, GLS.Graphics, GLS.Color, GLS.RenderContextInfo, GLS.Coordinates, GLS.BaseClasses, GLS.State, Stage.TextureFormat, Stage.Utils; type (* Imposter rendering options. Following options are supported: impoBlended : the imposters are transparently blended during renders, this will smooth their edges but requires them to be rendered sorted from back to front impoAlphaTest : alpha test is used to eliminate transparent pixels, the alpha treshold is adjusted by the AlphaTreshold property impoNearestFiltering : use nearest texture filtering (the alternative is linear filtering) impoPerspectiveCorrection : activates a special imposter rendering projection suitable for distorting the sprites when seen from a level angle of view with a wide focal camera (think trees/grass when walking in a forest), if not active, the imposter sprites are camera-facing *) TImposterOption = (impoBlended, impoAlphaTest, impoNearestFiltering, impoPerspectiveCorrection); TImposterOptions = set of TImposterOption; const cDefaultImposterOptions = [impoBlended, impoAlphaTest]; type TGLImposterBuilder = class; (* Base class for imposters manipulation and handling. Rendering imposters is performed by three methods, BeginRender must be invoked first, then Render for each of the impostr This class assumes a single impostor per texture. Note: Remeber to enable Destination Alpha on your viewer.*) TImposter = class(TObject) private FRequestCount: Integer; FBuilder: TGLImposterBuilder; FTexture: TGLTextureHandle; FImpostoredObject: TGLBaseSceneObject; FAspectRatio: Single; FModulated: Boolean; protected FVx, FVy: TGLVector; FStaticOffset: TGLVector; FQuad: array[0..3] of TGLVector; FStaticScale: Single; procedure PrepareTexture(var rci: TGLRenderContextInfo); virtual; procedure RenderQuad(const texExtents, objPos: TGLVector; size: Single); public constructor Create(aBuilder: TGLImposterBuilder); virtual; destructor Destroy; override; procedure BeginRender(var rci: TGLRenderContextInfo); virtual; procedure Render(var rci: TGLRenderContextInfo; const objPos, localCameraPos: TGLVector; size: Single); virtual; procedure EndRender(var rci: TGLRenderContextInfo); virtual; procedure RenderOnce(var rci: TGLRenderContextInfo; const objPos, localCameraPos: TGLVector; size: Single); property AspectRatio: Single read FAspectRatio write FAspectRatio; property Builder: TGLImposterBuilder read FBuilder; property Texture: TGLTextureHandle read FTexture; property ImpostoredObject: TGLBaseSceneObject read FImpostoredObject write FImpostoredObject; property Modulated: Boolean read FModulated write FModulated; end; // Imposter loading events TLoadingImposterEvent = function (Sender : TObject; impostoredObject : TGLBaseSceneObject; destImposter : TImposter) : TGLBitmap32 of object; {$NODEFINE TLoadingImposterEvent} //Used CPPB procedure instead of Delphi function //TLoadingImposterEvent = procedure (Sender : TObject; impostoredObject : TGLBaseSceneObject; destImposter : TImposter; var result : TGLBitmap32) of object; {$HPPEMIT 'typedef GLS.Graphics::TGLBitmap32* __fastcall (__closure *TLoadingImposterEvent)(System::TObject* Sender, Glscene::TGLBaseSceneObject* impostoredObject, TImposter* destImposter);'} TImposterLoadedEvent = procedure (Sender : TObject; impostoredObject : TGLBaseSceneObject; destImposter : TImposter) of object; TImposterReference = (irCenter, irTop, irBottom); // Abstract ImposterBuilder class. TGLImposterBuilder = class(TGLUpdateAbleComponent) private FBackColor: TGLColor; FBuildOffset: TGLCoordinates; FImposterRegister: TGLPersistentObjectList; FRenderPoint: TGLRenderPoint; FImposterOptions: TImposterOptions; FAlphaTreshold: Single; FImposterReference: TImposterReference; FOnLoadingImposter: TLoadingImposterEvent; FOnImposterLoaded: TImposterLoadedEvent; protected procedure SetRenderPoint(AValue: TGLRenderPoint); procedure RenderPointFreed(Sender: TObject); procedure SetBackColor(AValue: TGLColor); procedure SetBuildOffset(AValue: TGLCoordinates); procedure SetImposterReference(AValue: TImposterReference); procedure InitializeImpostorTexture(const TextureSize: TPoint); property ImposterRegister: TGLPersistentObjectList read FImposterRegister; procedure UnregisterImposter(imposter: TImposter); function CreateNewImposter: TImposter; virtual; procedure PrepareImposters(Sender: TObject; var rci: TGLRenderContextInfo); virtual; procedure DoPrepareImposter(var rci: TGLRenderContextInfo; impostoredObject: TGLBaseSceneObject; destImposter: TImposter); virtual; abstract; procedure DoUserSpecifiedImposter( var rci: TGLRenderContextInfo; destImposter: TImposter; bmp32: TGLBitmap32); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure NotifyChange(Sender: TObject); override; (* Returns a valid imposter for the specified object. Imposter must have been requested first, and the builder given an opportunity to prepare it before it can be available. *) function ImposterFor(impostoredObject: TGLBaseSceneObject): TImposter; // Request an imposter to be prepared for the specified object. procedure RequestImposterFor(impostoredObject: TGLBaseSceneObject); // Tells the imposter for the specified object is no longer needed. procedure UnRequestImposterFor(impostoredObject: TGLBaseSceneObject); published (* Specifies the render point at which the impostor texture(s) can be prepared. For best result, the render point should happen in viewer that has a destination alpha (otherwise, impostors will be opaque). *) property RenderPoint: TGLRenderPoint read FRenderPoint write SetRenderPoint; (* Background color for impostor rendering. Typically, you'll want to leave the alpha channel to zero, and pick as RGB as color that matches the impostor'ed objects edge colors most.*) property BackColor: TGLColor read FBackColor write SetBackColor; (* Offset applied to the impostor'ed object during imposter construction. Can be used to manually tune the centering of objects. *) property BuildOffset: TGLCoordinates read FBuildOffset write SetBuildOffset; // Imposter rendering options. property ImposterOptions: TImposterOptions read FImposterOptions write FImposterOptions default cDefaultImposterOptions; (* Determines how the imposter are handled. This is the reference point for imposters, impostor'ed objects that are centered should use irCenter, those whose bottom is the origin should use irBottom, etc. *) property ImposterReference: TImposterReference read FImposterReference write SetImposterReference default irCenter; // Alpha testing teshold. property AlphaTreshold: Single read FAlphaTreshold write FAlphaTreshold; (* Event fired before preparing/loading an imposter. If an already prepared version of the importer is available, place it in the TGLBitmap32 the event shall return (the bitmap will be freed by the imposter builder). If a bitmap is specified, it will be used in place of what automatic generation could have generated. *) property OnLoadingImposter: TLoadingImposterEvent read FOnLoadingImposter write FOnLoadingImposter; (* Event fired after preparing/loading an imposter. This events gives an opportunity to save the imposter after it has been loaded or prepared. *) property OnImposterLoaded: TImposterLoadedEvent read FOnImposterLoaded write FOnImposterLoaded; end; // Describes a set of orientation in a corona fashion. TGLStaticImposterBuilderCorona = class(TCollectionItem) private FSamples: Integer; FElevation: Single; FSampleBaseIndex: Integer; protected function GetDisplayName: string; override; procedure SetSamples(AValue: Integer); procedure SetElevation(AValue: Single); public constructor Create(ACollection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; published property Samples: Integer read FSamples write SetSamples default 8; property Elevation: Single read FElevation write SetElevation; end; TCoronaTangentLookup = record minTan, maxTan: Single; corona: TGLStaticImposterBuilderCorona; end; TGLStaticImposterBuilderCoronas = class(TOwnedCollection) private FCoronaTangentLookup: array of TCoronaTangentLookup; protected procedure SetItems(AIndex: Integer; const AValue: TGLStaticImposterBuilderCorona); function GetItems(AIndex: Integer): TGLStaticImposterBuilderCorona; procedure Update(Item: TCollectionItem); override; procedure PrepareSampleBaseIndices; procedure PrepareCoronaTangentLookup; function CoronaForElevationTangent(aTangent: Single): TGLStaticImposterBuilderCorona; public constructor Create(AOwner: TPersistent); function Add: TGLStaticImposterBuilderCorona; overload; function Add(const elevation: Single; samples: Integer): TGLStaticImposterBuilderCorona; overload; property Items[AIndex: Integer]: TGLStaticImposterBuilderCorona read GetItems write SetItems; default; function SampleCount: Integer; procedure NotifyChange; virtual; procedure EndUpdate; override; end; // Imposter class whose texture contains several views from different angles. TStaticImposter = class(TImposter) public procedure Render(var rci: TGLRenderContextInfo; const objPos, localCameraPos: TGLVector; size: Single); override; end; TSIBLigthing = (siblNoLighting, siblStaticLighting, siblLocalLighting); // Builds imposters whose texture is a catalog of prerendered views. TGLStaticImposterBuilder = class(TGLImposterBuilder) private FCoronas: TGLStaticImposterBuilderCoronas; FSampleSize: Integer; FTextureSize: TPoint; FSamplesPerAxis: TPoint; FInvSamplesPerAxis: TVector2f; FSamplingRatioBias, FInvSamplingRatioBias: Single; FLighting: TSIBLigthing; FSamplesAlphaScale: Single; protected procedure SetCoronas(AValue: TGLStaticImposterBuilderCoronas); procedure SetSampleSize(AValue: Integer); procedure SetSamplingRatioBias(AValue: Single); function StoreSamplingRatioBias: Boolean; procedure SetLighting(AValue: TSIBLigthing); procedure SetSamplesAlphaScale(AValue: Single); function StoreSamplesAlphaScale: Boolean; function GetTextureSizeInfo: string; procedure SetTextureSizeInfo(const texSize: string); // Computes the optimal texture size that would be able to hold all samples. function ComputeOptimalTextureSize: TPoint; function CreateNewImposter: TImposter; override; procedure DoPrepareImposter(var rci: TGLRenderContextInfo; impostoredObject: TGLBaseSceneObject; destImposter: TImposter); override; procedure DoUserSpecifiedImposter( var rci: TGLRenderContextInfo; destImposter: TImposter; bmp32: TGLBitmap32); override; procedure ComputeStaticParams(destImposter: TImposter); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; (* Render imposter texture. Buffer and object must be compatible, RC must have been activated. *) procedure Render(var rci: TGLRenderContextInfo; impostoredObject: TGLBaseSceneObject; destImposter: TImposter); (* Ratio (0..1) of the texture that will be used by samples. If this value is below 1, you're wasting texture space and may as well increase the number of samples. *) function TextureFillRatio: Single; // Meaningful only after imposter texture has been prepared. property TextureSize: TPoint read FTextureSize; property SamplesPerAxis: TPoint read FSamplesPerAxis; published // Description of the samples looking orientations. property Coronas: TGLStaticImposterBuilderCoronas read FCoronas write SetCoronas; // Size of the imposter samples (square). property SampleSize: Integer read FSampleSize write SetSampleSize default 32; (* Size ratio applied to the impostor'ed objects during sampling. Values greater than one can be used to "fill" the samples more by scaling up the object. This is especially useful when the impostor'ed object doesn't fill its bounding sphere, and/or if the outer details are not relevant for impostoring. *) property SamplingRatioBias: Single read FSamplingRatioBias write SetSamplingRatioBias stored StoreSamplingRatioBias; (* Scale factor apply to the sample alpha channel. Main use is to saturate the samples alpha channel, and make fully opaque what would have been partially transparent, while leaving fully transparent what was fully transparent. *) property SamplesAlphaScale: Single read FSamplesAlphaScale write SetSamplesAlphaScale stored StoreSamplesAlphaScale; // Lighting mode to apply during samples construction. property Lighting: TSIBLigthing read FLighting write FLighting default siblStaticLighting; (* Dummy property that returns the size of the imposter texture. This property is essentially here as a helper at design time, to give you the requirements your coronas and samplesize parameters imply. *) property TextureSizeInfo: string read GetTextureSizeInfo write SetTextureSizeInfo stored False; end; TGLDynamicImposterBuilder = class(TGLImposterBuilder) private FMinTexSize, FMaxTexSize: Integer; FMinDistance, FTolerance: Single; FUseMatrixError: Boolean; protected procedure SetMinDistance(const AValue: Single); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; /// procedure DoRender(var rci : TGLRenderContextInfo; renderSelf, renderChildren : Boolean); override; published property MinTexSize: Integer read FMinTexSize write FMinTexSize; property MaxTexSize: Integer read FMaxTexSize write FMaxTexSize; property MinDistance: Single read FMinDistance write SetMinDistance; property Tolerance: Single read FTolerance write FTolerance; property UseMatrixError: Boolean read FUseMatrixError write FUseMatrixError; end; TGLImposter = class(TGLImmaterialSceneObject) private FBuilder: TGLImposterBuilder; FImpostoredObject: TGLBaseSceneObject; protected procedure SetBuilder(const AValue: TGLImposterBuilder); procedure SetImpostoredObject(const AValue: TGLBaseSceneObject); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure DoRender(var ARci: TGLRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override; published property Builder: TGLImposterBuilder read FBuilder write SetBuilder; property ImpostoredObject: TGLBaseSceneObject read FImpostoredObject write SetImpostoredObject; end; //------------------------------------------------------------- implementation //------------------------------------------------------------- const cReferenceToPos: array[Low(TImposterReference)..High(TImposterReference)] of Single = (0, -1, 1); // ---------- // ---------- TImposter ---------- // ---------- constructor TImposter.Create(aBuilder: TGLImposterBuilder); begin inherited Create; FBuilder := aBuilder; FTexture := TGLTextureHandle.Create; aBuilder.FImposterRegister.Add(Self); FAspectRatio := 1; end; destructor TImposter.Destroy; begin if Assigned(FBuilder) then FBuilder.UnregisterImposter(Self); FTexture.Free; inherited; end; procedure TImposter.PrepareTexture(var rci: TGLRenderContextInfo); var i: Integer; begin if FTexture.Handle <> 0 then Exit; FTexture.AllocateHandle; FTexture.Target := ttTexture2D; rci.GLStates.TextureBinding[0, ttTexture2D] := FTexture.Handle; if gl.EXT_texture_edge_clamp then i := GL_CLAMP_TO_EDGE else i := GL_CLAMP; begin gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, i); gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, i); gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); end; end; procedure TImposter.BeginRender(var rci: TGLRenderContextInfo); var mat: TGLMatrix; filter: Cardinal; fx, fy, yOffset, cosAlpha, dynScale: Single; begin with rci.GLStates do begin Disable(stLighting); Disable(stCullFace); ActiveTextureEnabled[ttTexture2D] := True; if impoAlphaTest in Builder.ImposterOptions then begin Enable(stAlphaTest); SetGLAlphaFunction(cfGEqual, Builder.AlphaTreshold); end else Disable(stAlphaTest); if impoBlended in Builder.ImposterOptions then begin Enable(stBlend); SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); end else Disable(stBlend); TextureBinding[0, ttTexture2D] := Texture.Handle; if impoNearestFiltering in Builder.ImposterOptions then filter := GL_NEAREST else filter := GL_LINEAR; gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, filter); gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, filter); if FModulated then begin gl.Color4fv(@XYZWHmgVector); gl.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); end else gl.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); mat := rci.PipelineTransformation.ModelViewMatrix^; FVx.X := mat.X.X; FVx.Y := mat.Y.X; FVx.Z := mat.Z.X; NormalizeVector(FVx); FVy.X := mat.X.Y; FVy.Y := mat.Y.Y; FVy.Z := mat.Z.Y; NormalizeVector(FVy); if impoPerspectiveCorrection in Builder.ImposterOptions then begin cosAlpha := VectorDotProduct(FVy, YHmgVector); FVy := VectorLerp(FVy, YHmgVector, Abs(cosAlpha)); NormalizeVector(FVy); dynScale := ClampValue(1 / cosAlpha, 1, 1.414) * FStaticScale; end else dynScale := FStaticScale; fx := Sqrt(FAspectRatio); fy := 1 / fx; yOffset := cReferenceToPos[Builder.ImposterReference] * dynScale * fy; fx := fx * dynScale; fy := fy * dynScale; FQuad[0] := VectorSubtract(VectorCombine(FVx, FVy, fx, fy + yOffset), FStaticOffset); FQuad[1] := VectorSubtract(VectorCombine(FVx, FVy, -fx, fy + yOffset), FStaticOffset); FQuad[2] := VectorSubtract(VectorCombine(FVx, FVy, -fx, -fy + yOffset), FStaticOffset); FQuad[3] := VectorSubtract(VectorCombine(FVx, FVy, fx, -fy + yOffset), FStaticOffset); gl.Begin_(GL_QUADS); end; end; procedure TImposter.Render(var rci: TGLRenderContextInfo; const objPos, localCameraPos: TGLVector; size: Single); const cQuadTexExtents: TGLVector = (X:0; Y:0; Z:1; W:1); begin RenderQuad(cQuadTexExtents, objPos, size); end; procedure TImposter.RenderQuad(const texExtents, objPos: TGLVector; size: Single); var pos: TGLVector; begin VectorCombine(objPos, FQuad[0], size, pos); gl.TexCoord2f(texExtents.Z, texExtents.W); gl.Vertex3fv(@pos); VectorCombine(objPos, FQuad[1], size, pos); gl.TexCoord2f(texExtents.X, texExtents.W); gl.Vertex3fv(@pos); VectorCombine(objPos, FQuad[2], size, pos); gl.TexCoord2f(texExtents.X, texExtents.Y); gl.Vertex3fv(@pos); VectorCombine(objPos, FQuad[3], size, pos); gl.TexCoord2f(texExtents.Z, texExtents.Y); gl.Vertex3fv(@pos); end; procedure TImposter.EndRender(var rci: TGLRenderContextInfo); begin gl.End_; rci.GLStates.ActiveTextureEnabled[ttTexture2D] := False; end; procedure TImposter.RenderOnce(var rci: TGLRenderContextInfo; const objPos, localCameraPos: TGLVector; size: Single); begin BeginRender(rci); Render(rci, objPos, localCameraPos, size); EndRender(rci); end; // ---------- // ---------- TGLImposterBuilder ---------- // ---------- constructor TGLImposterBuilder.Create(AOwner: TComponent); begin inherited; FImposterRegister := TGLPersistentObjectList.Create; FBackColor := TGLColor.CreateInitialized(Self, clrTransparent); FBuildOffset := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, CsPoint); FImposterOptions := cDefaultImposterOptions; FAlphaTreshold := 0.5; end; destructor TGLImposterBuilder.Destroy; var i: Integer; begin FBuildOffset.Free; FBackColor.Free; for i := 0 to FImposterRegister.Count - 1 do TImposter(FImposterRegister[i]).FBuilder := nil; FImposterRegister.CleanFree; inherited; end; procedure TGLImposterBuilder.Notification(AComponent: TComponent; Operation: TOperation); var i: Integer; imposter: TImposter; begin if Operation = opRemove then begin if AComponent = FRenderPoint then FRenderPoint := nil; for i := FImposterRegister.Count - 1 downto 0 do begin imposter := TImposter(FImposterRegister[i]); if imposter.ImpostoredObject = AComponent then begin imposter.Free; Break; end; end; end; inherited; end; function TGLImposterBuilder.CreateNewImposter: TImposter; begin Result := TImposter.Create(Self); end; procedure TGLImposterBuilder.PrepareImposters(Sender: TObject; var rci: TGLRenderContextInfo); var i: Integer; imp: TImposter; bmp32: TGLBitmap32; begin for i := 0 to ImposterRegister.Count - 1 do begin imp := TImposter(ImposterRegister[i]); if (imp.ImpostoredObject <> nil) and (imp.Texture.Handle = 0) then begin if Assigned(FOnLoadingImposter) then bmp32:=FOnLoadingImposter(Self, imp.ImpostoredObject, imp) else bmp32 := nil; if not Assigned(bmp32) then DoPrepareImposter(rci, imp.ImpostoredObject, imp) else begin DoUserSpecifiedImposter(rci, imp, bmp32); bmp32.Free; end; if Assigned(FOnImposterLoaded) then FOnImposterLoaded(Self, imp.ImpostoredObject, imp); end; end; end; procedure TGLImposterBuilder.DoUserSpecifiedImposter( var rci: TGLRenderContextInfo; destImposter: TImposter; bmp32: TGLBitmap32); var size: Integer; begin destImposter.PrepareTexture(rci); bmp32.RegisterAsOpenGLTexture( destImposter.FTexture, False, GL_RGBA8, size, size, size); end; procedure TGLImposterBuilder.NotifyChange(Sender: TObject); var i: Integer; begin for i := 0 to FImposterRegister.Count - 1 do TImposter(FImposterRegister[i]).Texture.DestroyHandle; inherited; end; function TGLImposterBuilder.ImposterFor(impostoredObject: TGLBaseSceneObject): TImposter; var i: Integer; begin for i := 0 to FImposterRegister.Count - 1 do begin Result := TImposter(FImposterRegister[i]); if Result.ImpostoredObject = impostoredObject then Exit; end; Result := nil; end; procedure TGLImposterBuilder.RequestImposterFor(impostoredObject: TGLBaseSceneObject); var imposter: TImposter; begin if impostoredObject = nil then Exit; imposter := ImposterFor(impostoredObject); if imposter = nil then begin imposter := CreateNewImposter; imposter.ImpostoredObject := impostoredObject; end; Inc(imposter.FRequestCount); end; procedure TGLImposterBuilder.UnRequestImposterFor(impostoredObject: TGLBaseSceneObject); var imposter: TImposter; begin if impostoredObject = nil then Exit; imposter := ImposterFor(impostoredObject); if imposter <> nil then begin Dec(imposter.FRequestCount); if imposter.FRequestCount = 0 then imposter.Free; end; end; procedure TGLImposterBuilder.SetRenderPoint(AValue: TGLRenderPoint); begin if AValue <> FRenderPoint then begin if Assigned(FRenderPoint) then begin FRenderPoint.RemoveFreeNotification(Self); FRenderPoint.UnRegisterCallBack(PrepareImposters); end; FRenderPoint := AValue; if Assigned(FRenderPoint) then begin FRenderPoint.FreeNotification(Self); FRenderPoint.RegisterCallBack(PrepareImposters, RenderPointFreed); end; end; end; procedure TGLImposterBuilder.RenderPointFreed(Sender: TObject); begin FRenderPoint := nil; end; procedure TGLImposterBuilder.SetBackColor(AValue: TGLColor); begin FBackColor.Assign(AValue); end; procedure TGLImposterBuilder.SetBuildOffset(AValue: TGLCoordinates); begin FBuildOffset.Assign(AValue); end; procedure TGLImposterBuilder.SetImposterReference(AValue: TImposterReference); begin if FImposterReference <> AValue then begin FImposterReference := AValue; NotifyChange(Self); end; end; procedure TGLImposterBuilder.InitializeImpostorTexture(const textureSize: TPoint); begin gl.TexImage2D(GL_TEXTURE_2D, 0, GL_RGBA8, textureSize.X, textureSize.Y, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil); end; procedure TGLImposterBuilder.UnregisterImposter(imposter: TImposter); begin if imposter.Builder = Self then begin FImposterRegister.Remove(imposter); imposter.FBuilder := nil; end; end; // ---------- // ---------- TGLStaticImposterBuilderCorona ---------- // ---------- constructor TGLStaticImposterBuilderCorona.Create(ACollection: TCollection); begin inherited; FSamples := 8; end; destructor TGLStaticImposterBuilderCorona.Destroy; begin inherited; end; procedure TGLStaticImposterBuilderCorona.Assign(Source: TPersistent); begin if Source is TGLStaticImposterBuilderCorona then begin FSamples := TGLStaticImposterBuilderCorona(Source).FSamples; FElevation := TGLStaticImposterBuilderCorona(Source).FElevation; end; inherited; end; function TGLStaticImposterBuilderCorona.GetDisplayName: string; begin Result := Format('%.1f° / %d samples', [Elevation, Samples]); end; procedure TGLStaticImposterBuilderCorona.SetSamples(AValue: Integer); begin if AValue <> FSamples then begin FSamples := AValue; if FSamples < 1 then FSamples := 1; (Collection as TGLStaticImposterBuilderCoronas).NotifyChange; end; end; procedure TGLStaticImposterBuilderCorona.SetElevation(AValue: Single); begin if AValue <> FElevation then begin FElevation := ClampValue(AValue, -89, 89); (Collection as TGLStaticImposterBuilderCoronas).NotifyChange; end; end; // ---------- // ---------- TGLStaticImposterBuilderCoronas ---------- // ---------- constructor TGLStaticImposterBuilderCoronas.Create(AOwner: TPersistent); begin inherited Create(AOwner, TGLStaticImposterBuilderCorona); end; function TGLStaticImposterBuilderCoronas.Add: TGLStaticImposterBuilderCorona; begin Result := (inherited Add) as TGLStaticImposterBuilderCorona; end; function TGLStaticImposterBuilderCoronas.Add(const elevation: Single; samples: Integer): TGLStaticImposterBuilderCorona; begin Result := (inherited Add) as TGLStaticImposterBuilderCorona; Result.Elevation := elevation; Result.Samples := samples; end; procedure TGLStaticImposterBuilderCoronas.SetItems(AIndex: Integer; const AValue: TGLStaticImposterBuilderCorona); begin inherited Items[AIndex] := AValue; end; function TGLStaticImposterBuilderCoronas.GetItems(AIndex: Integer): TGLStaticImposterBuilderCorona; begin Result := TGLStaticImposterBuilderCorona(inherited Items[AIndex]); end; procedure TGLStaticImposterBuilderCoronas.Update(Item: TCollectionItem); begin inherited; NotifyChange; end; procedure TGLStaticImposterBuilderCoronas.NotifyChange; begin if (UpdateCount = 0) and (GetOwner <> nil) and (GetOwner is TGLUpdateAbleComponent) then TGLUpdateAbleComponent(GetOwner).NotifyChange(Self); end; procedure TGLStaticImposterBuilderCoronas.EndUpdate; begin inherited; NotifyChange; end; function TGLStaticImposterBuilderCoronas.SampleCount: Integer; var i: Integer; begin Result := 0; for i := 0 to Count - 1 do Result := Result + Items[i].Samples; end; procedure TGLStaticImposterBuilderCoronas.PrepareSampleBaseIndices; var p, i: Integer; begin p := 0; for i := 0 to Count - 1 do begin Items[i].FSampleBaseIndex := p; Inc(p, Items[i].Samples); end; end; procedure TGLStaticImposterBuilderCoronas.PrepareCoronaTangentLookup; var i, j: Integer; corona: TGLStaticImposterBuilderCorona; boundary: Single; begin SetLength(FCoronaTangentLookup, Count); // place them in the array and sort by ascending elevation for i := 0 to Count - 1 do FCoronaTangentLookup[i].corona := Items[i]; for i := 0 to Count - 2 do for j := i + 1 to Count - 1 do if FCoronaTangentLookup[j].corona.Elevation < FCoronaTangentLookup[i].corona.Elevation then begin corona := FCoronaTangentLookup[j].corona; FCoronaTangentLookup[j].corona := FCoronaTangentLookup[i].corona; FCoronaTangentLookup[i].corona := corona; end; // adjust min max then intermediate boundaries FCoronaTangentLookup[0].minTan := -1e30; FCoronaTangentLookup[Count - 1].minTan := 1e30; for i := 0 to Count - 2 do begin boundary := Tan((0.5 * cPIdiv180) * (FCoronaTangentLookup[i].corona.Elevation + FCoronaTangentLookup[i + 1].corona.Elevation)); FCoronaTangentLookup[i].maxTan := boundary; FCoronaTangentLookup[i + 1].minTan := boundary; end; end; function TGLStaticImposterBuilderCoronas.CoronaForElevationTangent(aTangent: Single): TGLStaticImposterBuilderCorona; var i, n: Integer; begin n := High(FCoronaTangentLookup); if (n = 0) or (aTangent <= FCoronaTangentLookup[0].maxTan) then Result := FCoronaTangentLookup[0].corona else if aTangent > FCoronaTangentLookup[n].minTan then Result := FCoronaTangentLookup[n].corona else begin Result := FCoronaTangentLookup[1].corona; for i := 2 to n - 2 do begin if aTangent <= FCoronaTangentLookup[i].minTan then Break; Result := FCoronaTangentLookup[i].corona; end; end; end; // ---------- // ---------- TStaticImposter ---------- // ---------- procedure TStaticImposter.Render(var rci: TGLRenderContextInfo; const objPos, localCameraPos: TGLVector; size: Single); var azimuthAngle: Single; i: Integer; x, y: Word; bestCorona: TGLStaticImposterBuilderCorona; texExtents: TGLVector; tdx, tdy: Single; siBuilder: TGLStaticImposterBuilder; begin // inherited; exit; siBuilder := TGLStaticImposterBuilder(Builder); // determine closest corona bestCorona := siBuilder.Coronas.CoronaForElevationTangent( localCameraPos.Y / VectorLength(localCameraPos.X, localCameraPos.Z)); // determine closest sample in corona azimuthAngle := FastArcTangent2(localCameraPos.Z, localCameraPos.X) + cPI; i := Round(azimuthAngle * bestCorona.Samples * cInv2PI); if i < 0 then i := 0 else if i >= bestCorona.Samples then i := bestCorona.Samples - 1; i := bestCorona.FSampleBaseIndex + i; tdx := siBuilder.FInvSamplesPerAxis.X; tdy := siBuilder.FInvSamplesPerAxis.Y; DivMod(i, siBuilder.SamplesPerAxis.X, y, x); texExtents.X := tdx * x; texExtents.Y := tdy * y; texExtents.Z := texExtents.X + tdx; texExtents.W := texExtents.Y + tdy; // then render it RenderQuad(texExtents, objPos, Size); end; // ---------- // ---------- TGLStaticImposterBuilder ---------- // ---------- constructor TGLStaticImposterBuilder.Create(AOwner: TComponent); begin inherited; FCoronas := TGLStaticImposterBuilderCoronas.Create(Self); FCoronas.Add; FSampleSize := 16; FSamplingRatioBias := 1; FInvSamplingRatioBias := 1; FLighting := siblStaticLighting; FSamplesAlphaScale := 1; end; destructor TGLStaticImposterBuilder.Destroy; begin FCoronas.Free; inherited; end; function TGLStaticImposterBuilder.CreateNewImposter: TImposter; begin Result := TStaticImposter.Create(Self); end; procedure TGLStaticImposterBuilder.SetCoronas(AValue: TGLStaticImposterBuilderCoronas); begin FCoronas.Assign(AValue); NotifyChange(Self); end; procedure TGLStaticImposterBuilder.SetSampleSize(AValue: Integer); begin AValue := RoundUpToPowerOf2(AValue); if AValue < 8 then AValue := 8; if AValue > 1024 then AValue := 1024; if AValue <> FSampleSize then begin FSampleSize := AValue; NotifyChange(Self); end; end; procedure TGLStaticImposterBuilder.SetSamplingRatioBias(AValue: Single); begin AValue := ClampValue(AValue, 0.1, 10); if AValue <> FSamplingRatioBias then begin FSamplingRatioBias := AValue; FInvSamplingRatioBias := 1 / AValue; NotifyChange(Self); end; end; function TGLStaticImposterBuilder.StoreSamplingRatioBias: Boolean; begin Result := (FSamplingRatioBias <> 1); end; procedure TGLStaticImposterBuilder.SetLighting(AValue: TSIBLigthing); begin if AValue <> FLighting then begin FLighting := AValue; NotifyChange(Self); end; end; procedure TGLStaticImposterBuilder.SetSamplesAlphaScale(AValue: Single); begin if FSamplesAlphaScale <> AValue then begin FSamplesAlphaScale := AValue; NotifyChange(Self); end; end; function TGLStaticImposterBuilder.StoreSamplesAlphaScale: Boolean; begin Result := (FSamplesAlphaScale <> 1); end; function TGLStaticImposterBuilder.GetTextureSizeInfo: string; var t: TPoint; fill: Integer; begin t := ComputeOptimalTextureSize; Result := Format('%d x %d', [t.X, t.Y]); fill := Coronas.SampleCount * SampleSize * SampleSize; if fill < t.X * t.Y then Result := Result + Format(' (%.1f%%)', [(100 * fill) / (t.X * t.Y)]); end; procedure TGLStaticImposterBuilder.SetTextureSizeInfo(const texSize: string); begin // do nothing, this is a dummy property! end; procedure TGLStaticImposterBuilder.DoPrepareImposter(var rci: TGLRenderContextInfo; impostoredObject: TGLBaseSceneObject; destImposter: TImposter); begin Render(rci, impostoredObject, destImposter); end; procedure TGLStaticImposterBuilder.DoUserSpecifiedImposter( var rci: TGLRenderContextInfo; destImposter: TImposter; bmp32: TGLBitmap32); begin inherited; FTextureSize.X := bmp32.Width; FTextureSize.Y := bmp32.Height; ComputeStaticParams(destImposter); end; procedure TGLStaticImposterBuilder.ComputeStaticParams(destImposter: TImposter); var radius: Single; begin Coronas.PrepareCoronaTangentLookup; Coronas.PrepareSampleBaseIndices; FSamplesPerAxis.X := FTextureSize.X div SampleSize; FSamplesPerAxis.Y := FTextureSize.Y div SampleSize; FInvSamplesPerAxis.X := 1 / FSamplesPerAxis.X; FInvSamplesPerAxis.Y := 1 / FSamplesPerAxis.Y; Assert(FSamplesPerAxis.X * FSamplesPerAxis.Y >= Coronas.SampleCount, 'User specified bitmap and imposter parameters don''t match'); radius := destImposter.ImpostoredObject.BoundingSphereRadius / SamplingRatioBias; if ImposterReference = irCenter then destImposter.FStaticScale := radius else destImposter.FStaticScale := radius * 0.5; destImposter.FStaticOffset := FBuildOffset.DirectVector; end; procedure TGLStaticImposterBuilder.Render(var rci: TGLRenderContextInfo; impostoredObject: TGLBaseSceneObject; destImposter: TImposter); var i, coronaIdx, curSample: Integer; radius: Single; cameraDirection, cameraOffset: TGLVector; xDest, xSrc, yDest, ySrc: Integer; corona: TGLStaticImposterBuilderCorona; fx, fy, yOffset: Single; LM: TGLMatrix; begin FTextureSize := ComputeOptimalTextureSize; if (FTextureSize.X <= 0) and (FTextureSize.Y <= 0) then begin SampleSize := SampleSize shr 1; Assert(False, 'Too many samples, can''t fit in a texture! Reduce SampleSize.'); end; ComputeStaticParams(destImposter); radius := impostoredObject.BoundingSphereRadius / SamplingRatioBias; if ImposterReference <> irCenter then radius := radius * 0.5; Assert((rci.GLStates.ViewPort.Z >= SampleSize) and (rci.GLStates.ViewPort.W >= SampleSize), 'ViewPort too small to render imposter samples!'); // Setup the buffer in a suitable fashion for our needs with FBackColor do rci.GLStates.ColorClearValue := Color; if Lighting = siblNoLighting then rci.GLStates.Disable(stLighting); rci.PipelineTransformation.Push; fx := radius * rci.GLStates.ViewPort.Z / SampleSize; fy := radius * rci.GLStates.ViewPort.W / SampleSize; yOffset := cReferenceToPos[ImposterReference] * radius; rci.PipelineTransformation.SetProjectionMatrix( CreateOrthoMatrix(-fx, fx, yOffset - fy, yOffset + fy, radius * 0.5, radius * 5)); xSrc := (rci.GLStates.ViewPort.Z - SampleSize) div 2; ySrc := (rci.GLStates.ViewPort.W - SampleSize) div 2; // setup imposter texture if destImposter.Texture.Handle = 0 then begin {$IFDEF USE_OPENGL_DEBUG} if gl.GREMEDY_string_marker then gl.StringMarkerGREMEDY(22, 'Imposter texture setup'); {$ENDIF} destImposter.PrepareTexture(rci); InitializeImpostorTexture(FTextureSize); end; gl.PixelTransferf(GL_ALPHA_SCALE, FSamplesAlphaScale); // Now render each sample curSample := 0; for coronaIdx := 0 to Coronas.Count - 1 do begin corona := Coronas[coronaIdx]; cameraDirection := XHmgVector; RotateVector(cameraDirection, ZHmgPoint, corona.Elevation * cPIdiv180); for i := 0 to corona.Samples - 1 do begin cameraOffset := cameraDirection; RotateVector(cameraOffset, YHmgVector, (c2PI * i) / corona.Samples); ScaleVector(cameraOffset, -radius * 2); rci.GLStates.DepthWriteMask := True; gl.Clear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT); LM := CreateLookAtMatrix(cameraOffset, NullHmgVector, YHmgVector); if Lighting = siblStaticLighting then (rci.scene as TGLScene).SetupLights(rci.GLStates.MaxLights); rci.PipelineTransformation.SetViewMatrix(MatrixMultiply( CreateTranslationMatrix(FBuildOffset.AsVector), LM)); impostoredObject.Render(rci); gl.CheckError; xDest := (curSample mod FSamplesPerAxis.X) * SampleSize; yDest := (curSample div FSamplesPerAxis.X) * SampleSize; rci.GLStates.TextureBinding[0, ttTexture2D] := destImposter.Texture.Handle; gl.CopyTexSubImage2D(GL_TEXTURE_2D, 0, xDest, yDest, xSrc, ySrc, SampleSize, SampleSize); Inc(curSample); end; end; // Restore buffer stuff gl.PixelTransferf(GL_ALPHA_SCALE, 1); rci.PipelineTransformation.Pop; gl.Clear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT); if Lighting = siblStaticLighting then (rci.scene as TGLScene).SetupLights(rci.GLStates.MaxLights); end; function TGLStaticImposterBuilder.ComputeOptimalTextureSize: TPoint; var nbSamples, maxSamples, maxTexSize, baseSize: Integer; texDim, bestTexDim: TPoint; requiredSurface, currentSurface, bestSurface: Integer; begin nbSamples := Coronas.SampleCount; if CurrentGLContext = nil then maxTexSize := 16 * 1024 else gl.GetIntegerv(GL_MAX_TEXTURE_SIZE, @maxTexSize); maxSamples := Sqr(maxTexSize div SampleSize); if nbSamples < maxSamples then begin Result.X := -1; Result.Y := -1; end; requiredSurface := nbSamples * SampleSize * SampleSize; baseSize := RoundUpToPowerOf2(SampleSize); // determine the texture size with the best fill ratio bestSurface := MaxInt; texDim.X := baseSize; while texDim.X <= maxTexSize do begin texDim.Y := baseSize; while texDim.Y <= maxTexSize do begin currentSurface := texDim.X * texDim.Y; if currentSurface >= requiredSurface then begin if currentSurface < bestSurface then begin bestTexDim := texDim; bestSurface := currentSurface; end else if (currentSurface = bestSurface) and (MaxInteger(texDim.X, texDim.Y) < MaxInteger(bestTexDim.X, bestTexDim.Y)) then begin bestTexDim := texDim; bestSurface := currentSurface; end else Break; end; texDim.Y := texDim.Y * 2; end; texDim.X := texDim.X * 2; end; Assert(bestSurface <> MaxInt); Result := bestTexDim; end; function TGLStaticImposterBuilder.TextureFillRatio: Single; var texDim: TPoint; begin texDim := ComputeOptimalTextureSize; Result := (Coronas.SampleCount * SampleSize * SampleSize) / (texDim.X * texDim.Y); end; // ---------- // ---------- TGLDynamicImposterBuilder ---------- // ---------- constructor TGLDynamicImposterBuilder.Create(AOwner: TComponent); begin inherited; FTolerance := 0.1; FUseMatrixError := True; FMinTexSize := 16; FMaxTexSize := 64; end; destructor TGLDynamicImposterBuilder.Destroy; begin inherited; end; { procedure TGLDynamicImposterBuilder.DoRender(var rci : TGLRenderContextInfo; renderSelf, renderChildren : Boolean); var i, size, Left, Top, Width, Height : Integer; imposter : TGLImposter; mat, projection, modelview : TGLMatrix; BackColor, pos, temp : TGLVector; rad : Single; AABB : TAABB; begin if (csDesigning in ComponentState) or not FEnabled then exit; // Store the current clear color glGetFloatv(GL_COLOR_CLEAR_VALUE, @BackColor[0]); // Get the projection matrix if UseMatrixError then glGetFloatv(GL_PROJECTION_MATRIX, @projection); // Render and save each imposter as required for i:=0 to FImposterRegister.Count-1 do begin imposter:=TGLImposter(FImposterRegister[i]); if (imposter.Count = 0) or not imposter.Visible then Continue; imposter.FDrawImposter:=True; if VectorDistance(imposter.AbsolutePosition, rci.cameraPosition)FMaxTexSize then begin imposter.FDrawImposter:=False; glPopMatrix; Continue; end; temp:=pos; temp[0]:=temp[0]+size; temp:=Scene.CurrentBuffer.ScreenToWorld(temp); Imposter.FSize:=VectorDistance(imposter.AbsolutePosition,temp); imposter.FTexSize:=size; pos[0]:=pos[0]-size/2; pos[1]:=pos[1]-size/2; // Calculate error if UseMatrixError then begin mat:=MatrixMultiply(modelview, projection); if (imposter.CalcError(mat)>FTolerance) or (imposter.FInvalidated) then imposter.FOldMatrix:=mat else begin glPopMatrix; Continue; end; end; // Clear to transparent black glClearColor(0,0,0,0); // Determine size by color (for debug purposes) (*case size of 16 : glClearColor(0,0,1,0.1); 32 : glClearColor(0,1,0,0.1); 64 : glClearColor(1,0,0,0.1); 128 : glClearColor(1,1,0,0.1); 256 : glClearColor(1,0,1,0.1); end;// *) glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT); // Render the imposter's children imposter.RenderChildren(0, imposter.Count-1, rci); glPopMatrix; // Select the imposters texture (will create the handle if null) glBindTexture(GL_TEXTURE_2D,imposter.TextureHandle); // Check for resize or invalidation if (imposter.FTexSize <> imposter.FLastTexSize) or (imposter.FInvalidated) then begin glTexImage2d(GL_TEXTURE_2D, 0, GL_RGBA, size, size, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil); imposter.FLastTexSize:=imposter.FTexSize; imposter.FInvalidated:=False; imposter.NotifyChange(self); end; // Get the region to be copied from the frame buffer Left:=Floor(pos[0]); Top:=Floor(pos[1]); Width:=Size; Height:=Size; // ... Perhaps some region clamping here? // Copy the frame buffer pixels to the imposter texture glCopyTexSubImage2d(GL_TEXTURE_2D, 0, 0, 0, Left, Top, Width, Height); end; // Reset the clear color and clear color, depth and stencil buffers glClearColor(BackColor[0],BackColor[1],BackColor[2],BackColor[3]); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT); end; } procedure TGLDynamicImposterBuilder.SetMinDistance(const AValue: Single); begin if AValue <> FMinDistance then begin FMinDistance := AValue; NotifyChange(Self); end; end; // ---------- // ---------- TGLImposter ---------- // ---------- constructor TGLImposter.Create(AOwner: TComponent); begin inherited; ObjectStyle := ObjectStyle + [osDirectDraw]; end; destructor TGLImposter.Destroy; begin Builder := nil; ImpostoredObject := nil; inherited; end; procedure TGLImposter.Notification(AComponent: TComponent; Operation: TOperation); begin if Operation = opRemove then begin if AComponent = Builder then Builder := nil; if AComponent = ImpostoredObject then ImpostoredObject := nil; end; inherited; end; procedure TGLImposter.DoRender(var ARci: TGLRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); var camPos: TGLVector; imposter: TImposter; begin if ARenderSelf and Assigned(Builder) and Assigned(ImpostoredObject) then begin imposter := Builder.ImposterFor(ImpostoredObject); if Assigned(imposter) and (imposter.Texture.Handle <> 0) then begin camPos := AbsoluteToLocal(ARci.cameraPosition); imposter.BeginRender(ARci); imposter.Render(ARci, NullHmgPoint, camPos, Scale.MaxXYZ); imposter.EndRender(ARci); end; end; if ARenderChildren then Self.RenderChildren(0, Count - 1, ARci); end; procedure TGLImposter.SetBuilder(const AValue: TGLImposterBuilder); begin if AValue <> FBuilder then begin if Assigned(FBuilder) then begin FBuilder.RemoveFreeNotification(Self); FBuilder.UnRequestImposterFor(ImpostoredObject); end; FBuilder := AValue; if Assigned(FBuilder) then begin FBuilder.FreeNotification(Self); FBuilder.RequestImposterFor(ImpostoredObject); end; end; end; procedure TGLImposter.SetImpostoredObject(const AValue: TGLBaseSceneObject); begin if AValue <> FImpostoredObject then begin if Assigned(Builder) then FBuilder.UnRequestImposterFor(ImpostoredObject); FImpostoredObject := AValue; if Assigned(Builder) then FBuilder.RequestImposterFor(ImpostoredObject); end; end; { function TGLImposter.AxisAlignedDimensionsUnscaled : TGLVector; begin Result:=NullHMGVector; end; function TGLImposter.CalcError(NewMatrix : TGLMatrix) : Single; var i : Integer; mat : TGLMatrix; err : Single; begin err:=0; mat:=NewMatrix; InvertMatrix(mat); mat:=MatrixMultiply(FOldMatrix, mat); for i:=0 to 3 do mat[i][i]:=mat[i][i]-1; for i:=0 to 15 do err:=err+Abs(mat[i div 4][i mod 4]); Result:=err; end; function TGLImposter.GetTextureHandle: Cardinal; begin if FTextureHandle = 0 then glGenTextures(1, @FTextureHandle); Result:=FTextureHandle; end; procedure TGLImposter.Invalidate; begin FInvalidated:=True; end; } //-------------------------------------------- initialization //-------------------------------------------- // RegisterClasses([TGLDynamicImposterBuilder, TGLImposter]); RegisterClasses([TGLImposter]); end.