GLS.Movement.pas 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.Movement;
  5. (*
  6. Movement path behaviour by Roger Cao
  7. Note: It is recommended to set TGLMovementPath.RotationMode = rmUpDirection,
  8. but the default value is rmTurnPitchRoll for backwards compatibility.
  9. *)
  10. interface
  11. {$I Stage.Defines.inc}
  12. uses
  13. System.Classes,
  14. System.SysUtils,
  15. Stage.VectorTypes,
  16. Stage.OpenGLTokens,
  17. GLS.PersistentClasses,
  18. Stage.VectorGeometry,
  19. GLS.XCollection,
  20. Stage.Spline,
  21. GLS.BaseClasses,
  22. GLS.Scene,
  23. GLS.Objects,
  24. Stage.Strings,
  25. Stage.Utils;
  26. type
  27. TGLPathNode = class (TCollectionItem)
  28. private
  29. FPosition: TGLVector;
  30. FScale: TGLVector;
  31. FRotation: TGLVector;
  32. FDirection: TGLVector;
  33. FUp: TGLVector;
  34. FSpeed: single;
  35. procedure SetPositionAsVector(const Value: TGLVector);
  36. procedure SetRotationAsVector(const Value: TGLVector);
  37. procedure SetScaleAsVector(const Value: TGLVector);
  38. function GetPositionCoordinate(const Index: Integer): TGLFloat;
  39. procedure SetPositionCoordinate(const Index: integer; const AValue: TGLFloat);
  40. function GetRotationCoordinate(const Index: Integer): TGLFloat; inline;
  41. procedure SetRotationCoordinate(const Index: integer; const AValue: TGLFloat);
  42. function GetScaleCoordinate(const Index: Integer): TGLFloat; inline;
  43. procedure SetScaleCoordinate(const Index: integer; const AValue: TGLFloat);
  44. procedure SetSpeed(const Value: single);
  45. function GetDirectionCoordinate(const Index: Integer): TGLFloat; inline;
  46. procedure SetDirectionCoordinate(const Index: integer; const AValue: TGLFloat);
  47. function GetUpCoordinate(const Index: Integer): TGLFloat; inline;
  48. procedure SetUpCoordinate(const Index: integer; const AValue: TGLFloat);
  49. protected
  50. function GetDisplayName: string; override;
  51. procedure WriteToFiler(writer : TWriter);
  52. procedure ReadFromFiler(reader : TReader);
  53. public
  54. constructor Create(Collection: TCollection); override;
  55. destructor Destroy; override;
  56. function PositionAsAddress: PGLFloat;
  57. function RotationAsAddress: PGLFloat;
  58. function ScaleAsAddress: PGLFloat;
  59. procedure Assign(Source: TPersistent); override;
  60. procedure InitializeByObject(const Obj: TGLBaseSceneObject);
  61. {Warning: does not take speed into account. }
  62. function EqualNode(const aNode: TGLPathNode): boolean;
  63. {Rotation.X means PitchAngle, Rotation.Y means TurnAngle, Rotation.Z means RollAngle.}
  64. property RotationAsVector: TGLVector Read FRotation Write SetRotationAsVector;
  65. property PositionAsVector: TGLVector Read FPosition Write SetPositionAsVector;
  66. property ScaleAsVector: TGLVector Read FScale Write SetScaleAsVector;
  67. property UpAsVector: TGLVector read FUp write FUp;
  68. property DirectionAsVector: TGLVector read FDirection write FDirection;
  69. published
  70. property X: TGLFloat index 0 Read GetPositionCoordinate Write SetPositionCoordinate;
  71. property Y: TGLFloat index 1 Read GetPositionCoordinate Write SetPositionCoordinate;
  72. property Z: TGLFloat index 2 Read GetPositionCoordinate Write SetPositionCoordinate;
  73. //Rotation.X means PitchAngle;
  74. //Rotation.Y means TurnAngle;
  75. //Rotation.Z means RollAngle;
  76. property PitchAngle: TGLFloat index 0 Read GetRotationCoordinate Write SetRotationCoordinate;
  77. property TurnAngle: TGLFloat index 1 Read GetRotationCoordinate Write SetRotationCoordinate;
  78. property RollAngle: TGLFloat index 2 Read GetRotationCoordinate Write SetRotationCoordinate;
  79. property ScaleX: TGLFloat index 0 Read GetScaleCoordinate Write SetScaleCoordinate;
  80. property ScaleY: TGLFloat index 1 Read GetScaleCoordinate Write SetScaleCoordinate;
  81. property ScaleZ: TGLFloat index 2 Read GetScaleCoordinate Write SetScaleCoordinate;
  82. property DirectionX: TGLFloat index 0 Read GetDirectionCoordinate Write SetDirectionCoordinate;
  83. property DirectionY: TGLFloat index 1 Read GetDirectionCoordinate Write SetDirectionCoordinate;
  84. property DirectionZ: TGLFloat index 2 Read GetDirectionCoordinate Write SetDirectionCoordinate;
  85. property UpX: TGLFloat index 0 Read GetUpCoordinate Write SetUpCoordinate;
  86. property UpY: TGLFloat index 1 Read GetUpCoordinate Write SetUpCoordinate;
  87. property UpZ: TGLFloat index 2 Read GetUpCoordinate Write SetUpCoordinate;
  88. property Speed: single Read FSpeed Write SetSpeed;
  89. end;
  90. TGLMovementRotationMode = (rmTurnPitchRoll, rmUpDirection);
  91. TGLMovementPath = class;
  92. TGLPathNodes = class (TOwnedCollection)
  93. protected
  94. procedure SetItems(const index: integer; const val: TGLPathNode);
  95. function GetItems(const index: integer): TGLPathNode;
  96. public
  97. constructor Create(aOwner: TGLMovementPath);
  98. function GetOwnerMovementPath: TGLMovementPath;
  99. function Add: TGLPathNode;
  100. function FindItemID(const ID: integer): TGLPathNode;
  101. property Items[const index: integer]: TGLPathNode Read GetItems Write SetItems; default;
  102. procedure NotifyChange; virtual;
  103. end;
  104. TGLMovement = class;
  105. TGLMovementPaths = class;
  106. TGLMovementPath = class(TCollectionItem)
  107. private
  108. FPathLine: TGLLines;
  109. FShowPath: Boolean;
  110. FPathSplineMode: TGLLineSplineMode;
  111. FNodes: TGLPathNodes;
  112. //All the time saved in ms
  113. FStartTimeApplied: Boolean;
  114. FStartTime: double;
  115. FInitialTime: Double;
  116. FEstimateTime: double;
  117. FCurrentNode: TGLPathNode;
  118. FInTravel: boolean;
  119. FLooped: boolean;
  120. FName: string;
  121. FRotationMode: TGLMovementRotationMode;
  122. MotionSplineControl: TCubicSpline;
  123. RotationSplineControl: TCubicSpline;
  124. ScaleSplineControl: TCubicSpline;
  125. DirectionSplineControl: TCubicSpline;
  126. UpSplineControl: TCubicSpline;
  127. FOnTravelStart: TNotifyEvent;
  128. FOnTravelStop: TNotifyEvent;
  129. FCurrentNodeIndex: integer;
  130. function GetNodeCount: integer;
  131. procedure SetStartTime(const Value: double);
  132. procedure SetCurrentNodeIndex(const Value: integer);
  133. procedure SetShowPath(const Value: Boolean);
  134. procedure SetPathSplineMode(const Value: TGLLineSplineMode);
  135. protected
  136. procedure WriteToFiler(writer : TWriter);
  137. procedure ReadFromFiler(reader : TReader);
  138. function CanTravel: boolean;
  139. function GetCollection: TGLMovementPaths;
  140. public
  141. constructor Create(Collection: TCollection); override;
  142. destructor Destroy; override;
  143. procedure Assign(Source: TPersistent); override;
  144. function GetMovement: TGLMovement;
  145. function AddNode: TGLPathNode; overload;
  146. function AddNode(const Node: TGLPathNode): TGLPathNode; overload;
  147. function AddNodeFromObject(const Obj: TGLBaseSceneObject): TGLPathNode;
  148. function InsertNodeFromObject(const Obj: TGLBaseSceneObject; const Index: integer): TGLPathNode;
  149. function InsertNode(const Node: TGLPathNode; const Index: integer): TGLPathNode; overload;
  150. function InsertNode(const Index: integer): TGLPathNode; overload;
  151. function DeleteNode(const Index: integer): TGLPathNode; overload;
  152. function DeleteNode(const Node: TGLPathNode): TGLPathNode; overload;
  153. procedure ClearNodes;
  154. procedure UpdatePathLine;
  155. function NodeDistance(const Node1, Node2: TGLPathNode): double;
  156. procedure CalculateState(const CurrentTime: double);
  157. procedure TravelPath(const Start: boolean); overload;
  158. procedure TravelPath(const Start: boolean; const aStartTime: double); overload;
  159. property NodeCount: integer Read GetNodeCount;
  160. property CurrentNode: TGLPathNode Read FCurrentNode;
  161. property InTravel: boolean Read FInTravel;
  162. function PrevNode: integer;
  163. function NextNode: integer;
  164. property CurrentNodeIndex: integer Read FCurrentNodeIndex Write SetCurrentNodeIndex;
  165. property OnTravelStart: TNotifyEvent Read FOnTravelStart Write FOnTravelStart;
  166. property OnTravelStop: TNotifyEvent Read FOnTravelStop Write FOnTravelStop;
  167. published
  168. property Name: string Read FName Write FName;
  169. {This property is currently ignored. }
  170. property PathSplineMode: TGLLineSplineMode read FPathSplineMode write SetPathSplineMode default lsmLines;
  171. property RotationMode: TGLMovementRotationMode read FRotationMode write FRotationMode default rmTurnPitchRoll;
  172. property StartTime: double Read FStartTime Write SetStartTime;
  173. property EstimateTime: double Read FEstimateTime;
  174. property Looped: boolean Read FLooped Write FLooped;
  175. property Nodes: TGLPathNodes Read FNodes;
  176. property ShowPath: Boolean read FShowPath write SetShowPath;
  177. end;
  178. TGLMovementPaths = class(TOwnedCollection)
  179. protected
  180. procedure SetItems(const index: integer; const val: TGLMovementPath);
  181. function GetItems(const index: integer): TGLMovementPath;
  182. function GetMovement: TGLMovement;
  183. public
  184. constructor Create(aOwner: TGLMovement);
  185. function Add: TGLMovementPath;
  186. function FindItemID(const ID: integer): TGLMovementPath;
  187. property Items[const index: integer]: TGLMovementPath Read GetItems Write SetItems; default;
  188. procedure NotifyChange; virtual;
  189. end;
  190. //Event for path related event
  191. TPathTravelStartEvent = procedure (Sender: TObject;
  192. Path: TGLMovementPath) of object;
  193. TPathTravelStopEvent = procedure (Sender: TObject;
  194. Path: TGLMovementPath; var Looped: boolean) of object;
  195. TGLMovement = class(TGLBehaviour)
  196. private
  197. FPaths: TGLMovementPaths;
  198. FAutoStartNextPath: boolean;
  199. FActivePathIndex: integer;
  200. FOnAllPathTravelledOver: TNotifyEvent;
  201. FOnPathTravelStart: TPathTravelStartEvent;
  202. FOnPathTravelStop: TPathTravelStopEvent;
  203. (*
  204. function GetMovementPath(Index: integer): TGLMovementPath;
  205. procedure SetMovementPath(Index: integer; AValue: TGLMovementPath);
  206. *)
  207. function GetPathCount: integer;
  208. procedure SetActivePathIndex(Value: integer);
  209. function GetActivePath: TGLMovementPath;
  210. procedure SetActivePath(Value: TGLMovementPath);
  211. protected
  212. procedure WriteToFiler(writer : TWriter); override;
  213. procedure ReadFromFiler(reader : TReader); override;
  214. procedure PathTravelStart(Sender: TObject);
  215. procedure PathTravelStop(Sender: TObject);
  216. function GetSceneObject: TGLBaseSceneObject;
  217. public
  218. constructor Create(aOwner: TXCollection); override;
  219. destructor Destroy; override;
  220. //add an empty path;
  221. function AddPath: TGLMovementPath; overload;
  222. //add an path with one node, and the node is based on aObject
  223. function AddPath(aObject: TGLBaseSceneObject): TGLMovementPath; overload;
  224. //add one path to the new one
  225. function AddPath(Path: TGLMovementPath): TGLMovementPath; overload;
  226. procedure ClearPaths;
  227. //Result is current path
  228. function DeletePath(Path: TGLMovementPath): TGLMovementPath; overload;
  229. function DeletePath(Index: integer): TGLMovementPath; overload;
  230. function DeletePath: TGLMovementPath; overload;
  231. procedure Assign(Source: TPersistent); override;
  232. class function FriendlyName: string; override;
  233. class function FriendlyDescription: string; override;
  234. class function UniqueItem: boolean; override;
  235. procedure StartPathTravel;
  236. procedure StopPathTravel;
  237. procedure DoProgress(const progressTime : TGLProgressTimes); override;
  238. function NextPath: integer;
  239. function PrevPath: integer;
  240. function FirstPath: integer;
  241. function LastPath: integer;
  242. //property Paths[index: Integer]: TGLMovementPath read GetMovementPath write SetMovementPath;
  243. property PathCount: integer Read GetPathCount;
  244. //why do these property can't be saved in IDE ?
  245. property OnAllPathTravelledOver: TNotifyEvent Read FOnAllPathTravelledOver Write FOnAllPathTravelledOver;
  246. property OnPathTravelStart: TPathTravelStartEvent Read FOnPathTravelStart Write FOnPathTravelStart;
  247. property OnPathTravelStop: TPathTravelStopEvent Read FOnPathTravelStop Write FOnPathTravelStop;
  248. published
  249. property Paths: TGLMovementPaths Read FPaths;
  250. property AutoStartNextPath: boolean Read FAutoStartNextPath Write FAutoStartNextPath;
  251. property ActivePathIndex: integer Read FActivePathIndex Write SetActivePathIndex;
  252. property ActivePath: TGLMovementPath Read GetActivePath Write SetActivePath;
  253. end;
  254. function GetMovement(const behaviours: TGLBehaviours): TGLMovement; overload;
  255. function GetMovement(const obj: TGLBaseSceneObject): TGLMovement; overload;
  256. function GetOrCreateMovement(const behaviours: TGLBehaviours): TGLMovement; overload;
  257. function GetOrCreateMovement(const obj: TGLBaseSceneObject): TGLMovement; overload;
  258. procedure StartAllMovements(const Scene: TGLScene; const StartCamerasMove, StartObjectsMove: Boolean);
  259. procedure StopAllMovements(const Scene: TGLScene; const StopCamerasMove, StopObjectsMove: Boolean);
  260. // ------------------------------------------------------------------
  261. implementation
  262. // ------------------------------------------------------------------
  263. //----------------------------- TGLPathNode ------------------------------------
  264. constructor TGLPathNode.Create(Collection: TCollection);
  265. begin
  266. inherited Create(Collection);
  267. FPosition := VectorMake(0, 0, 0, 1);
  268. FRotation := VectorMake(0, 0, 0, 1);
  269. FScale := VectorMake(1, 1, 1, 1);
  270. FDirection := ZHmgVector;
  271. FUp := YHmgVector;
  272. FSpeed := 0;
  273. end;
  274. destructor TGLPathNode.Destroy;
  275. begin
  276. inherited Destroy;
  277. end;
  278. procedure TGLPathNode.SetPositionAsVector(const Value: TGLVector);
  279. begin
  280. FPosition := Value;
  281. (Collection as TGLPathNodes).NotifyChange;
  282. end;
  283. procedure TGLPathNode.SetRotationAsVector(const Value: TGLVector);
  284. begin
  285. FRotation := Value;
  286. (Collection as TGLPathNodes).NotifyChange;
  287. end;
  288. procedure TGLPathNode.SetScaleAsVector(const Value: TGLVector);
  289. begin
  290. FScale := Value;
  291. (Collection as TGLPathNodes).NotifyChange;
  292. end;
  293. function TGLPathNode.PositionAsAddress: PGLFloat;
  294. begin
  295. Result := @FPosition;
  296. end;
  297. function TGLPathNode.RotationAsAddress: PGLFloat;
  298. begin
  299. Result := @FRotation;
  300. end;
  301. function TGLPathNode.ScaleAsAddress: PGLFloat;
  302. begin
  303. Result := @FScale;
  304. end;
  305. procedure TGLPathNode.WriteToFiler(writer : TWriter);
  306. var
  307. WriteStuff: boolean;
  308. begin
  309. with Writer do
  310. begin
  311. WriteInteger(1); // Archive Version 1.
  312. WriteStuff := not (VectorEquals(FPosition, NullHmgPoint) and
  313. VectorEquals(FRotation, NullHmgPoint) and
  314. VectorEquals(FScale, XYZHmgVector) and
  315. (Speed = 0) and
  316. VectorEquals(FDirection, ZHmgVector) and
  317. VectorEquals(FUp, YHmgVector));
  318. WriteBoolean(writeStuff);
  319. if WriteStuff then
  320. begin
  321. // Archive Version 0.
  322. Write(FPosition, SizeOf(FPosition));
  323. Write(FRotation, SizeOf(FRotation));
  324. Write(FScale, SizeOf(FScale));
  325. WriteFloat(FSpeed);
  326. // Archive Version 1.
  327. Write(FDirection, SizeOf(FDirection));
  328. Write(FUp, SizeOf(FUp));
  329. end;
  330. end;
  331. end;
  332. procedure TGLPathNode.ReadFromFiler(reader : TReader);
  333. var
  334. lVersion: Integer;
  335. begin
  336. with Reader do
  337. begin
  338. lVersion := ReadInteger;
  339. if ReadBoolean then
  340. begin
  341. // Archive Version 0.
  342. Read(FPosition, SizeOf(FPosition));
  343. Read(FRotation, SizeOf(FRotation));
  344. Read(FScale, SizeOf(FScale));
  345. FSpeed := ReadFloat;
  346. // Archive Version 1.
  347. if lVersion >= 1 then
  348. begin
  349. Read(FDirection, SizeOf(FDirection));
  350. Read(FUp, SizeOf(FUp));
  351. end;
  352. end
  353. else
  354. begin
  355. // Default parameters.
  356. FPosition := NullHmgPoint;
  357. FRotation := NullHmgPoint;
  358. FScale := VectorMake(1, 1, 1, 1);
  359. FSpeed := 0;
  360. FDirection := ZHmgVector;
  361. FUp := YHmgVector;
  362. end;
  363. end;
  364. end;
  365. procedure TGLPathNode.InitializeByObject(const Obj: TGLBaseSceneObject);
  366. begin
  367. if Assigned(Obj) then
  368. begin
  369. FPosition := Obj.Position.AsVector;
  370. FScale := Obj.Scale.AsVector;
  371. FRotation := Obj.Rotation.AsVector;
  372. FDirection := Obj.Direction.AsVector;
  373. FUp := Obj.Up.AsVector;
  374. end;
  375. end;
  376. procedure TGLPathNode.Assign(Source: TPersistent);
  377. begin
  378. if Source is TGLPathNode then
  379. begin
  380. FPosition := TGLPathNode(Source).FPosition;
  381. FRotation := TGLPathNode(Source).FRotation;
  382. FScale := TGLPathNode(Source).FScale;
  383. FSpeed := TGLPathNode(Source).FSpeed;
  384. FDirection := TGLPathNode(Source).FDirection;
  385. FUp := TGLPathNode(Source).FUp;
  386. end else
  387. inherited Assign(Source);
  388. end;
  389. function TGLPathNode.EqualNode(const aNode: TGLPathNode): boolean;
  390. begin
  391. Result := VectorEquals(FPosition, aNode.FPosition) and
  392. VectorEquals(FRotation, aNode.FRotation) and
  393. VectorEquals(FScale, aNode.FScale) and
  394. VectorEquals(FDirection, aNode.FDirection) and
  395. VectorEquals(FUp, aNode.FUp);
  396. end;
  397. procedure TGLPathNode.SetSpeed(const Value: single);
  398. begin
  399. FSpeed := Value;
  400. end;
  401. function TGLPathNode.GetDisplayName: string;
  402. begin
  403. Result := 'PathNode';
  404. end;
  405. function TGLPathNode.GetPositionCoordinate(const Index: Integer): TGLFloat;
  406. begin
  407. result := FPosition.V[Index];
  408. end;
  409. procedure TGLPathNode.SetPositionCoordinate(const Index: integer; const AValue: TGLFloat);
  410. begin
  411. FPosition.V[Index] := AValue;
  412. if Collection <> nil then
  413. (Collection as TGLPathNodes).NotifyChange;
  414. end;
  415. function TGLPathNode.GetRotationCoordinate(const Index: Integer): TGLFloat;
  416. begin
  417. result := FRotation.V[Index];
  418. end;
  419. procedure TGLPathNode.SetRotationCoordinate(const Index: integer; const AValue: TGLFloat);
  420. begin
  421. FRotation.V[Index] := AValue;
  422. if Collection <> nil then
  423. (Collection as TGLPathNodes).NotifyChange;
  424. end;
  425. function TGLPathNode.GetScaleCoordinate(const Index: Integer): TGLFloat;
  426. begin
  427. result := FScale.V[Index];
  428. end;
  429. procedure TGLPathNode.SetScaleCoordinate(const Index: integer; const AValue: TGLFloat);
  430. begin
  431. FScale.V[Index] := AValue;
  432. if Collection <> nil then
  433. (Collection as TGLPathNodes).NotifyChange;
  434. end;
  435. function TGLPathNode.GetDirectionCoordinate(const Index: Integer): TGLFloat;
  436. begin
  437. result := FDirection.V[Index];
  438. end;
  439. procedure TGLPathNode.SetDirectionCoordinate(const Index: integer;
  440. const AValue: TGLFloat);
  441. begin
  442. FDirection.V[Index] := AValue;
  443. if Collection <> nil then
  444. (Collection as TGLPathNodes).NotifyChange;
  445. end;
  446. function TGLPathNode.GetUpCoordinate(const Index: Integer): TGLFloat;
  447. begin
  448. result := FUp.V[Index];
  449. end;
  450. procedure TGLPathNode.SetUpCoordinate(const Index: integer; const AValue: TGLFloat);
  451. begin
  452. FUp.V[Index] := AValue;
  453. if Collection <> nil then
  454. (Collection as TGLPathNodes).NotifyChange;
  455. end;
  456. //--------------------------- TGLPathNodes -------------------------------------
  457. constructor TGLPathNodes.Create(aOwner: TGLMovementPath);
  458. begin
  459. inherited Create(aOwner, TGLPathNode);
  460. end;
  461. procedure TGLPathNodes.SetItems(const index: integer; const val: TGLPathNode);
  462. begin
  463. inherited Items[index] := val;
  464. end;
  465. function TGLPathNodes.GetItems(const index: integer): TGLPathNode;
  466. begin
  467. Result := TGLPathNode(inherited Items[index]);
  468. end;
  469. function TGLPathNodes.Add: TGLPathNode;
  470. begin
  471. Result := (inherited Add) as TGLPathNode;
  472. end;
  473. function TGLPathNodes.GetOwnerMovementPath: TGLMovementPath;
  474. begin
  475. Result := TGLMovementPath(GetOwner);
  476. end;
  477. function TGLPathNodes.FindItemID(const ID: integer): TGLPathNode;
  478. begin
  479. Result := (inherited FindItemID(ID)) as TGLPathNode;
  480. end;
  481. procedure TGLPathNodes.NotifyChange;
  482. begin
  483. // Update the path-line if avalible in TGLMovementPath.
  484. GetOwnerMovementPath.UpdatePathLine;
  485. end;
  486. //--------------------------- TGLMovementPath ----------------------------------
  487. constructor TGLMovementPath.Create(Collection: TCollection);
  488. begin
  489. // This object can only be added to a TGLMovement class.
  490. inherited Create(Collection);
  491. FNodes := TGLPathNodes.Create(Self);
  492. FCurrentNodeIndex := -1;
  493. FRotationMode := rmTurnPitchRoll;
  494. FPathSplineMode := lsmCubicSpline;
  495. FStartTimeApplied := False;
  496. end;
  497. destructor TGLMovementPath.Destroy;
  498. begin
  499. // Make sure the splines are freed.
  500. FLooped:= false;
  501. ClearNodes;
  502. FNodes.Free;
  503. inherited Destroy;
  504. end;
  505. procedure TGLMovementPath.WriteToFiler(writer : TWriter);
  506. var
  507. WriteStuff: boolean;
  508. I: Integer;
  509. begin
  510. with Writer do
  511. begin
  512. WriteInteger(1); // Archive Version 1.
  513. WriteStuff := (FNodes.Count>0) or (FLooped) or (FCurrentNodeIndex<>-1) or (FShowPath) or
  514. (FPathSplineMode <> lsmCubicSpline) or (FRotationMode <> rmTurnPitchRoll);
  515. WriteBoolean(writeStuff);
  516. if WriteStuff then
  517. begin
  518. // Archive Version 0.
  519. WriteBoolean(FLooped);
  520. WriteInteger(FCurrentNodeIndex);
  521. WriteBoolean(FShowPath);
  522. Write(FPathSplineMode, SizeOf(FPathSplineMode));
  523. WriteInteger(FNodes.Count);
  524. for I:=0 to FNodes.Count-1 do
  525. FNodes.Items[I].WriteToFiler(Writer);
  526. // Archive Version 1.
  527. WriteInteger(Ord(FRotationMode));
  528. end;
  529. end;
  530. end;
  531. procedure TGLMovementPath.ReadFromFiler(reader : TReader);
  532. var
  533. I: Integer;
  534. Count: Integer;
  535. Node: TGLPathNode;
  536. lVersion: Integer;
  537. begin
  538. ClearNodes;
  539. with Reader do
  540. begin
  541. lVersion := ReadInteger; // Archive Version.
  542. if ReadBoolean then
  543. begin
  544. // Archive Version 0.
  545. FLooped := ReadBoolean;
  546. FCurrentNodeIndex := ReadInteger;
  547. ShowPath := ReadBoolean;
  548. Read(FPathSplineMode, SizeOf(FPathSplineMode));
  549. Count := ReadInteger;
  550. for I:=0 to Count-1 do
  551. begin
  552. Node := AddNode;
  553. Node.ReadFromFiler(Reader);
  554. end;
  555. // Archive Version 1.
  556. if lVersion >= 1 then
  557. begin
  558. FRotationMode := TGLMovementRotationMode(ReadInteger);
  559. end;
  560. end
  561. else
  562. begin
  563. FLooped := False;
  564. FCurrentNodeIndex := -1;
  565. FShowPath := False;
  566. FPathSplineMode := lsmCubicSpline;
  567. FRotationMode := rmTurnPitchRoll;
  568. end;
  569. end;
  570. UpdatePathLine;
  571. end;
  572. procedure TGLMovementPath.SetPathSplineMode(const Value: TGLLineSplineMode);
  573. begin
  574. if Value<>FPathSplineMode then
  575. begin
  576. FPathSplineMode := Value;
  577. if FShowPath then
  578. FPathLine.SplineMode := FPathSplineMode;
  579. end;
  580. end;
  581. procedure TGLMovementPath.UpdatePathLine;
  582. var
  583. I: Integer;
  584. Node: TGLPathNode;
  585. begin
  586. if FShowPath then
  587. begin
  588. FPathLine.Nodes.Clear;
  589. for I:=0 to Nodes.Count-1 do
  590. begin
  591. Node := Nodes.Items[I];
  592. FPathLine.AddNode(Node.PositionAsVector);
  593. end;
  594. end;
  595. end;
  596. procedure TGLMovementPath.SetShowPath(const Value: Boolean);
  597. var
  598. OwnerObj: TGLBaseSceneObject;
  599. begin
  600. if FShowPath<>Value then
  601. begin
  602. FShowPath := Value;
  603. OwnerObj := GetMovement.GetSceneObject;
  604. if FShowPath then
  605. begin
  606. FPathLine := TGLLines.Create(OwnerObj);
  607. MakeSubComponent(FPathLine, True);
  608. OwnerObj.Scene.Objects.AddChild(FPathLine);
  609. FPathLine.SplineMode := FPathSplineMode;
  610. UpdatePathLine;
  611. end
  612. else
  613. FreeAndNil(FPathLine);
  614. end;
  615. end;
  616. procedure TGLMovementPath.ClearNodes;
  617. begin
  618. TravelPath(False);
  619. FNodes.Clear;
  620. if Assigned(FCurrentNode) then
  621. begin
  622. FCurrentNode.Free;
  623. FCurrentNode := nil;
  624. end;
  625. FCurrentNodeIndex := -1;
  626. UpdatePathLine;
  627. end;
  628. procedure TGLMovementPath.SetCurrentNodeIndex(const Value: integer);
  629. begin
  630. if FNodes.Count = 0 then
  631. begin
  632. FCurrentNodeIndex := -1;
  633. exit;
  634. end;
  635. if (FInTravel) or (Value > FNodes.Count - 1) or (Value < 0) then
  636. exit
  637. else
  638. begin
  639. FCurrentNodeIndex := Value;
  640. if not Assigned(FCurrentNode) then
  641. FCurrentNode := TGLPathNode.Create(nil);
  642. FCurrentNode.Assign(Nodes[FCurrentNodeIndex]);
  643. end;
  644. end;
  645. function TGLMovementPath.InsertNode(const Node: TGLPathNode; const Index: integer): TGLPathNode;
  646. var
  647. N: TGLPathNode;
  648. begin
  649. Result := nil;
  650. //Intravel, can't insert
  651. if FInTravel then
  652. exit;
  653. //Insert into the position
  654. if (Assigned(Node)) and (Assigned(Nodes[Index])) then
  655. begin
  656. N := TGLPathNode(FNodes.Insert(Index));
  657. if Index >0 then
  658. N.Assign(Nodes[Index -1]);
  659. end
  660. else
  661. //add to the tail of list
  662. N := FNodes.Add;
  663. Result := N;
  664. UpdatePathLine;
  665. end;
  666. function TGLMovementPath.InsertNode(const Index: integer): TGLPathNode;
  667. var
  668. N: TGLPathNode;
  669. begin
  670. Result := nil;
  671. //Intravel, can't insert
  672. if FInTravel then
  673. exit;
  674. //Insert into the position
  675. if (Assigned(Nodes[Index])) then
  676. begin
  677. N := TGLPathNode(FNodes.Insert(Index));
  678. if Index >0 then
  679. N.Assign(Nodes[Index -1]);
  680. Result := N;
  681. end
  682. else
  683. //add to the tail of list
  684. Result := AddNode;
  685. UpdatePathLine;
  686. end;
  687. function TGLMovementPath.AddNodeFromObject(const Obj: TGLBaseSceneObject): TGLPathNode;
  688. begin
  689. Result := nil;
  690. if (FInTravel) or (not Assigned(Obj)) then
  691. exit;
  692. Result := AddNode;
  693. Result.FPosition := Obj.Position.AsVector;
  694. Result.FScale := Obj.Scale.AsVector;
  695. Result.FRotation := Obj.Rotation.AsVector;
  696. Result.FDirection:= Obj.Direction.AsVector;
  697. Result.FUp:= Obj.Up.AsVector;
  698. UpdatePathLine;
  699. end;
  700. function TGLMovementPath.InsertNodeFromObject(const Obj: TGLBaseSceneObject; const Index: integer): TGLPathNode;
  701. begin
  702. Result := nil;
  703. if (FInTravel) or (not Assigned(Obj)) then
  704. exit;
  705. Result := InsertNode(Index);
  706. Result.FPosition := Obj.Position.AsVector;
  707. Result.FScale := Obj.Scale.AsVector;
  708. Result.FRotation := Obj.Rotation.AsVector;
  709. Result.FDirection:= Obj.Direction.AsVector;
  710. Result.FUp:= Obj.Up.AsVector;
  711. UpdatePathLine;
  712. end;
  713. function TGLMovementPath.DeleteNode(const Index: integer): TGLPathNode;
  714. var
  715. Node: TGLPathNode;
  716. begin
  717. Result := nil;
  718. //Ontravel, can't delete
  719. if FInTravel then
  720. exit;
  721. Node := Nodes[Index];
  722. if Assigned(Node) then
  723. begin
  724. FNodes.Delete(Index);
  725. if FCurrentNodeIndex < 0 then
  726. exit;
  727. if (Index =0) then
  728. begin
  729. if FNodes.Count > 0 then
  730. FCurrentNodeIndex := 0
  731. else
  732. FCurrentNodeIndex := -1;
  733. end
  734. else
  735. begin
  736. //one has been deleted, so the index should be equal to FNodeList.Count
  737. if Index =FNodes.Count then
  738. FCurrentNodeIndex := Index -1
  739. else
  740. FCurrentNodeIndex := Index;
  741. end;
  742. Result := Nodes[FCurrentNodeIndex];
  743. end;
  744. UpdatePathLine;
  745. end;
  746. function TGLMovementPath.DeleteNode(const Node: TGLPathNode): TGLPathNode;
  747. var
  748. I: integer;
  749. begin
  750. Result := nil;
  751. for I := 0 to FNodes.Count - 1 do
  752. begin
  753. if Node = Nodes[I] then
  754. begin
  755. Result := DeleteNode(I);
  756. break;
  757. end;
  758. end;
  759. UpdatePathLine;
  760. end;
  761. function TGLMovementPath.PrevNode: integer;
  762. begin
  763. Result := FCurrentNodeIndex;
  764. if FNodes.Count = 0 then
  765. exit;
  766. Dec(FCurrentNodeIndex);
  767. if (FCurrentNodeIndex < 0) then
  768. FCurrentNodeIndex := 0
  769. else
  770. //this line can cause the CurrentNode generated
  771. CurrentNodeIndex := FCurrentNodeIndex;
  772. Result := FCurrentNodeIndex;
  773. end;
  774. function TGLMovementPath.NextNode: integer;
  775. begin
  776. Result := FCurrentNodeIndex;
  777. if FNodes.Count = 0 then
  778. exit;
  779. Inc(FCurrentNodeIndex);
  780. if (FCurrentNodeIndex = FNodes.Count) then
  781. Dec(FCurrentNodeIndex)
  782. else
  783. //this line can cause the CurrentNode generated
  784. CurrentNodeIndex := FCurrentNodeIndex;
  785. Result := FCurrentNodeIndex;
  786. end;
  787. function TGLMovementPath.NodeDistance(const Node1, Node2: TGLPathNode): double;
  788. begin
  789. Result := VectorDistance(Node1.FPosition, Node2.FPosition);
  790. end;
  791. //need to do
  792. //1 No acceleration implemented
  793. //2 The travel-time of a segment is based a simple linear movement, at the start and the end
  794. // of the segment, the speed will be more high than in the middle
  795. //3 Rotation Interpolation has not been tested
  796. procedure TGLMovementPath.CalculateState(const CurrentTime: double);
  797. var
  798. I: integer;
  799. SumTime: double;
  800. L, L2: single;
  801. Interpolated: boolean;
  802. T: double;
  803. a:double;
  804. procedure Interpolation(ReturnNode: TGLPathNode; Time1, Time2: double; Index: integer);
  805. var
  806. Ratio: double;
  807. x, y, z, p, t, r, sx, sy, sz: single;
  808. dx, dy, dz,ux, uy, uz: single;
  809. begin
  810. Ratio:=(Nodes[I - 1].Speed*Time2+0.5*a*time2*time2)/L + Index;
  811. MotionSplineControl.SplineXYZ(Ratio, x, y, z);
  812. RotationSplineControl.SplineXYZ(Ratio, p, t, r);
  813. ScaleSplineControl.SplineXYZ(Ratio, sx, sy, sz);
  814. DirectionSplineControl.SplineXYZ(Ratio,dx,dy,dz);
  815. UpSplineControl.SplineXYZ(Ratio,ux,uy,uz);
  816. ReturnNode.FPosition := VectorMake(x, y, z, 1);
  817. ReturnNode.FRotation := VectorMake(p, t, r, 1);
  818. ReturnNode.FScale := VectorMake(sx, sy, sz, 1);
  819. ReturnNode.FDirection := VectorMake(dx,dy,dz, 1);
  820. ReturnNode.FUp := VectorMake(ux,uy,uz, 1);
  821. end;
  822. begin
  823. I := 1;
  824. if (FInitialTime = 0) or (FInitialTime > CurrentTime) then
  825. FInitialTime := CurrentTime;
  826. if (FStartTime <> 0) and not FStartTimeApplied then
  827. begin
  828. if FInitialTime + FStartTime < CurrentTime then
  829. begin
  830. FInitialTime := CurrentTime;
  831. FStartTimeApplied := True;
  832. end
  833. else
  834. Exit;
  835. end;
  836. SumTime := FInitialTime;
  837. Interpolated := False;
  838. while I < FNodes.Count do
  839. begin
  840. L := NodeDistance(Nodes[I], Nodes[I - 1]);
  841. if L = 0 then
  842. L := VectorDistance(Nodes[i].FScale, Nodes[i-1].FScale);
  843. if L = 0 then
  844. begin
  845. L := VectorDistance(Nodes[i].FDirection, Nodes[i-1].FDirection);
  846. L2 := VectorDistance(Nodes[i].FUp, Nodes[i-1].Fup);
  847. if (L2 > L) then L:= L2;
  848. end;
  849. if L = 0 then
  850. L := Nodes[I - 0].Speed;
  851. T := L / (Nodes[I - 1].Speed + Nodes[I - 0].Speed) * 2;
  852. if (SumTime + T) >= CurrentTime then
  853. begin
  854. a:=(Nodes[I - 0].Speed-Nodes[I - 1].Speed)/T;
  855. Interpolation(FCurrentNode, T, CurrentTime - SumTime, I - 1);
  856. Interpolated := True;
  857. break;
  858. end
  859. else
  860. begin
  861. Inc(I);
  862. SumTime := SumTime + T;
  863. end;
  864. end;
  865. if (not Interpolated) then
  866. begin
  867. Interpolation(FCurrentNode, 1.0, 0.0, FNodes.Count - 1);
  868. TravelPath(False);
  869. end;
  870. end;
  871. function TGLMovementPath.CanTravel: boolean;
  872. var
  873. I: integer;
  874. begin
  875. Result := True;
  876. if FNodes.Count < 2 then
  877. begin
  878. Result := False;
  879. exit;
  880. end;
  881. for I := 0 to FNodes.Count - 1 do
  882. if Abs(Nodes[I].Speed) < 0.01 then
  883. begin
  884. Result := False;
  885. break;
  886. end;
  887. end;
  888. function TGLMovementPath.GetCollection: TGLMovementPaths;
  889. begin
  890. Result := TGLMovementPaths(GetOwner);
  891. end;
  892. function TGLMovementPath.GetMovement: TGLMovement;
  893. begin
  894. Result := GetCollection.GetMovement;
  895. end;
  896. procedure TGLMovementPath.TravelPath(const Start: boolean);
  897. var
  898. x, y, z: PFloatArray;
  899. p, t, r: PFloatArray;
  900. sx, sy, sz: PFloatArray;
  901. dx, dy, dz: PFloatArray;
  902. ux, uy, uz: PFloatArray;
  903. I: integer;
  904. begin
  905. if (FInTravel = Start) or (FNodes.Count = 0) then
  906. exit;
  907. //One of the node speed < 0.01;
  908. if (Start) and (not CanTravel) then
  909. exit;
  910. FInTravel := Start;
  911. if FInTravel then
  912. begin
  913. GetMem(x, sizeof(single) * FNodes.Count);
  914. GetMem(y, sizeof(single) * FNodes.Count);
  915. GetMem(z, sizeof(single) * FNodes.Count);
  916. GetMem(p, sizeof(single) * FNodes.Count);
  917. GetMem(t, sizeof(single) * FNodes.Count);
  918. GetMem(r, sizeof(single) * FNodes.Count);
  919. GetMem(sx, sizeof(single) * FNodes.Count);
  920. GetMem(sy, sizeof(single) * FNodes.Count);
  921. GetMem(sz, sizeof(single) * FNodes.Count);
  922. GetMem(dx, sizeof(single) * FNodes.Count);
  923. GetMem(dy, sizeof(single) * FNodes.Count);
  924. GetMem(dz, sizeof(single) * FNodes.Count);
  925. GetMem(ux, sizeof(single) * FNodes.Count);
  926. GetMem(uy, sizeof(single) * FNodes.Count);
  927. GetMem(uz, sizeof(single) * FNodes.Count);
  928. for I := 0 to FNodes.Count - 1 do
  929. begin
  930. PFloatArray(x)[I] := Nodes[I].FPosition.X;
  931. PFloatArray(y)[I] := Nodes[I].FPosition.Y;
  932. PFloatArray(z)[I] := Nodes[I].FPosition.Z;
  933. PFloatArray(p)[I] := Nodes[I].FRotation.X;
  934. PFloatArray(t)[I] := Nodes[I].FRotation.Y;
  935. PFloatArray(r)[I] := Nodes[I].FRotation.Z;
  936. PFloatArray(sx)[I] := Nodes[I].FScale.X;
  937. PFloatArray(sy)[I] := Nodes[I].FScale.Y;
  938. PFloatArray(sz)[I] := Nodes[I].FScale.Z;
  939. PFloatArray(dx)[I] := Nodes[I].FDirection.X;
  940. PFloatArray(dy)[I] := Nodes[I].FDirection.Y;
  941. PFloatArray(dz)[I] := Nodes[I].FDirection.Z;
  942. PFloatArray(ux)[I] := Nodes[I].FUp.X;
  943. PFloatArray(uy)[I] := Nodes[I].FUp.Y;
  944. PFloatArray(uz)[I] := Nodes[I].FUp.Z;
  945. end;
  946. MotionSplineControl := TCubicSpline.Create(x, y, z, nil, FNodes.Count);
  947. RotationSplineControl := TCubicSpline.Create(p, t, r, nil, FNodes.Count);
  948. ScaleSplineControl := TCubicSpline.Create(sx, sy, sz, nil, FNodes.Count);
  949. DirectionSplineControl:= TCubicSpline.Create(dx, dy, dz, nil, FNodes.Count);
  950. UpSplineControl:= TCubicSpline.Create(ux, uy, uz, nil, FNodes.Count);
  951. FreeMem(x);
  952. FreeMem(y);
  953. FreeMem(z);
  954. FreeMem(p);
  955. FreeMem(t);
  956. FreeMem(r);
  957. FreeMem(sx);
  958. FreeMem(sy);
  959. FreeMem(sz);
  960. FreeMem(dx);
  961. FreeMem(dy);
  962. FreeMem(dz);
  963. FreeMem(ux);
  964. FreeMem(uy);
  965. FreeMem(uz);
  966. FreeAndNil(FCurrentNode);
  967. FCurrentNode := TGLPathNode.Create(nil);
  968. FCurrentNode.Assign(Nodes[0]);
  969. FCurrentNodeIndex := -1;
  970. FEstimateTime := 0;
  971. for I := 1 to FNodes.Count - 1 do
  972. FEstimateTime := FEstimateTime + NodeDistance(Nodes[I], Nodes[I - 1]) / Nodes[I - 1].Speed;
  973. if Assigned(FOnTravelStart) then
  974. FOnTravelStart(self);
  975. end
  976. else
  977. begin
  978. FreeAndNil(MotionSplineControl);
  979. FreeAndNil(RotationSplineControl);
  980. FreeAndNil(ScaleSplineControl);
  981. FreeAndNil(DirectionSplineControl);
  982. FreeAndNil(UpSplineControl);
  983. if Assigned(FOnTravelStop) then
  984. FOnTravelStop(self);
  985. end;
  986. end;
  987. procedure TGLMovementPath.TravelPath(const Start: boolean; const aStartTime: double);
  988. begin
  989. if FInTravel = Start then
  990. exit;
  991. FInitialTime := aStartTime;
  992. FStartTimeApplied := False;
  993. TravelPath(Start);
  994. end;
  995. function TGLMovementPath.GetNodeCount: integer;
  996. begin
  997. Result := FNodes.Count;
  998. end;
  999. //-------------------------- This function need modified -----------------------
  1000. procedure TGLMovementPath.SetStartTime(const Value: double);
  1001. begin
  1002. FStartTime := Value;
  1003. end;
  1004. procedure TGLMovementPath.Assign(Source: TPersistent);
  1005. var
  1006. I: integer;
  1007. begin
  1008. if Source is TGLMovementPath then
  1009. begin
  1010. ClearNodes;
  1011. for I := 0 to TGLMovementPath(Source).NodeCount - 1 do
  1012. begin
  1013. AddNode;
  1014. Nodes[I].Assign(TGLMovementPath(Source).Nodes[I]);
  1015. FStartTime := TGLMovementPath(Source).FStartTime;
  1016. //FEstimateTime := TGLMovementPath(Source).FEstimateTime;
  1017. FLooped := TGLMovementPath(Source).FLooped;
  1018. FRotationMode := TGLMovementPath(Source).FRotationMode;
  1019. end;
  1020. end;
  1021. end;
  1022. function TGLMovementPath.AddNode: TGLPathNode;
  1023. var
  1024. Node: TGLPathNode;
  1025. I: integer;
  1026. begin
  1027. //Add a empty node, if it's not the first one, try locate the node to the previous one
  1028. Node := FNodes.Add;
  1029. I := FNodes.Count;
  1030. if I > 1 then
  1031. Node.Assign(Nodes[I - 2]);
  1032. Result := Node;
  1033. end;
  1034. function TGLMovementPath.AddNode(const Node: TGLPathNode): TGLPathNode;
  1035. begin
  1036. Result := AddNode;
  1037. if Assigned(Node) then
  1038. Result.Assign(Node);
  1039. end;
  1040. //------------------------- TGLMovementPaths ----------------------------------
  1041. constructor TGLMovementPaths.Create(aOwner: TGLMovement);
  1042. begin
  1043. inherited Create(aOwner, TGLMovementPath);
  1044. end;
  1045. procedure TGLMovementPaths.SetItems(const index: integer; const val: TGLMovementPath);
  1046. begin
  1047. inherited Items[index] := val;
  1048. end;
  1049. function TGLMovementPaths.GetItems(const index: integer): TGLMovementPath;
  1050. begin
  1051. Result := TGLMovementPath(inherited Items[index]);
  1052. end;
  1053. function TGLMovementPaths.Add: TGLMovementPath;
  1054. begin
  1055. Result := (inherited Add) as TGLMovementPath;
  1056. end;
  1057. function TGLMovementPaths.FindItemID(const ID: integer): TGLMovementPath;
  1058. begin
  1059. Result := (inherited FindItemID(ID)) as TGLMovementPath;
  1060. end;
  1061. procedure TGLMovementPaths.NotifyChange;
  1062. begin
  1063. // Do nothing here.
  1064. end;
  1065. function TGLMovementPaths.GetMovement: TGLMovement;
  1066. begin
  1067. Result := TGLMovement(GetOwner);
  1068. end;
  1069. //--------------------------- TGLMovement --------------------------------------
  1070. constructor TGLMovement.Create(aOwner: TXCollection);
  1071. begin
  1072. inherited Create(aOwner);
  1073. FPaths := TGLMovementPaths.Create(Self);
  1074. FAutoStartNextPath := True;
  1075. FActivePathIndex := -1;
  1076. FOnAllPathTravelledOver := nil;
  1077. FOnPathTravelStart := nil;
  1078. FOnPathTravelStop := nil;
  1079. end;
  1080. destructor TGLMovement.Destroy;
  1081. begin
  1082. ClearPaths;
  1083. FPaths.Free;
  1084. inherited Destroy;
  1085. end;
  1086. procedure TGLMovement.WriteToFiler(writer : TWriter);
  1087. var
  1088. WriteStuff: boolean;
  1089. I: Integer;
  1090. begin
  1091. with Writer do
  1092. begin
  1093. // Archive Version 1, added inherited call
  1094. WriteInteger(1);
  1095. inherited;
  1096. WriteStuff := (FPaths.Count>0) or (not FAutoStartNextPath) or (FActivePathIndex<>-1);
  1097. WriteBoolean(WriteStuff);
  1098. if WriteStuff then
  1099. begin
  1100. WriteBoolean(FAutoStartNextPath);
  1101. WriteInteger(FActivePathIndex);
  1102. WriteInteger(FPaths.Count);
  1103. for I:=0 to FPaths.Count-1 do
  1104. FPaths.Items[I].WriteToFiler(Writer);
  1105. end;
  1106. end;
  1107. end;
  1108. procedure TGLMovement.ReadFromFiler(reader : TReader);
  1109. var
  1110. I: Integer;
  1111. Count: Integer;
  1112. Path: TGLMovementPath;
  1113. archiveVersion: Integer;
  1114. begin
  1115. ClearPaths;
  1116. with Reader do
  1117. begin
  1118. archiveVersion := ReadInteger;
  1119. if archiveVersion >= 1 then
  1120. inherited;
  1121. if ReadBoolean then
  1122. begin
  1123. FAutoStartNextPath := ReadBoolean;
  1124. FActivePathIndex := ReadInteger;
  1125. Count := ReadInteger;
  1126. for I:=0 to Count-1 do
  1127. begin
  1128. Path := AddPath;
  1129. Path.ReadFromFiler(Reader);
  1130. end;
  1131. end else
  1132. begin
  1133. FAutoStartNextPath := True;
  1134. FActivePathIndex := -1;
  1135. end;
  1136. end;
  1137. end;
  1138. procedure TGLMovement.ClearPaths;
  1139. begin
  1140. StopPathTravel;
  1141. FPaths.Clear;
  1142. FActivePathIndex := -1;
  1143. end;
  1144. procedure TGLMovement.PathTravelStart(Sender: TObject);
  1145. begin
  1146. if Assigned(FOnPathTravelStart) then
  1147. FOnPathTravelStart(Self, TGLMovementPath(Sender));
  1148. end;
  1149. procedure TGLMovement.PathTravelStop(Sender: TObject);
  1150. begin
  1151. if Assigned(FOnPathTravelStop) then
  1152. FOnPathTravelStop(Self, TGLMovementPath(Sender), TGLMovementPath(Sender).FLooped);
  1153. if TGLMovementPath(Sender).FLooped then
  1154. begin
  1155. //if looped, then re-start the path
  1156. StartPathTravel;
  1157. end
  1158. else if (FActivePathIndex = FPaths.Count - 1) then
  1159. begin
  1160. if (Assigned(FOnAllPathTravelledOver)) then
  1161. FOnAllPathTravelledOver(Self);
  1162. end
  1163. else //auto-start next path
  1164. if FAutoStartNextPath then
  1165. begin
  1166. Inc(FActivePathIndex);
  1167. StartPathTravel;
  1168. end;
  1169. end;
  1170. function TGLMovement.GetSceneObject: TGLBaseSceneObject;
  1171. begin
  1172. Result := TGLBaseSceneObject(Owner{TGLBehavours}.Owner);
  1173. end;
  1174. function TGLMovement.AddPath: TGLMovementPath;
  1175. var
  1176. Path: TGLMovementPath;
  1177. begin
  1178. Path := FPaths.Add;
  1179. Path.OnTravelStart := PathTravelStart;
  1180. Path.OnTravelStop := PathTravelStop;
  1181. Result := Path;
  1182. end;
  1183. function TGLMovement.AddPath(aObject: TGLBaseSceneObject): TGLMovementPath;
  1184. begin
  1185. Result := AddPath;
  1186. Result.AddNodeFromObject(aObject);
  1187. end;
  1188. function TGLMovement.AddPath(Path: TGLMovementPath): TGLMovementPath;
  1189. begin
  1190. Result := AddPath;
  1191. if Assigned(Path) then
  1192. Result.Assign(Path);
  1193. end;
  1194. function TGLMovement.DeletePath: TGLMovementPath;
  1195. begin
  1196. Result := DeletePath(FActivePathIndex);
  1197. end;
  1198. function TGLMovement.DeletePath(Path: TGLMovementPath): TGLMovementPath;
  1199. var
  1200. I: integer;
  1201. begin
  1202. Result := nil;
  1203. for I := 0 to FPaths.Count - 1 do
  1204. begin
  1205. if Path = Paths[I] then
  1206. begin
  1207. Result := DeletePath(I);
  1208. break;
  1209. end;
  1210. end;
  1211. end;
  1212. function TGLMovement.DeletePath(Index: integer): TGLMovementPath;
  1213. begin
  1214. Result := nil;
  1215. if (Index <0) or (Index >=FPaths.Count) then
  1216. exit;
  1217. if Index >=0 then
  1218. begin
  1219. TGLMovementPath(FPaths[Index]).Free;
  1220. FPaths.Delete(Index);
  1221. if FActivePathIndex < 0 then
  1222. exit;
  1223. if (Index =0) then
  1224. begin
  1225. if FPaths.Count > 0 then
  1226. FActivePathIndex := 0
  1227. else
  1228. FActivePathIndex := -1;
  1229. end
  1230. else
  1231. begin
  1232. //one has been deleted, so the index should be equal to FPathList.Count
  1233. if Index =FPaths.Count then
  1234. FActivePathIndex := Index -1
  1235. else
  1236. FActivePathIndex := Index;
  1237. end;
  1238. Result := ActivePath;
  1239. end;
  1240. end;
  1241. procedure TGLMovement.SetActivePathIndex(Value: integer);
  1242. begin
  1243. if FActivePathIndex = Value then
  1244. exit;
  1245. //if current has a Active path in travelling, then exit the method
  1246. if (Assigned(ActivePath)) and (ActivePath.InTravel) then
  1247. exit;
  1248. if (Value >= 0) and (Value < FPaths.Count) then
  1249. begin
  1250. FActivePathIndex := Value;
  1251. //Start the new path or wait for the start-command
  1252. end
  1253. else if Value < 0 then
  1254. begin
  1255. FActivePathIndex := -1;
  1256. //Stop all the running path
  1257. end;
  1258. end;
  1259. function TGLMovement.NextPath: integer;
  1260. begin
  1261. ActivePathIndex := FActivePathIndex + 1;
  1262. Result := FActivePathIndex;
  1263. end;
  1264. function TGLMovement.PrevPath: integer;
  1265. begin
  1266. ActivePathIndex := FActivePathIndex - 1;
  1267. if (FActivePathIndex < 0) and (FPaths.Count > 0) then
  1268. Result := 0
  1269. else
  1270. Result := FActivePathIndex;
  1271. end;
  1272. function TGLMovement.FirstPath: integer;
  1273. begin
  1274. if FPaths.Count > 0 then
  1275. FActivePathIndex := 0;
  1276. Result := FActivePathIndex;
  1277. end;
  1278. function TGLMovement.LastPath: integer;
  1279. begin
  1280. if FPaths.Count > 0 then
  1281. FActivePathIndex := FPaths.Count - 1;
  1282. Result := FActivePathIndex;
  1283. end;
  1284. function TGLMovement.GetActivePath: TGLMovementPath;
  1285. begin
  1286. if FActivePathIndex >= 0 then
  1287. Result := Paths[FActivePathIndex]
  1288. else
  1289. Result := nil;
  1290. end;
  1291. procedure TGLMovement.SetActivePath(Value: TGLMovementPath);
  1292. var
  1293. I: integer;
  1294. begin
  1295. ActivePathIndex := -1;
  1296. for I := 0 to FPaths.Count - 1 do
  1297. begin
  1298. if Value = Paths[I] then
  1299. begin
  1300. ActivePathIndex := I;
  1301. break;
  1302. end;
  1303. end;
  1304. end;
  1305. function TGLMovement.GetPathCount: integer;
  1306. begin
  1307. Result := FPaths.Count;
  1308. end;
  1309. procedure TGLMovement.Assign(Source: TPersistent);
  1310. var
  1311. I: integer;
  1312. begin
  1313. if Source is TGLMovement then
  1314. begin
  1315. ClearPaths;
  1316. for I := 0 to TGLMovement(Source).PathCount - 1 do
  1317. begin
  1318. AddPath;
  1319. Paths[I].Assign(TGLMovement(Source).Paths[I]);
  1320. end;
  1321. FAutoStartNextPath := TGLMovement(Source).FAutoStartNextPath;
  1322. end;
  1323. end;
  1324. class function TGLMovement.FriendlyName: string;
  1325. begin
  1326. Result := 'Movement controls'
  1327. end;
  1328. class function TGLMovement.FriendlyDescription: string;
  1329. begin
  1330. Result := 'Object movement path controls'
  1331. end;
  1332. class function TGLMovement.UniqueItem: boolean;
  1333. begin
  1334. Result := True;
  1335. end;
  1336. procedure TGLMovement.StartPathTravel;
  1337. begin
  1338. if FActivePathIndex < 0 then
  1339. exit;
  1340. //convert the time to second
  1341. Paths[FActivePathIndex].TravelPath(True, 0);
  1342. end;
  1343. procedure TGLMovement.StopPathTravel;
  1344. var
  1345. I: Integer;
  1346. begin
  1347. if FPaths.Count <> 0 then
  1348. for I := 0 to FPaths.Count - 1 do
  1349. Paths[I].TravelPath(False);
  1350. end;
  1351. //Calculate functions add into this method
  1352. procedure TGLMovement.DoProgress(const progressTime : TGLProgressTimes);
  1353. var
  1354. Path: TGLMovementPath;
  1355. begin
  1356. if (FActivePathIndex >= 0) and (Paths[FActivePathIndex].InTravel) then
  1357. begin
  1358. Path := Paths[FActivePathIndex];
  1359. Path.CalculateState(progressTime.newTime);
  1360. if Assigned(Path.CurrentNode) then
  1361. begin
  1362. if Owner.Owner is TGLBaseSceneObject then
  1363. with TGLBaseSceneObject(Owner.Owner) do
  1364. begin
  1365. Position.AsVector := Path.CurrentNode.FPosition;
  1366. Scale.AsVector := Path.CurrentNode.FScale;
  1367. case Path.FRotationMode of
  1368. rmTurnPitchRoll:
  1369. begin
  1370. PitchAngle := Path.CurrentNode.PitchAngle;
  1371. TurnAngle := Path.CurrentNode.TurnAngle;
  1372. RollAngle := Path.CurrentNode.RollAngle;
  1373. end;
  1374. rmUpDirection:
  1375. begin
  1376. Direction.AsVector := Path.CurrentNode.FDirection;
  1377. Up.AsVector := Path.CurrentNode.FUp;
  1378. end;
  1379. else
  1380. Assert(False, strErrorEx + strUnknownType);
  1381. end
  1382. end;
  1383. end;
  1384. end;
  1385. end;
  1386. function GetMovement(const behaviours: TGLBehaviours): TGLMovement; overload;
  1387. var
  1388. i: integer;
  1389. begin
  1390. i := behaviours.IndexOfClass(TGLMovement);
  1391. if i >= 0 then
  1392. Result := TGLMovement(behaviours[i])
  1393. else
  1394. Result := nil;
  1395. end;
  1396. function GetMovement(const obj: TGLBaseSceneObject): TGLMovement; overload;
  1397. begin
  1398. Result := GetMovement(obj.behaviours);
  1399. end;
  1400. function GetOrCreateMovement(const behaviours: TGLBehaviours): TGLMovement; overload;
  1401. var
  1402. i: integer;
  1403. begin
  1404. i := behaviours.IndexOfClass(TGLMovement);
  1405. if i >= 0 then
  1406. Result := TGLMovement(behaviours[i])
  1407. else
  1408. Result := TGLMovement.Create(behaviours);
  1409. end;
  1410. function GetOrCreateMovement(const obj: TGLBaseSceneObject): TGLMovement; overload;
  1411. begin
  1412. Result := GetOrCreateMovement(obj.behaviours);
  1413. end;
  1414. procedure StartStopTravel(const Obj: TGLBaseSceneObject; Start: Boolean; ChangeCameras, ChangeObjects: Boolean);
  1415. var
  1416. NewObj: TGLBaseSceneObject;
  1417. I: Integer;
  1418. Movement: TGLMovement;
  1419. begin
  1420. if ((Obj is TGLCamera)and(ChangeCameras))or
  1421. ((not(Obj is TGLCamera))and(ChangeObjects)) then
  1422. begin
  1423. Movement := GetMovement(Obj);
  1424. if Assigned(Movement) then
  1425. if Start then
  1426. begin
  1427. if (Movement.PathCount>0) and (Movement.ActivePathIndex=-1) then
  1428. Movement.ActivePathIndex := 0;
  1429. Movement.StartPathTravel;
  1430. end else
  1431. Movement.StopPathTravel;
  1432. end;
  1433. for I:=0 to Obj.Count-1 do
  1434. begin
  1435. NewObj := Obj.Children[I];
  1436. StartStopTravel(NewObj, Start, ChangeCameras, ChangeObjects);
  1437. end;
  1438. end;
  1439. procedure StartAllMovements(const Scene: TGLScene; const StartCamerasMove, StartObjectsMove: Boolean);
  1440. begin
  1441. if Assigned(Scene) then
  1442. begin
  1443. if StartCamerasMove or StartObjectsMove then
  1444. StartStopTravel(Scene.Objects, True, StartCamerasMove, StartObjectsMove);
  1445. end;
  1446. end;
  1447. procedure StopAllMovements(const Scene: TGLScene; const StopCamerasMove, StopObjectsMove: Boolean);
  1448. begin
  1449. if Assigned(Scene) then
  1450. begin
  1451. if StopCamerasMove or StopObjectsMove then
  1452. StartStopTravel(Scene.Objects, False, StopCamerasMove, StopObjectsMove);
  1453. end;
  1454. end;
  1455. // ------------------------------------------------------------------
  1456. initialization
  1457. // ------------------------------------------------------------------
  1458. RegisterXCollectionItemClass(TGLMovement);
  1459. finalization
  1460. UnregisterXCollectionItemClass(TGLMovement);
  1461. end.