1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363 |
- //
- // The graphics engine GLScene
- //
- unit GLS.DCE;
- (*
- Dynamic Collision Engine
- How to use:
- - Add a DCEManager to you form and configure its properties
- - Add a Dynamic Collision Behavior to you object
- - Add a Static Collision behaviour to objects which yours will collide
- - You can choose the shape of your static object
- - csEllipsoid, csBox
- - csFreeform MUST BE A TGLFreeform, otherwise will raise errors
- - csTerrain MUST BE A TGLTerrainRenderer, same condition above
- - Active: Disable or enable the behaviour for this object
- - Friction: is a value aprox. between 0 (no friction) and 100 (no movement)
- - Layer: An object collides only with lower or equal layers
- - Size: is used for Ellipsoids (Radius) / Boxes (Dimensions)
- - Solid: Object still generate collision events but it doesn't "block" the dynamic object
- - UseGravity: You can disable the gravity for that object
- - SlideOrBounce: The object can bounce like a ball or slide like an FPS
- - BounceFactor: Restituition factor, 1 means that it will bounce forever
- *)
- interface
- {$I Stage.Defines.inc}
- uses
- System.Classes,
- System.SysUtils,
- System.Types,
- Stage.VectorTypes,
- Stage.VectorGeometry,
- GLS.BaseClasses,
- GLS.Coordinates,
- Stage.Manager,
- GLS.XCollection,
- GLS.VectorLists,
- GLS.Scene,
- GLS.VectorFileObjects,
- GLS.EllipseCollision,
- GLS.TerrainRenderer,
- GLS.ProxyObjects,
- GLS.MultiProxy,
- Stage.Strings;
- type
- // Only csEllipsoid can have dynamic behaviour
- TDCEShape = (csEllipsoid, csBox, csFreeform, csTerrain);
- (* Indicates which type of layer comparison is made when trying to detect
- collisions between 2 bodies (A and B). Possible values are:
- ccsDCEStandard: Collides bodies if A.layer <= B.layer
- ccsCollisionStandard: Collides bodies if either A or B have
- layer equal to zero or if their layers are different.
- ccsHybrid: Collides bodies if either one of the previous
- checks would pass (i.e. if the layer of either body is
- equal to 0 or if A.layer <= B.layer) *and* if both
- layers are positive (that is, turns off collision
- for bodies whose layer is < 0) *)
- TDCECollisionSelection = (ccsDCEStandard, ccsCollisionStandard, ccsHybrid);
- TDCECollision = record
- Position: TAffineVector;
- Normal: TAffineVector; // Surface normal
- Bounce: TAffineVector; // Surface reflection
- Nearest: Boolean;
- RootCollision: Boolean;
- Distance: single;
- end;
- TGLDCEStatic = class;
- TGLDCEDynamic = class;
- TDCECollisionEvent = procedure(Sender: TObject;
- object1, object2: TGLBaseSceneObject; CollisionInfo: TDCECollision)
- of object;
- TDCEObjectCollisionEvent = procedure(Sender: TObject;
- ObjectCollided: TGLBaseSceneObject; CollisionInfo: TDCECollision) of object;
- // The Dynamic Collision Engine Manager class
- TGLDCEManager = class(TComponent)
- private
- FStatics: TList;
- FDynamics: TList;
- FGravity: single;
- FWorldDirection: TGLCoordinates; // Used to calculate jumps f.i.
- FWorldScale: single;
- FMovimentScale: single;
- FStandardiseLayers: TDCECollisionSelection;
- FManualStep: Boolean;
- FOnCollision: TDCECollisionEvent;
- procedure SetWorldDirection(const Value: TGLCoordinates);
- procedure SetWorldScale(const Value: single);
- function GetDynamicCount: Integer;
- function GetStaticCount: Integer;
- protected
- procedure RegisterStatic(aClient: TGLDCEStatic);
- procedure DeRegisterStatic(aClient: TGLDCEStatic);
- procedure DeRegisterAllStatics;
- procedure RegisterDynamic(aClient: TGLDCEDynamic);
- procedure DeRegisterDynamic(aClient: TGLDCEDynamic);
- procedure DeRegisterAllDynamics;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- // Moves the body by the distance and returns the average friction
- function MoveByDistance(var Body: TGLDCEDynamic;
- deltaS, deltaAbsS: TAffineVector): single;
- procedure Step(deltaTime: Double);
- property DynamicCount: Integer read GetDynamicCount;
- property StaticCount: Integer read GetStaticCount;
- published
- property Gravity: single read FGravity write FGravity;
- property WorldDirection: TGLCoordinates read FWorldDirection
- write SetWorldDirection;
- property WorldScale: single read FWorldScale write SetWorldScale;
- property MovimentScale: single read FMovimentScale write FMovimentScale;
- Property StandardiseLayers: TDCECollisionSelection read FStandardiseLayers
- write FStandardiseLayers;
- Property ManualStep: Boolean read FManualStep write FManualStep;
- property OnCollision: TDCECollisionEvent read FOnCollision
- write FOnCollision;
- end;
- TGLDCEStatic = class(TGLBehaviour)
- private
- FManager: TGLDCEManager;
- FManagerName: String; // NOT persistent, temporarily used for persistence
- FActive: Boolean;
- FShape: TDCEShape;
- // Collides only with lower or equal layers
- FLayer: Integer;
- // Collide and slide if true, otherwise it "walk thru walls"
- FSolid: Boolean;
- FFriction: single; // 0 (no friction); 100 (no movement)
- FBounceFactor: single; // 0 (don't bounce); 1 (bounce forever)
- FSize: TGLCoordinates;
- // Events
- FOnCollision: TDCEObjectCollisionEvent;
- procedure SetShape(const Value: TDCEShape);
- procedure SetFriction(const Value: single);
- procedure SetBounceFactor(const Value: single);
- procedure SetSize(const Value: TGLCoordinates);
- protected
- procedure SetManager(const val: TGLDCEManager);
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure Loaded; override;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- property OnCollision: TDCEObjectCollisionEvent read FOnCollision
- write FOnCollision;
- published
- property Active: Boolean read FActive write FActive;
- property Manager: TGLDCEManager read FManager write SetManager;
- property Shape: TDCEShape read FShape write SetShape;
- property Layer: Integer read FLayer write FLayer;
- property Solid: Boolean read FSolid write FSolid;
- property Friction: single read FFriction write SetFriction;
- property BounceFactor: single read FBounceFactor write SetBounceFactor;
- property Size: TGLCoordinates read FSize write SetSize;
- end;
- TDCESlideOrBounce = (csbSlide, csbBounce);
- TGLDCEDynamic = class(TGLBehaviour)
- private
- FManager: TGLDCEManager;
- FManagerName: String; // NOT persistent, temporarily used for persistence
- FActive: Boolean;
- FUseGravity: Boolean;
- FLayer: Integer; // Collides only with lower or equal layers
- FSolid: Boolean;
- // Collide and slide if true, otherwise it "walk thru walls"
- FFriction: single; // 0 (no friction); 100 (no movement)
- FBounceFactor: single; // 0 (don't bounce); 1 (bounce forever)
- FSize: TGLCoordinates;
- // Number of iterations of the collision method
- FMaxRecursionDepth: byte;
- FSlideOrBounce: TDCESlideOrBounce; // gak20041122
- // Movement
- FAccel: TAffineVector; // Current acceleration
- FSpeed: TAffineVector; // Current speed
- FAbsAccel: TAffineVector; // Current absolute accel
- FAbsSpeed: TAffineVector; // Current absolute speed
- FGravSpeed: TAffineVector; // Current gravity speed
- FTotalFriction: single; // Current sum of all contatcs friction
- FInGround: Boolean;
- FGroundNormal: TAffineVector;
- FJumpHeight, FJumpForce, FJumpSpeed: single;
- FJumping: Boolean;
- // Events
- FOnCollision: TDCEObjectCollisionEvent;
- procedure SetFriction(const Value: single);
- procedure SetBounceFactor(const Value: single);
- procedure SetSize(const Value: TGLCoordinates);
- protected
- procedure SetManager(const val: TGLDCEManager);
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure Loaded; override;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- procedure ApplyAccel(NewAccel: TAffineVector); overload;
- procedure ApplyAccel(x, y, z: single); overload;
- procedure ApplyAbsAccel(NewAccel: TAffineVector); overload;
- procedure ApplyAbsAccel(x, y, z: single); overload;
- procedure StopAccel;
- procedure StopAbsAccel;
- procedure Jump(jHeight, jSpeed: single);
- procedure Move(deltaS: TAffineVector; deltaTime: Double);
- procedure MoveTo(Position: TAffineVector; Amount: single);
- procedure DoMove(deltaTime: Double);
- procedure DoProgress(const progressTime: TGLProgressTimes); override;
- // Runtime only
- property Speed: TAffineVector read FSpeed write FSpeed;
- property InGround: Boolean read FInGround;
- property MaxRecursionDepth: byte read FMaxRecursionDepth
- write FMaxRecursionDepth;
- property OnCollision: TDCEObjectCollisionEvent read FOnCollision
- write FOnCollision;
- published
- property Active: Boolean read FActive write FActive;
- property Manager: TGLDCEManager read FManager write SetManager;
- property UseGravity: Boolean read FUseGravity write FUseGravity;
- property Layer: Integer read FLayer write FLayer;
- property Solid: Boolean read FSolid write FSolid;
- property Friction: single read FFriction write SetFriction;
- property BounceFactor: single read FBounceFactor write SetBounceFactor;
- property Size: TGLCoordinates read FSize write SetSize;
- property SlideOrBounce: TDCESlideOrBounce read FSlideOrBounce
- write FSlideOrBounce;
- end;
- // ---------------------- DCE Misc functions ---------------------------
- // Calculate and set the collision range
- procedure ECSetCollisionRange(var MovePack: TECMovePack);
- // Set the collider lists to null
- procedure ECResetColliders(var MovePack: TECMovePack);
- // Add freeform's octree data
- procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TGLBaseSceneObject;
- Solid: Boolean; ObjectID: Integer);
- // Add a TriMesh box
- procedure ECAddBox(var MovePack: TECMovePack; BoxObj: TGLBaseSceneObject;
- BoxSize: TAffineVector; Solid: Boolean; ObjectID: Integer);
- // Add the terrain as a TriMesh
- procedure ECAddTerrain(var MovePack: TECMovePack;
- TerrainRenderer: TGLTerrainRenderer; Resolution: single; Solid: Boolean;
- ObjectID: Integer);
- // Add a static ellipsoid
- procedure ECAddEllipsoid(var MovePack: TECMovePack;
- ePos, eRadius: TAffineVector; Solid: Boolean; ObjectID: Integer);
- function GetOrCreateDCEStatic(behaviours: TGLBehaviours): TGLDCEStatic;
- overload;
- function GetOrCreateDCEStatic(obj: TGLBaseSceneObject): TGLDCEStatic; overload;
- function GetOrCreateDCEDynamic(behaviours: TGLBehaviours)
- : TGLDCEDynamic; overload;
- function GetOrCreateDCEDynamic(obj: TGLBaseSceneObject): TGLDCEDynamic;
- overload;
- const
- DCEBox: array [0 .. 35] of TAffineVector = ((x: 1; y: - 1; z: - 1), (x: 1;
- y: 1; z: - 1), (x: 1; y: - 1; z: 1), (x: 1; y: 1; z: - 1), (x: 1; y: 1;
- z: 1), (x: 1; y: - 1; z: 1), (x: 1; y: 1; z: - 1), (x: - 1; y: 1; z: - 1),
- (x: - 1; y: 1; z: 1), (x: 1; y: 1; z: 1), (x: 1; y: 1; z: - 1), (x: - 1;
- y: 1; z: 1), (x: - 1; y: 1; z: 1), (x: - 1; y: - 1; z: 1), (x: 1; y: - 1;
- z: 1), (x: 1; y: 1; z: 1), (x: - 1; y: 1; z: 1), (x: 1; y: - 1; z: 1),
- (x: - 1; y: - 1; z: 1), (x: - 1; y: 1; z: 1), (x: - 1; y: 1; z: - 1),
- (x: - 1; y: - 1; z: - 1), (x: - 1; y: - 1; z: 1), (x: - 1; y: 1; z: - 1),
- (x: 1; y: - 1; z: 1), (x: - 1; y: - 1; z: 1), (x: 1; y: - 1; z: - 1),
- (x: - 1; y: - 1; z: 1), (x: - 1; y: - 1; z: - 1), (x: 1; y: - 1; z: - 1),
- (x: 1; y: 1; z: - 1), (x: 1; y: - 1; z: - 1), (x: - 1; y: 1; z: - 1), (x: 1;
- y: - 1; z: - 1), (x: - 1; y: - 1; z: - 1), (x: - 1; y: 1; z: - 1));
- // ----------------------------------------------------------------
- implementation
- // ----------------------------------------------------------------
- // ------------------------ DCE Misc -----------------------------
- procedure ECSetCollisionRange(var MovePack: TECMovePack);
- var
- N: TAffineVector;
- begin
- N.x := Abs(MovePack.Velocity.x) + Abs(MovePack.Gravity.x) +
- (MovePack.Radius.x);
- N.y := Abs(MovePack.Velocity.y) + Abs(MovePack.Gravity.y) +
- (MovePack.Radius.y);
- N.z := Abs(MovePack.Velocity.z) + Abs(MovePack.Gravity.z) +
- (MovePack.Radius.z);
- MovePack.CollisionRange := MaxXYZComponent(N);
- end;
- procedure ECResetColliders(var MovePack: TECMovePack);
- begin
- SetLength(MovePack.TriMeshes, 0);
- SetLength(MovePack.Freeforms, 0);
- SetLength(MovePack.Colliders, 0);
- end;
- procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TGLBaseSceneObject;
- Solid: Boolean; ObjectID: Integer);
- var
- i, count: Integer;
- Pos: TGLVector;
- Master: TGLBaseSceneObject;
- d1, d2: single;
- begin
- Master := FreeForm;
- if Master is TGLFreeFormProxy then
- Master := TGLFreeFormProxy(Master).MasterObject;
- if Master is TGLMultiProxy then
- if TGLMultiProxy(Master).MasterObjects.count > 0 then
- Master := TGLMultiProxy(Master).MasterObjects[0].MasterObject;
- Assert((Master is TGLFreeForm),
- 'Object must be freeform, freeformproxy or freeformbased Multiproxy.');
- Assert(Assigned(TGLFreeForm(Master).Octree),
- 'Octree must have been prepared and setup before use.');
- SetVector(Pos, FreeForm.AbsoluteToLocal(MovePack.Position));
- // Is in boundingsphere?
- d1 := VectorDistance2(MovePack.Position,
- AffineVectorMake(FreeForm.AbsolutePosition));
- d2 := sqr(MovePack.CollisionRange + FreeForm.BoundingSphereRadius);
- if d1 > d2 then
- exit;
- count := Length(MovePack.Freeforms);
- with TGLFreeForm(Master).Octree do
- begin
- WalkSphereToLeaf(RootNode, Pos, MovePack.CollisionRange);
- if not Assigned(resultarray) then
- exit;
- // Copy the result array
- SetLength(MovePack.Freeforms, count + 1);
- SetLength(MovePack.Freeforms[count].OctreeNodes, Length(resultarray));
- for i := 0 to High(resultarray) do
- MovePack.Freeforms[count].OctreeNodes[i] := resultarray[i];
- // Reference to this octree
- MovePack.Freeforms[count].triangleFiler := @triangleFiler;
- MovePack.Freeforms[count].ObjectInfo.AbsoluteMatrix :=
- FreeForm.AbsoluteMatrix;
- MovePack.Freeforms[count].ObjectInfo.Solid := Solid;
- MovePack.Freeforms[count].ObjectInfo.ObjectID := ObjectID;
- MovePack.Freeforms[count].InvertedNormals := TGLFreeForm(Master)
- .NormalsOrientation = mnoInvert;
- end;
- end;
- procedure ECAddBox(var MovePack: TECMovePack; BoxObj: TGLBaseSceneObject;
- BoxSize: TAffineVector; Solid: Boolean; ObjectID: Integer);
- var
- t, count, i: Integer;
- p1, p2, p3: TAffineVector;
- BoxRadius, d1, d2: single;
- begin
- BoxRadius := MaxXYZComponent(BoxSize) *
- MaxXYZComponent(BoxObj.Scale.AsAffineVector);
- d1 := VectorDistance2(MovePack.Position,
- AffineVectorMake(BoxObj.AbsolutePosition));
- d2 := sqr(MovePack.CollisionRange + BoxRadius);
- if d1 > d2 then
- exit;
- // Add the box to the triangle list
- t := Length(MovePack.TriMeshes);
- SetLength(MovePack.TriMeshes, t + 1);
- ScaleVector(BoxSize, 0.5);
- count := 0;
- i := 0;
- while i < 36 do
- begin
- count := count + 1;
- SetLength(MovePack.TriMeshes[t].Triangles, count);
- with MovePack.TriMeshes[t] do
- begin
- p1 := DCEBox[i];
- ScaleVector(p1, BoxSize);
- p1 := BoxObj.LocalToAbsolute(p1);
- p2 := DCEBox[i + 1];
- ScaleVector(p2, BoxSize);
- p2 := BoxObj.LocalToAbsolute(p2);
- p3 := DCEBox[i + 2];
- ScaleVector(p3, BoxSize);
- p3 := BoxObj.LocalToAbsolute(p3);
- i := i + 3;
- SetVector(Triangles[count - 1].p1, p1);
- SetVector(Triangles[count - 1].p2, p2);
- SetVector(Triangles[count - 1].p3, p3);
- ObjectInfo.Solid := Solid;
- ObjectInfo.ObjectID := ObjectID;
- end;
- end;
- end;
- procedure ECAddTerrain(var MovePack: TECMovePack;
- TerrainRenderer: TGLTerrainRenderer; Resolution: single; Solid: Boolean;
- ObjectID: Integer);
- function intvec(x, z: single): TAffineVector;
- begin
- result.x := x + MovePack.Position.x;
- result.y := 0 + MovePack.Position.y;
- result.z := z + MovePack.Position.z;
- end;
- function locabs(x, y, z: single): TAffineVector;
- begin
- // result := TerrainRenderer.LocalToAbsolute(AffineVectorMake(x,y,z));
- // result := AffineVectorMake(x,y,z);
- result.x := x + MovePack.Position.x;
- result.y := y + TerrainRenderer.AbsolutePosition.y;
- result.z := z + MovePack.Position.z;
- end;
- var
- count, t: Integer;
- x, y, z: single;
- begin
- // Add the terrain to the list
- count := Length(MovePack.TriMeshes);
- SetLength(MovePack.TriMeshes, count + 1);
- with MovePack.TriMeshes[count] do
- begin
- ObjectInfo.Solid := Solid;
- ObjectInfo.ObjectID := ObjectID;
- t := 0;
- x := -MovePack.CollisionRange;
- while x < MovePack.CollisionRange do
- begin
- z := -MovePack.CollisionRange;
- while z < MovePack.CollisionRange do
- begin
- // Add 2 triangles
- t := t + 2;
- SetLength(Triangles, t);
- // Tri 1
- y := TerrainRenderer.InterpolatedHeight(intvec(x, z));
- Triangles[t - 2].p1 := locabs(x, y, z);
- y := TerrainRenderer.InterpolatedHeight(intvec(x, z + Resolution));
- Triangles[t - 2].p2 := locabs(x, y, z + Resolution);
- y := TerrainRenderer.InterpolatedHeight(intvec(x + Resolution, z));
- Triangles[t - 2].p3 := locabs(x + Resolution, y, z);
- // Tri 2
- y := TerrainRenderer.InterpolatedHeight
- (intvec(x + Resolution, z + Resolution));
- Triangles[t - 1].p1 := locabs(x + Resolution, y, z + Resolution);
- y := TerrainRenderer.InterpolatedHeight(intvec(x + Resolution, z));
- Triangles[t - 1].p2 := locabs(x + Resolution, y, z);
- y := TerrainRenderer.InterpolatedHeight(intvec(x, z + Resolution));
- Triangles[t - 1].p3 := locabs(x, y, z + Resolution);
- z := z + Resolution;
- end;
- x := x + Resolution;
- end;
- end;
- end;
- procedure ECAddEllipsoid(var MovePack: TECMovePack;
- ePos, eRadius: TAffineVector; Solid: Boolean; ObjectID: Integer);
- var
- count: Integer;
- d1, d2, r: single;
- begin
- r := MaxXYZComponent(eRadius);
- d1 := VectorDistance2(MovePack.Position, ePos);
- d2 := sqr(MovePack.CollisionRange + r);
- if d1 > d2 then
- exit;
- // Add possible collider
- count := Length(MovePack.Colliders);
- SetLength(MovePack.Colliders, count + 1);
- with MovePack.Colliders[count] do
- begin
- Position := ePos;
- Radius := eRadius;
- ObjectInfo.Solid := Solid;
- ObjectInfo.ObjectID := ObjectID;
- end;
- end;
- // --------------------------- DCE ---------------------------------
- function RotateVectorByObject(obj: TGLBaseSceneObject; const v: TAffineVector)
- : TAffineVector;
- var
- v2: TGLVector;
- begin
- SetVector(v2, v);
- SetVector(result, VectorTransform(v2, obj.Matrix^));
- end;
- constructor TGLDCEManager.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FStatics := TList.Create;
- FDynamics := TList.Create;
- FGravity := 0;
- FWorldDirection := TGLCoordinates.CreateInitialized(Self, YHmgVector,
- csVector);
- FWorldScale := 1;
- FMovimentScale := 1;
- FStandardiseLayers := ccsDCEStandard;
- FManualStep := False;
- RegisterManager(Self);
- end;
- destructor TGLDCEManager.Destroy;
- begin
- DeRegisterAllStatics;
- DeRegisterAllDynamics;
- DeRegisterManager(Self);
- FStatics.Free;
- FDynamics.Free;
- FWorldDirection.Free;
- inherited Destroy;
- end;
- function TGLDCEManager.GetDynamicCount: Integer;
- begin
- result := FDynamics.count;
- end;
- function TGLDCEManager.GetStaticCount: Integer;
- begin
- result := FStatics.count;
- end;
- function TGLDCEManager.MoveByDistance(var Body: TGLDCEDynamic;
- deltaS, deltaAbsS: TAffineVector): single;
- var
- // Friction and bounce
- TotalFriction, Bounce, f, m, restitution: single;
- ContactList: TGLIntegerList;
- // Temporary properties (Static or Dynamic)
- tFriction, tBounceFactor: single;
- TObject: TGLBaseSceneObject;
- // Collision results
- ColInfo: TDCECollision;
- lastobj: Integer;
- i, oi: Integer;
- MP: TECMovePack;
- CanCollide, GravCollided: Boolean;
- // Vars used to calculate high velocities
- ColRange, MaxRange: single;
- dCR, dT, deltaCR: Double;
- begin
- // Set collider parameters
- MP.Radius := Body.Size.AsAffineVector;
- MP.Position := AffineVectorMake(Body.OwnerBaseSceneObject.AbsolutePosition);
- MP.Velocity := deltaS;
- MP.Gravity := deltaAbsS;
- MP.ObjectInfo.Solid := Body.Solid;
- MP.UnitScale := FWorldScale;
- MP.MaxRecursionDepth := Body.MaxRecursionDepth;
- // Get collision range, if it is too big separate into small pieces
- ECSetCollisionRange(MP);
- ColRange := MP.CollisionRange;
- deltaCR := ColRange;
- MaxRange := MaxXYZComponent(MP.Radius) * 2.1;
- SetLength(MP.Contacts, 0);
- GravCollided := False; // Is colliding with the ground
- Body.FGroundNormal := NullVector;
- while deltaCR > 0 do
- begin
- if deltaCR > MaxRange then
- begin
- dCR := MaxRange;
- deltaCR := deltaCR - MaxRange;
- end
- else
- begin
- dCR := deltaCR;
- deltaCR := 0;
- end;
- dT := dCR / ColRange;
- MP.Velocity := VectorScale(deltaS, dT);
- MP.Gravity := VectorScale(deltaAbsS, dT);
- ECSetCollisionRange(MP);
- ECResetColliders(MP);
- // For each static collider
- for i := 0 to FStatics.count - 1 do
- with TGLDCEStatic(FStatics[i]) do
- begin
- CanCollide := False;
- if (Active) then
- case FStandardiseLayers of
- ccsDCEStandard:
- CanCollide := (Layer <= Body.Layer);
- ccsCollisionStandard:
- CanCollide := (Layer = 0) or (Body.Layer = 0) or
- (Layer <> Body.Layer);
- ccsHybrid:
- CanCollide := ((Layer = 0) or (Body.Layer = 0) or
- (Layer <= Body.Layer)) and (Layer >= 0) and (Body.Layer >= 0);
- end;
- // Add colliders to move pack
- if CanCollide then
- begin
- case Shape of
- csFreeform:
- ECAddFreeForm(MP, OwnerBaseSceneObject, Solid, i);
- csEllipsoid:
- ECAddEllipsoid(MP,
- AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
- Size.AsAffineVector, Solid, i);
- csBox:
- ECAddBox(MP, OwnerBaseSceneObject, Size.AsAffineVector, Solid, i);
- csTerrain:
- ECAddTerrain(MP, TGLTerrainRenderer(OwnerBaseSceneObject),
- FWorldScale * 2, Solid, i);
- end;
- end;
- end;
- // For each dynamic collider add a static ellipsoid
- for i := 0 to FDynamics.count - 1 do
- with TGLDCEDynamic(FDynamics[i]) do
- begin
- CanCollide := False;
- if (Active) and (TGLDCEDynamic(FDynamics[i]) <> Body) then
- case FStandardiseLayers of
- ccsDCEStandard:
- CanCollide := (Layer <= Body.Layer);
- ccsCollisionStandard:
- CanCollide := (Layer = 0) or (Body.Layer = 0) or
- (Layer <> Body.Layer);
- ccsHybrid:
- CanCollide := ((Layer = 0) or (Body.Layer = 0) or
- (Layer <= Body.Layer)) and (Layer >= 0) and (Body.Layer >= 0);
- end;
- // Add collider to move pack
- // To differ from static it is added with a negative ID (id < 0)
- if CanCollide then
- ECAddEllipsoid(MP,
- AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
- Size.AsAffineVector, Solid, -1 - i);
- end;
- CollideAndSlide(MP);
- if MP.GravityCollided then
- begin
- GravCollided := True;
- Body.FGroundNormal := MP.GroundNormal;
- end;
- MP.Position := MP.ResultPos;
- end;
- // Set the result
- Body.OwnerBaseSceneObject.AbsolutePosition := VectorMake(MP.ResultPos);
- Body.FInGround := GravCollided;
- // Generate events and calculate average friction
- lastobj := -1;
- TotalFriction := Body.Friction;
- ContactList := TGLIntegerList.Create;
- try
- for i := 0 to High(MP.Contacts) do
- with MP do
- begin
- oi := Contacts[i].ObjectInfo.ObjectID;
- // Don't repeat objects with same ID
- if ContactList.IndexOf(oi) >= 0 then
- Continue
- else
- ContactList.Add(oi);
- // Check if it is static or dynamic
- if oi < 0 then
- begin
- tFriction := TGLDCEDynamic(FDynamics[System.Abs(oi) - 1]).Friction;
- tBounceFactor := TGLDCEDynamic(FDynamics[System.Abs(oi) - 1])
- .BounceFactor;
- TObject := TGLDCEDynamic(FDynamics[System.Abs(oi) - 1])
- .OwnerBaseSceneObject;
- end
- else
- begin
- tFriction := TGLDCEStatic(FStatics[oi]).Friction;
- tBounceFactor := TGLDCEStatic(FStatics[oi]).BounceFactor;
- TObject := TGLDCEStatic(FStatics[oi]).OwnerBaseSceneObject;
- end;
- TotalFriction := TotalFriction + tFriction;
- ColInfo.Position := Contacts[i].Position;
- ColInfo.Normal := Contacts[i].SurfaceNormal;
- ColInfo.Bounce := VectorNormalize
- (VectorReflect(VectorAdd(deltaS, deltaAbsS), ColInfo.Normal));
- ColInfo.Nearest := oi = MP.NearestObject;
- // Calculate bounce
- if (Body.SlideOrBounce = csbBounce) and ColInfo.Nearest then
- begin
- Bounce := VectorDotProduct(Body.FSpeed, ColInfo.Normal);
- if Bounce < 0 then
- begin
- restitution := (Body.BounceFactor + tBounceFactor) / 2;
- m := VectorLength(Body.FSpeed);
- f := -Bounce / VectorNorm(ColInfo.Normal) * (1 + restitution);
- CombineVector(Body.FSpeed, ColInfo.Normal, f);
- // Limit bounce speed
- if VectorLength(Body.FSpeed) > m * 2 then
- Body.FSpeed := NullVector;
- end;
- Bounce := VectorDotProduct(Body.FAbsSpeed, ColInfo.Normal);
- if Bounce < 0 then
- begin
- restitution := (Body.BounceFactor + tBounceFactor) / 2;
- m := VectorLength(Body.FAbsSpeed);
- f := -Bounce / VectorNorm(ColInfo.Normal) * (1 + restitution);
- CombineVector(Body.FAbsSpeed, ColInfo.Normal, f);
- // Limit
- if VectorLength(Body.FAbsSpeed) > m * 2 then
- Body.FAbsSpeed := NullVector;
- end;
- Bounce := VectorDotProduct(Body.FGravSpeed, ColInfo.Normal);
- if Bounce < 0 then
- begin
- restitution := (Body.BounceFactor + tBounceFactor) / 2;
- m := VectorLength(Body.FGravSpeed);
- f := -Bounce / VectorNorm(ColInfo.Normal) * (1 + restitution);
- CombineVector(Body.FGravSpeed, ColInfo.Normal, f);
- // Limit
- if VectorLength(Body.FGravSpeed) > m * 2 then
- Body.FGravSpeed := NullVector;
- end;
- end;
- ColInfo.RootCollision := (lastobj <> oi);
- ColInfo.Distance := Contacts[i].Distance;
- lastobj := oi;
- if Assigned(FOnCollision) then
- FOnCollision(Self, Body.OwnerBaseSceneObject, TObject, ColInfo);
- if Assigned(Body.FOnCollision) then
- Body.FOnCollision(Self, TObject, ColInfo);
- if Assigned(Body.FOnCollision) then
- Body.FOnCollision(Self, TObject, ColInfo);
- // If the collided object is static trigger its event
- if (oi >= 0) and Assigned(TGLDCEStatic(FStatics[oi]).FOnCollision) then
- TGLDCEStatic(FStatics[oi]).FOnCollision(Self,
- Body.OwnerBaseSceneObject, ColInfo);
- end;
- finally
- ContactList.Free;
- end;
- result := TotalFriction;
- end;
- procedure TGLDCEManager.Step(deltaTime: Double);
- var
- i: Integer;
- begin
- if deltaTime > 0.1 then
- deltaTime := 0.1;
- for i := 0 to FDynamics.count - 1 do
- with TGLDCEDynamic(FDynamics[i]) do
- if Active then
- DoMove(deltaTime);
- end;
- procedure TGLDCEManager.SetWorldDirection(const Value: TGLCoordinates);
- begin
- FWorldDirection := Value;
- FWorldDirection.Normalize;
- end;
- procedure TGLDCEManager.SetWorldScale(const Value: single);
- begin
- if Value = 0 then
- FWorldScale := 0.001
- else if Value < 0 then
- FWorldScale := Abs(Value)
- else
- FWorldScale := Value;
- end;
- procedure TGLDCEManager.RegisterStatic(aClient: TGLDCEStatic);
- begin
- if Assigned(aClient) then
- if FStatics.IndexOf(aClient) < 0 then
- begin
- FStatics.Add(aClient);
- aClient.FManager := Self;
- end;
- end;
- procedure TGLDCEManager.DeRegisterStatic(aClient: TGLDCEStatic);
- begin
- if Assigned(aClient) then
- begin
- aClient.FManager := nil;
- FStatics.Remove(aClient);
- end;
- end;
- procedure TGLDCEManager.DeRegisterAllStatics;
- var
- i: Integer;
- begin
- // Fast deregistration
- for i := 0 to FStatics.count - 1 do
- TGLDCEStatic(FStatics[i]).FManager := nil;
- FStatics.Clear;
- end;
- procedure TGLDCEManager.RegisterDynamic(aClient: TGLDCEDynamic);
- begin
- if Assigned(aClient) then
- if FDynamics.IndexOf(aClient) < 0 then
- begin
- FDynamics.Add(aClient);
- aClient.FManager := Self;
- end;
- end;
- procedure TGLDCEManager.DeRegisterDynamic(aClient: TGLDCEDynamic);
- begin
- if Assigned(aClient) then
- begin
- aClient.FManager := nil;
- FDynamics.Remove(aClient);
- end;
- end;
- procedure TGLDCEManager.DeRegisterAllDynamics;
- var
- i: Integer;
- begin
- // Fast deregistration
- for i := 0 to FDynamics.count - 1 do
- TGLDCEDynamic(FDynamics[i]).FManager := nil;
- FDynamics.Clear;
- end;
- // ---------------------
- // TGLDCEStatic
- // ---------------------
- procedure TGLDCEStatic.Assign(Source: TPersistent);
- begin
- if Source is TGLDCEStatic then
- begin
- Active := TGLDCEStatic(Source).Active;
- Manager := TGLDCEStatic(Source).Manager;
- Shape := TGLDCEStatic(Source).Shape;
- Layer := TGLDCEStatic(Source).Layer;
- Solid := TGLDCEStatic(Source).Solid;
- Size.Assign(TGLDCEStatic(Source).Size);
- Friction := TGLDCEStatic(Source).Friction;
- BounceFactor := TGLDCEStatic(Source).BounceFactor;
- end;
- inherited Assign(Source);
- end;
- constructor TGLDCEStatic.Create(AOwner: TXCollection);
- begin
- inherited Create(AOwner);
- FActive := True;
- FSize := TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
- FShape := csEllipsoid;
- FSolid := True;
- FFriction := 1;
- FBounceFactor := 0;
- end;
- destructor TGLDCEStatic.Destroy;
- begin
- Manager := nil;
- FSize.Free;
- inherited Destroy;
- end;
- class function TGLDCEStatic.FriendlyDescription: String;
- begin
- result := 'Static Collision-detection registration';
- end;
- class function TGLDCEStatic.FriendlyName: String;
- begin
- result := 'DCE Static Collider';
- end;
- procedure TGLDCEStatic.Loaded;
- var
- mng: TComponent;
- begin
- inherited;
- if FManagerName <> '' then
- begin
- mng := FindManager(TGLDCEManager, FManagerName);
- if Assigned(mng) then
- Manager := TGLDCEManager(mng);
- FManagerName := '';
- end;
- end;
- procedure TGLDCEStatic.WriteToFiler(writer: TWriter);
- begin
- with writer do
- begin
- // ArchiveVersion 1, added inherited call
- WriteInteger(1);
- inherited;
- if Assigned(FManager) then
- WriteString(FManager.GetNamePath)
- else
- WriteString('');
- WriteInteger(Integer(FShape));
- WriteInteger(FLayer);
- WriteBoolean(FSolid);
- WriteBoolean(FActive);
- WriteSingle(FFriction);
- WriteSingle(FBounceFactor);
- FSize.WriteToFiler(writer);
- end;
- end;
- procedure TGLDCEStatic.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert(archiveVersion in [0 .. 1]);
- if archiveVersion >= 1 then
- inherited;
- FManagerName := ReadString;
- Manager := nil;
- FShape := TDCEShape(ReadInteger);
- FLayer := ReadInteger;
- FSolid := ReadBoolean;
- FActive := ReadBoolean;
- FFriction := ReadSingle;
- FBounceFactor := ReadSingle;
- FSize.ReadFromFiler(reader);
- end;
- end;
- procedure TGLDCEStatic.SetBounceFactor(const Value: single);
- begin
- FBounceFactor := Value;
- if FBounceFactor < 0 then
- FBounceFactor := 0;
- if FBounceFactor > 1 then
- FBounceFactor := 1;
- end;
- procedure TGLDCEStatic.SetFriction(const Value: single);
- begin
- FFriction := Value;
- if FFriction < 0 then
- FFriction := 0;
- if FFriction > 100 then
- FFriction := 100;
- end;
- procedure TGLDCEStatic.SetManager(const val: TGLDCEManager);
- begin
- if val <> FManager then
- begin
- if Assigned(FManager) then
- FManager.DeRegisterStatic(Self);
- if Assigned(val) then
- val.RegisterStatic(Self);
- end;
- end;
- procedure TGLDCEStatic.SetShape(const Value: TDCEShape);
- begin
- FShape := Value;
- end;
- procedure TGLDCEStatic.SetSize(const Value: TGLCoordinates);
- begin
- FSize.Assign(Value);
- if FSize.x <= 0 then
- FSize.x := 0.1;
- if FSize.y <= 0 then
- FSize.y := 0.1;
- if FSize.z <= 0 then
- FSize.z := 0.1;
- end;
- //-----------------------------
- // TGLDCEDynamic
- //-----------------------------
- procedure TGLDCEDynamic.ApplyAccel(NewAccel: TAffineVector);
- begin
- AddVector(FAccel, NewAccel);
- end;
- procedure TGLDCEDynamic.ApplyAccel(x, y, z: single);
- begin
- AddVector(FAccel, AffineVectorMake(x, y, z));
- end;
- procedure TGLDCEDynamic.ApplyAbsAccel(NewAccel: TAffineVector);
- begin
- AddVector(FAbsAccel, NewAccel);
- end;
- procedure TGLDCEDynamic.ApplyAbsAccel(x, y, z: single);
- begin
- AddVector(FAbsAccel, AffineVectorMake(x, y, z));
- end;
- procedure TGLDCEDynamic.StopAccel;
- begin
- SetVector(FAccel, NullVector);
- end;
- procedure TGLDCEDynamic.StopAbsAccel;
- begin
- SetVector(FAbsAccel, NullVector);
- end;
- procedure TGLDCEDynamic.Assign(Source: TPersistent);
- begin
- if Source is TGLDCEDynamic then
- begin
- Manager := TGLDCEDynamic(Source).Manager;
- Active := TGLDCEDynamic(Source).Active;
- UseGravity := TGLDCEDynamic(Source).UseGravity;
- Layer := TGLDCEDynamic(Source).Layer;
- Solid := TGLDCEDynamic(Source).Solid;
- Size.Assign(TGLDCEDynamic(Source).Size);
- Friction := TGLDCEDynamic(Source).Friction;
- BounceFactor := TGLDCEDynamic(Source).BounceFactor;
- SlideOrBounce := TGLDCEDynamic(Source).SlideOrBounce;
- MaxRecursionDepth := TGLDCEDynamic(Source).MaxRecursionDepth;
- end;
- inherited Assign(Source);
- end;
- constructor TGLDCEDynamic.Create(AOwner: TXCollection);
- begin
- inherited Create(AOwner);
- FActive := True;
- FUseGravity := True;
- FSize := TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
- FSolid := True;
- FFriction := 1;
- FBounceFactor := 0;
- FMaxRecursionDepth := 5;
- FSlideOrBounce := csbSlide;
- FInGround := False;
- FAccel := NullVector;
- FAbsAccel := NullVector;
- FSpeed := NullVector;
- FAbsSpeed := NullVector;
- FGravSpeed := NullVector;
- end;
- destructor TGLDCEDynamic.Destroy;
- begin
- Manager := nil;
- FSize.Free;
- inherited Destroy;
- end;
- procedure TGLDCEDynamic.DoMove(deltaTime: Double);
- var
- fGround, fAir, G: single;
- v, deltaS, deltaAbsS: TAffineVector;
- procedure Accel(var aSpeed: TAffineVector; aFric: single;
- aForce: TAffineVector);
- begin
- ScaleVector(aForce, deltaTime);
- ScaleVector(aSpeed, aFric);
- aSpeed := VectorAdd(aForce, aSpeed);
- end;
- begin
- if (FSlideOrBounce = csbBounce) then
- FAccel := RotateVectorByObject(OwnerBaseSceneObject, FAccel);
- // Ground friction
- fGround := 1 - deltaTime * FTotalFriction;
- if fGround < 0 then
- fGround := 0;
- // Air friction
- fAir := 1 - deltaTime * FFriction;
- if fAir < 0 then
- fAir := 0;
- if FUseGravity and (not FInGround) then
- ScaleVector(FAccel, 0.01);
- // v = TIME * force + max(1-TIME*Friction,0) * v;
- Accel(FSpeed, fGround, FAccel);
- Accel(FAbsSpeed, fGround, FAbsAccel);
- (* FSpeed[0] := deltaTime * FAccel[0] + fGround * FSpeed[0];
- FSpeed[1] := deltaTime * FAccel[1] + fGround * FSpeed[1];
- FSpeed[2] := deltaTime * FAccel[2] + fGround * FSpeed[2];
- FAbsSpeed[0] := deltaTime * FAbsAccel[0] + fGround * FAbsSpeed[0];
- FAbsSpeed[1] := deltaTime * FAbsAccel[1] + fGround * FAbsSpeed[1];
- FAbsSpeed[2] := deltaTime * FAbsAccel[2] + fGround * FAbsSpeed[2]; *)
- if FUseGravity then
- begin
- // Calculate gravity acceleration
- if FInGround then
- G := FManager.Gravity * Abs(1 - VectorDotProduct(FGroundNormal,
- FManager.WorldDirection.AsAffineVector))
- else
- G := FManager.Gravity;
- if FJumping then
- G := 0;
- v := VectorScale(FManager.WorldDirection.AsAffineVector, G);
- Accel(FGravSpeed, fAir, v);
- (* FGravSpeed[0] := deltaTime * v[0] + fAir * FGravSpeed[0];
- FGravSpeed[1] := deltaTime * v[1] + fAir * FGravSpeed[1];
- FGravSpeed[2] := deltaTime * v[2] + fAir * FGravSpeed[2]; *)
- end
- else
- FGravSpeed := NullVector;
- if FJumping then
- begin
- FJumpSpeed := FJumpForce;
- FJumpHeight := FJumpHeight - (FJumpSpeed * deltaTime);
- FJumping := FJumpHeight > 0;
- if FJumping then
- FGravSpeed := NullVector
- else
- begin
- v := VectorScale(FManager.WorldDirection.AsAffineVector, FJumpSpeed);
- AddVector(FGravSpeed, v);
- FJumpForce := 0;
- FJumpSpeed := 0;
- end;
- end;
- // s = s0 + vt (add relative speed)
- if FSlideOrBounce = csbBounce then
- deltaS := FSpeed
- else
- deltaS := RotateVectorByObject(OwnerBaseSceneObject, FSpeed);
- // Add absolute speed
- AddVector(deltaS, FAbsSpeed);
- // Add jump speed
- v := VectorScale(FManager.WorldDirection.AsAffineVector, FJumpSpeed);
- AddVector(deltaS, v);
- (* The absolute space must be only the gravity
- so it can calculate when it is in the ground *)
- deltaAbsS := FGravSpeed;
- ScaleVector(deltaS, deltaTime);
- ScaleVector(deltaAbsS, deltaTime);
- // Returns the friction of all collided objects
- FTotalFriction := FManager.MoveByDistance(Self, deltaS, deltaAbsS);
- FAccel := NullVector;
- FAbsAccel := NullVector;
- end;
- procedure TGLDCEDynamic.DoProgress(const progressTime: TGLProgressTimes);
- begin
- inherited DoProgress(progressTime);
- Assert(Assigned(Manager), 'DCE Manager not assigned to behaviour.');
- if (not FManager.ManualStep) and FActive then
- begin
- if progressTime.deltaTime > 0.1 then
- DoMove(0.1)
- else
- DoMove(progressTime.deltaTime);
- end;
- end;
- class function TGLDCEDynamic.FriendlyDescription: String;
- begin
- result := 'Dynamic Collision-detection registration';
- end;
- class function TGLDCEDynamic.FriendlyName: String;
- begin
- result := 'DCE Dynamic Collider';
- end;
- procedure TGLDCEDynamic.Jump(jHeight, jSpeed: single);
- begin
- if (not FJumping) and (FInGround) and
- (VectorDotProduct(FGroundNormal, FManager.WorldDirection.AsAffineVector)
- > 0.5) then
- begin
- FJumpHeight := jHeight;
- FJumpForce := jSpeed;
- FJumpSpeed := FJumpForce;
- FJumping := True;
- FInGround := False;
- AddVector(FAbsSpeed, RotateVectorByObject(OwnerBaseSceneObject, FSpeed));
- FSpeed := NullVector;
- end;
- end;
- procedure TGLDCEDynamic.Loaded;
- var
- mng: TComponent;
- begin
- inherited;
- if FManagerName <> '' then
- begin
- mng := FindManager(TGLDCEManager, FManagerName);
- if Assigned(mng) then
- Manager := TGLDCEManager(mng);
- FManagerName := '';
- end;
- end;
- procedure TGLDCEDynamic.Move(deltaS: TAffineVector; deltaTime: Double);
- begin
- ScaleVector(deltaS, deltaTime);
- FManager.MoveByDistance(Self, NullVector, deltaS);
- end;
- procedure TGLDCEDynamic.MoveTo(Position: TAffineVector; Amount: single);
- begin
- SubtractVector(Position,
- AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition));
- Move(Position, Amount);
- end;
- procedure TGLDCEDynamic.WriteToFiler(writer: TWriter);
- begin
- with writer do
- begin
- // ArchiveVersion 1, added inherited call
- WriteInteger(1);
- inherited;
- if Assigned(FManager) then
- WriteString(FManager.GetNamePath)
- else
- WriteString('');
- WriteInteger(FLayer);
- WriteBoolean(FSolid);
- WriteBoolean(FActive);
- WriteBoolean(FUseGravity);
- WriteSingle(FFriction);
- WriteSingle(FBounceFactor);
- WriteInteger(FMaxRecursionDepth);
- WriteInteger(ord(FSlideOrBounce));
- FSize.WriteToFiler(writer);
- end;
- end;
- procedure TGLDCEDynamic.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert(archiveVersion in [0 .. 1]);
- if archiveVersion >= 1 then
- inherited;
- FManagerName := ReadString;
- Manager := nil;
- FLayer := ReadInteger;
- FSolid := ReadBoolean;
- FActive := ReadBoolean;
- FUseGravity := ReadBoolean;
- FFriction := ReadSingle;
- FBounceFactor := ReadSingle;
- FMaxRecursionDepth := ReadInteger;
- FSlideOrBounce := TDCESlideOrBounce(ReadInteger);
- FSize.ReadFromFiler(reader);
- end;
- end;
- procedure TGLDCEDynamic.SetBounceFactor(const Value: single);
- begin
- FBounceFactor := Value;
- if FBounceFactor < 0 then
- FBounceFactor := 0;
- if FBounceFactor > 1 then
- FBounceFactor := 1;
- end;
- procedure TGLDCEDynamic.SetFriction(const Value: single);
- begin
- FFriction := Value;
- if FFriction < 0 then
- FFriction := 0;
- if FFriction > 100 then
- FFriction := 100;
- end;
- procedure TGLDCEDynamic.SetManager(const val: TGLDCEManager);
- begin
- if val <> FManager then
- begin
- if Assigned(FManager) then
- FManager.DeRegisterDynamic(Self);
- if Assigned(val) then
- val.RegisterDynamic(Self);
- end;
- end;
- procedure TGLDCEDynamic.SetSize(const Value: TGLCoordinates);
- begin
- FSize.Assign(Value);
- if FSize.x <= 0 then
- FSize.x := 0.1;
- if FSize.y <= 0 then
- FSize.y := 0.1;
- if FSize.z <= 0 then
- FSize.z := 0.1;
- end;
- // ----------------------------------------------------------------
- function GetOrCreateDCEStatic(behaviours: TGLBehaviours): TGLDCEStatic;
- var
- i: Integer;
- begin
- i := behaviours.IndexOfClass(TGLDCEStatic);
- if i >= 0 then
- result := TGLDCEStatic(behaviours[i])
- else
- result := TGLDCEStatic.Create(behaviours);
- end;
- function GetOrCreateDCEStatic(obj: TGLBaseSceneObject): TGLDCEStatic;
- begin
- result := GetOrCreateDCEStatic(obj.behaviours);
- end;
- function GetOrCreateDCEDynamic(behaviours: TGLBehaviours): TGLDCEDynamic;
- var
- i: Integer;
- begin
- i := behaviours.IndexOfClass(TGLDCEDynamic);
- if i >= 0 then
- result := TGLDCEDynamic(behaviours[i])
- else
- result := TGLDCEDynamic.Create(behaviours);
- end;
- function GetOrCreateDCEDynamic(obj: TGLBaseSceneObject): TGLDCEDynamic;
- begin
- result := GetOrCreateDCEDynamic(obj.behaviours);
- end;
- // ------------------------------------------------------------------
- initialization
- // ------------------------------------------------------------------
- // class registrations
- RegisterXCollectionItemClass(TGLDCEStatic);
- RegisterXCollectionItemClass(TGLDCEDynamic);
- finalization
- UnregisterXCollectionItemClass(TGLDCEStatic);
- UnregisterXCollectionItemClass(TGLDCEDynamic);
- end.
|