// // The graphics engine GLScene // unit GLS.MultiProxy; (* Implements a multi-proxy objects, useful for discreet LOD. *) interface {$I Stage.Defines.inc} uses System.Classes, System.SysUtils, Stage.OpenGLTokens, GLS.PersistentClasses, Stage.VectorGeometry, GLS.Context, GLS.Scene, GLS.Silhouette, GLS.RenderContextInfo, GLS.BaseClasses, Stage.VectorTypes; type TGLMultiProxy = class; // MasterObject description for a MultiProxy object TGLMultiProxyMaster = class (TCollectionItem) private FMasterObject : TGLBaseSceneObject; FDistanceMin, FDistanceMin2 : Single; FDistanceMax, FDistanceMax2 : Single; FVisible : Boolean; protected function GetDisplayName : String; override; procedure SetMasterObject(const val : TGLBaseSceneObject); procedure SetDistanceMin(const val : Single); procedure SetDistanceMax(const val : Single); procedure SetVisible(const val : Boolean); public constructor Create(Collection : TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; function OwnerObject : TGLMultiProxy; procedure NotifyChange; published // Specifies the Master object which will be proxy'ed. property MasterObject : TGLBaseSceneObject read FMasterObject write SetMasterObject; // Minimum visibility distance (inclusive). property DistanceMin : Single read FDistanceMin write SetDistanceMin; // Maximum visibility distance (exclusive). property DistanceMax : Single read FDistanceMax write SetDistanceMax; (* Determines if the master object can be visible (proxy'ed). Note: the master object's distance also has to be within DistanceMin and DistanceMax. *) property Visible : Boolean read FVisible write SetVisible default True; end; // Collection of TGLMultiProxyMaster. TGLMultiProxyMasters = class (TOwnedCollection) protected procedure SetItems(index : Integer; const val : TGLMultiProxyMaster); function GetItems(index : Integer) : TGLMultiProxyMaster; procedure Update(Item: TCollectionItem); override; public constructor Create(AOwner : TPersistent); function Add : TGLMultiProxyMaster; overload; function Add(master : TGLBaseSceneObject; distanceMin, distanceMax : Single) : TGLMultiProxyMaster; overload; property Items[index : Integer] : TGLMultiProxyMaster read GetItems write SetItems; default; procedure Notification(AComponent: TComponent); procedure NotifyChange; procedure EndUpdate; override; end; (* Multiple Proxy object. This proxy has multiple master objects, which are individually made visible depending on a distance to the camera criterion. It can be used to implement discreet level of detail directly for static objects, or objects that go through cyclic animation. For dimensionsn raycasting and silhouette purposes, the first master is used (item zero in the MasterObjects collection). *) TGLMultiProxy = class (TGLSceneObject) private FMasterObjects : TGLMultiProxyMasters; FRendering : Boolean; // internal use (loop protection) protected procedure SetMasterObjects(const val : TGLMultiProxyMasters); procedure Notification(AComponent: TComponent; Operation: TOperation); override; function PrimaryMaster : TGLBaseSceneObject; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure DoRender(var rci : TGLRenderContextInfo; renderSelf, renderChildren : Boolean); override; function AxisAlignedDimensionsUnscaled : TGLVector; override; function RayCastIntersect(const rayStart, rayVector : TGLVector; intersectPoint : PGLVector = nil; intersectNormal : PGLVector = nil) : Boolean; override; function GenerateSilhouette(const silhouetteParameters : TGLSilhouetteParameters) : TGLSilhouette; override; published property MasterObjects : TGLMultiProxyMasters read FMasterObjects write SetMasterObjects; property ObjectsSorting; property Direction; property PitchAngle; property Position; property RollAngle; property Scale; property ShowAxes; property TurnAngle; property Up; property Visible; property OnProgress; property Behaviours; end; //------------------------------------------------------------- implementation //------------------------------------------------------------- // ------------------ // ------------------ TGLMultiProxyMaster ------------------ // ------------------ constructor TGLMultiProxyMaster.Create(Collection : TCollection); begin inherited Create(Collection); FVisible:=True; end; destructor TGLMultiProxyMaster.Destroy; begin MasterObject:=nil; inherited Destroy; end; procedure TGLMultiProxyMaster.Assign(Source: TPersistent); begin if Source is TGLMultiProxyMaster then begin MasterObject:=TGLMultiProxyMaster(Source).MasterObject; FDistanceMin:=TGLMultiProxyMaster(Source).FDistanceMin; FDistanceMin2:=TGLMultiProxyMaster(Source).FDistanceMin2; FDistanceMax:=TGLMultiProxyMaster(Source).FDistanceMax; FDistanceMax2:=TGLMultiProxyMaster(Source).FDistanceMax2; FVisible:=TGLMultiProxyMaster(Source).FVisible; NotifyChange; end else inherited; end; function TGLMultiProxyMaster.OwnerObject : TGLMultiProxy; begin Result:=TGLMultiProxy(TGLMultiProxyMasters(Collection).GetOwner); end; procedure TGLMultiProxyMaster.NotifyChange; begin TGLMultiProxyMasters(Collection).NotifyChange; end; function TGLMultiProxyMaster.GetDisplayName : String; begin if MasterObject<>nil then Result:=MasterObject.Name else Result:='???'; Result:=Result+Format(' [%.2f; %.2f[', [DistanceMin, DistanceMax]); if not Visible then Result:=Result+' (hidden)'; end; procedure TGLMultiProxyMaster.SetMasterObject(const val : TGLBaseSceneObject); begin if FMasterObject<>val then begin if Assigned(FMasterObject) then FMasterObject.RemoveFreeNotification(OwnerObject); FMasterObject:=val; if Assigned(FMasterObject) then FMasterObject.FreeNotification(OwnerObject); NotifyChange; end; end; procedure TGLMultiProxyMaster.SetDistanceMin(const val : Single); begin if FDistanceMin<>val then begin FDistanceMin:=val; FDistanceMin2:=Sqr(val); NotifyChange; end; end; procedure TGLMultiProxyMaster.SetDistanceMax(const val : Single); begin if FDistanceMax<>val then begin FDistanceMax:=val; FDistanceMax2:=Sqr(val); NotifyChange; end; end; procedure TGLMultiProxyMaster.SetVisible(const val : Boolean); begin if FVisible<>val then begin FVisible:=val; NotifyChange; end; end; // ------------------ // ------------------ TGLMultiProxyMasters ------------------ // ------------------ constructor TGLMultiProxyMasters.Create(AOwner : TPersistent); begin inherited Create(AOwner, TGLMultiProxyMaster) end; procedure TGLMultiProxyMasters.SetItems(index : Integer; const val : TGLMultiProxyMaster); begin inherited Items[index]:=val; end; function TGLMultiProxyMasters.GetItems(index : Integer) : TGLMultiProxyMaster; begin Result:=TGLMultiProxyMaster(inherited Items[index]); end; procedure TGLMultiProxyMasters.Update(Item : TCollectionItem); begin inherited; NotifyChange; end; function TGLMultiProxyMasters.Add : TGLMultiProxyMaster; begin Result:=(inherited Add) as TGLMultiProxyMaster; end; function TGLMultiProxyMasters.Add(master : TGLBaseSceneObject; distanceMin, distanceMax : Single) : TGLMultiProxyMaster; begin BeginUpdate; Result:=(inherited Add) as TGLMultiProxyMaster; Result.MasterObject:=master; Result.DistanceMin:=distanceMin; Result.DistanceMax:=distanceMax; EndUpdate; end; procedure TGLMultiProxyMasters.Notification(AComponent: TComponent); var i : Integer; begin for i:=0 to Count-1 do with Items[i] do if FMasterObject=AComponent then FMasterObject:=nil; end; procedure TGLMultiProxyMasters.NotifyChange; begin if (UpdateCount=0) and (GetOwner<>nil) and (GetOwner is TGLUpdateAbleComponent) then TGLUpdateAbleComponent(GetOwner).NotifyChange(Self); end; procedure TGLMultiProxyMasters.EndUpdate; begin inherited EndUpdate; // Workaround for a bug in VCL's EndUpdate if UpdateCount=0 then NotifyChange; end; // ------------------ // ------------------ TGLMultiProxy ------------------ // ------------------ constructor TGLMultiProxy.Create(AOwner: TComponent); begin inherited Create(AOwner); ObjectStyle:=ObjectStyle+[osDirectDraw]; FMasterObjects:=TGLMultiProxyMasters.Create(Self); end; destructor TGLMultiProxy.Destroy; begin inherited Destroy; FMasterObjects.Free; end; procedure TGLMultiProxy.Notification(AComponent: TComponent; Operation: TOperation); begin if Operation=opRemove then FMasterObjects.Notification(AComponent); inherited; end; procedure TGLMultiProxy.SetMasterObjects(const val : TGLMultiProxyMasters); begin FMasterObjects.Assign(val); StructureChanged; end; procedure TGLMultiProxy.Assign(Source: TPersistent); begin if Source is TGLMultiProxy then begin MasterObjects:=TGLMultiProxy(Source).MasterObjects; end; inherited; end; procedure TGLMultiProxy.DoRender(var rci : TGLRenderContextInfo; renderSelf, renderChildren : Boolean); var i : Integer; oldProxySubObject : Boolean; mpMaster : TGLMultiProxyMaster; master : TGLBaseSceneObject; d2 : Single; begin if FRendering then Exit; FRendering:=True; try d2:=VectorDistance2(rci.cameraPosition, AbsolutePosition); for i:=0 to MasterObjects.Count-1 do begin mpMaster:=MasterObjects[i]; if mpMaster.Visible then begin master:=mpMaster.MasterObject; if (master<>nil) and (d2>=mpMaster.FDistanceMin2) and (d20)); rci.proxySubObject:=oldProxySubObject; end; end; end; // now render self stuff (our children, our effects, etc.) if renderChildren and (Count>0) then Self.RenderChildren(0, Count-1, rci); // if masterGotEffects then // FMasterObject.Effects.RenderPostEffects(Scene.CurrentBuffer, rci); finally FRendering:=False; end; ClearStructureChanged; end; function TGLMultiProxy.PrimaryMaster : TGLBaseSceneObject; begin if MasterObjects.Count>0 then Result:=MasterObjects[0].MasterObject else Result:=nil; end; function TGLMultiProxy.AxisAlignedDimensionsUnscaled : TGLVector; var master : TGLBaseSceneObject; begin master:=PrimaryMaster; if Assigned(master) then begin Result:=master.AxisAlignedDimensionsUnscaled; end else Result:=inherited AxisAlignedDimensionsUnscaled; end; function TGLMultiProxy.RayCastIntersect(const rayStart, rayVector : TGLVector; intersectPoint : PGLVector = nil; intersectNormal : PGLVector = nil) : Boolean; var localRayStart, localRayVector : TGLVector; master : TGLBaseSceneObject; begin master:=PrimaryMaster; if Assigned(master) then begin SetVector(localRayStart, AbsoluteToLocal(rayStart)); SetVector(localRayStart, master.LocalToAbsolute(localRayStart)); SetVector(localRayVector, AbsoluteToLocal(rayVector)); SetVector(localRayVector, master.LocalToAbsolute(localRayVector)); NormalizeVector(localRayVector); Result:=master.RayCastIntersect(localRayStart, localRayVector, intersectPoint, intersectNormal); if Result then begin if Assigned(intersectPoint) then begin SetVector(intersectPoint^, master.AbsoluteToLocal(intersectPoint^)); SetVector(intersectPoint^, LocalToAbsolute(intersectPoint^)); end; if Assigned(intersectNormal) then begin SetVector(intersectNormal^, master.AbsoluteToLocal(intersectNormal^)); SetVector(intersectNormal^, LocalToAbsolute(intersectNormal^)); end; end; end else Result:=False; end; function TGLMultiProxy.GenerateSilhouette(const silhouetteParameters : TGLSilhouetteParameters) : TGLSilhouette; var master : TGLBaseSceneObject; begin master:=PrimaryMaster; if Assigned(master) then Result:=master.GenerateSilhouette(silhouetteParameters) else Result:=nil; end; //------------------------------------------------------------- initialization //------------------------------------------------------------- RegisterClasses([TGLMultiProxy]); end.