| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896 |
- //
- // The graphics engine GLScene https://github.com/glscene
- //
- unit GLS.PhysManager;
- (* The Manager for Scene Physics Interactions (SPI) *)
- interface
- uses
- System.Classes,
- System.SysUtils,
- GLScene.XCollection,
- GLScene.VectorGeometry,
- GLS.Scene,
- GLS.PhysForces,
- GLS.Behaviours;
- type
- // only ssEuler is usable at the moment
- TDESolverType = (ssEuler, ssRungeKutta4, ssVerlet);
- // TDESolver = procedure((*RigidBody:TGLRigidBody;*)DeltaTime:Real) of object;
- TStateArray = Array of Real;
- TGLPhysManager = class;
- (*
- ***Euler***, EulerImproved, EulerModified, MidPoint
- RungeKutta2, ***RungeKutta4***, RungKutta4Adaptive
- State Variables: Position, Velocity
- Verlet
- State Variables: Position, Old Position
- *)
- // need to have state array(s) seperate from inertias to allow for implicit & explicit methods
- TDESolver = class(TObject)
- public
- StateSize: Integer;
- StateArray: TStateArray;
- Owner: TGLPhysManager;
- function StateToArray(): TStateArray; virtual;
- procedure ArrayToState(StateArray: TStateArray); virtual;
- procedure Solve(DeltaTime: Real); virtual; abstract;
- constructor Create(aOwner: TGLPhysManager); // override; //abstract;
- destructor Destroy; override;
- // procedure Assign(Source: TPersistent); override;
- end;
- // explicit e.g. Euler, Mid-point, Runge-Kutta integration
- TDESolverExplicit = class(TDESolver)
- public
- StateArrayDot: TStateArray; // Velocity stored
- function CalcStateDot(): TStateArray; virtual;
- end;
- TDESolverEuler = class(TDESolverExplicit)
- public
- procedure Solve(DeltaTime: Real); override;
- end;
- TDESolverRungeKutta4 = class(TDESolverExplicit)
- public
- procedure Solve(DeltaTime: Real); override;
- end;
- // implicit e.g. Verlet Integration
- TDESolverImplicit = class(TDESolver)
- public
- LastStateArray: TStateArray; // Last state stored
- end;
- TDESolverVerlet = class(TDESolverImplicit)
- public
- end;
- TGLForces = class;
- TGLBaseForceFieldEmitter = class;
- // TGLPhysManager = class;
- (* purpose of TGLBaseInertia is to allow for inertias that may be constrained
- to 1 or 2 dimensions
- Shouldn't be used directly, instead use TGLParticleInertia (for a 3D particle)
- TGLRigidBodyInertia (for a 3D rigid-body) or define a new sub-class
- e.g. TGL1DParticleInertia, this will allow for faster speed *)
- TGLBaseInertia = class(TGLBehaviour)
- private
- FDampingEnabled: Boolean;
- FManager: TGLPhysManager;
- FManagerName: String; // NOT persistent, temporarily used for persistence
- protected
- procedure Loaded; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- public
- StateSize: Integer; // don't re-declare this in sub-classes
- // just initialise it in constructor
- procedure StateToArray(var StateArray: TStateArray;
- StatePos: Integer); virtual;
- procedure ArrayToState( { var } StateArray: TStateArray;
- StatePos: Integer); virtual;
- procedure CalcStateDot(var StateArray: TStateArray;
- StatePos: Integer); virtual;
- procedure RemoveForces(); virtual;
- procedure CalculateForceFieldForce(ForceFieldEmitter
- : TGLBaseForceFieldEmitter); virtual;
- procedure CalcAuxiliary(); virtual;
- procedure SetUpStartingState(); virtual;
- function CalculateKE(): Real; virtual;
- function CalculatePE(): Real; virtual;
- constructor Create(aOwner: TXCollection); override; // abstract;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- procedure SetManager(const val: TGLPhysManager);
- published
- property DampingEnabled: Boolean read FDampingEnabled write FDampingEnabled;
- property Manager: TGLPhysManager read FManager write SetManager;
- end;
- (* A base for different types of force-field behaviours *)
- TGLBaseForceFieldEmitter = class(TGLBehaviour)
- private
- FManager: TGLPhysManager;
- FManagerName: String; // NOT persistent, temporarily used for persistence
- protected
- procedure Loaded; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- public
- constructor Create(aOwner: TXCollection); override; // abstract;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- procedure SetManager(const val: TGLPhysManager);
- function CalculateForceField(Body: TGLBaseSceneObject): TAffineVector; virtual;
- published
- property Manager: TGLPhysManager read FManager write SetManager;
- end;
- (* The Simple Physics Interaction (SPI) manager can only deal with objects from one scene
- More than one physics manager can be assigned to a scene *)
- TGLPhysManager = class(TComponent)
- // StateSize:Integer;
- protected
- fInertias: TList; // list of all inertias with manager = self
- fForceFieldEmitters: TList; // list of all forcefield emitters
- fForces: TGLForces; // Collection of forces acting on/between objects
- fDESolverType: TDESolverType;
- DESolver: TDESolver;
- fScene: TGLScene;
- protected
- procedure Loaded; override;
- procedure DefineProperties(Filer: TFiler); override;
- procedure WriteForces(stream: TStream);
- procedure ReadForces(stream: TStream);
- procedure SetForces(const val: TGLForces);
- function GetForces: TGLForces;
- procedure SetInertias(const val: TList);
- procedure SetForceFieldEmitters(const val: TList);
- procedure SetScene(const val: TGLScene);
- public
- procedure RegisterInertia(aInertia: TGLBaseInertia);
- procedure DeRegisterInertia(aInertia: TGLBaseInertia);
- procedure DeRegisterAllInertias;
- procedure RegisterForceFieldEmitter(aForceField: TGLBaseForceFieldEmitter);
- procedure DeRegisterForceFieldEmitter(aForceField: TGLBaseForceFieldEmitter);
- procedure DeRegisterAllForceFieldEmitters;
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- constructor Create(aOwner: TComponent); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- procedure CalculateNextState(DeltaTime: Real);
- function CalculateKE(): Real;
- function CalculatePE(): Real;
- procedure SetDESolver(SolverType: TDESolverType);
- function FindObjectByName(Name: String): TGLBaseSceneObject;
- function FindForceFieldEmitterByName(Name: String): TGLBaseSceneObject;
- property Inertias: TList read fInertias write SetInertias; // stored False;
- property ForceFieldEmitters: TList read fForceFieldEmitters
- write SetForceFieldEmitters; // stored False;
- published
- property Forces: TGLForces read GetForces write SetForces; // stored False;
- property Solver: TDESolverType read fDESolverType write SetDESolver;
- property Scene: TGLScene read fScene write SetScene;
- end;
- TGLForces = class(TXCollection)
- protected
- function GetForce(index: Integer): TGLForce;
- public
- constructor Create(aOwner: TPersistent); override;
- // destructor Destroy;override;
- class function ItemsClass: TXCollectionItemClass; override;
- property Force[index: Integer]: TGLForce read GetForce; default;
- function CanAdd(aClass: TXCollectionItemClass): Boolean; override;
- end;
- // ------------------------------------------------------------------
- implementation
- // ------------------------------------------------------------------
- procedure TGLPhysManager.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- (* if Operation=opRemove then
- begin
- if AComponent=FScene then FScene:=nil;
- end;
- *)
- end;
- procedure TGLPhysManager.DefineProperties(Filer: TFiler);
- begin
- inherited DefineProperties(Filer);
- Filer.DefineBinaryProperty('ForcesData', ReadForces, WriteForces,
- (Assigned(fForces) and (fForces.Count > 0)));
- end;
- procedure TGLPhysManager.Loaded;
- begin
- inherited Loaded;
- if Assigned(fForces) then
- fForces.Loaded;
- end;
- function TGLPhysManager.FindObjectByName(Name: String): TGLBaseSceneObject;
- var
- i: Integer;
- begin
- Result := nil;
- for i := 0 to fInertias.Count - 1 do
- begin
- if (TGLBaseInertia(fInertias.Items[i]).OwnerBaseSceneObject.GetNamePath =
- Name) then
- begin
- Result := TGLBaseInertia(fInertias.Items[i]).OwnerBaseSceneObject;
- end
- else if Owner.FindComponent(Name) <> nil then
- begin
- Result := TGLBaseSceneObject(Owner.FindComponent(Name));
- end;
- end;
- end;
- function TGLPhysManager.FindForceFieldEmitterByName(Name: String)
- : TGLBaseSceneObject;
- var
- i: Integer;
- begin
- Result := nil;
- for i := 0 to fForceFieldEmitters.Count - 1 do
- begin
- if (TGLBaseForceFieldEmitter(fForceFieldEmitters.Items[i])
- .OwnerBaseSceneObject.GetNamePath = Name) then
- begin
- Result := TGLBaseForceFieldEmitter(fForceFieldEmitters.Items[i])
- .OwnerBaseSceneObject;
- end;
- end;
- end;
- procedure TGLPhysManager.WriteForces(stream: TStream);
- var
- writer: TWriter;
- begin
- // Writing forces
- writer := TWriter.Create(stream, 16384);
- try
- Forces.WriteToFiler(writer);
- finally
- writer.Free;
- end;
- end;
- procedure TGLPhysManager.ReadForces(stream: TStream);
- var
- reader: TReader;
- begin
- reader := TReader.Create(stream, 16384);
- try
- Forces.ReadFromFiler(reader);
- finally
- reader.Free;
- end;
- end;
- procedure TGLPhysManager.SetForces(const val: TGLForces);
- begin
- Forces.Assign(val);
- end;
- procedure TGLPhysManager.SetInertias(const val: TList);
- begin
- fInertias.Assign(val);
- end;
- procedure TGLPhysManager.SetForceFieldEmitters(const val: TList);
- begin
- fForceFieldEmitters.Assign(val);
- end;
- procedure TGLPhysManager.SetScene(const val: TGLScene);
- begin
- // fScene:=val;
- if fScene <> val then
- begin
- if Assigned(fScene) then
- fScene.RemoveFreeNotification(Self);
- fScene := val;
- if Assigned(fScene) then
- fScene.FreeNotification(Self);
- end;
- end;
- function TGLPhysManager.GetForces: TGLForces;
- begin
- if not Assigned(fForces) then
- fForces := TGLForces.Create(Self);
- Result := fForces;
- end;
- // Not accurate yet, because Forces should be re-calculated for each KVector.
- // Since forces will depend on distances between objects, then this will require
- // a central physics manager, that calculates KVector for all objects, then calculate forces
- // between objects for this new estimated state.
- //
- function TDESolver.StateToArray(): TStateArray;
- var
- i { ,j } : Integer;
- currentpos: Integer;
- // state:TStateArray;
- begin
- currentpos := 0;
- for i := 0 to Owner.fInertias.Count - 1 do
- begin
- TGLBaseInertia(Owner.fInertias.Items[i]).StateToArray(StateArray,
- currentpos);
- currentpos := currentpos + TGLBaseInertia(Owner.fInertias.Items[i])
- .StateSize;
- end;
- Result := StateArray;
- end;
- procedure TDESolver.ArrayToState(StateArray: TStateArray);
- var
- i: Integer;
- currentpos: Integer;
- begin
- currentpos := 0;
- for i := 0 to Owner.fInertias.Count - 1 do
- begin
- TGLBaseInertia(Owner.fInertias.Items[i]).ArrayToState(StateArray,
- currentpos);
- currentpos := currentpos + TGLBaseInertia(Owner.fInertias.Items[i])
- .StateSize;
- end;
- end;
- constructor TDESolver.Create(aOwner: TGLPhysManager);
- begin
- Self.Owner := aOwner;
- end;
- destructor TDESolver.Destroy;
- begin
- //
- end;
- function TDESolverExplicit.CalcStateDot(): TStateArray;
- var
- i { ,j } : Integer;
- currentpos: Integer;
- state: TStateArray;
- begin
- //
- SetLength(state, StateSize);
- for i := 0 to StateSize - 1 do
- state[i] := StateArray[i];
- // state:=StateArray;
- currentpos := 0;
- for i := 0 to Owner.fInertias.Count - 1 do
- begin
- TGLBaseInertia(Owner.fInertias.Items[i]).CalcStateDot(state, currentpos);
- currentpos := currentpos + TGLBaseInertia(Owner.fInertias.Items[i])
- .StateSize;
- end;
- Result := state;
- end;
- procedure TDESolverRungeKutta4.Solve(DeltaTime: Real);
- var
- // X,X0:TStateArray;
- Kvectors: array [0 .. 3] of TStateArray;
- n: Integer;
- StateArray0: TStateArray;
- tempStateArray: TStateArray;
- // tempState:TGLBInertia;
- begin
- // tempState:=TGLBInertia.Create(nil);
- // tempState.Assign(Self);
- tempStateArray := StateToArray();
- StateArray0 := tempStateArray;
- for n := 0 to 3 do
- SetLength(Kvectors[n], Length(StateArray0));
- Kvectors[0] := CalcStateDot();
- for n := 0 to StateSize - 1 do
- tempStateArray[n] := tempStateArray[n] + DeltaTime / 2 * Kvectors[0][n];
- ArrayToState(tempStateArray);
- Kvectors[1] := CalcStateDot();
- for n := 0 to StateSize - 1 do
- tempStateArray[n] := tempStateArray[n] + DeltaTime / 2 * Kvectors[1][n];
- ArrayToState(tempStateArray);
- Kvectors[2] := CalcStateDot();
- for n := 0 to StateSize - 1 do
- tempStateArray[n] := tempStateArray[n] + DeltaTime / 2 * Kvectors[2][n];
- ArrayToState(tempStateArray);
- Kvectors[3] := CalcStateDot();
- for n := 0 to StateSize - 1 do
- begin
- tempStateArray[n] := StateArray0[n] + DeltaTime / 6 *
- (Kvectors[0][n] + 2 * Kvectors[1][n] + 2 * Kvectors[2][n] +
- Kvectors[3][n]);
- end;
- ArrayToState(tempStateArray);
- // NormalizeQuaternion(AngularOrientation);
- // tempState.Free();
- end;
- procedure TDESolverEuler.Solve(DeltaTime: Real);
- var
- i, j: Integer;
- tempState, tempStateDot: TStateArray;
- // force1:TAffineVector;
- Inertia1: TGLBaseInertia;
- tempForce: TAffineVector;
- // UnDampedMomentum,DampedMomentum:Real;
- begin
- {$IFDEF DEBUG}
- Write('Euler integration');
- {$ENDIF}
- for i := 0 to Owner.fInertias.Count - 1 do
- begin
- Inertia1 := TGLBaseInertia(Owner.fInertias.Items[i]);
- // TGLRigidBodyInertia(FObjects.Items[i]).SetTorque(0,0,0);
- for j := 0 to Owner.fForceFieldEmitters.Count - 1 do
- begin
- Inertia1.CalculateForceFieldForce
- (TGLBaseForceFieldEmitter(Owner.fForceFieldEmitters.Items[j]));
- // Inertia1.ApplyForce(TGLForceFieldEmitter(FForceFieldEmitters.Items[j]).CalculateForceField(Inertia1.OwnerBaseSceneObject));
- end;
- end;
- for i := 0 to Owner.Forces.Count - 1 do
- begin
- { force1:= } Owner.Forces.Force[i].CalculateForce();
- end;
- tempState := StateToArray();
- tempStateDot := CalcStateDot();
- for i := 0 to StateSize - 1 do
- tempState[i] := tempState[i] + DeltaTime * tempStateDot[i];
- ArrayToState(tempState);
- for i := 0 to Owner.fInertias.Count - 1 do
- begin
- // TGLInertia(FObjects.Items[i]).SetForce(0,0,0);
- Inertia1 := TGLBaseInertia(Owner.fInertias.Items[i]);
- if Inertia1.DampingEnabled = true then
- begin
- // UnDampedMomentum:=VectorLength(Inertia1.TranslationSpeed.AsAffineVector);
- // DampedMomentum:= Inertia1.TranslationDamping.Calculate(UnDampedMomentum,deltaTime);
- // if UnDampedMomentum<>0 then
- begin
- // ScaleVector(Inertia1.TranslationSpeed.AsAffineVector,DampedMomentum/UnDampedMomentum);
- // ScaleVector(Inertia1.LinearMomentum,DampedMomentum/UnDampedMomentum);
- end;
- // Inertia1.TranslationDamping.Calculate(VectorLength(Inertia1.LinearMomentum),deltaTime);
- end;
- Inertia1.CalcAuxiliary();
- Inertia1.RemoveForces();
- end;
- // NormalizeQuaternion(AngularOrientation);
- end;
- constructor TGLPhysManager.Create(aOwner: TComponent);
- begin
- inherited Create(aOwner);
- fInertias := TList.Create();
- fForceFieldEmitters := TList.Create();
- fForces := TGLForces.Create(Self);
- SetDESolver(ssEuler);
- ///RegisterManager(Self);
- end;
- destructor TGLPhysManager.Destroy;
- begin
- // fScene:=nil;
- DeRegisterAllInertias();
- DeRegisterAllForceFieldEmitters();
- /// DeRegisterManager(Self);
- fInertias.Free();
- fForceFieldEmitters.Free();
- fForces.Free();
- inherited Destroy;
- end;
- procedure TGLPhysManager.Assign(Source: TPersistent);
- begin
- inherited Assign(Source);
- end;
- procedure TGLPhysManager.SetDESolver(SolverType: TDESolverType);
- var
- tempSolver: TDESolver;
- begin
- if Assigned(DESolver) then
- begin
- if (fDESolverType <> SolverType) then
- case SolverType of
- ssRungeKutta4:
- begin
- // DESolver:=RungeKutta4;
- end;
- ssEuler:
- begin
- // DESolver:=Euler;
- end;
- end;
- end
- else
- begin
- // if (fDESolverType<>SolverType) then
- case SolverType of
- ssRungeKutta4:
- begin
- DESolver := TDESolverRungeKutta4.Create(Self);
- end;
- ssEuler:
- begin
- DESolver := TDESolverEuler.Create(Self);
- end;
- end;
- fDESolverType := SolverType;
- end;
- end;
- procedure TGLPhysManager.RegisterInertia(aInertia: TGLBaseInertia);
- begin
- if Assigned(aInertia) then
- if fInertias.IndexOf(aInertia) < 0 then
- begin
- fInertias.Add(aInertia);
- aInertia.FManager := Self;
- DESolver.StateSize := DESolver.StateSize + aInertia.StateSize;
- SetLength(DESolver.StateArray, DESolver.StateSize);
- end;
- end;
- procedure TGLPhysManager.DeRegisterInertia(aInertia: TGLBaseInertia);
- begin
- if Assigned(aInertia) then
- begin
- aInertia.FManager := nil;
- fInertias.Remove(aInertia);
- DESolver.StateSize := DESolver.StateSize - aInertia.StateSize;
- SetLength(DESolver.StateArray, DESolver.StateSize);
- end;
- end;
- procedure TGLPhysManager.DeRegisterAllInertias;
- var
- i: Integer;
- begin
- // Fast deregistration
- for i := 0 to fInertias.Count - 1 do
- TGLBaseInertia(fInertias[i]).FManager := nil;
- fInertias.Clear;
- DESolver.StateSize := 0;
- // SetLEngth(StateArray,0);
- end;
- procedure TGLPhysManager.RegisterForceFieldEmitter
- (aForceField: TGLBaseForceFieldEmitter);
- begin
- if Assigned(aForceField) then
- if fForceFieldEmitters.IndexOf(aForceField) < 0 then
- begin
- fForceFieldEmitters.Add(aForceField);
- aForceField.FManager := Self;
- end;
- end;
- procedure TGLPhysManager.DeRegisterForceFieldEmitter
- (aForceField: TGLBaseForceFieldEmitter);
- begin
- if Assigned(aForceField) then
- begin
- aForceField.FManager := nil;
- fForceFieldEmitters.Remove(aForceField);
- end;
- end;
- procedure TGLPhysManager.DeRegisterAllForceFieldEmitters;
- var
- i: Integer;
- begin
- // Fast deregistration
- for i := 0 to fForceFieldEmitters.Count - 1 do
- TGLBaseForceFieldEmitter(fForceFieldEmitters[i]).FManager := nil;
- fForceFieldEmitters.Clear;
- end;
- function TGLPhysManager.CalculateKE(): Real;
- var
- Total: Real;
- i: Integer;
- begin
- Total := 0;
- for i := 0 to fInertias.Count - 1 do
- begin
- // calculate fInertias[i] KE
- Total := Total + TGLBaseInertia(fInertias.Items[i]).CalculateKE();
- end;
- Result := Total;
- end;
- function TGLPhysManager.CalculatePE(): Real;
- var
- Total: Real;
- i: Integer;
- begin
- Total := 0;
- for i := 0 to fInertias.Count - 1 do
- begin
- // calculate fobject[i] PE
- Total := Total + TGLBaseInertia(fInertias.Items[i]).CalculatePE();
- end;
- Result := Total;
- end;
- procedure TGLPhysManager.CalculateNextState(DeltaTime: Real);
- begin
- if Assigned(DESolver) then
- DESolver.Solve(DeltaTime);
- end;
- constructor TGLForces.Create(aOwner: TPersistent);
- begin
- // Assert(aOwner is TGLBaseSceneObject);
- inherited Create(aOwner);
- end;
- { destructor TGLForces.Destroy;
- begin
- inherited Destroy;
- end;
- }
- class function TGLForces.ItemsClass: TXCollectionItemClass;
- begin
- Result := TGLForce;
- end;
- function TGLForces.GetForce(index: Integer): TGLForce;
- begin
- Result := TGLForce(Items[index]);
- end;
- function TGLForces.CanAdd(aClass: TXCollectionItemClass): Boolean;
- begin
- Result := { (not aClass.InheritsFrom(TGLEffect)) and }
- (inherited CanAdd(aClass));
- end;
- // -----------------------------------------------------------------------------
- procedure TGLBaseInertia.SetManager(const val: TGLPhysManager);
- begin
- if val <> FManager then
- begin
- if Assigned(FManager) then
- FManager.DeRegisterInertia(Self);
- if Assigned(val) then
- val.RegisterInertia(Self);
- // Write(val.GetNamePath);
- end;
- end;
- procedure TGLBaseInertia.Loaded;
- var
- mng: TComponent;
- begin
- inherited;
- if FManagerName <> '' then
- begin
- ///? mng := FindManager(TGLPhysManager, FManagerName);
- if Assigned(mng) then
- Manager := TGLPhysManager(mng);
- FManagerName := '';
- end;
- end;
- procedure TGLBaseInertia.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive Version 0
- WriteBoolean(FDampingEnabled);
- if Assigned(FManager) then
- WriteString(FManager.GetNamePath)
- else
- WriteString('');
- end;
- end;
- procedure TGLBaseInertia.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- ReadInteger; // ignore archiveVersion
- FDampingEnabled := ReadBoolean;
- FManagerName := ReadString;
- Manager := nil;
- end;
- // Loaded; //DB100
- end;
- constructor TGLBaseInertia.Create(aOwner: TXCollection);
- begin
- inherited Create(aOwner);
- FDampingEnabled := true;
- end;
- destructor TGLBaseInertia.Destroy;
- begin
- SetManager(nil);
- inherited Destroy;
- end;
- procedure TGLBaseInertia.Assign(Source: TPersistent);
- begin
- if Source.ClassType = Self.ClassType then
- begin
- StateSize := TGLBaseInertia(Source).StateSize;
- FDampingEnabled := TGLBaseInertia(Source).DampingEnabled;
- Manager := TGLBaseInertia(Source).Manager;
- end;
- inherited Assign(Source);
- end;
- procedure TGLBaseInertia.StateToArray(var StateArray: TStateArray;
- StatePos: Integer);
- begin
- end;
- procedure TGLBaseInertia.ArrayToState( { var } StateArray: TStateArray;
- StatePos: Integer);
- begin
- end;
- procedure TGLBaseInertia.CalcStateDot(var StateArray: TStateArray;
- StatePos: Integer);
- begin
- end;
- procedure TGLBaseInertia.RemoveForces();
- begin
- end;
- procedure TGLBaseInertia.CalculateForceFieldForce(ForceFieldEmitter
- : TGLBaseForceFieldEmitter);
- begin
- end;
- function TGLBaseInertia.CalculateKE(): Real;
- begin
- Result := 0;
- end;
- function TGLBaseInertia.CalculatePE(): Real;
- begin
- Result := 0;
- end;
- procedure TGLBaseInertia.CalcAuxiliary();
- begin
- end;
- procedure TGLBaseInertia.SetUpStartingState();
- begin
- end;
- // -----------------------------------------------------------------------------
- procedure TGLBaseForceFieldEmitter.SetManager(const val: TGLPhysManager);
- begin
- if val <> FManager then
- begin
- if Assigned(FManager) then
- FManager.DeRegisterForceFieldEmitter(Self);
- if Assigned(val) then
- val.RegisterForceFieldEmitter(Self);
- end;
- end;
- procedure TGLBaseForceFieldEmitter.Loaded;
- var
- mng: TComponent;
- begin
- inherited;
- if FManagerName <> '' then
- begin
- ///? mng := FindManager(TGLPhysManager, FManagerName);
- if Assigned(mng) then
- Manager := TGLPhysManager(mng);
- FManagerName := '';
- end;
- end;
- procedure TGLBaseForceFieldEmitter.WriteToFiler(writer: TWriter);
- begin
- inherited; // Dan Bartlett
- with writer do
- begin
- WriteInteger(0); // Archive Version 0
- if Assigned(FManager) then
- WriteString(FManager.GetNamePath)
- else
- WriteString('');
- end;
- end;
- procedure TGLBaseForceFieldEmitter.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- ReadInteger; // ignore archiveVersion
- FManagerName := ReadString;
- Manager := nil;
- end;
- // Loaded; //DB100
- end;
- constructor TGLBaseForceFieldEmitter.Create(aOwner: TXCollection);
- begin
- inherited Create(aOwner);
- end;
- destructor TGLBaseForceFieldEmitter.Destroy;
- begin
- SetManager(nil);
- inherited Destroy;
- end;
- procedure TGLBaseForceFieldEmitter.Assign(Source: TPersistent);
- begin
- if Source.ClassType = Self.ClassType then
- begin
- Manager := TGLBaseForceFieldEmitter(Source).Manager;
- end;
- inherited Assign(Source);
- end;
- // CalculateForceField
- function TGLBaseForceFieldEmitter.CalculateForceField(Body: TGLBaseSceneObject)
- : TAffineVector;
- begin
- Result := nullVector;
- end;
- // ------------------------------------------------------------------
- initialization
- // ------------------------------------------------------------------
- // RegisterClasses([TGLForces]);
- // RegisterClasses([TGLPhysManager, TGLBaseInertia, TGLBaseForceFieldEmitter]);
- // RegisterXCollectionItemClass(TGLBaseInertia);
- // RegisterXCollectionItemClass(TGLBaseForceFieldEmitter);
- // RegisterXCollectionItemClass(TGLPhysicsForce);
- end.
|