GLS.PhysManager.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896
  1. //
  2. // The graphics engine GLScene https://github.com/glscene
  3. //
  4. unit GLS.PhysManager;
  5. (* The Manager for Scene Physics Interactions (SPI) *)
  6. interface
  7. uses
  8. System.Classes,
  9. System.SysUtils,
  10. GLScene.XCollection,
  11. GLScene.VectorGeometry,
  12. GLS.Scene,
  13. GLS.PhysForces,
  14. GLS.Behaviours;
  15. type
  16. // only ssEuler is usable at the moment
  17. TDESolverType = (ssEuler, ssRungeKutta4, ssVerlet);
  18. // TDESolver = procedure((*RigidBody:TGLRigidBody;*)DeltaTime:Real) of object;
  19. TStateArray = Array of Real;
  20. TGLPhysManager = class;
  21. (*
  22. ***Euler***, EulerImproved, EulerModified, MidPoint
  23. RungeKutta2, ***RungeKutta4***, RungKutta4Adaptive
  24. State Variables: Position, Velocity
  25. Verlet
  26. State Variables: Position, Old Position
  27. *)
  28. // need to have state array(s) seperate from inertias to allow for implicit & explicit methods
  29. TDESolver = class(TObject)
  30. public
  31. StateSize: Integer;
  32. StateArray: TStateArray;
  33. Owner: TGLPhysManager;
  34. function StateToArray(): TStateArray; virtual;
  35. procedure ArrayToState(StateArray: TStateArray); virtual;
  36. procedure Solve(DeltaTime: Real); virtual; abstract;
  37. constructor Create(aOwner: TGLPhysManager); // override; //abstract;
  38. destructor Destroy; override;
  39. // procedure Assign(Source: TPersistent); override;
  40. end;
  41. // explicit e.g. Euler, Mid-point, Runge-Kutta integration
  42. TDESolverExplicit = class(TDESolver)
  43. public
  44. StateArrayDot: TStateArray; // Velocity stored
  45. function CalcStateDot(): TStateArray; virtual;
  46. end;
  47. TDESolverEuler = class(TDESolverExplicit)
  48. public
  49. procedure Solve(DeltaTime: Real); override;
  50. end;
  51. TDESolverRungeKutta4 = class(TDESolverExplicit)
  52. public
  53. procedure Solve(DeltaTime: Real); override;
  54. end;
  55. // implicit e.g. Verlet Integration
  56. TDESolverImplicit = class(TDESolver)
  57. public
  58. LastStateArray: TStateArray; // Last state stored
  59. end;
  60. TDESolverVerlet = class(TDESolverImplicit)
  61. public
  62. end;
  63. TGLForces = class;
  64. TGLBaseForceFieldEmitter = class;
  65. // TGLPhysManager = class;
  66. (* purpose of TGLBaseInertia is to allow for inertias that may be constrained
  67. to 1 or 2 dimensions
  68. Shouldn't be used directly, instead use TGLParticleInertia (for a 3D particle)
  69. TGLRigidBodyInertia (for a 3D rigid-body) or define a new sub-class
  70. e.g. TGL1DParticleInertia, this will allow for faster speed *)
  71. TGLBaseInertia = class(TGLBehaviour)
  72. private
  73. FDampingEnabled: Boolean;
  74. FManager: TGLPhysManager;
  75. FManagerName: String; // NOT persistent, temporarily used for persistence
  76. protected
  77. procedure Loaded; override;
  78. procedure WriteToFiler(writer: TWriter); override;
  79. procedure ReadFromFiler(reader: TReader); override;
  80. public
  81. StateSize: Integer; // don't re-declare this in sub-classes
  82. // just initialise it in constructor
  83. procedure StateToArray(var StateArray: TStateArray;
  84. StatePos: Integer); virtual;
  85. procedure ArrayToState( { var } StateArray: TStateArray;
  86. StatePos: Integer); virtual;
  87. procedure CalcStateDot(var StateArray: TStateArray;
  88. StatePos: Integer); virtual;
  89. procedure RemoveForces(); virtual;
  90. procedure CalculateForceFieldForce(ForceFieldEmitter
  91. : TGLBaseForceFieldEmitter); virtual;
  92. procedure CalcAuxiliary(); virtual;
  93. procedure SetUpStartingState(); virtual;
  94. function CalculateKE(): Real; virtual;
  95. function CalculatePE(): Real; virtual;
  96. constructor Create(aOwner: TXCollection); override; // abstract;
  97. destructor Destroy; override;
  98. procedure Assign(Source: TPersistent); override;
  99. procedure SetManager(const val: TGLPhysManager);
  100. published
  101. property DampingEnabled: Boolean read FDampingEnabled write FDampingEnabled;
  102. property Manager: TGLPhysManager read FManager write SetManager;
  103. end;
  104. (* A base for different types of force-field behaviours *)
  105. TGLBaseForceFieldEmitter = class(TGLBehaviour)
  106. private
  107. FManager: TGLPhysManager;
  108. FManagerName: String; // NOT persistent, temporarily used for persistence
  109. protected
  110. procedure Loaded; override;
  111. procedure WriteToFiler(writer: TWriter); override;
  112. procedure ReadFromFiler(reader: TReader); override;
  113. public
  114. constructor Create(aOwner: TXCollection); override; // abstract;
  115. destructor Destroy; override;
  116. procedure Assign(Source: TPersistent); override;
  117. procedure SetManager(const val: TGLPhysManager);
  118. function CalculateForceField(Body: TGLBaseSceneObject): TAffineVector; virtual;
  119. published
  120. property Manager: TGLPhysManager read FManager write SetManager;
  121. end;
  122. (* The Simple Physics Interaction (SPI) manager can only deal with objects from one scene
  123. More than one physics manager can be assigned to a scene *)
  124. TGLPhysManager = class(TComponent)
  125. // StateSize:Integer;
  126. protected
  127. fInertias: TList; // list of all inertias with manager = self
  128. fForceFieldEmitters: TList; // list of all forcefield emitters
  129. fForces: TGLForces; // Collection of forces acting on/between objects
  130. fDESolverType: TDESolverType;
  131. DESolver: TDESolver;
  132. fScene: TGLScene;
  133. protected
  134. procedure Loaded; override;
  135. procedure DefineProperties(Filer: TFiler); override;
  136. procedure WriteForces(stream: TStream);
  137. procedure ReadForces(stream: TStream);
  138. procedure SetForces(const val: TGLForces);
  139. function GetForces: TGLForces;
  140. procedure SetInertias(const val: TList);
  141. procedure SetForceFieldEmitters(const val: TList);
  142. procedure SetScene(const val: TGLScene);
  143. public
  144. procedure RegisterInertia(aInertia: TGLBaseInertia);
  145. procedure DeRegisterInertia(aInertia: TGLBaseInertia);
  146. procedure DeRegisterAllInertias;
  147. procedure RegisterForceFieldEmitter(aForceField: TGLBaseForceFieldEmitter);
  148. procedure DeRegisterForceFieldEmitter(aForceField: TGLBaseForceFieldEmitter);
  149. procedure DeRegisterAllForceFieldEmitters;
  150. procedure Notification(AComponent: TComponent;
  151. Operation: TOperation); override;
  152. constructor Create(aOwner: TComponent); override;
  153. destructor Destroy; override;
  154. procedure Assign(Source: TPersistent); override;
  155. procedure CalculateNextState(DeltaTime: Real);
  156. function CalculateKE(): Real;
  157. function CalculatePE(): Real;
  158. procedure SetDESolver(SolverType: TDESolverType);
  159. function FindObjectByName(Name: String): TGLBaseSceneObject;
  160. function FindForceFieldEmitterByName(Name: String): TGLBaseSceneObject;
  161. property Inertias: TList read fInertias write SetInertias; // stored False;
  162. property ForceFieldEmitters: TList read fForceFieldEmitters
  163. write SetForceFieldEmitters; // stored False;
  164. published
  165. property Forces: TGLForces read GetForces write SetForces; // stored False;
  166. property Solver: TDESolverType read fDESolverType write SetDESolver;
  167. property Scene: TGLScene read fScene write SetScene;
  168. end;
  169. TGLForces = class(TXCollection)
  170. protected
  171. function GetForce(index: Integer): TGLForce;
  172. public
  173. constructor Create(aOwner: TPersistent); override;
  174. // destructor Destroy;override;
  175. class function ItemsClass: TXCollectionItemClass; override;
  176. property Force[index: Integer]: TGLForce read GetForce; default;
  177. function CanAdd(aClass: TXCollectionItemClass): Boolean; override;
  178. end;
  179. // ------------------------------------------------------------------
  180. implementation
  181. // ------------------------------------------------------------------
  182. procedure TGLPhysManager.Notification(AComponent: TComponent;
  183. Operation: TOperation);
  184. begin
  185. (* if Operation=opRemove then
  186. begin
  187. if AComponent=FScene then FScene:=nil;
  188. end;
  189. *)
  190. end;
  191. procedure TGLPhysManager.DefineProperties(Filer: TFiler);
  192. begin
  193. inherited DefineProperties(Filer);
  194. Filer.DefineBinaryProperty('ForcesData', ReadForces, WriteForces,
  195. (Assigned(fForces) and (fForces.Count > 0)));
  196. end;
  197. procedure TGLPhysManager.Loaded;
  198. begin
  199. inherited Loaded;
  200. if Assigned(fForces) then
  201. fForces.Loaded;
  202. end;
  203. function TGLPhysManager.FindObjectByName(Name: String): TGLBaseSceneObject;
  204. var
  205. i: Integer;
  206. begin
  207. Result := nil;
  208. for i := 0 to fInertias.Count - 1 do
  209. begin
  210. if (TGLBaseInertia(fInertias.Items[i]).OwnerBaseSceneObject.GetNamePath =
  211. Name) then
  212. begin
  213. Result := TGLBaseInertia(fInertias.Items[i]).OwnerBaseSceneObject;
  214. end
  215. else if Owner.FindComponent(Name) <> nil then
  216. begin
  217. Result := TGLBaseSceneObject(Owner.FindComponent(Name));
  218. end;
  219. end;
  220. end;
  221. function TGLPhysManager.FindForceFieldEmitterByName(Name: String)
  222. : TGLBaseSceneObject;
  223. var
  224. i: Integer;
  225. begin
  226. Result := nil;
  227. for i := 0 to fForceFieldEmitters.Count - 1 do
  228. begin
  229. if (TGLBaseForceFieldEmitter(fForceFieldEmitters.Items[i])
  230. .OwnerBaseSceneObject.GetNamePath = Name) then
  231. begin
  232. Result := TGLBaseForceFieldEmitter(fForceFieldEmitters.Items[i])
  233. .OwnerBaseSceneObject;
  234. end;
  235. end;
  236. end;
  237. procedure TGLPhysManager.WriteForces(stream: TStream);
  238. var
  239. writer: TWriter;
  240. begin
  241. // Writing forces
  242. writer := TWriter.Create(stream, 16384);
  243. try
  244. Forces.WriteToFiler(writer);
  245. finally
  246. writer.Free;
  247. end;
  248. end;
  249. procedure TGLPhysManager.ReadForces(stream: TStream);
  250. var
  251. reader: TReader;
  252. begin
  253. reader := TReader.Create(stream, 16384);
  254. try
  255. Forces.ReadFromFiler(reader);
  256. finally
  257. reader.Free;
  258. end;
  259. end;
  260. procedure TGLPhysManager.SetForces(const val: TGLForces);
  261. begin
  262. Forces.Assign(val);
  263. end;
  264. procedure TGLPhysManager.SetInertias(const val: TList);
  265. begin
  266. fInertias.Assign(val);
  267. end;
  268. procedure TGLPhysManager.SetForceFieldEmitters(const val: TList);
  269. begin
  270. fForceFieldEmitters.Assign(val);
  271. end;
  272. procedure TGLPhysManager.SetScene(const val: TGLScene);
  273. begin
  274. // fScene:=val;
  275. if fScene <> val then
  276. begin
  277. if Assigned(fScene) then
  278. fScene.RemoveFreeNotification(Self);
  279. fScene := val;
  280. if Assigned(fScene) then
  281. fScene.FreeNotification(Self);
  282. end;
  283. end;
  284. function TGLPhysManager.GetForces: TGLForces;
  285. begin
  286. if not Assigned(fForces) then
  287. fForces := TGLForces.Create(Self);
  288. Result := fForces;
  289. end;
  290. // Not accurate yet, because Forces should be re-calculated for each KVector.
  291. // Since forces will depend on distances between objects, then this will require
  292. // a central physics manager, that calculates KVector for all objects, then calculate forces
  293. // between objects for this new estimated state.
  294. //
  295. function TDESolver.StateToArray(): TStateArray;
  296. var
  297. i { ,j } : Integer;
  298. currentpos: Integer;
  299. // state:TStateArray;
  300. begin
  301. currentpos := 0;
  302. for i := 0 to Owner.fInertias.Count - 1 do
  303. begin
  304. TGLBaseInertia(Owner.fInertias.Items[i]).StateToArray(StateArray,
  305. currentpos);
  306. currentpos := currentpos + TGLBaseInertia(Owner.fInertias.Items[i])
  307. .StateSize;
  308. end;
  309. Result := StateArray;
  310. end;
  311. procedure TDESolver.ArrayToState(StateArray: TStateArray);
  312. var
  313. i: Integer;
  314. currentpos: Integer;
  315. begin
  316. currentpos := 0;
  317. for i := 0 to Owner.fInertias.Count - 1 do
  318. begin
  319. TGLBaseInertia(Owner.fInertias.Items[i]).ArrayToState(StateArray,
  320. currentpos);
  321. currentpos := currentpos + TGLBaseInertia(Owner.fInertias.Items[i])
  322. .StateSize;
  323. end;
  324. end;
  325. constructor TDESolver.Create(aOwner: TGLPhysManager);
  326. begin
  327. Self.Owner := aOwner;
  328. end;
  329. destructor TDESolver.Destroy;
  330. begin
  331. //
  332. end;
  333. function TDESolverExplicit.CalcStateDot(): TStateArray;
  334. var
  335. i { ,j } : Integer;
  336. currentpos: Integer;
  337. state: TStateArray;
  338. begin
  339. //
  340. SetLength(state, StateSize);
  341. for i := 0 to StateSize - 1 do
  342. state[i] := StateArray[i];
  343. // state:=StateArray;
  344. currentpos := 0;
  345. for i := 0 to Owner.fInertias.Count - 1 do
  346. begin
  347. TGLBaseInertia(Owner.fInertias.Items[i]).CalcStateDot(state, currentpos);
  348. currentpos := currentpos + TGLBaseInertia(Owner.fInertias.Items[i])
  349. .StateSize;
  350. end;
  351. Result := state;
  352. end;
  353. procedure TDESolverRungeKutta4.Solve(DeltaTime: Real);
  354. var
  355. // X,X0:TStateArray;
  356. Kvectors: array [0 .. 3] of TStateArray;
  357. n: Integer;
  358. StateArray0: TStateArray;
  359. tempStateArray: TStateArray;
  360. // tempState:TGLBInertia;
  361. begin
  362. // tempState:=TGLBInertia.Create(nil);
  363. // tempState.Assign(Self);
  364. tempStateArray := StateToArray();
  365. StateArray0 := tempStateArray;
  366. for n := 0 to 3 do
  367. SetLength(Kvectors[n], Length(StateArray0));
  368. Kvectors[0] := CalcStateDot();
  369. for n := 0 to StateSize - 1 do
  370. tempStateArray[n] := tempStateArray[n] + DeltaTime / 2 * Kvectors[0][n];
  371. ArrayToState(tempStateArray);
  372. Kvectors[1] := CalcStateDot();
  373. for n := 0 to StateSize - 1 do
  374. tempStateArray[n] := tempStateArray[n] + DeltaTime / 2 * Kvectors[1][n];
  375. ArrayToState(tempStateArray);
  376. Kvectors[2] := CalcStateDot();
  377. for n := 0 to StateSize - 1 do
  378. tempStateArray[n] := tempStateArray[n] + DeltaTime / 2 * Kvectors[2][n];
  379. ArrayToState(tempStateArray);
  380. Kvectors[3] := CalcStateDot();
  381. for n := 0 to StateSize - 1 do
  382. begin
  383. tempStateArray[n] := StateArray0[n] + DeltaTime / 6 *
  384. (Kvectors[0][n] + 2 * Kvectors[1][n] + 2 * Kvectors[2][n] +
  385. Kvectors[3][n]);
  386. end;
  387. ArrayToState(tempStateArray);
  388. // NormalizeQuaternion(AngularOrientation);
  389. // tempState.Free();
  390. end;
  391. procedure TDESolverEuler.Solve(DeltaTime: Real);
  392. var
  393. i, j: Integer;
  394. tempState, tempStateDot: TStateArray;
  395. // force1:TAffineVector;
  396. Inertia1: TGLBaseInertia;
  397. tempForce: TAffineVector;
  398. // UnDampedMomentum,DampedMomentum:Real;
  399. begin
  400. {$IFDEF DEBUG}
  401. Write('Euler integration');
  402. {$ENDIF}
  403. for i := 0 to Owner.fInertias.Count - 1 do
  404. begin
  405. Inertia1 := TGLBaseInertia(Owner.fInertias.Items[i]);
  406. // TGLRigidBodyInertia(FObjects.Items[i]).SetTorque(0,0,0);
  407. for j := 0 to Owner.fForceFieldEmitters.Count - 1 do
  408. begin
  409. Inertia1.CalculateForceFieldForce
  410. (TGLBaseForceFieldEmitter(Owner.fForceFieldEmitters.Items[j]));
  411. // Inertia1.ApplyForce(TGLForceFieldEmitter(FForceFieldEmitters.Items[j]).CalculateForceField(Inertia1.OwnerBaseSceneObject));
  412. end;
  413. end;
  414. for i := 0 to Owner.Forces.Count - 1 do
  415. begin
  416. { force1:= } Owner.Forces.Force[i].CalculateForce();
  417. end;
  418. tempState := StateToArray();
  419. tempStateDot := CalcStateDot();
  420. for i := 0 to StateSize - 1 do
  421. tempState[i] := tempState[i] + DeltaTime * tempStateDot[i];
  422. ArrayToState(tempState);
  423. for i := 0 to Owner.fInertias.Count - 1 do
  424. begin
  425. // TGLInertia(FObjects.Items[i]).SetForce(0,0,0);
  426. Inertia1 := TGLBaseInertia(Owner.fInertias.Items[i]);
  427. if Inertia1.DampingEnabled = true then
  428. begin
  429. // UnDampedMomentum:=VectorLength(Inertia1.TranslationSpeed.AsAffineVector);
  430. // DampedMomentum:= Inertia1.TranslationDamping.Calculate(UnDampedMomentum,deltaTime);
  431. // if UnDampedMomentum<>0 then
  432. begin
  433. // ScaleVector(Inertia1.TranslationSpeed.AsAffineVector,DampedMomentum/UnDampedMomentum);
  434. // ScaleVector(Inertia1.LinearMomentum,DampedMomentum/UnDampedMomentum);
  435. end;
  436. // Inertia1.TranslationDamping.Calculate(VectorLength(Inertia1.LinearMomentum),deltaTime);
  437. end;
  438. Inertia1.CalcAuxiliary();
  439. Inertia1.RemoveForces();
  440. end;
  441. // NormalizeQuaternion(AngularOrientation);
  442. end;
  443. constructor TGLPhysManager.Create(aOwner: TComponent);
  444. begin
  445. inherited Create(aOwner);
  446. fInertias := TList.Create();
  447. fForceFieldEmitters := TList.Create();
  448. fForces := TGLForces.Create(Self);
  449. SetDESolver(ssEuler);
  450. ///RegisterManager(Self);
  451. end;
  452. destructor TGLPhysManager.Destroy;
  453. begin
  454. // fScene:=nil;
  455. DeRegisterAllInertias();
  456. DeRegisterAllForceFieldEmitters();
  457. /// DeRegisterManager(Self);
  458. fInertias.Free();
  459. fForceFieldEmitters.Free();
  460. fForces.Free();
  461. inherited Destroy;
  462. end;
  463. procedure TGLPhysManager.Assign(Source: TPersistent);
  464. begin
  465. inherited Assign(Source);
  466. end;
  467. procedure TGLPhysManager.SetDESolver(SolverType: TDESolverType);
  468. var
  469. tempSolver: TDESolver;
  470. begin
  471. if Assigned(DESolver) then
  472. begin
  473. if (fDESolverType <> SolverType) then
  474. case SolverType of
  475. ssRungeKutta4:
  476. begin
  477. // DESolver:=RungeKutta4;
  478. end;
  479. ssEuler:
  480. begin
  481. // DESolver:=Euler;
  482. end;
  483. end;
  484. end
  485. else
  486. begin
  487. // if (fDESolverType<>SolverType) then
  488. case SolverType of
  489. ssRungeKutta4:
  490. begin
  491. DESolver := TDESolverRungeKutta4.Create(Self);
  492. end;
  493. ssEuler:
  494. begin
  495. DESolver := TDESolverEuler.Create(Self);
  496. end;
  497. end;
  498. fDESolverType := SolverType;
  499. end;
  500. end;
  501. procedure TGLPhysManager.RegisterInertia(aInertia: TGLBaseInertia);
  502. begin
  503. if Assigned(aInertia) then
  504. if fInertias.IndexOf(aInertia) < 0 then
  505. begin
  506. fInertias.Add(aInertia);
  507. aInertia.FManager := Self;
  508. DESolver.StateSize := DESolver.StateSize + aInertia.StateSize;
  509. SetLength(DESolver.StateArray, DESolver.StateSize);
  510. end;
  511. end;
  512. procedure TGLPhysManager.DeRegisterInertia(aInertia: TGLBaseInertia);
  513. begin
  514. if Assigned(aInertia) then
  515. begin
  516. aInertia.FManager := nil;
  517. fInertias.Remove(aInertia);
  518. DESolver.StateSize := DESolver.StateSize - aInertia.StateSize;
  519. SetLength(DESolver.StateArray, DESolver.StateSize);
  520. end;
  521. end;
  522. procedure TGLPhysManager.DeRegisterAllInertias;
  523. var
  524. i: Integer;
  525. begin
  526. // Fast deregistration
  527. for i := 0 to fInertias.Count - 1 do
  528. TGLBaseInertia(fInertias[i]).FManager := nil;
  529. fInertias.Clear;
  530. DESolver.StateSize := 0;
  531. // SetLEngth(StateArray,0);
  532. end;
  533. procedure TGLPhysManager.RegisterForceFieldEmitter
  534. (aForceField: TGLBaseForceFieldEmitter);
  535. begin
  536. if Assigned(aForceField) then
  537. if fForceFieldEmitters.IndexOf(aForceField) < 0 then
  538. begin
  539. fForceFieldEmitters.Add(aForceField);
  540. aForceField.FManager := Self;
  541. end;
  542. end;
  543. procedure TGLPhysManager.DeRegisterForceFieldEmitter
  544. (aForceField: TGLBaseForceFieldEmitter);
  545. begin
  546. if Assigned(aForceField) then
  547. begin
  548. aForceField.FManager := nil;
  549. fForceFieldEmitters.Remove(aForceField);
  550. end;
  551. end;
  552. procedure TGLPhysManager.DeRegisterAllForceFieldEmitters;
  553. var
  554. i: Integer;
  555. begin
  556. // Fast deregistration
  557. for i := 0 to fForceFieldEmitters.Count - 1 do
  558. TGLBaseForceFieldEmitter(fForceFieldEmitters[i]).FManager := nil;
  559. fForceFieldEmitters.Clear;
  560. end;
  561. function TGLPhysManager.CalculateKE(): Real;
  562. var
  563. Total: Real;
  564. i: Integer;
  565. begin
  566. Total := 0;
  567. for i := 0 to fInertias.Count - 1 do
  568. begin
  569. // calculate fInertias[i] KE
  570. Total := Total + TGLBaseInertia(fInertias.Items[i]).CalculateKE();
  571. end;
  572. Result := Total;
  573. end;
  574. function TGLPhysManager.CalculatePE(): Real;
  575. var
  576. Total: Real;
  577. i: Integer;
  578. begin
  579. Total := 0;
  580. for i := 0 to fInertias.Count - 1 do
  581. begin
  582. // calculate fobject[i] PE
  583. Total := Total + TGLBaseInertia(fInertias.Items[i]).CalculatePE();
  584. end;
  585. Result := Total;
  586. end;
  587. procedure TGLPhysManager.CalculateNextState(DeltaTime: Real);
  588. begin
  589. if Assigned(DESolver) then
  590. DESolver.Solve(DeltaTime);
  591. end;
  592. constructor TGLForces.Create(aOwner: TPersistent);
  593. begin
  594. // Assert(aOwner is TGLBaseSceneObject);
  595. inherited Create(aOwner);
  596. end;
  597. { destructor TGLForces.Destroy;
  598. begin
  599. inherited Destroy;
  600. end;
  601. }
  602. class function TGLForces.ItemsClass: TXCollectionItemClass;
  603. begin
  604. Result := TGLForce;
  605. end;
  606. function TGLForces.GetForce(index: Integer): TGLForce;
  607. begin
  608. Result := TGLForce(Items[index]);
  609. end;
  610. function TGLForces.CanAdd(aClass: TXCollectionItemClass): Boolean;
  611. begin
  612. Result := { (not aClass.InheritsFrom(TGLEffect)) and }
  613. (inherited CanAdd(aClass));
  614. end;
  615. // -----------------------------------------------------------------------------
  616. procedure TGLBaseInertia.SetManager(const val: TGLPhysManager);
  617. begin
  618. if val <> FManager then
  619. begin
  620. if Assigned(FManager) then
  621. FManager.DeRegisterInertia(Self);
  622. if Assigned(val) then
  623. val.RegisterInertia(Self);
  624. // Write(val.GetNamePath);
  625. end;
  626. end;
  627. procedure TGLBaseInertia.Loaded;
  628. var
  629. mng: TComponent;
  630. begin
  631. inherited;
  632. if FManagerName <> '' then
  633. begin
  634. ///? mng := FindManager(TGLPhysManager, FManagerName);
  635. if Assigned(mng) then
  636. Manager := TGLPhysManager(mng);
  637. FManagerName := '';
  638. end;
  639. end;
  640. procedure TGLBaseInertia.WriteToFiler(writer: TWriter);
  641. begin
  642. inherited;
  643. with writer do
  644. begin
  645. WriteInteger(0); // Archive Version 0
  646. WriteBoolean(FDampingEnabled);
  647. if Assigned(FManager) then
  648. WriteString(FManager.GetNamePath)
  649. else
  650. WriteString('');
  651. end;
  652. end;
  653. procedure TGLBaseInertia.ReadFromFiler(reader: TReader);
  654. begin
  655. inherited;
  656. with reader do
  657. begin
  658. ReadInteger; // ignore archiveVersion
  659. FDampingEnabled := ReadBoolean;
  660. FManagerName := ReadString;
  661. Manager := nil;
  662. end;
  663. // Loaded; //DB100
  664. end;
  665. constructor TGLBaseInertia.Create(aOwner: TXCollection);
  666. begin
  667. inherited Create(aOwner);
  668. FDampingEnabled := true;
  669. end;
  670. destructor TGLBaseInertia.Destroy;
  671. begin
  672. SetManager(nil);
  673. inherited Destroy;
  674. end;
  675. procedure TGLBaseInertia.Assign(Source: TPersistent);
  676. begin
  677. if Source.ClassType = Self.ClassType then
  678. begin
  679. StateSize := TGLBaseInertia(Source).StateSize;
  680. FDampingEnabled := TGLBaseInertia(Source).DampingEnabled;
  681. Manager := TGLBaseInertia(Source).Manager;
  682. end;
  683. inherited Assign(Source);
  684. end;
  685. procedure TGLBaseInertia.StateToArray(var StateArray: TStateArray;
  686. StatePos: Integer);
  687. begin
  688. end;
  689. procedure TGLBaseInertia.ArrayToState( { var } StateArray: TStateArray;
  690. StatePos: Integer);
  691. begin
  692. end;
  693. procedure TGLBaseInertia.CalcStateDot(var StateArray: TStateArray;
  694. StatePos: Integer);
  695. begin
  696. end;
  697. procedure TGLBaseInertia.RemoveForces();
  698. begin
  699. end;
  700. procedure TGLBaseInertia.CalculateForceFieldForce(ForceFieldEmitter
  701. : TGLBaseForceFieldEmitter);
  702. begin
  703. end;
  704. function TGLBaseInertia.CalculateKE(): Real;
  705. begin
  706. Result := 0;
  707. end;
  708. function TGLBaseInertia.CalculatePE(): Real;
  709. begin
  710. Result := 0;
  711. end;
  712. procedure TGLBaseInertia.CalcAuxiliary();
  713. begin
  714. end;
  715. procedure TGLBaseInertia.SetUpStartingState();
  716. begin
  717. end;
  718. // -----------------------------------------------------------------------------
  719. procedure TGLBaseForceFieldEmitter.SetManager(const val: TGLPhysManager);
  720. begin
  721. if val <> FManager then
  722. begin
  723. if Assigned(FManager) then
  724. FManager.DeRegisterForceFieldEmitter(Self);
  725. if Assigned(val) then
  726. val.RegisterForceFieldEmitter(Self);
  727. end;
  728. end;
  729. procedure TGLBaseForceFieldEmitter.Loaded;
  730. var
  731. mng: TComponent;
  732. begin
  733. inherited;
  734. if FManagerName <> '' then
  735. begin
  736. ///? mng := FindManager(TGLPhysManager, FManagerName);
  737. if Assigned(mng) then
  738. Manager := TGLPhysManager(mng);
  739. FManagerName := '';
  740. end;
  741. end;
  742. procedure TGLBaseForceFieldEmitter.WriteToFiler(writer: TWriter);
  743. begin
  744. inherited; // Dan Bartlett
  745. with writer do
  746. begin
  747. WriteInteger(0); // Archive Version 0
  748. if Assigned(FManager) then
  749. WriteString(FManager.GetNamePath)
  750. else
  751. WriteString('');
  752. end;
  753. end;
  754. procedure TGLBaseForceFieldEmitter.ReadFromFiler(reader: TReader);
  755. begin
  756. inherited;
  757. with reader do
  758. begin
  759. ReadInteger; // ignore archiveVersion
  760. FManagerName := ReadString;
  761. Manager := nil;
  762. end;
  763. // Loaded; //DB100
  764. end;
  765. constructor TGLBaseForceFieldEmitter.Create(aOwner: TXCollection);
  766. begin
  767. inherited Create(aOwner);
  768. end;
  769. destructor TGLBaseForceFieldEmitter.Destroy;
  770. begin
  771. SetManager(nil);
  772. inherited Destroy;
  773. end;
  774. procedure TGLBaseForceFieldEmitter.Assign(Source: TPersistent);
  775. begin
  776. if Source.ClassType = Self.ClassType then
  777. begin
  778. Manager := TGLBaseForceFieldEmitter(Source).Manager;
  779. end;
  780. inherited Assign(Source);
  781. end;
  782. // CalculateForceField
  783. function TGLBaseForceFieldEmitter.CalculateForceField(Body: TGLBaseSceneObject)
  784. : TAffineVector;
  785. begin
  786. Result := nullVector;
  787. end;
  788. // ------------------------------------------------------------------
  789. initialization
  790. // ------------------------------------------------------------------
  791. // RegisterClasses([TGLForces]);
  792. // RegisterClasses([TGLPhysManager, TGLBaseInertia, TGLBaseForceFieldEmitter]);
  793. // RegisterXCollectionItemClass(TGLBaseInertia);
  794. // RegisterXCollectionItemClass(TGLBaseForceFieldEmitter);
  795. // RegisterXCollectionItemClass(TGLPhysicsForce);
  796. end.