GLS.DCE.pas 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.DCE;
  5. (*
  6. Dynamic Collision Engine
  7. How to use:
  8. - Add a DCEManager to you form and configure its properties
  9. - Add a Dynamic Collision Behavior to you object
  10. - Add a Static Collision behaviour to objects which yours will collide
  11. - You can choose the shape of your static object
  12. - csEllipsoid, csBox
  13. - csFreeform MUST BE A TGLFreeform, otherwise will raise errors
  14. - csTerrain MUST BE A TGLTerrainRenderer, same condition above
  15. - Active: Disable or enable the behaviour for this object
  16. - Friction: is a value aprox. between 0 (no friction) and 100 (no movement)
  17. - Layer: An object collides only with lower or equal layers
  18. - Size: is used for Ellipsoids (Radius) / Boxes (Dimensions)
  19. - Solid: Object still generate collision events but it doesn't "block" the dynamic object
  20. - UseGravity: You can disable the gravity for that object
  21. - SlideOrBounce: The object can bounce like a ball or slide like an FPS
  22. - BounceFactor: Restituition factor, 1 means that it will bounce forever
  23. *)
  24. interface
  25. {$I Stage.Defines.inc}
  26. uses
  27. System.Classes,
  28. System.SysUtils,
  29. System.Types,
  30. Stage.VectorTypes,
  31. Stage.VectorGeometry,
  32. GLS.BaseClasses,
  33. GLS.Coordinates,
  34. Stage.Manager,
  35. GLS.XCollection,
  36. GLS.VectorLists,
  37. GLS.Scene,
  38. GLS.VectorFileObjects,
  39. GLS.EllipseCollision,
  40. GLS.TerrainRenderer,
  41. GLS.ProxyObjects,
  42. GLS.MultiProxy,
  43. Stage.Strings;
  44. type
  45. // Only csEllipsoid can have dynamic behaviour
  46. TDCEShape = (csEllipsoid, csBox, csFreeform, csTerrain);
  47. (* Indicates which type of layer comparison is made when trying to detect
  48. collisions between 2 bodies (A and B). Possible values are:
  49. ccsDCEStandard: Collides bodies if A.layer <= B.layer
  50. ccsCollisionStandard: Collides bodies if either A or B have
  51. layer equal to zero or if their layers are different.
  52. ccsHybrid: Collides bodies if either one of the previous
  53. checks would pass (i.e. if the layer of either body is
  54. equal to 0 or if A.layer <= B.layer) *and* if both
  55. layers are positive (that is, turns off collision
  56. for bodies whose layer is < 0) *)
  57. TDCECollisionSelection = (ccsDCEStandard, ccsCollisionStandard, ccsHybrid);
  58. TDCECollision = record
  59. Position: TAffineVector;
  60. Normal: TAffineVector; // Surface normal
  61. Bounce: TAffineVector; // Surface reflection
  62. Nearest: Boolean;
  63. RootCollision: Boolean;
  64. Distance: single;
  65. end;
  66. TGLDCEStatic = class;
  67. TGLDCEDynamic = class;
  68. TDCECollisionEvent = procedure(Sender: TObject;
  69. object1, object2: TGLBaseSceneObject; CollisionInfo: TDCECollision)
  70. of object;
  71. TDCEObjectCollisionEvent = procedure(Sender: TObject;
  72. ObjectCollided: TGLBaseSceneObject; CollisionInfo: TDCECollision) of object;
  73. // The Dynamic Collision Engine Manager class
  74. TGLDCEManager = class(TComponent)
  75. private
  76. FStatics: TList;
  77. FDynamics: TList;
  78. FGravity: single;
  79. FWorldDirection: TGLCoordinates; // Used to calculate jumps f.i.
  80. FWorldScale: single;
  81. FMovimentScale: single;
  82. FStandardiseLayers: TDCECollisionSelection;
  83. FManualStep: Boolean;
  84. FOnCollision: TDCECollisionEvent;
  85. procedure SetWorldDirection(const Value: TGLCoordinates);
  86. procedure SetWorldScale(const Value: single);
  87. function GetDynamicCount: Integer;
  88. function GetStaticCount: Integer;
  89. protected
  90. procedure RegisterStatic(aClient: TGLDCEStatic);
  91. procedure DeRegisterStatic(aClient: TGLDCEStatic);
  92. procedure DeRegisterAllStatics;
  93. procedure RegisterDynamic(aClient: TGLDCEDynamic);
  94. procedure DeRegisterDynamic(aClient: TGLDCEDynamic);
  95. procedure DeRegisterAllDynamics;
  96. public
  97. constructor Create(AOwner: TComponent); override;
  98. destructor Destroy; override;
  99. // Moves the body by the distance and returns the average friction
  100. function MoveByDistance(var Body: TGLDCEDynamic;
  101. deltaS, deltaAbsS: TAffineVector): single;
  102. procedure Step(deltaTime: Double);
  103. property DynamicCount: Integer read GetDynamicCount;
  104. property StaticCount: Integer read GetStaticCount;
  105. published
  106. property Gravity: single read FGravity write FGravity;
  107. property WorldDirection: TGLCoordinates read FWorldDirection
  108. write SetWorldDirection;
  109. property WorldScale: single read FWorldScale write SetWorldScale;
  110. property MovimentScale: single read FMovimentScale write FMovimentScale;
  111. Property StandardiseLayers: TDCECollisionSelection read FStandardiseLayers
  112. write FStandardiseLayers;
  113. Property ManualStep: Boolean read FManualStep write FManualStep;
  114. property OnCollision: TDCECollisionEvent read FOnCollision
  115. write FOnCollision;
  116. end;
  117. TGLDCEStatic = class(TGLBehaviour)
  118. private
  119. FManager: TGLDCEManager;
  120. FManagerName: String; // NOT persistent, temporarily used for persistence
  121. FActive: Boolean;
  122. FShape: TDCEShape;
  123. // Collides only with lower or equal layers
  124. FLayer: Integer;
  125. // Collide and slide if true, otherwise it "walk thru walls"
  126. FSolid: Boolean;
  127. FFriction: single; // 0 (no friction); 100 (no movement)
  128. FBounceFactor: single; // 0 (don't bounce); 1 (bounce forever)
  129. FSize: TGLCoordinates;
  130. // Events
  131. FOnCollision: TDCEObjectCollisionEvent;
  132. procedure SetShape(const Value: TDCEShape);
  133. procedure SetFriction(const Value: single);
  134. procedure SetBounceFactor(const Value: single);
  135. procedure SetSize(const Value: TGLCoordinates);
  136. protected
  137. procedure SetManager(const val: TGLDCEManager);
  138. procedure WriteToFiler(writer: TWriter); override;
  139. procedure ReadFromFiler(reader: TReader); override;
  140. procedure Loaded; override;
  141. public
  142. constructor Create(AOwner: TXCollection); override;
  143. destructor Destroy; override;
  144. procedure Assign(Source: TPersistent); override;
  145. class function FriendlyName: String; override;
  146. class function FriendlyDescription: String; override;
  147. property OnCollision: TDCEObjectCollisionEvent read FOnCollision
  148. write FOnCollision;
  149. published
  150. property Active: Boolean read FActive write FActive;
  151. property Manager: TGLDCEManager read FManager write SetManager;
  152. property Shape: TDCEShape read FShape write SetShape;
  153. property Layer: Integer read FLayer write FLayer;
  154. property Solid: Boolean read FSolid write FSolid;
  155. property Friction: single read FFriction write SetFriction;
  156. property BounceFactor: single read FBounceFactor write SetBounceFactor;
  157. property Size: TGLCoordinates read FSize write SetSize;
  158. end;
  159. TDCESlideOrBounce = (csbSlide, csbBounce);
  160. TGLDCEDynamic = class(TGLBehaviour)
  161. private
  162. FManager: TGLDCEManager;
  163. FManagerName: String; // NOT persistent, temporarily used for persistence
  164. FActive: Boolean;
  165. FUseGravity: Boolean;
  166. FLayer: Integer; // Collides only with lower or equal layers
  167. FSolid: Boolean;
  168. // Collide and slide if true, otherwise it "walk thru walls"
  169. FFriction: single; // 0 (no friction); 100 (no movement)
  170. FBounceFactor: single; // 0 (don't bounce); 1 (bounce forever)
  171. FSize: TGLCoordinates;
  172. // Number of iterations of the collision method
  173. FMaxRecursionDepth: byte;
  174. FSlideOrBounce: TDCESlideOrBounce; // gak20041122
  175. // Movement
  176. FAccel: TAffineVector; // Current acceleration
  177. FSpeed: TAffineVector; // Current speed
  178. FAbsAccel: TAffineVector; // Current absolute accel
  179. FAbsSpeed: TAffineVector; // Current absolute speed
  180. FGravSpeed: TAffineVector; // Current gravity speed
  181. FTotalFriction: single; // Current sum of all contatcs friction
  182. FInGround: Boolean;
  183. FGroundNormal: TAffineVector;
  184. FJumpHeight, FJumpForce, FJumpSpeed: single;
  185. FJumping: Boolean;
  186. // Events
  187. FOnCollision: TDCEObjectCollisionEvent;
  188. procedure SetFriction(const Value: single);
  189. procedure SetBounceFactor(const Value: single);
  190. procedure SetSize(const Value: TGLCoordinates);
  191. protected
  192. procedure SetManager(const val: TGLDCEManager);
  193. procedure WriteToFiler(writer: TWriter); override;
  194. procedure ReadFromFiler(reader: TReader); override;
  195. procedure Loaded; override;
  196. public
  197. constructor Create(AOwner: TXCollection); override;
  198. destructor Destroy; override;
  199. procedure Assign(Source: TPersistent); override;
  200. class function FriendlyName: String; override;
  201. class function FriendlyDescription: String; override;
  202. procedure ApplyAccel(NewAccel: TAffineVector); overload;
  203. procedure ApplyAccel(x, y, z: single); overload;
  204. procedure ApplyAbsAccel(NewAccel: TAffineVector); overload;
  205. procedure ApplyAbsAccel(x, y, z: single); overload;
  206. procedure StopAccel;
  207. procedure StopAbsAccel;
  208. procedure Jump(jHeight, jSpeed: single);
  209. procedure Move(deltaS: TAffineVector; deltaTime: Double);
  210. procedure MoveTo(Position: TAffineVector; Amount: single);
  211. procedure DoMove(deltaTime: Double);
  212. procedure DoProgress(const progressTime: TGLProgressTimes); override;
  213. // Runtime only
  214. property Speed: TAffineVector read FSpeed write FSpeed;
  215. property InGround: Boolean read FInGround;
  216. property MaxRecursionDepth: byte read FMaxRecursionDepth
  217. write FMaxRecursionDepth;
  218. property OnCollision: TDCEObjectCollisionEvent read FOnCollision
  219. write FOnCollision;
  220. published
  221. property Active: Boolean read FActive write FActive;
  222. property Manager: TGLDCEManager read FManager write SetManager;
  223. property UseGravity: Boolean read FUseGravity write FUseGravity;
  224. property Layer: Integer read FLayer write FLayer;
  225. property Solid: Boolean read FSolid write FSolid;
  226. property Friction: single read FFriction write SetFriction;
  227. property BounceFactor: single read FBounceFactor write SetBounceFactor;
  228. property Size: TGLCoordinates read FSize write SetSize;
  229. property SlideOrBounce: TDCESlideOrBounce read FSlideOrBounce
  230. write FSlideOrBounce;
  231. end;
  232. // ---------------------- DCE Misc functions ---------------------------
  233. // Calculate and set the collision range
  234. procedure ECSetCollisionRange(var MovePack: TECMovePack);
  235. // Set the collider lists to null
  236. procedure ECResetColliders(var MovePack: TECMovePack);
  237. // Add freeform's octree data
  238. procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TGLBaseSceneObject;
  239. Solid: Boolean; ObjectID: Integer);
  240. // Add a TriMesh box
  241. procedure ECAddBox(var MovePack: TECMovePack; BoxObj: TGLBaseSceneObject;
  242. BoxSize: TAffineVector; Solid: Boolean; ObjectID: Integer);
  243. // Add the terrain as a TriMesh
  244. procedure ECAddTerrain(var MovePack: TECMovePack;
  245. TerrainRenderer: TGLTerrainRenderer; Resolution: single; Solid: Boolean;
  246. ObjectID: Integer);
  247. // Add a static ellipsoid
  248. procedure ECAddEllipsoid(var MovePack: TECMovePack;
  249. ePos, eRadius: TAffineVector; Solid: Boolean; ObjectID: Integer);
  250. function GetOrCreateDCEStatic(behaviours: TGLBehaviours): TGLDCEStatic;
  251. overload;
  252. function GetOrCreateDCEStatic(obj: TGLBaseSceneObject): TGLDCEStatic; overload;
  253. function GetOrCreateDCEDynamic(behaviours: TGLBehaviours)
  254. : TGLDCEDynamic; overload;
  255. function GetOrCreateDCEDynamic(obj: TGLBaseSceneObject): TGLDCEDynamic;
  256. overload;
  257. const
  258. DCEBox: array [0 .. 35] of TAffineVector = ((x: 1; y: - 1; z: - 1), (x: 1;
  259. y: 1; z: - 1), (x: 1; y: - 1; z: 1), (x: 1; y: 1; z: - 1), (x: 1; y: 1;
  260. z: 1), (x: 1; y: - 1; z: 1), (x: 1; y: 1; z: - 1), (x: - 1; y: 1; z: - 1),
  261. (x: - 1; y: 1; z: 1), (x: 1; y: 1; z: 1), (x: 1; y: 1; z: - 1), (x: - 1;
  262. y: 1; z: 1), (x: - 1; y: 1; z: 1), (x: - 1; y: - 1; z: 1), (x: 1; y: - 1;
  263. z: 1), (x: 1; y: 1; z: 1), (x: - 1; y: 1; z: 1), (x: 1; y: - 1; z: 1),
  264. (x: - 1; y: - 1; z: 1), (x: - 1; y: 1; z: 1), (x: - 1; y: 1; z: - 1),
  265. (x: - 1; y: - 1; z: - 1), (x: - 1; y: - 1; z: 1), (x: - 1; y: 1; z: - 1),
  266. (x: 1; y: - 1; z: 1), (x: - 1; y: - 1; z: 1), (x: 1; y: - 1; z: - 1),
  267. (x: - 1; y: - 1; z: 1), (x: - 1; y: - 1; z: - 1), (x: 1; y: - 1; z: - 1),
  268. (x: 1; y: 1; z: - 1), (x: 1; y: - 1; z: - 1), (x: - 1; y: 1; z: - 1), (x: 1;
  269. y: - 1; z: - 1), (x: - 1; y: - 1; z: - 1), (x: - 1; y: 1; z: - 1));
  270. // ----------------------------------------------------------------
  271. implementation
  272. // ----------------------------------------------------------------
  273. // ------------------------ DCE Misc -----------------------------
  274. procedure ECSetCollisionRange(var MovePack: TECMovePack);
  275. var
  276. N: TAffineVector;
  277. begin
  278. N.x := Abs(MovePack.Velocity.x) + Abs(MovePack.Gravity.x) +
  279. (MovePack.Radius.x);
  280. N.y := Abs(MovePack.Velocity.y) + Abs(MovePack.Gravity.y) +
  281. (MovePack.Radius.y);
  282. N.z := Abs(MovePack.Velocity.z) + Abs(MovePack.Gravity.z) +
  283. (MovePack.Radius.z);
  284. MovePack.CollisionRange := MaxXYZComponent(N);
  285. end;
  286. procedure ECResetColliders(var MovePack: TECMovePack);
  287. begin
  288. SetLength(MovePack.TriMeshes, 0);
  289. SetLength(MovePack.Freeforms, 0);
  290. SetLength(MovePack.Colliders, 0);
  291. end;
  292. procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TGLBaseSceneObject;
  293. Solid: Boolean; ObjectID: Integer);
  294. var
  295. i, count: Integer;
  296. Pos: TGLVector;
  297. Master: TGLBaseSceneObject;
  298. d1, d2: single;
  299. begin
  300. Master := FreeForm;
  301. if Master is TGLFreeFormProxy then
  302. Master := TGLFreeFormProxy(Master).MasterObject;
  303. if Master is TGLMultiProxy then
  304. if TGLMultiProxy(Master).MasterObjects.count > 0 then
  305. Master := TGLMultiProxy(Master).MasterObjects[0].MasterObject;
  306. Assert((Master is TGLFreeForm),
  307. 'Object must be freeform, freeformproxy or freeformbased Multiproxy.');
  308. Assert(Assigned(TGLFreeForm(Master).Octree),
  309. 'Octree must have been prepared and setup before use.');
  310. SetVector(Pos, FreeForm.AbsoluteToLocal(MovePack.Position));
  311. // Is in boundingsphere?
  312. d1 := VectorDistance2(MovePack.Position,
  313. AffineVectorMake(FreeForm.AbsolutePosition));
  314. d2 := sqr(MovePack.CollisionRange + FreeForm.BoundingSphereRadius);
  315. if d1 > d2 then
  316. exit;
  317. count := Length(MovePack.Freeforms);
  318. with TGLFreeForm(Master).Octree do
  319. begin
  320. WalkSphereToLeaf(RootNode, Pos, MovePack.CollisionRange);
  321. if not Assigned(resultarray) then
  322. exit;
  323. // Copy the result array
  324. SetLength(MovePack.Freeforms, count + 1);
  325. SetLength(MovePack.Freeforms[count].OctreeNodes, Length(resultarray));
  326. for i := 0 to High(resultarray) do
  327. MovePack.Freeforms[count].OctreeNodes[i] := resultarray[i];
  328. // Reference to this octree
  329. MovePack.Freeforms[count].triangleFiler := @triangleFiler;
  330. MovePack.Freeforms[count].ObjectInfo.AbsoluteMatrix :=
  331. FreeForm.AbsoluteMatrix;
  332. MovePack.Freeforms[count].ObjectInfo.Solid := Solid;
  333. MovePack.Freeforms[count].ObjectInfo.ObjectID := ObjectID;
  334. MovePack.Freeforms[count].InvertedNormals := TGLFreeForm(Master)
  335. .NormalsOrientation = mnoInvert;
  336. end;
  337. end;
  338. procedure ECAddBox(var MovePack: TECMovePack; BoxObj: TGLBaseSceneObject;
  339. BoxSize: TAffineVector; Solid: Boolean; ObjectID: Integer);
  340. var
  341. t, count, i: Integer;
  342. p1, p2, p3: TAffineVector;
  343. BoxRadius, d1, d2: single;
  344. begin
  345. BoxRadius := MaxXYZComponent(BoxSize) *
  346. MaxXYZComponent(BoxObj.Scale.AsAffineVector);
  347. d1 := VectorDistance2(MovePack.Position,
  348. AffineVectorMake(BoxObj.AbsolutePosition));
  349. d2 := sqr(MovePack.CollisionRange + BoxRadius);
  350. if d1 > d2 then
  351. exit;
  352. // Add the box to the triangle list
  353. t := Length(MovePack.TriMeshes);
  354. SetLength(MovePack.TriMeshes, t + 1);
  355. ScaleVector(BoxSize, 0.5);
  356. count := 0;
  357. i := 0;
  358. while i < 36 do
  359. begin
  360. count := count + 1;
  361. SetLength(MovePack.TriMeshes[t].Triangles, count);
  362. with MovePack.TriMeshes[t] do
  363. begin
  364. p1 := DCEBox[i];
  365. ScaleVector(p1, BoxSize);
  366. p1 := BoxObj.LocalToAbsolute(p1);
  367. p2 := DCEBox[i + 1];
  368. ScaleVector(p2, BoxSize);
  369. p2 := BoxObj.LocalToAbsolute(p2);
  370. p3 := DCEBox[i + 2];
  371. ScaleVector(p3, BoxSize);
  372. p3 := BoxObj.LocalToAbsolute(p3);
  373. i := i + 3;
  374. SetVector(Triangles[count - 1].p1, p1);
  375. SetVector(Triangles[count - 1].p2, p2);
  376. SetVector(Triangles[count - 1].p3, p3);
  377. ObjectInfo.Solid := Solid;
  378. ObjectInfo.ObjectID := ObjectID;
  379. end;
  380. end;
  381. end;
  382. procedure ECAddTerrain(var MovePack: TECMovePack;
  383. TerrainRenderer: TGLTerrainRenderer; Resolution: single; Solid: Boolean;
  384. ObjectID: Integer);
  385. function intvec(x, z: single): TAffineVector;
  386. begin
  387. result.x := x + MovePack.Position.x;
  388. result.y := 0 + MovePack.Position.y;
  389. result.z := z + MovePack.Position.z;
  390. end;
  391. function locabs(x, y, z: single): TAffineVector;
  392. begin
  393. // result := TerrainRenderer.LocalToAbsolute(AffineVectorMake(x,y,z));
  394. // result := AffineVectorMake(x,y,z);
  395. result.x := x + MovePack.Position.x;
  396. result.y := y + TerrainRenderer.AbsolutePosition.y;
  397. result.z := z + MovePack.Position.z;
  398. end;
  399. var
  400. count, t: Integer;
  401. x, y, z: single;
  402. begin
  403. // Add the terrain to the list
  404. count := Length(MovePack.TriMeshes);
  405. SetLength(MovePack.TriMeshes, count + 1);
  406. with MovePack.TriMeshes[count] do
  407. begin
  408. ObjectInfo.Solid := Solid;
  409. ObjectInfo.ObjectID := ObjectID;
  410. t := 0;
  411. x := -MovePack.CollisionRange;
  412. while x < MovePack.CollisionRange do
  413. begin
  414. z := -MovePack.CollisionRange;
  415. while z < MovePack.CollisionRange do
  416. begin
  417. // Add 2 triangles
  418. t := t + 2;
  419. SetLength(Triangles, t);
  420. // Tri 1
  421. y := TerrainRenderer.InterpolatedHeight(intvec(x, z));
  422. Triangles[t - 2].p1 := locabs(x, y, z);
  423. y := TerrainRenderer.InterpolatedHeight(intvec(x, z + Resolution));
  424. Triangles[t - 2].p2 := locabs(x, y, z + Resolution);
  425. y := TerrainRenderer.InterpolatedHeight(intvec(x + Resolution, z));
  426. Triangles[t - 2].p3 := locabs(x + Resolution, y, z);
  427. // Tri 2
  428. y := TerrainRenderer.InterpolatedHeight
  429. (intvec(x + Resolution, z + Resolution));
  430. Triangles[t - 1].p1 := locabs(x + Resolution, y, z + Resolution);
  431. y := TerrainRenderer.InterpolatedHeight(intvec(x + Resolution, z));
  432. Triangles[t - 1].p2 := locabs(x + Resolution, y, z);
  433. y := TerrainRenderer.InterpolatedHeight(intvec(x, z + Resolution));
  434. Triangles[t - 1].p3 := locabs(x, y, z + Resolution);
  435. z := z + Resolution;
  436. end;
  437. x := x + Resolution;
  438. end;
  439. end;
  440. end;
  441. procedure ECAddEllipsoid(var MovePack: TECMovePack;
  442. ePos, eRadius: TAffineVector; Solid: Boolean; ObjectID: Integer);
  443. var
  444. count: Integer;
  445. d1, d2, r: single;
  446. begin
  447. r := MaxXYZComponent(eRadius);
  448. d1 := VectorDistance2(MovePack.Position, ePos);
  449. d2 := sqr(MovePack.CollisionRange + r);
  450. if d1 > d2 then
  451. exit;
  452. // Add possible collider
  453. count := Length(MovePack.Colliders);
  454. SetLength(MovePack.Colliders, count + 1);
  455. with MovePack.Colliders[count] do
  456. begin
  457. Position := ePos;
  458. Radius := eRadius;
  459. ObjectInfo.Solid := Solid;
  460. ObjectInfo.ObjectID := ObjectID;
  461. end;
  462. end;
  463. // --------------------------- DCE ---------------------------------
  464. function RotateVectorByObject(obj: TGLBaseSceneObject; const v: TAffineVector)
  465. : TAffineVector;
  466. var
  467. v2: TGLVector;
  468. begin
  469. SetVector(v2, v);
  470. SetVector(result, VectorTransform(v2, obj.Matrix^));
  471. end;
  472. constructor TGLDCEManager.Create(AOwner: TComponent);
  473. begin
  474. inherited Create(AOwner);
  475. FStatics := TList.Create;
  476. FDynamics := TList.Create;
  477. FGravity := 0;
  478. FWorldDirection := TGLCoordinates.CreateInitialized(Self, YHmgVector,
  479. csVector);
  480. FWorldScale := 1;
  481. FMovimentScale := 1;
  482. FStandardiseLayers := ccsDCEStandard;
  483. FManualStep := False;
  484. RegisterManager(Self);
  485. end;
  486. destructor TGLDCEManager.Destroy;
  487. begin
  488. DeRegisterAllStatics;
  489. DeRegisterAllDynamics;
  490. DeRegisterManager(Self);
  491. FStatics.Free;
  492. FDynamics.Free;
  493. FWorldDirection.Free;
  494. inherited Destroy;
  495. end;
  496. function TGLDCEManager.GetDynamicCount: Integer;
  497. begin
  498. result := FDynamics.count;
  499. end;
  500. function TGLDCEManager.GetStaticCount: Integer;
  501. begin
  502. result := FStatics.count;
  503. end;
  504. function TGLDCEManager.MoveByDistance(var Body: TGLDCEDynamic;
  505. deltaS, deltaAbsS: TAffineVector): single;
  506. var
  507. // Friction and bounce
  508. TotalFriction, Bounce, f, m, restitution: single;
  509. ContactList: TGLIntegerList;
  510. // Temporary properties (Static or Dynamic)
  511. tFriction, tBounceFactor: single;
  512. TObject: TGLBaseSceneObject;
  513. // Collision results
  514. ColInfo: TDCECollision;
  515. lastobj: Integer;
  516. i, oi: Integer;
  517. MP: TECMovePack;
  518. CanCollide, GravCollided: Boolean;
  519. // Vars used to calculate high velocities
  520. ColRange, MaxRange: single;
  521. dCR, dT, deltaCR: Double;
  522. begin
  523. // Set collider parameters
  524. MP.Radius := Body.Size.AsAffineVector;
  525. MP.Position := AffineVectorMake(Body.OwnerBaseSceneObject.AbsolutePosition);
  526. MP.Velocity := deltaS;
  527. MP.Gravity := deltaAbsS;
  528. MP.ObjectInfo.Solid := Body.Solid;
  529. MP.UnitScale := FWorldScale;
  530. MP.MaxRecursionDepth := Body.MaxRecursionDepth;
  531. // Get collision range, if it is too big separate into small pieces
  532. ECSetCollisionRange(MP);
  533. ColRange := MP.CollisionRange;
  534. deltaCR := ColRange;
  535. MaxRange := MaxXYZComponent(MP.Radius) * 2.1;
  536. SetLength(MP.Contacts, 0);
  537. GravCollided := False; // Is colliding with the ground
  538. Body.FGroundNormal := NullVector;
  539. while deltaCR > 0 do
  540. begin
  541. if deltaCR > MaxRange then
  542. begin
  543. dCR := MaxRange;
  544. deltaCR := deltaCR - MaxRange;
  545. end
  546. else
  547. begin
  548. dCR := deltaCR;
  549. deltaCR := 0;
  550. end;
  551. dT := dCR / ColRange;
  552. MP.Velocity := VectorScale(deltaS, dT);
  553. MP.Gravity := VectorScale(deltaAbsS, dT);
  554. ECSetCollisionRange(MP);
  555. ECResetColliders(MP);
  556. // For each static collider
  557. for i := 0 to FStatics.count - 1 do
  558. with TGLDCEStatic(FStatics[i]) do
  559. begin
  560. CanCollide := False;
  561. if (Active) then
  562. case FStandardiseLayers of
  563. ccsDCEStandard:
  564. CanCollide := (Layer <= Body.Layer);
  565. ccsCollisionStandard:
  566. CanCollide := (Layer = 0) or (Body.Layer = 0) or
  567. (Layer <> Body.Layer);
  568. ccsHybrid:
  569. CanCollide := ((Layer = 0) or (Body.Layer = 0) or
  570. (Layer <= Body.Layer)) and (Layer >= 0) and (Body.Layer >= 0);
  571. end;
  572. // Add colliders to move pack
  573. if CanCollide then
  574. begin
  575. case Shape of
  576. csFreeform:
  577. ECAddFreeForm(MP, OwnerBaseSceneObject, Solid, i);
  578. csEllipsoid:
  579. ECAddEllipsoid(MP,
  580. AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
  581. Size.AsAffineVector, Solid, i);
  582. csBox:
  583. ECAddBox(MP, OwnerBaseSceneObject, Size.AsAffineVector, Solid, i);
  584. csTerrain:
  585. ECAddTerrain(MP, TGLTerrainRenderer(OwnerBaseSceneObject),
  586. FWorldScale * 2, Solid, i);
  587. end;
  588. end;
  589. end;
  590. // For each dynamic collider add a static ellipsoid
  591. for i := 0 to FDynamics.count - 1 do
  592. with TGLDCEDynamic(FDynamics[i]) do
  593. begin
  594. CanCollide := False;
  595. if (Active) and (TGLDCEDynamic(FDynamics[i]) <> Body) then
  596. case FStandardiseLayers of
  597. ccsDCEStandard:
  598. CanCollide := (Layer <= Body.Layer);
  599. ccsCollisionStandard:
  600. CanCollide := (Layer = 0) or (Body.Layer = 0) or
  601. (Layer <> Body.Layer);
  602. ccsHybrid:
  603. CanCollide := ((Layer = 0) or (Body.Layer = 0) or
  604. (Layer <= Body.Layer)) and (Layer >= 0) and (Body.Layer >= 0);
  605. end;
  606. // Add collider to move pack
  607. // To differ from static it is added with a negative ID (id < 0)
  608. if CanCollide then
  609. ECAddEllipsoid(MP,
  610. AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
  611. Size.AsAffineVector, Solid, -1 - i);
  612. end;
  613. CollideAndSlide(MP);
  614. if MP.GravityCollided then
  615. begin
  616. GravCollided := True;
  617. Body.FGroundNormal := MP.GroundNormal;
  618. end;
  619. MP.Position := MP.ResultPos;
  620. end;
  621. // Set the result
  622. Body.OwnerBaseSceneObject.AbsolutePosition := VectorMake(MP.ResultPos);
  623. Body.FInGround := GravCollided;
  624. // Generate events and calculate average friction
  625. lastobj := -1;
  626. TotalFriction := Body.Friction;
  627. ContactList := TGLIntegerList.Create;
  628. try
  629. for i := 0 to High(MP.Contacts) do
  630. with MP do
  631. begin
  632. oi := Contacts[i].ObjectInfo.ObjectID;
  633. // Don't repeat objects with same ID
  634. if ContactList.IndexOf(oi) >= 0 then
  635. Continue
  636. else
  637. ContactList.Add(oi);
  638. // Check if it is static or dynamic
  639. if oi < 0 then
  640. begin
  641. tFriction := TGLDCEDynamic(FDynamics[System.Abs(oi) - 1]).Friction;
  642. tBounceFactor := TGLDCEDynamic(FDynamics[System.Abs(oi) - 1])
  643. .BounceFactor;
  644. TObject := TGLDCEDynamic(FDynamics[System.Abs(oi) - 1])
  645. .OwnerBaseSceneObject;
  646. end
  647. else
  648. begin
  649. tFriction := TGLDCEStatic(FStatics[oi]).Friction;
  650. tBounceFactor := TGLDCEStatic(FStatics[oi]).BounceFactor;
  651. TObject := TGLDCEStatic(FStatics[oi]).OwnerBaseSceneObject;
  652. end;
  653. TotalFriction := TotalFriction + tFriction;
  654. ColInfo.Position := Contacts[i].Position;
  655. ColInfo.Normal := Contacts[i].SurfaceNormal;
  656. ColInfo.Bounce := VectorNormalize
  657. (VectorReflect(VectorAdd(deltaS, deltaAbsS), ColInfo.Normal));
  658. ColInfo.Nearest := oi = MP.NearestObject;
  659. // Calculate bounce
  660. if (Body.SlideOrBounce = csbBounce) and ColInfo.Nearest then
  661. begin
  662. Bounce := VectorDotProduct(Body.FSpeed, ColInfo.Normal);
  663. if Bounce < 0 then
  664. begin
  665. restitution := (Body.BounceFactor + tBounceFactor) / 2;
  666. m := VectorLength(Body.FSpeed);
  667. f := -Bounce / VectorNorm(ColInfo.Normal) * (1 + restitution);
  668. CombineVector(Body.FSpeed, ColInfo.Normal, f);
  669. // Limit bounce speed
  670. if VectorLength(Body.FSpeed) > m * 2 then
  671. Body.FSpeed := NullVector;
  672. end;
  673. Bounce := VectorDotProduct(Body.FAbsSpeed, ColInfo.Normal);
  674. if Bounce < 0 then
  675. begin
  676. restitution := (Body.BounceFactor + tBounceFactor) / 2;
  677. m := VectorLength(Body.FAbsSpeed);
  678. f := -Bounce / VectorNorm(ColInfo.Normal) * (1 + restitution);
  679. CombineVector(Body.FAbsSpeed, ColInfo.Normal, f);
  680. // Limit
  681. if VectorLength(Body.FAbsSpeed) > m * 2 then
  682. Body.FAbsSpeed := NullVector;
  683. end;
  684. Bounce := VectorDotProduct(Body.FGravSpeed, ColInfo.Normal);
  685. if Bounce < 0 then
  686. begin
  687. restitution := (Body.BounceFactor + tBounceFactor) / 2;
  688. m := VectorLength(Body.FGravSpeed);
  689. f := -Bounce / VectorNorm(ColInfo.Normal) * (1 + restitution);
  690. CombineVector(Body.FGravSpeed, ColInfo.Normal, f);
  691. // Limit
  692. if VectorLength(Body.FGravSpeed) > m * 2 then
  693. Body.FGravSpeed := NullVector;
  694. end;
  695. end;
  696. ColInfo.RootCollision := (lastobj <> oi);
  697. ColInfo.Distance := Contacts[i].Distance;
  698. lastobj := oi;
  699. if Assigned(FOnCollision) then
  700. FOnCollision(Self, Body.OwnerBaseSceneObject, TObject, ColInfo);
  701. if Assigned(Body.FOnCollision) then
  702. Body.FOnCollision(Self, TObject, ColInfo);
  703. if Assigned(Body.FOnCollision) then
  704. Body.FOnCollision(Self, TObject, ColInfo);
  705. // If the collided object is static trigger its event
  706. if (oi >= 0) and Assigned(TGLDCEStatic(FStatics[oi]).FOnCollision) then
  707. TGLDCEStatic(FStatics[oi]).FOnCollision(Self,
  708. Body.OwnerBaseSceneObject, ColInfo);
  709. end;
  710. finally
  711. ContactList.Free;
  712. end;
  713. result := TotalFriction;
  714. end;
  715. procedure TGLDCEManager.Step(deltaTime: Double);
  716. var
  717. i: Integer;
  718. begin
  719. if deltaTime > 0.1 then
  720. deltaTime := 0.1;
  721. for i := 0 to FDynamics.count - 1 do
  722. with TGLDCEDynamic(FDynamics[i]) do
  723. if Active then
  724. DoMove(deltaTime);
  725. end;
  726. procedure TGLDCEManager.SetWorldDirection(const Value: TGLCoordinates);
  727. begin
  728. FWorldDirection := Value;
  729. FWorldDirection.Normalize;
  730. end;
  731. procedure TGLDCEManager.SetWorldScale(const Value: single);
  732. begin
  733. if Value = 0 then
  734. FWorldScale := 0.001
  735. else if Value < 0 then
  736. FWorldScale := Abs(Value)
  737. else
  738. FWorldScale := Value;
  739. end;
  740. procedure TGLDCEManager.RegisterStatic(aClient: TGLDCEStatic);
  741. begin
  742. if Assigned(aClient) then
  743. if FStatics.IndexOf(aClient) < 0 then
  744. begin
  745. FStatics.Add(aClient);
  746. aClient.FManager := Self;
  747. end;
  748. end;
  749. procedure TGLDCEManager.DeRegisterStatic(aClient: TGLDCEStatic);
  750. begin
  751. if Assigned(aClient) then
  752. begin
  753. aClient.FManager := nil;
  754. FStatics.Remove(aClient);
  755. end;
  756. end;
  757. procedure TGLDCEManager.DeRegisterAllStatics;
  758. var
  759. i: Integer;
  760. begin
  761. // Fast deregistration
  762. for i := 0 to FStatics.count - 1 do
  763. TGLDCEStatic(FStatics[i]).FManager := nil;
  764. FStatics.Clear;
  765. end;
  766. procedure TGLDCEManager.RegisterDynamic(aClient: TGLDCEDynamic);
  767. begin
  768. if Assigned(aClient) then
  769. if FDynamics.IndexOf(aClient) < 0 then
  770. begin
  771. FDynamics.Add(aClient);
  772. aClient.FManager := Self;
  773. end;
  774. end;
  775. procedure TGLDCEManager.DeRegisterDynamic(aClient: TGLDCEDynamic);
  776. begin
  777. if Assigned(aClient) then
  778. begin
  779. aClient.FManager := nil;
  780. FDynamics.Remove(aClient);
  781. end;
  782. end;
  783. procedure TGLDCEManager.DeRegisterAllDynamics;
  784. var
  785. i: Integer;
  786. begin
  787. // Fast deregistration
  788. for i := 0 to FDynamics.count - 1 do
  789. TGLDCEDynamic(FDynamics[i]).FManager := nil;
  790. FDynamics.Clear;
  791. end;
  792. // ---------------------
  793. // TGLDCEStatic
  794. // ---------------------
  795. procedure TGLDCEStatic.Assign(Source: TPersistent);
  796. begin
  797. if Source is TGLDCEStatic then
  798. begin
  799. Active := TGLDCEStatic(Source).Active;
  800. Manager := TGLDCEStatic(Source).Manager;
  801. Shape := TGLDCEStatic(Source).Shape;
  802. Layer := TGLDCEStatic(Source).Layer;
  803. Solid := TGLDCEStatic(Source).Solid;
  804. Size.Assign(TGLDCEStatic(Source).Size);
  805. Friction := TGLDCEStatic(Source).Friction;
  806. BounceFactor := TGLDCEStatic(Source).BounceFactor;
  807. end;
  808. inherited Assign(Source);
  809. end;
  810. constructor TGLDCEStatic.Create(AOwner: TXCollection);
  811. begin
  812. inherited Create(AOwner);
  813. FActive := True;
  814. FSize := TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
  815. FShape := csEllipsoid;
  816. FSolid := True;
  817. FFriction := 1;
  818. FBounceFactor := 0;
  819. end;
  820. destructor TGLDCEStatic.Destroy;
  821. begin
  822. Manager := nil;
  823. FSize.Free;
  824. inherited Destroy;
  825. end;
  826. class function TGLDCEStatic.FriendlyDescription: String;
  827. begin
  828. result := 'Static Collision-detection registration';
  829. end;
  830. class function TGLDCEStatic.FriendlyName: String;
  831. begin
  832. result := 'DCE Static Collider';
  833. end;
  834. procedure TGLDCEStatic.Loaded;
  835. var
  836. mng: TComponent;
  837. begin
  838. inherited;
  839. if FManagerName <> '' then
  840. begin
  841. mng := FindManager(TGLDCEManager, FManagerName);
  842. if Assigned(mng) then
  843. Manager := TGLDCEManager(mng);
  844. FManagerName := '';
  845. end;
  846. end;
  847. procedure TGLDCEStatic.WriteToFiler(writer: TWriter);
  848. begin
  849. with writer do
  850. begin
  851. // ArchiveVersion 1, added inherited call
  852. WriteInteger(1);
  853. inherited;
  854. if Assigned(FManager) then
  855. WriteString(FManager.GetNamePath)
  856. else
  857. WriteString('');
  858. WriteInteger(Integer(FShape));
  859. WriteInteger(FLayer);
  860. WriteBoolean(FSolid);
  861. WriteBoolean(FActive);
  862. WriteSingle(FFriction);
  863. WriteSingle(FBounceFactor);
  864. FSize.WriteToFiler(writer);
  865. end;
  866. end;
  867. procedure TGLDCEStatic.ReadFromFiler(reader: TReader);
  868. var
  869. archiveVersion: Integer;
  870. begin
  871. with reader do
  872. begin
  873. archiveVersion := ReadInteger;
  874. Assert(archiveVersion in [0 .. 1]);
  875. if archiveVersion >= 1 then
  876. inherited;
  877. FManagerName := ReadString;
  878. Manager := nil;
  879. FShape := TDCEShape(ReadInteger);
  880. FLayer := ReadInteger;
  881. FSolid := ReadBoolean;
  882. FActive := ReadBoolean;
  883. FFriction := ReadSingle;
  884. FBounceFactor := ReadSingle;
  885. FSize.ReadFromFiler(reader);
  886. end;
  887. end;
  888. procedure TGLDCEStatic.SetBounceFactor(const Value: single);
  889. begin
  890. FBounceFactor := Value;
  891. if FBounceFactor < 0 then
  892. FBounceFactor := 0;
  893. if FBounceFactor > 1 then
  894. FBounceFactor := 1;
  895. end;
  896. procedure TGLDCEStatic.SetFriction(const Value: single);
  897. begin
  898. FFriction := Value;
  899. if FFriction < 0 then
  900. FFriction := 0;
  901. if FFriction > 100 then
  902. FFriction := 100;
  903. end;
  904. procedure TGLDCEStatic.SetManager(const val: TGLDCEManager);
  905. begin
  906. if val <> FManager then
  907. begin
  908. if Assigned(FManager) then
  909. FManager.DeRegisterStatic(Self);
  910. if Assigned(val) then
  911. val.RegisterStatic(Self);
  912. end;
  913. end;
  914. procedure TGLDCEStatic.SetShape(const Value: TDCEShape);
  915. begin
  916. FShape := Value;
  917. end;
  918. procedure TGLDCEStatic.SetSize(const Value: TGLCoordinates);
  919. begin
  920. FSize.Assign(Value);
  921. if FSize.x <= 0 then
  922. FSize.x := 0.1;
  923. if FSize.y <= 0 then
  924. FSize.y := 0.1;
  925. if FSize.z <= 0 then
  926. FSize.z := 0.1;
  927. end;
  928. //-----------------------------
  929. // TGLDCEDynamic
  930. //-----------------------------
  931. procedure TGLDCEDynamic.ApplyAccel(NewAccel: TAffineVector);
  932. begin
  933. AddVector(FAccel, NewAccel);
  934. end;
  935. procedure TGLDCEDynamic.ApplyAccel(x, y, z: single);
  936. begin
  937. AddVector(FAccel, AffineVectorMake(x, y, z));
  938. end;
  939. procedure TGLDCEDynamic.ApplyAbsAccel(NewAccel: TAffineVector);
  940. begin
  941. AddVector(FAbsAccel, NewAccel);
  942. end;
  943. procedure TGLDCEDynamic.ApplyAbsAccel(x, y, z: single);
  944. begin
  945. AddVector(FAbsAccel, AffineVectorMake(x, y, z));
  946. end;
  947. procedure TGLDCEDynamic.StopAccel;
  948. begin
  949. SetVector(FAccel, NullVector);
  950. end;
  951. procedure TGLDCEDynamic.StopAbsAccel;
  952. begin
  953. SetVector(FAbsAccel, NullVector);
  954. end;
  955. procedure TGLDCEDynamic.Assign(Source: TPersistent);
  956. begin
  957. if Source is TGLDCEDynamic then
  958. begin
  959. Manager := TGLDCEDynamic(Source).Manager;
  960. Active := TGLDCEDynamic(Source).Active;
  961. UseGravity := TGLDCEDynamic(Source).UseGravity;
  962. Layer := TGLDCEDynamic(Source).Layer;
  963. Solid := TGLDCEDynamic(Source).Solid;
  964. Size.Assign(TGLDCEDynamic(Source).Size);
  965. Friction := TGLDCEDynamic(Source).Friction;
  966. BounceFactor := TGLDCEDynamic(Source).BounceFactor;
  967. SlideOrBounce := TGLDCEDynamic(Source).SlideOrBounce;
  968. MaxRecursionDepth := TGLDCEDynamic(Source).MaxRecursionDepth;
  969. end;
  970. inherited Assign(Source);
  971. end;
  972. constructor TGLDCEDynamic.Create(AOwner: TXCollection);
  973. begin
  974. inherited Create(AOwner);
  975. FActive := True;
  976. FUseGravity := True;
  977. FSize := TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
  978. FSolid := True;
  979. FFriction := 1;
  980. FBounceFactor := 0;
  981. FMaxRecursionDepth := 5;
  982. FSlideOrBounce := csbSlide;
  983. FInGround := False;
  984. FAccel := NullVector;
  985. FAbsAccel := NullVector;
  986. FSpeed := NullVector;
  987. FAbsSpeed := NullVector;
  988. FGravSpeed := NullVector;
  989. end;
  990. destructor TGLDCEDynamic.Destroy;
  991. begin
  992. Manager := nil;
  993. FSize.Free;
  994. inherited Destroy;
  995. end;
  996. procedure TGLDCEDynamic.DoMove(deltaTime: Double);
  997. var
  998. fGround, fAir, G: single;
  999. v, deltaS, deltaAbsS: TAffineVector;
  1000. procedure Accel(var aSpeed: TAffineVector; aFric: single;
  1001. aForce: TAffineVector);
  1002. begin
  1003. ScaleVector(aForce, deltaTime);
  1004. ScaleVector(aSpeed, aFric);
  1005. aSpeed := VectorAdd(aForce, aSpeed);
  1006. end;
  1007. begin
  1008. if (FSlideOrBounce = csbBounce) then
  1009. FAccel := RotateVectorByObject(OwnerBaseSceneObject, FAccel);
  1010. // Ground friction
  1011. fGround := 1 - deltaTime * FTotalFriction;
  1012. if fGround < 0 then
  1013. fGround := 0;
  1014. // Air friction
  1015. fAir := 1 - deltaTime * FFriction;
  1016. if fAir < 0 then
  1017. fAir := 0;
  1018. if FUseGravity and (not FInGround) then
  1019. ScaleVector(FAccel, 0.01);
  1020. // v = TIME * force + max(1-TIME*Friction,0) * v;
  1021. Accel(FSpeed, fGround, FAccel);
  1022. Accel(FAbsSpeed, fGround, FAbsAccel);
  1023. (* FSpeed[0] := deltaTime * FAccel[0] + fGround * FSpeed[0];
  1024. FSpeed[1] := deltaTime * FAccel[1] + fGround * FSpeed[1];
  1025. FSpeed[2] := deltaTime * FAccel[2] + fGround * FSpeed[2];
  1026. FAbsSpeed[0] := deltaTime * FAbsAccel[0] + fGround * FAbsSpeed[0];
  1027. FAbsSpeed[1] := deltaTime * FAbsAccel[1] + fGround * FAbsSpeed[1];
  1028. FAbsSpeed[2] := deltaTime * FAbsAccel[2] + fGround * FAbsSpeed[2]; *)
  1029. if FUseGravity then
  1030. begin
  1031. // Calculate gravity acceleration
  1032. if FInGround then
  1033. G := FManager.Gravity * Abs(1 - VectorDotProduct(FGroundNormal,
  1034. FManager.WorldDirection.AsAffineVector))
  1035. else
  1036. G := FManager.Gravity;
  1037. if FJumping then
  1038. G := 0;
  1039. v := VectorScale(FManager.WorldDirection.AsAffineVector, G);
  1040. Accel(FGravSpeed, fAir, v);
  1041. (* FGravSpeed[0] := deltaTime * v[0] + fAir * FGravSpeed[0];
  1042. FGravSpeed[1] := deltaTime * v[1] + fAir * FGravSpeed[1];
  1043. FGravSpeed[2] := deltaTime * v[2] + fAir * FGravSpeed[2]; *)
  1044. end
  1045. else
  1046. FGravSpeed := NullVector;
  1047. if FJumping then
  1048. begin
  1049. FJumpSpeed := FJumpForce;
  1050. FJumpHeight := FJumpHeight - (FJumpSpeed * deltaTime);
  1051. FJumping := FJumpHeight > 0;
  1052. if FJumping then
  1053. FGravSpeed := NullVector
  1054. else
  1055. begin
  1056. v := VectorScale(FManager.WorldDirection.AsAffineVector, FJumpSpeed);
  1057. AddVector(FGravSpeed, v);
  1058. FJumpForce := 0;
  1059. FJumpSpeed := 0;
  1060. end;
  1061. end;
  1062. // s = s0 + vt (add relative speed)
  1063. if FSlideOrBounce = csbBounce then
  1064. deltaS := FSpeed
  1065. else
  1066. deltaS := RotateVectorByObject(OwnerBaseSceneObject, FSpeed);
  1067. // Add absolute speed
  1068. AddVector(deltaS, FAbsSpeed);
  1069. // Add jump speed
  1070. v := VectorScale(FManager.WorldDirection.AsAffineVector, FJumpSpeed);
  1071. AddVector(deltaS, v);
  1072. (* The absolute space must be only the gravity
  1073. so it can calculate when it is in the ground *)
  1074. deltaAbsS := FGravSpeed;
  1075. ScaleVector(deltaS, deltaTime);
  1076. ScaleVector(deltaAbsS, deltaTime);
  1077. // Returns the friction of all collided objects
  1078. FTotalFriction := FManager.MoveByDistance(Self, deltaS, deltaAbsS);
  1079. FAccel := NullVector;
  1080. FAbsAccel := NullVector;
  1081. end;
  1082. procedure TGLDCEDynamic.DoProgress(const progressTime: TGLProgressTimes);
  1083. begin
  1084. inherited DoProgress(progressTime);
  1085. Assert(Assigned(Manager), 'DCE Manager not assigned to behaviour.');
  1086. if (not FManager.ManualStep) and FActive then
  1087. begin
  1088. if progressTime.deltaTime > 0.1 then
  1089. DoMove(0.1)
  1090. else
  1091. DoMove(progressTime.deltaTime);
  1092. end;
  1093. end;
  1094. class function TGLDCEDynamic.FriendlyDescription: String;
  1095. begin
  1096. result := 'Dynamic Collision-detection registration';
  1097. end;
  1098. class function TGLDCEDynamic.FriendlyName: String;
  1099. begin
  1100. result := 'DCE Dynamic Collider';
  1101. end;
  1102. procedure TGLDCEDynamic.Jump(jHeight, jSpeed: single);
  1103. begin
  1104. if (not FJumping) and (FInGround) and
  1105. (VectorDotProduct(FGroundNormal, FManager.WorldDirection.AsAffineVector)
  1106. > 0.5) then
  1107. begin
  1108. FJumpHeight := jHeight;
  1109. FJumpForce := jSpeed;
  1110. FJumpSpeed := FJumpForce;
  1111. FJumping := True;
  1112. FInGround := False;
  1113. AddVector(FAbsSpeed, RotateVectorByObject(OwnerBaseSceneObject, FSpeed));
  1114. FSpeed := NullVector;
  1115. end;
  1116. end;
  1117. procedure TGLDCEDynamic.Loaded;
  1118. var
  1119. mng: TComponent;
  1120. begin
  1121. inherited;
  1122. if FManagerName <> '' then
  1123. begin
  1124. mng := FindManager(TGLDCEManager, FManagerName);
  1125. if Assigned(mng) then
  1126. Manager := TGLDCEManager(mng);
  1127. FManagerName := '';
  1128. end;
  1129. end;
  1130. procedure TGLDCEDynamic.Move(deltaS: TAffineVector; deltaTime: Double);
  1131. begin
  1132. ScaleVector(deltaS, deltaTime);
  1133. FManager.MoveByDistance(Self, NullVector, deltaS);
  1134. end;
  1135. procedure TGLDCEDynamic.MoveTo(Position: TAffineVector; Amount: single);
  1136. begin
  1137. SubtractVector(Position,
  1138. AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition));
  1139. Move(Position, Amount);
  1140. end;
  1141. procedure TGLDCEDynamic.WriteToFiler(writer: TWriter);
  1142. begin
  1143. with writer do
  1144. begin
  1145. // ArchiveVersion 1, added inherited call
  1146. WriteInteger(1);
  1147. inherited;
  1148. if Assigned(FManager) then
  1149. WriteString(FManager.GetNamePath)
  1150. else
  1151. WriteString('');
  1152. WriteInteger(FLayer);
  1153. WriteBoolean(FSolid);
  1154. WriteBoolean(FActive);
  1155. WriteBoolean(FUseGravity);
  1156. WriteSingle(FFriction);
  1157. WriteSingle(FBounceFactor);
  1158. WriteInteger(FMaxRecursionDepth);
  1159. WriteInteger(ord(FSlideOrBounce));
  1160. FSize.WriteToFiler(writer);
  1161. end;
  1162. end;
  1163. procedure TGLDCEDynamic.ReadFromFiler(reader: TReader);
  1164. var
  1165. archiveVersion: Integer;
  1166. begin
  1167. with reader do
  1168. begin
  1169. archiveVersion := ReadInteger;
  1170. Assert(archiveVersion in [0 .. 1]);
  1171. if archiveVersion >= 1 then
  1172. inherited;
  1173. FManagerName := ReadString;
  1174. Manager := nil;
  1175. FLayer := ReadInteger;
  1176. FSolid := ReadBoolean;
  1177. FActive := ReadBoolean;
  1178. FUseGravity := ReadBoolean;
  1179. FFriction := ReadSingle;
  1180. FBounceFactor := ReadSingle;
  1181. FMaxRecursionDepth := ReadInteger;
  1182. FSlideOrBounce := TDCESlideOrBounce(ReadInteger);
  1183. FSize.ReadFromFiler(reader);
  1184. end;
  1185. end;
  1186. procedure TGLDCEDynamic.SetBounceFactor(const Value: single);
  1187. begin
  1188. FBounceFactor := Value;
  1189. if FBounceFactor < 0 then
  1190. FBounceFactor := 0;
  1191. if FBounceFactor > 1 then
  1192. FBounceFactor := 1;
  1193. end;
  1194. procedure TGLDCEDynamic.SetFriction(const Value: single);
  1195. begin
  1196. FFriction := Value;
  1197. if FFriction < 0 then
  1198. FFriction := 0;
  1199. if FFriction > 100 then
  1200. FFriction := 100;
  1201. end;
  1202. procedure TGLDCEDynamic.SetManager(const val: TGLDCEManager);
  1203. begin
  1204. if val <> FManager then
  1205. begin
  1206. if Assigned(FManager) then
  1207. FManager.DeRegisterDynamic(Self);
  1208. if Assigned(val) then
  1209. val.RegisterDynamic(Self);
  1210. end;
  1211. end;
  1212. procedure TGLDCEDynamic.SetSize(const Value: TGLCoordinates);
  1213. begin
  1214. FSize.Assign(Value);
  1215. if FSize.x <= 0 then
  1216. FSize.x := 0.1;
  1217. if FSize.y <= 0 then
  1218. FSize.y := 0.1;
  1219. if FSize.z <= 0 then
  1220. FSize.z := 0.1;
  1221. end;
  1222. // ----------------------------------------------------------------
  1223. function GetOrCreateDCEStatic(behaviours: TGLBehaviours): TGLDCEStatic;
  1224. var
  1225. i: Integer;
  1226. begin
  1227. i := behaviours.IndexOfClass(TGLDCEStatic);
  1228. if i >= 0 then
  1229. result := TGLDCEStatic(behaviours[i])
  1230. else
  1231. result := TGLDCEStatic.Create(behaviours);
  1232. end;
  1233. function GetOrCreateDCEStatic(obj: TGLBaseSceneObject): TGLDCEStatic;
  1234. begin
  1235. result := GetOrCreateDCEStatic(obj.behaviours);
  1236. end;
  1237. function GetOrCreateDCEDynamic(behaviours: TGLBehaviours): TGLDCEDynamic;
  1238. var
  1239. i: Integer;
  1240. begin
  1241. i := behaviours.IndexOfClass(TGLDCEDynamic);
  1242. if i >= 0 then
  1243. result := TGLDCEDynamic(behaviours[i])
  1244. else
  1245. result := TGLDCEDynamic.Create(behaviours);
  1246. end;
  1247. function GetOrCreateDCEDynamic(obj: TGLBaseSceneObject): TGLDCEDynamic;
  1248. begin
  1249. result := GetOrCreateDCEDynamic(obj.behaviours);
  1250. end;
  1251. // ------------------------------------------------------------------
  1252. initialization
  1253. // ------------------------------------------------------------------
  1254. // class registrations
  1255. RegisterXCollectionItemClass(TGLDCEStatic);
  1256. RegisterXCollectionItemClass(TGLDCEDynamic);
  1257. finalization
  1258. UnregisterXCollectionItemClass(TGLDCEStatic);
  1259. UnregisterXCollectionItemClass(TGLDCEDynamic);
  1260. end.