DWSx.Scene.pas 37 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063
  1. //
  2. // The graphics rendering platform GLScene http://glscene.org
  3. //
  4. unit DWSx.Scene;
  5. (*
  6. DelphiWebScript symbol creation for base FMX classes.
  7. This unit is dependent on dws2Classes and dws2VectorGeometry.
  8. These components must be associated with the same compiler
  9. for the FireMonkey classes to inherit from.
  10. *)
  11. interface
  12. uses
  13. System.Classes,
  14. System.SysUtils,
  15. GXS.Scene,
  16. GXS.VectorGeometry,
  17. GXS.Coordinates,
  18. DWSx.HelperFunc,
  19. dwsExprs, // dwxExprs, ... ?
  20. dwsSymbols,
  21. dwsComp,
  22. dwsCompStrings,
  23. dwsStack,
  24. dwsFunctions;
  25. type
  26. TdwxGLSceneUnit = class(TdwxUnitComponent)
  27. private
  28. procedure AddClassTGLCoordinates(SymbolTable: TSymbolTable);
  29. procedure AddClassTGLBaseSceneObject(SymbolTable: TSymbolTable);
  30. protected
  31. procedure AddUnitSymbols(SymbolTable: TSymbolTable); override;
  32. public
  33. constructor Create(AOwner: TComponent); override;
  34. end;
  35. procedure Register;
  36. // --------------------------------------------------------
  37. implementation
  38. // --------------------------------------------------------
  39. // ----------
  40. // ---------- Internal class method class declarations ----------
  41. // ----------
  42. type
  43. // --------------------------
  44. // -------- TGLCoordinates
  45. // --------------------------
  46. TGLCoordinatesSetXMethod = class(TInternalMethod)
  47. public
  48. procedure Execute(var ExternalObject: TObject); override;
  49. end;
  50. TGLCoordinatesGetXMethod = class(TInternalMethod)
  51. public
  52. procedure Execute(var ExternalObject: TObject); override;
  53. end;
  54. TGLCoordinatesSetYMethod = class(TInternalMethod)
  55. public
  56. procedure Execute(var ExternalObject: TObject); override;
  57. end;
  58. TGLCoordinatesGetYMethod = class(TInternalMethod)
  59. public
  60. procedure Execute(var ExternalObject: TObject); override;
  61. end;
  62. TGLCoordinatesSetZMethod = class(TInternalMethod)
  63. public
  64. procedure Execute(var ExternalObject: TObject); override;
  65. end;
  66. TGLCoordinatesGetZMethod = class(TInternalMethod)
  67. public
  68. procedure Execute(var ExternalObject: TObject); override;
  69. end;
  70. TGLCoordinatesSetWMethod = class(TInternalMethod)
  71. public
  72. procedure Execute(var ExternalObject: TObject); override;
  73. end;
  74. TGLCoordinatesGetWMethod = class(TInternalMethod)
  75. public
  76. procedure Execute(var ExternalObject: TObject); override;
  77. end;
  78. TGLCoordinatesSetVectorMethod = class(TInternalMethod)
  79. public
  80. procedure Execute(var ExternalObject: TObject); override;
  81. end;
  82. TGLCoordinatesSetPointMethod = class(TInternalMethod)
  83. public
  84. procedure Execute(var ExternalObject: TObject); override;
  85. end;
  86. TGLCoordinatesSetToZeroMethod = class(TInternalMethod)
  87. public
  88. procedure Execute(var ExternalObject: TObject); override;
  89. end;
  90. TGLCoordinatesSetAsVectorMethod = class(TInternalMethod)
  91. public
  92. procedure Execute(var ExternalObject: TObject); override;
  93. end;
  94. TGLCoordinatesGetAsVectorMethod = class(TInternalMethod)
  95. public
  96. procedure Execute(var ExternalObject: TObject); override;
  97. end;
  98. TGLCoordinatesGetAsStringMethod = class(TInternalMethod)
  99. public
  100. procedure Execute(var ExternalObject: TObject); override;
  101. end;
  102. TGLCoordinatesTranslateMethod = class(TInternalMethod)
  103. public
  104. procedure Execute(var ExternalObject: TObject); override;
  105. end;
  106. TGLCoordinatesAddScaledVectorMethod = class(TInternalMethod)
  107. public
  108. procedure Execute(var ExternalObject: TObject); override;
  109. end;
  110. TGLCoordinatesRotateMethod = class(TInternalMethod)
  111. public
  112. procedure Execute(var ExternalObject: TObject); override;
  113. end;
  114. TGLCoordinatesNormalizeMethod = class(TInternalMethod)
  115. public
  116. procedure Execute(var ExternalObject: TObject); override;
  117. end;
  118. TGLCoordinatesInvertMethod = class(TInternalMethod)
  119. public
  120. procedure Execute(var ExternalObject: TObject); override;
  121. end;
  122. TGLCoordinatesScaleMethod = class(TInternalMethod)
  123. public
  124. procedure Execute(var ExternalObject: TObject); override;
  125. end;
  126. TGLCoordinatesEqualsMethod = class(TInternalMethod)
  127. public
  128. procedure Execute(var ExternalObject: TObject); override;
  129. end;
  130. // --------------------------
  131. // TGLBaseSceneObject
  132. // --------------------------
  133. TGLBaseSceneObjectSetVisibleMethod = class(TInternalMethod)
  134. public
  135. procedure Execute(var ExternalObject: TObject); override;
  136. end;
  137. TGLBaseSceneObjectGetVisibleMethod = class(TInternalMethod)
  138. public
  139. procedure Execute(var ExternalObject: TObject); override;
  140. end;
  141. TGLBaseSceneObjectSetMatrixMethod = class(TInternalMethod)
  142. public
  143. procedure Execute(var ExternalObject: TObject); override;
  144. end;
  145. TGLBaseSceneObjectGetMatrixMethod = class(TInternalMethod)
  146. public
  147. procedure Execute(var ExternalObject: TObject); override;
  148. end;
  149. TGLBaseSceneObjectAbsoluteMatrixMethod = class(TInternalMethod)
  150. public
  151. procedure Execute(var ExternalObject: TObject); override;
  152. end;
  153. TGLBaseSceneObjectInvAbsoluteMatrixMethod = class(TInternalMethod)
  154. public
  155. procedure Execute(var ExternalObject: TObject); override;
  156. end;
  157. TGLBaseSceneObjectSetAbsolutePositionMethod = class(TInternalMethod)
  158. public
  159. procedure Execute(var ExternalObject: TObject); override;
  160. end;
  161. TGLBaseSceneObjectGetAbsolutePositionMethod = class(TInternalMethod)
  162. public
  163. procedure Execute(var ExternalObject: TObject); override;
  164. end;
  165. TGLBaseSceneObjectSetAbsoluteUpMethod = class(TInternalMethod)
  166. public
  167. procedure Execute(var ExternalObject: TObject); override;
  168. end;
  169. TGLBaseSceneObjectGetAbsoluteUpMethod = class(TInternalMethod)
  170. public
  171. procedure Execute(var ExternalObject: TObject); override;
  172. end;
  173. TGLBaseSceneObjectSetAbsoluteDirectionMethod = class(TInternalMethod)
  174. public
  175. procedure Execute(var ExternalObject: TObject); override;
  176. end;
  177. TGLBaseSceneObjectGetAbsoluteDirectionMethod = class(TInternalMethod)
  178. public
  179. procedure Execute(var ExternalObject: TObject); override;
  180. end;
  181. TGLBaseSceneObjectSetPositionMethod = class(TInternalMethod)
  182. public
  183. procedure Execute(var ExternalObject: TObject); override;
  184. end;
  185. TGLBaseSceneObjectGetPositionMethod = class(TInternalMethod)
  186. public
  187. procedure Execute(var ExternalObject: TObject); override;
  188. end;
  189. TGLBaseSceneObjectSetDirectionMethod = class(TInternalMethod)
  190. public
  191. procedure Execute(var ExternalObject: TObject); override;
  192. end;
  193. TGLBaseSceneObjectGetDirectionMethod = class(TInternalMethod)
  194. public
  195. procedure Execute(var ExternalObject: TObject); override;
  196. end;
  197. TGLBaseSceneObjectSetUpMethod = class(TInternalMethod)
  198. public
  199. procedure Execute(var ExternalObject: TObject); override;
  200. end;
  201. TGLBaseSceneObjectGetUpMethod = class(TInternalMethod)
  202. public
  203. procedure Execute(var ExternalObject: TObject); override;
  204. end;
  205. TGLBaseSceneObjectSetScaleMethod = class(TInternalMethod)
  206. public
  207. procedure Execute(var ExternalObject: TObject); override;
  208. end;
  209. TGLBaseSceneObjectGetScaleMethod = class(TInternalMethod)
  210. public
  211. procedure Execute(var ExternalObject: TObject); override;
  212. end;
  213. TGLBaseSceneObjectSetPitchAngleMethod = class(TInternalMethod)
  214. public
  215. procedure Execute(var ExternalObject: TObject); override;
  216. end;
  217. TGLBaseSceneObjectGetPitchAngleMethod = class(TInternalMethod)
  218. public
  219. procedure Execute(var ExternalObject: TObject); override;
  220. end;
  221. TGLBaseSceneObjectSetTurnAngleMethod = class(TInternalMethod)
  222. public
  223. procedure Execute(var ExternalObject: TObject); override;
  224. end;
  225. TGLBaseSceneObjectGetTurnAngleMethod = class(TInternalMethod)
  226. public
  227. procedure Execute(var ExternalObject: TObject); override;
  228. end;
  229. TGLBaseSceneObjectSetRollAngleMethod = class(TInternalMethod)
  230. public
  231. procedure Execute(var ExternalObject: TObject); override;
  232. end;
  233. TGLBaseSceneObjectGetRollAngleMethod = class(TInternalMethod)
  234. public
  235. procedure Execute(var ExternalObject: TObject); override;
  236. end;
  237. TGLBaseSceneObjectPitchMethod = class(TInternalMethod)
  238. public
  239. procedure Execute(var ExternalObject: TObject); override;
  240. end;
  241. TGLBaseSceneObjectTurnMethod = class(TInternalMethod)
  242. public
  243. procedure Execute(var ExternalObject: TObject); override;
  244. end;
  245. TGLBaseSceneObjectRollMethod = class(TInternalMethod)
  246. public
  247. procedure Execute(var ExternalObject: TObject); override;
  248. end;
  249. TGLBaseSceneObjectMoveMethod = class(TInternalMethod)
  250. public
  251. procedure Execute(var ExternalObject: TObject); override;
  252. end;
  253. TGLBaseSceneObjectAddChildMethod = class(TInternalMethod)
  254. public
  255. procedure Execute(var ExternalObject: TObject); override;
  256. end;
  257. // ----------
  258. // ---------- Vector/Matrix to/from IInfo helper functions ----------
  259. // ----------
  260. function GetVectorFromInfo(Info: IInfo): TGXVector;
  261. begin
  262. Result := VectorMake(Info.Element([0]).Value, Info.Element([1]).Value,
  263. Info.Element([2]).Value, Info.Element([3]).Value);
  264. end;
  265. procedure SetInfoFromVector(Info: IInfo; vec: TGXVector);
  266. var
  267. i: Integer;
  268. begin
  269. for i := 0 to 3 do
  270. Info.Element([i]).Value := vec[i];
  271. end;
  272. function GetMatrixFromInfo(Info: IInfo): TGXMatrix;
  273. var
  274. i: Integer;
  275. begin
  276. for i := 0 to 3 do
  277. Result[i] := VectorMake(Info.Element([i]).Element([0]).Value,
  278. Info.Element([i]).Element([1]).Value, Info.Element([i]).Element([2])
  279. .Value, Info.Element([i]).Element([3]).Value);
  280. end;
  281. procedure SetInfoFromMatrix(Info: IInfo; mat: TGXMatrix);
  282. var
  283. i, j: Integer;
  284. begin
  285. for i := 0 to 3 do
  286. for j := 0 to 3 do
  287. Info.Element([i]).Element([j]).Value := mat[i][j];
  288. end;
  289. // ----------
  290. // ---------- Internal class method execute procedures ----------
  291. // ----------
  292. // TGLCoordinates internal class methods
  293. // TGLCoordinates.X write access
  294. procedure TGLCoordinatesSetXMethod.Execute(var ExternalObject: TObject);
  295. begin
  296. ValidateExternalObject(ExternalObject, TGLCoordinates);
  297. TGLCoordinates(ExternalObject).X := Info['Value'];
  298. end;
  299. // TGLCoordinates.X read access
  300. procedure TGLCoordinatesGetXMethod.Execute(var ExternalObject: TObject);
  301. begin
  302. ValidateExternalObject(ExternalObject, TGLCoordinates);
  303. Info.Result := TGLCoordinates(ExternalObject).X;
  304. end;
  305. // TGLCoordinates.Y write access
  306. procedure TGLCoordinatesSetYMethod.Execute(var ExternalObject: TObject);
  307. begin
  308. ValidateExternalObject(ExternalObject, TGLCoordinates);
  309. TGLCoordinates(ExternalObject).Y := Info['Value'];
  310. end;
  311. // TGLCoordinates.Y read access
  312. procedure TGLCoordinatesGetYMethod.Execute(var ExternalObject: TObject);
  313. begin
  314. ValidateExternalObject(ExternalObject, TGLCoordinates);
  315. Info.Result := TGLCoordinates(ExternalObject).Y;
  316. end;
  317. // TGLCoordinates.Z write access
  318. procedure TGLCoordinatesSetZMethod.Execute(var ExternalObject: TObject);
  319. begin
  320. ValidateExternalObject(ExternalObject, TGLCoordinates);
  321. TGLCoordinates(ExternalObject).Z := Info['Value'];
  322. end;
  323. // TGLCoordinates.Z read access
  324. procedure TGLCoordinatesGetZMethod.Execute(var ExternalObject: TObject);
  325. begin
  326. ValidateExternalObject(ExternalObject, TGLCoordinates);
  327. Info.Result := TGLCoordinates(ExternalObject).Z;
  328. end;
  329. // TGLCoordinates.W write access
  330. procedure TGLCoordinatesSetWMethod.Execute(var ExternalObject: TObject);
  331. begin
  332. ValidateExternalObject(ExternalObject, TGLCoordinates);
  333. TGLCoordinates(ExternalObject).W := Info['Value'];
  334. end;
  335. // TGLCoordinates.W read access
  336. procedure TGLCoordinatesGetWMethod.Execute(var ExternalObject: TObject);
  337. begin
  338. ValidateExternalObject(ExternalObject, TGLCoordinates);
  339. Info.Result := TGLCoordinates(ExternalObject).W;
  340. end;
  341. // TGLCoordinates.SetVector
  342. procedure TGLCoordinatesSetVectorMethod.Execute(var ExternalObject: TObject);
  343. begin
  344. ValidateExternalObject(ExternalObject, TGLCoordinates);
  345. TGLCoordinates(ExternalObject).SetVector(Info['x'], Info['y'], Info['z'],
  346. Info['w']);
  347. end;
  348. // TGLCoordinates.SetPoint
  349. procedure TGLCoordinatesSetPointMethod.Execute(var ExternalObject: TObject);
  350. begin
  351. ValidateExternalObject(ExternalObject, TGLCoordinates);
  352. TGLCoordinates(ExternalObject).SetPoint(Info['x'], Info['y'], Info['z']);
  353. end;
  354. // TGLCoordinates.AsVector write access
  355. procedure TGLCoordinatesSetAsVectorMethod.Execute(var ExternalObject: TObject);
  356. var
  357. v: TGXVector;
  358. begin
  359. ValidateExternalObject(ExternalObject, TGLCoordinates);
  360. v := GetVectorFromInfo(Info.Vars['Value']);
  361. TGLCoordinates(ExternalObject).AsVector := v;
  362. end;
  363. // TGLCoordinates.AsVector read access
  364. procedure TGLCoordinatesGetAsVectorMethod.Execute(var ExternalObject: TObject);
  365. var
  366. v: TGXVector;
  367. begin
  368. ValidateExternalObject(ExternalObject, TGLCoordinates);
  369. v := TGLCoordinates(ExternalObject).AsVector;
  370. SetInfoFromVector(Info.Vars['Result'], v);
  371. end;
  372. // TGLCoordinates.AsString read access
  373. procedure TGLCoordinatesGetAsStringMethod.Execute(var ExternalObject: TObject);
  374. begin
  375. ValidateExternalObject(ExternalObject, TGLCoordinates);
  376. Info.Result := TGLCoordinates(ExternalObject).AsString;
  377. end;
  378. // TGLCoordinates.Translate
  379. procedure TGLCoordinatesTranslateMethod.Execute(var ExternalObject: TObject);
  380. var
  381. v: TGXVector;
  382. begin
  383. ValidateExternalObject(ExternalObject, TGLCoordinates);
  384. v := GetVectorFromInfo(Info.Vars['translationVector']);
  385. TGLCoordinates(ExternalObject).Translate(v);
  386. end;
  387. // TGLCoordinates.AddScaledVector
  388. procedure TGLCoordinatesAddScaledVectorMethod.Execute(var ExternalObject
  389. : TObject);
  390. var
  391. v: TGXVector;
  392. begin
  393. ValidateExternalObject(ExternalObject, TGLCoordinates);
  394. v := GetVectorFromInfo(Info.Vars['translationVector']);
  395. TGLCoordinates(ExternalObject).AddScaledVector(Info['factor'], v);
  396. end;
  397. // TGLCoordinates.Rotate
  398. procedure TGLCoordinatesRotateMethod.Execute(var ExternalObject: TObject);
  399. var
  400. v: TGXVector;
  401. begin
  402. ValidateExternalObject(ExternalObject, TGLCoordinates);
  403. v := GetVectorFromInfo(Info.Vars['anAxis']);
  404. TGLCoordinates(ExternalObject).Rotate(v, Info['anAngle']);
  405. end;
  406. // TGLCoordinates.Normalize
  407. procedure TGLCoordinatesNormalizeMethod.Execute(var ExternalObject: TObject);
  408. begin
  409. ValidateExternalObject(ExternalObject, TGLCoordinates);
  410. TGLCoordinates(ExternalObject).Normalize;
  411. end;
  412. // TGLCoordinates.Invert
  413. procedure TGLCoordinatesInvertMethod.Execute(var ExternalObject: TObject);
  414. begin
  415. ValidateExternalObject(ExternalObject, TGLCoordinates);
  416. TGLCoordinates(ExternalObject).Invert;
  417. end;
  418. // TGLCoordinates.Scale
  419. procedure TGLCoordinatesScaleMethod.Execute(var ExternalObject: TObject);
  420. begin
  421. ValidateExternalObject(ExternalObject, TGLCoordinates);
  422. TGLCoordinates(ExternalObject).Scale(Info['factor']);
  423. end;
  424. // TGLCoordinates.Equals
  425. procedure TGLCoordinatesEqualsMethod.Execute(var ExternalObject: TObject);
  426. var
  427. v: TGXVector;
  428. begin
  429. ValidateExternalObject(ExternalObject, TGLCoordinates);
  430. v := GetVectorFromInfo(Info.Vars['aVector']);
  431. Info.Result := TGLCoordinates(ExternalObject).Equals(v);
  432. end;
  433. // TGLCoordinates.SetToZero
  434. procedure TGLCoordinatesSetToZeroMethod.Execute(var ExternalObject: TObject);
  435. begin
  436. ValidateExternalObject(ExternalObject, TGLCoordinates);
  437. TGLCoordinates(ExternalObject).SetToZero;
  438. end;
  439. // TGLBaseSceneObject internal class methods
  440. // TGLBaseSceneObject.SetVisible
  441. procedure TGLBaseSceneObjectSetVisibleMethod.Execute(var ExternalObject
  442. : TObject);
  443. begin
  444. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  445. TGLBaseSceneObject(ExternalObject).Visible := Info.Vars['Value'].Value;
  446. end;
  447. // TGLBaseSceneObject.GetVisible
  448. procedure TGLBaseSceneObjectGetVisibleMethod.Execute(var ExternalObject
  449. : TObject);
  450. begin
  451. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  452. Info.Result := TGLBaseSceneObject(ExternalObject).Visible;
  453. end;
  454. // TGLBaseSceneObject.SetMatrix
  455. procedure TGLBaseSceneObjectSetMatrixMethod.Execute(var ExternalObject
  456. : TObject);
  457. begin
  458. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  459. TGLBaseSceneObject(ExternalObject).Matrix :=
  460. GetMatrixFromInfo(Info.Vars['Value']);
  461. end;
  462. // TGLBaseSceneObject.GetMatrix
  463. procedure TGLBaseSceneObjectGetMatrixMethod.Execute(var ExternalObject
  464. : TObject);
  465. begin
  466. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  467. SetInfoFromMatrix(Info.Vars['Result'],
  468. TGLBaseSceneObject(ExternalObject).Matrix);
  469. end;
  470. // TGLBaseSceneObject.AbsoluteMatrix
  471. procedure TGLBaseSceneObjectAbsoluteMatrixMethod.Execute(var ExternalObject
  472. : TObject);
  473. begin
  474. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  475. SetInfoFromMatrix(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
  476. .AbsoluteMatrix);
  477. end;
  478. // TGLBaseSceneObject.InvAbsoluteMatrix
  479. procedure TGLBaseSceneObjectInvAbsoluteMatrixMethod.Execute(var ExternalObject
  480. : TObject);
  481. begin
  482. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  483. SetInfoFromMatrix(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
  484. .InvAbsoluteMatrix);
  485. end;
  486. // TGLBaseSceneObject.SetAbsolutePosition
  487. procedure TGLBaseSceneObjectSetAbsolutePositionMethod.Execute(var ExternalObject
  488. : TObject);
  489. begin
  490. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  491. TGLBaseSceneObject(ExternalObject).AbsolutePosition :=
  492. GetVectorFromInfo(Info.Vars['Value']);
  493. end;
  494. // TGLBaseSceneObject.GetAbsolutePosition
  495. procedure TGLBaseSceneObjectGetAbsolutePositionMethod.Execute(var ExternalObject
  496. : TObject);
  497. begin
  498. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  499. SetInfoFromVector(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
  500. .AbsolutePosition);
  501. end;
  502. // TGLBaseSceneObject.SetAbsoluteUp
  503. procedure TGLBaseSceneObjectSetAbsoluteUpMethod.Execute(var ExternalObject
  504. : TObject);
  505. begin
  506. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  507. TGLBaseSceneObject(ExternalObject).AbsoluteUp :=
  508. GetVectorFromInfo(Info.Vars['Value']);
  509. end;
  510. // TGLBaseSceneObject.GetAbsoluteUp
  511. procedure TGLBaseSceneObjectGetAbsoluteUpMethod.Execute(var ExternalObject
  512. : TObject);
  513. begin
  514. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  515. SetInfoFromVector(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
  516. .AbsoluteUp);
  517. end;
  518. // TGLBaseSceneObject.SetAbsoluteDirection
  519. procedure TGLBaseSceneObjectSetAbsoluteDirectionMethod.Execute
  520. (var ExternalObject: TObject);
  521. begin
  522. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  523. TGLBaseSceneObject(ExternalObject).AbsoluteDirection :=
  524. GetVectorFromInfo(Info.Vars['Value']);
  525. end;
  526. // TGLBaseSceneObject.GetAbsoluteDirection
  527. procedure TGLBaseSceneObjectGetAbsoluteDirectionMethod.Execute
  528. (var ExternalObject: TObject);
  529. begin
  530. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  531. SetInfoFromVector(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
  532. .AbsoluteDirection);
  533. end;
  534. // TGLBaseSceneObject.Position write access
  535. procedure TGLBaseSceneObjectSetPositionMethod.Execute(var ExternalObject
  536. : TObject);
  537. var
  538. Value: TGLCoordinates;
  539. begin
  540. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  541. Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
  542. TGLBaseSceneObject(ExternalObject).Position := Value;
  543. end;
  544. // TGLBaseSceneObject.Position read access
  545. procedure TGLBaseSceneObjectGetPositionMethod.Execute(var ExternalObject
  546. : TObject);
  547. begin
  548. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  549. Info.Result := Info.RegisterExternalObject(TGLBaseSceneObject(ExternalObject)
  550. .Position);
  551. end;
  552. // TGLBaseSceneObject.Direction write access
  553. procedure TGLBaseSceneObjectSetDirectionMethod.Execute(var ExternalObject
  554. : TObject);
  555. var
  556. Value: TGLCoordinates;
  557. begin
  558. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  559. Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
  560. TGLBaseSceneObject(ExternalObject).Direction := Value;
  561. end;
  562. // TGLBaseSceneObject.Direction read access
  563. procedure TGLBaseSceneObjectGetDirectionMethod.Execute(var ExternalObject
  564. : TObject);
  565. begin
  566. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  567. Info.Result := Info.RegisterExternalObject(TGLBaseSceneObject(ExternalObject)
  568. .Direction);
  569. end;
  570. // TGLBaseSceneObject.Up write access
  571. procedure TGLBaseSceneObjectSetUpMethod.Execute(var ExternalObject: TObject);
  572. var
  573. Value: TGLCoordinates;
  574. begin
  575. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  576. Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
  577. TGLBaseSceneObject(ExternalObject).Up := Value;
  578. end;
  579. // TGLBaseSceneObject.Up read access
  580. procedure TGLBaseSceneObjectGetUpMethod.Execute(var ExternalObject: TObject);
  581. begin
  582. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  583. Info.Result := Info.RegisterExternalObject
  584. (TGLBaseSceneObject(ExternalObject).Up);
  585. end;
  586. // TGLBaseSceneObject.Scale write access
  587. procedure TGLBaseSceneObjectSetScaleMethod.Execute(var ExternalObject: TObject);
  588. var
  589. Value: TGLCoordinates;
  590. begin
  591. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  592. Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
  593. TGLBaseSceneObject(ExternalObject).Scale := Value;
  594. end;
  595. // TGLBaseSceneObject.Scale read access
  596. procedure TGLBaseSceneObjectGetScaleMethod.Execute(var ExternalObject: TObject);
  597. begin
  598. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  599. Info.Result := Info.RegisterExternalObject
  600. (TGLBaseSceneObject(ExternalObject).Scale);
  601. end;
  602. // TGLBaseSceneObject.PitchAngle write access
  603. procedure TGLBaseSceneObjectSetPitchAngleMethod.Execute(var ExternalObject
  604. : TObject);
  605. begin
  606. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  607. TGLBaseSceneObject(ExternalObject).PitchAngle := Info.Vars['Value'].Value;
  608. end;
  609. // TGLBaseSceneObject.PitchAngle read access
  610. procedure TGLBaseSceneObjectGetPitchAngleMethod.Execute(var ExternalObject
  611. : TObject);
  612. begin
  613. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  614. Info.Result := TGLBaseSceneObject(ExternalObject).PitchAngle;
  615. end;
  616. // TGLBaseSceneObject.TurnAngle write access
  617. procedure TGLBaseSceneObjectSetTurnAngleMethod.Execute(var ExternalObject
  618. : TObject);
  619. begin
  620. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  621. TGLBaseSceneObject(ExternalObject).TurnAngle := Info.Vars['Value'].Value;
  622. end;
  623. // TGLBaseSceneObject.TurnAngle read access
  624. procedure TGLBaseSceneObjectGetTurnAngleMethod.Execute(var ExternalObject
  625. : TObject);
  626. begin
  627. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  628. Info.Result := TGLBaseSceneObject(ExternalObject).TurnAngle;
  629. end;
  630. // TGLBaseSceneObject.RollAngle write access
  631. procedure TGLBaseSceneObjectSetRollAngleMethod.Execute(var ExternalObject
  632. : TObject);
  633. begin
  634. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  635. TGLBaseSceneObject(ExternalObject).RollAngle := Info.Vars['Value'].Value;
  636. end;
  637. // TGLBaseSceneObject.RollAngle read access
  638. procedure TGLBaseSceneObjectGetRollAngleMethod.Execute(var ExternalObject
  639. : TObject);
  640. begin
  641. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  642. Info.Result := TGLBaseSceneObject(ExternalObject).RollAngle;
  643. end;
  644. // TGLBaseSceneObject.Pitch
  645. procedure TGLBaseSceneObjectPitchMethod.Execute(var ExternalObject: TObject);
  646. begin
  647. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  648. TGLBaseSceneObject(ExternalObject).Pitch(Info['angle']);
  649. end;
  650. // TGLBaseSceneObject.Turn
  651. procedure TGLBaseSceneObjectTurnMethod.Execute(var ExternalObject: TObject);
  652. begin
  653. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  654. TGLBaseSceneObject(ExternalObject).Turn(Info['angle']);
  655. end;
  656. // TGLBaseSceneObject.Roll
  657. procedure TGLBaseSceneObjectRollMethod.Execute(var ExternalObject: TObject);
  658. begin
  659. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  660. TGLBaseSceneObject(ExternalObject).Roll(Info['angle']);
  661. end;
  662. // TGLBaseSceneObject.Move
  663. procedure TGLBaseSceneObjectMoveMethod.Execute(var ExternalObject: TObject);
  664. begin
  665. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  666. TGLBaseSceneObject(ExternalObject).Move(Info['ADistance']);
  667. end;
  668. // TGLBaseSceneObject.AddChild
  669. procedure TGLBaseSceneObjectAddChildMethod.Execute(var ExternalObject: TObject);
  670. var
  671. AChild: TObject;
  672. begin
  673. ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
  674. AChild := Info.GetExternalObjForVar('AChild');
  675. if not Assigned(AChild) then
  676. raise Exception.Create('AChild parameter is unassigned.');
  677. if not(AChild is TGLBaseSceneObject) then
  678. Exception.Create
  679. ('AChild parameter is not inheriting from TGLBaseSceneObject.');
  680. TGLBaseSceneObject(ExternalObject).AddChild(TGLBaseSceneObject(AChild));
  681. end;
  682. // ----------
  683. // ---------- Global procedures/functions ----------
  684. // ----------
  685. // ----------
  686. // ---------- TdwsGLSceneUnit ----------
  687. // ----------
  688. constructor TdwsGLSceneUnit.Create(AOwner: TComponent);
  689. begin
  690. inherited;
  691. FUnitName := 'GLScene';
  692. with FDependencies do
  693. begin
  694. Add('Classes');
  695. Add('GXS.VectorGeometry');
  696. end;
  697. end;
  698. procedure TdwsGLSceneUnit.AddClassTGLCoordinates(SymbolTable: TSymbolTable);
  699. var
  700. ClassSym: TClassSymbol;
  701. begin
  702. ClassSym := TClassSymbol(AddClassSymbol(SymbolTable, 'TGLCoordinates',
  703. 'TPersistent'));
  704. // Methods
  705. if not Assigned(ClassSym.Members.FindLocal('SetX')) then
  706. TGLCoordinatesSetXMethod.Create(mkProcedure, [], 0, 'SetX',
  707. ['Value', 'Float'], '', ClassSym, SymbolTable);
  708. if not Assigned(ClassSym.Members.FindLocal('GetX')) then
  709. TGLCoordinatesGetXMethod.Create(mkFunction, [], 0, 'GetX', [], 'Float',
  710. ClassSym, SymbolTable);
  711. if not Assigned(ClassSym.Members.FindLocal('SetY')) then
  712. TGLCoordinatesSetYMethod.Create(mkProcedure, [], 0, 'SetY',
  713. ['Value', 'Float'], '', ClassSym, SymbolTable);
  714. if not Assigned(ClassSym.Members.FindLocal('GetY')) then
  715. TGLCoordinatesGetYMethod.Create(mkFunction, [], 0, 'GetY', [], 'Float',
  716. ClassSym, SymbolTable);
  717. if not Assigned(ClassSym.Members.FindLocal('SetZ')) then
  718. TGLCoordinatesSetZMethod.Create(mkProcedure, [], 0, 'SetZ',
  719. ['Value', 'Float'], '', ClassSym, SymbolTable);
  720. if not Assigned(ClassSym.Members.FindLocal('GetZ')) then
  721. TGLCoordinatesGetZMethod.Create(mkFunction, [], 0, 'GetZ', [], 'Float',
  722. ClassSym, SymbolTable);
  723. if not Assigned(ClassSym.Members.FindLocal('SetW')) then
  724. TGLCoordinatesSetWMethod.Create(mkProcedure, [], 0, 'SetW',
  725. ['Value', 'Float'], '', ClassSym, SymbolTable);
  726. if not Assigned(ClassSym.Members.FindLocal('GetW')) then
  727. TGLCoordinatesGetWMethod.Create(mkFunction, [], 0, 'GetW', [], 'Float',
  728. ClassSym, SymbolTable);
  729. if not Assigned(ClassSym.Members.FindLocal('SetVector')) then
  730. TGLCoordinatesSetVectorMethod.Create(mkProcedure, [], 0, 'SetVector',
  731. ['x', 'Float', 'y', 'Float', 'z', 'Float', 'w', 'Float'], '', ClassSym,
  732. SymbolTable);
  733. if not Assigned(ClassSym.Members.FindLocal('SetPoint')) then
  734. TGLCoordinatesSetPointMethod.Create(mkProcedure, [], 0, 'SetPoint',
  735. ['x', 'Float', 'y', 'Float', 'z', 'Float'], '', ClassSym, SymbolTable);
  736. if not Assigned(ClassSym.Members.FindLocal('SetToZero')) then
  737. TGLCoordinatesSetToZeroMethod.Create(mkProcedure, [], 0, 'SetToZero', [],
  738. '', ClassSym, SymbolTable);
  739. if not Assigned(ClassSym.Members.FindLocal('SetAsVector')) then
  740. TGLCoordinatesSetAsVectorMethod.Create(mkProcedure, [], 0, 'SetAsVector',
  741. ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
  742. if not Assigned(ClassSym.Members.FindLocal('GetAsVector')) then
  743. TGLCoordinatesGetAsVectorMethod.Create(mkFunction, [], 0, 'GetAsVector', [],
  744. 'TGXVector', ClassSym, SymbolTable);
  745. if not Assigned(ClassSym.Members.FindLocal('GetAsString')) then
  746. TGLCoordinatesGetAsStringMethod.Create(mkFunction, [], 0, 'GetAsString', [],
  747. 'String', ClassSym, SymbolTable);
  748. if not Assigned(ClassSym.Members.FindLocal('Translate')) then
  749. TGLCoordinatesTranslateMethod.Create(mkProcedure, [], 0, 'Translate',
  750. ['translationVector', 'TGXVector'], '', ClassSym, SymbolTable);
  751. if not Assigned(ClassSym.Members.FindLocal('AddScaledVector')) then
  752. TGLCoordinatesAddScaledVectorMethod.Create(mkProcedure, [], 0,
  753. 'AddScaledVector', ['factor', 'Float', 'translationVector', 'TGXVector'],
  754. '', ClassSym, SymbolTable);
  755. if not Assigned(ClassSym.Members.FindLocal('Rotate')) then
  756. TGLCoordinatesRotateMethod.Create(mkProcedure, [], 0, 'Rotate',
  757. ['anAxis', 'TGXVector', 'anAngle', 'Float'], '', ClassSym, SymbolTable);
  758. if not Assigned(ClassSym.Members.FindLocal('Normalize')) then
  759. TGLCoordinatesNormalizeMethod.Create(mkProcedure, [], 0, 'Normalize', [],
  760. '', ClassSym, SymbolTable);
  761. if not Assigned(ClassSym.Members.FindLocal('Invert')) then
  762. TGLCoordinatesInvertMethod.Create(mkProcedure, [], 0, 'Invert', [], '',
  763. ClassSym, SymbolTable);
  764. if not Assigned(ClassSym.Members.FindLocal('Scale')) then
  765. TGLCoordinatesScaleMethod.Create(mkProcedure, [], 0, 'Scale',
  766. ['factor', 'Float'], '', ClassSym, SymbolTable);
  767. if not Assigned(ClassSym.Members.FindLocal('Equals')) then
  768. TGLCoordinatesEqualsMethod.Create(mkFunction, [], 0, 'Equals',
  769. ['aVector', 'TGXVector'], 'Boolean', ClassSym, SymbolTable);
  770. // Properties
  771. AddPropertyToClass('X', 'Float', 'GetX', 'SetX', '', False, ClassSym,
  772. SymbolTable);
  773. AddPropertyToClass('Y', 'Float', 'GetY', 'SetY', '', False, ClassSym,
  774. SymbolTable);
  775. AddPropertyToClass('Z', 'Float', 'GetZ', 'SetZ', '', False, ClassSym,
  776. SymbolTable);
  777. AddPropertyToClass('AsVector', 'TGXVector', 'GetAsVector', 'SetAsVector', '',
  778. False, ClassSym, SymbolTable);
  779. AddPropertyToClass('AsString', 'String', 'GetAsString', '', '', False,
  780. ClassSym, SymbolTable);
  781. end;
  782. procedure TdwsGLSceneUnit.AddClassTGLBaseSceneObject(SymbolTable: TSymbolTable);
  783. var
  784. ClassSym: TClassSymbol;
  785. begin
  786. ClassSym := TClassSymbol(AddClassSymbol(SymbolTable, 'TGLBaseSceneObject',
  787. 'TComponent'));
  788. // Methods
  789. if not Assigned(ClassSym.Members.FindLocal('SetVisible')) then
  790. TGLBaseSceneObjectSetVisibleMethod.Create(mkProcedure, [], 0, 'SetVisible',
  791. ['Value', 'Boolean'], '', ClassSym, SymbolTable);
  792. if not Assigned(ClassSym.Members.FindLocal('GetVisible')) then
  793. TGLBaseSceneObjectGetVisibleMethod.Create(mkFunction, [], 0, 'GetVisible',
  794. [], 'Boolean', ClassSym, SymbolTable);
  795. if not Assigned(ClassSym.Members.FindLocal('SetMatrix')) then
  796. TGLBaseSceneObjectSetMatrixMethod.Create(mkProcedure, [], 0, 'SetMatrix',
  797. ['Value', 'TGXMatrix'], '', ClassSym, SymbolTable);
  798. if not Assigned(ClassSym.Members.FindLocal('GetMatrix')) then
  799. TGLBaseSceneObjectGetMatrixMethod.Create(mkFunction, [], 0, 'GetMatrix', [],
  800. 'TGXMatrix', ClassSym, SymbolTable);
  801. if not Assigned(ClassSym.Members.FindLocal('AbsoluteMatrix')) then
  802. TGLBaseSceneObjectAbsoluteMatrixMethod.Create(mkFunction, [], 0,
  803. 'AbsoluteMatrix', [], 'TGXMatrix', ClassSym, SymbolTable);
  804. if not Assigned(ClassSym.Members.FindLocal('InvAbsoluteMatrix')) then
  805. TGLBaseSceneObjectInvAbsoluteMatrixMethod.Create(mkFunction, [], 0,
  806. 'InvAbsoluteMatrix', [], 'TGXMatrix', ClassSym, SymbolTable);
  807. if not Assigned(ClassSym.Members.FindLocal('SetAbsolutePosition')) then
  808. TGLBaseSceneObjectSetAbsolutePositionMethod.Create(mkProcedure, [], 0,
  809. 'SetAbsolutePosition', ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
  810. if not Assigned(ClassSym.Members.FindLocal('GetAbsolutePosition')) then
  811. TGLBaseSceneObjectGetAbsolutePositionMethod.Create(mkFunction, [], 0,
  812. 'GetAbsolutePosition', [], 'TGXVector', ClassSym, SymbolTable);
  813. if not Assigned(ClassSym.Members.FindLocal('SetAbsoluteUp')) then
  814. TGLBaseSceneObjectSetAbsoluteUpMethod.Create(mkProcedure, [], 0,
  815. 'SetAbsoluteUp', ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
  816. if not Assigned(ClassSym.Members.FindLocal('GetAbsoluteUp')) then
  817. TGLBaseSceneObjectGetAbsoluteUpMethod.Create(mkFunction, [], 0,
  818. 'GetAbsoluteUp', [], 'TGXVector', ClassSym, SymbolTable);
  819. if not Assigned(ClassSym.Members.FindLocal('SetAbsoluteDirection')) then
  820. TGLBaseSceneObjectSetAbsoluteDirectionMethod.Create(mkProcedure, [], 0,
  821. 'SetAbsoluteDirection', ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
  822. if not Assigned(ClassSym.Members.FindLocal('GetAbsoluteDirection')) then
  823. TGLBaseSceneObjectGetAbsoluteDirectionMethod.Create(mkFunction, [], 0,
  824. 'GetAbsoluteDirection', [], 'TGXVector', ClassSym, SymbolTable);
  825. if not Assigned(ClassSym.Members.FindLocal('SetPosition')) then
  826. TGLBaseSceneObjectSetPositionMethod.Create(mkProcedure, [], 0,
  827. 'SetPosition', ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
  828. if not Assigned(ClassSym.Members.FindLocal('GetPosition')) then
  829. TGLBaseSceneObjectGetPositionMethod.Create(mkFunction, [], 0, 'GetPosition',
  830. [], 'TGLCoordinates', ClassSym, SymbolTable);
  831. if not Assigned(ClassSym.Members.FindLocal('SetDirection')) then
  832. TGLBaseSceneObjectSetDirectionMethod.Create(mkProcedure, [], 0,
  833. 'SetDirection', ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
  834. if not Assigned(ClassSym.Members.FindLocal('GetDirection')) then
  835. TGLBaseSceneObjectGetDirectionMethod.Create(mkFunction, [], 0,
  836. 'GetDirection', [], 'TGLCoordinates', ClassSym, SymbolTable);
  837. if not Assigned(ClassSym.Members.FindLocal('SetUp')) then
  838. TGLBaseSceneObjectSetUpMethod.Create(mkProcedure, [], 0, 'SetUp',
  839. ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
  840. if not Assigned(ClassSym.Members.FindLocal('GetUp')) then
  841. TGLBaseSceneObjectGetUpMethod.Create(mkFunction, [], 0, 'GetUp', [],
  842. 'TGLCoordinates', ClassSym, SymbolTable);
  843. if not Assigned(ClassSym.Members.FindLocal('SetScale')) then
  844. TGLBaseSceneObjectSetScaleMethod.Create(mkProcedure, [], 0, 'SetScale',
  845. ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
  846. if not Assigned(ClassSym.Members.FindLocal('GetScale')) then
  847. TGLBaseSceneObjectGetScaleMethod.Create(mkFunction, [], 0, 'GetScale', [],
  848. 'TGLCoordinates', ClassSym, SymbolTable);
  849. if not Assigned(ClassSym.Members.FindLocal('SetPitchAngle')) then
  850. TGLBaseSceneObjectSetPitchAngleMethod.Create(mkProcedure, [], 0,
  851. 'SetPitchAngle', ['Value', 'Float'], '', ClassSym, SymbolTable);
  852. if not Assigned(ClassSym.Members.FindLocal('GetPitchAngle')) then
  853. TGLBaseSceneObjectGetPitchAngleMethod.Create(mkFunction, [], 0,
  854. 'GetPitchAngle', [], 'Float', ClassSym, SymbolTable);
  855. if not Assigned(ClassSym.Members.FindLocal('SetTurnAngle')) then
  856. TGLBaseSceneObjectSetTurnAngleMethod.Create(mkProcedure, [], 0,
  857. 'SetTurnAngle', ['Value', 'Float'], '', ClassSym, SymbolTable);
  858. if not Assigned(ClassSym.Members.FindLocal('GetTurnAngle')) then
  859. TGLBaseSceneObjectGetTurnAngleMethod.Create(mkFunction, [], 0,
  860. 'GetTurnAngle', [], 'Float', ClassSym, SymbolTable);
  861. if not Assigned(ClassSym.Members.FindLocal('SetRollAngle')) then
  862. TGLBaseSceneObjectSetRollAngleMethod.Create(mkProcedure, [], 0,
  863. 'SetRollAngle', ['Value', 'Float'], '', ClassSym, SymbolTable);
  864. if not Assigned(ClassSym.Members.FindLocal('GetRollAngle')) then
  865. TGLBaseSceneObjectGetRollAngleMethod.Create(mkFunction, [], 0,
  866. 'GetRollAngle', [], 'Float', ClassSym, SymbolTable);
  867. if not Assigned(ClassSym.Members.FindLocal('Pitch')) then
  868. TGLBaseSceneObjectPitchMethod.Create(mkProcedure, [], 0, 'Pitch',
  869. ['angle', 'Float'], '', ClassSym, SymbolTable);
  870. if not Assigned(ClassSym.Members.FindLocal('Turn')) then
  871. TGLBaseSceneObjectTurnMethod.Create(mkProcedure, [], 0, 'Turn',
  872. ['angle', 'Float'], '', ClassSym, SymbolTable);
  873. if not Assigned(ClassSym.Members.FindLocal('Roll')) then
  874. TGLBaseSceneObjectRollMethod.Create(mkProcedure, [], 0, 'Roll',
  875. ['angle', 'Float'], '', ClassSym, SymbolTable);
  876. if not Assigned(ClassSym.Members.FindLocal('Move')) then
  877. TGLBaseSceneObjectMoveMethod.Create(mkProcedure, [], 0, 'Move',
  878. ['ADistance', 'Float'], '', ClassSym, SymbolTable);
  879. if not Assigned(ClassSym.Members.FindLocal('AddChild')) then
  880. TGLBaseSceneObjectAddChildMethod.Create(mkProcedure, [], 0, 'AddChild',
  881. ['AChild', 'TGLBaseSceneObject'], '', ClassSym, SymbolTable);
  882. // Properties
  883. AddPropertyToClass('Visible', 'Boolean', 'GetVisible', 'SetVisible', '',
  884. False, ClassSym, SymbolTable);
  885. AddPropertyToClass('Matrix', 'TGXMatrix', 'GetMatrix', 'SetMatrix', '', False,
  886. ClassSym, SymbolTable);
  887. AddPropertyToClass('AbsolutePosition', 'TGXVector', 'GetAbsolutePosition',
  888. 'SetAbsolutePosition', '', False, ClassSym, SymbolTable);
  889. AddPropertyToClass('AbsoluteUp', 'TGXVector', 'GetAbsoluteUp', 'SetAbsoluteUp',
  890. '', False, ClassSym, SymbolTable);
  891. AddPropertyToClass('AbsoluteDirection', 'TGXVector', 'GetAbsoluteDirection',
  892. 'SetAbsoluteDirection', '', False, ClassSym, SymbolTable);
  893. AddPropertyToClass('Position', 'TGLBaseSceneObject', 'GetPosition',
  894. 'SetPosition', '', False, ClassSym, SymbolTable);
  895. AddPropertyToClass('Direction', 'TGLBaseSceneObject', 'GetDirection',
  896. 'SetDirection', '', False, ClassSym, SymbolTable);
  897. AddPropertyToClass('Up', 'TGLBaseSceneObject', 'GetUp', 'SetUp', '', False,
  898. ClassSym, SymbolTable);
  899. AddPropertyToClass('Scale', 'TGLBaseSceneObject', 'GetScale', 'SetScale', '',
  900. False, ClassSym, SymbolTable);
  901. AddPropertyToClass('PitchAngle', 'Float', 'GetPitchAngle', 'SetPitchAngle',
  902. '', False, ClassSym, SymbolTable);
  903. AddPropertyToClass('TurnAngle', 'Float', 'GetTurnAngle', 'SetTurnAngle', '',
  904. False, ClassSym, SymbolTable);
  905. AddPropertyToClass('RollAngle', 'Float', 'GetRollAngle', 'SetRollAngle', '',
  906. False, ClassSym, SymbolTable);
  907. end;
  908. procedure TdwsGLSceneUnit.AddUnitSymbols(SymbolTable: TSymbolTable);
  909. begin
  910. // Forward class declaration
  911. AddForwardDeclaration('TGLCoordinates', SymbolTable);
  912. AddForwardDeclaration('TGLBaseSceneObject', SymbolTable);
  913. // Class types
  914. AddClassTGLCoordinates(SymbolTable);
  915. AddClassTGLBaseSceneObject(SymbolTable);
  916. end;
  917. procedure Register;
  918. begin
  919. RegisterComponents('GXScene DWX', [TdwxGLSceneUnit]);
  920. end;
  921. end.