GLMovement.pas 47 KB

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