GLS.Tree.pas 38 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378
  1. //
  2. // The multimedia graphics platform GLScene https://github.com/glscene
  3. //
  4. unit GLS.Tree;
  5. (*
  6. Dynamic tree generation in GLScene
  7. This code was adapted from the nVidia Tree Demo:
  8. http://developer.nvidia.com/object/Procedural_Tree.html
  9. Some info:
  10. CenterBranchConstant -
  11. Defines, how big the central branch is. When around 50%
  12. it makes a small branch inside the tree, for higher values
  13. much more branches and leaves are created, so either use it
  14. with low depth, or set it to zero, and have two-branched tree.
  15. Default value: 0.5
  16. "AutoRebuild" flag - Rebuild tree after property change.
  17. Default: True
  18. *)
  19. interface
  20. {$I GLScene.inc}
  21. uses
  22. Winapi.OpenGL,
  23. System.Classes,
  24. System.SysUtils,
  25. System.Math,
  26. GLS.OpenGLTokens,
  27. GLS.Scene,
  28. GLS.State,
  29. GLS.Material,
  30. GLS.VectorGeometry,
  31. GLS.VectorLists,
  32. GLS.VectorFileObjects,
  33. GLS.ApplicationFileIO,
  34. GLS.RenderContextInfo,
  35. GLS.PersistentClasses,
  36. GLS.XOpenGL,
  37. GLS.Context,
  38. GLS.VectorTypes,
  39. GLS.Utils;
  40. type
  41. TGLTree = class;
  42. TGLTreeBranches = class;
  43. TGLTreeBranchNoise = class;
  44. TGLTreeLeaves = class
  45. private
  46. FOwner: TGLTree;
  47. FCount: Integer;
  48. FVertices: TGLAffineVectorList;
  49. FNormals: TGLAffineVectorList;
  50. FTexCoords: TGLAffineVectorList;
  51. public
  52. constructor Create(AOwner: TGLTree);
  53. destructor Destroy; override;
  54. procedure BuildList(var rci: TGLRenderContextInfo);
  55. procedure AddNew(matrix: TGLMatrix);
  56. procedure Clear;
  57. property Owner: TGLTree read FOwner;
  58. property Count: Integer read FCount;
  59. property Vertices: TGLAffineVectorList read FVertices;
  60. property Normals: TGLAffineVectorList read FNormals;
  61. property TexCoords: TGLAffineVectorList read FTexCoords;
  62. end;
  63. TGLTreeBranch = class
  64. private
  65. FOwner: TGLTreeBranches;
  66. FLeft: TGLTreeBranch;
  67. FCenter: TGLTreeBranch;
  68. FRight: TGLTreeBranch;
  69. FParent: TGLTreeBranch;
  70. FBranchID: Integer;
  71. FParentID: Integer;
  72. FMatrix: TGLMatrix;
  73. FLower: TGLIntegerList;
  74. FUpper: TGLIntegerList;
  75. FCentralLeader: Boolean;
  76. procedure BuildBranch(branchNoise: TGLTreeBranchNoise;
  77. const matrix: TGLMatrix; TexCoordY, Twist: Single; Level: Integer);
  78. public
  79. constructor Create(AOwner: TGLTreeBranches; AParent: TGLTreeBranch);
  80. destructor Destroy; override;
  81. property Owner: TGLTreeBranches read FOwner;
  82. property Left: TGLTreeBranch read FLeft;
  83. property Center: TGLTreeBranch read FCenter;
  84. property Right: TGLTreeBranch read FRight;
  85. property Parent: TGLTreeBranch read FParent;
  86. property matrix: TGLMatrix read FMatrix;
  87. property Lower: TGLIntegerList read FLower;
  88. property Upper: TGLIntegerList read FUpper;
  89. end;
  90. TGLTreeBranches = class
  91. private
  92. FOwner: TGLTree;
  93. FSinList: TGLSingleList;
  94. FCosList: TGLSingleList;
  95. FVertices: TGLAffineVectorList;
  96. FNormals: TGLAffineVectorList;
  97. FTexCoords: TGLAffineVectorList;
  98. FIndices: TGLIntegerList;
  99. FRoot: TGLTreeBranch;
  100. FCount: Integer;
  101. FBranchCache: TList;
  102. FBranchIndices: TGLIntegerList;
  103. procedure BuildBranches;
  104. public
  105. constructor Create(AOwner: TGLTree);
  106. destructor Destroy; override;
  107. procedure BuildList(var rci: TGLRenderContextInfo);
  108. procedure Clear;
  109. property Owner: TGLTree read FOwner;
  110. property SinList: TGLSingleList read FSinList;
  111. property CosList: TGLSingleList read FCosList;
  112. property Vertices: TGLAffineVectorList read FVertices;
  113. property Normals: TGLAffineVectorList read FNormals;
  114. property TexCoords: TGLAffineVectorList read FTexCoords;
  115. property Count: Integer read FCount;
  116. end;
  117. TGLTreeBranchNoise = class
  118. private
  119. FBranchNoise: Single;
  120. FLeft, FRight, FCenter: TGLTreeBranchNoise;
  121. function GetLeft: TGLTreeBranchNoise;
  122. function GetCenter: TGLTreeBranchNoise;
  123. function GetRight: TGLTreeBranchNoise;
  124. public
  125. constructor Create;
  126. destructor Destroy; override;
  127. property Left: TGLTreeBranchNoise read GetLeft;
  128. property Center: TGLTreeBranchNoise read GetCenter;
  129. property Right: TGLTreeBranchNoise read GetRight;
  130. property branchNoise: Single read FBranchNoise;
  131. end;
  132. TGLTree = class(TGLImmaterialSceneObject)
  133. private
  134. FDepth: Integer;
  135. FBranchFacets: Integer;
  136. FLeafSize: Single;
  137. FBranchSize: Single;
  138. FBranchNoise: Single;
  139. FBranchAngleBias: Single;
  140. FBranchAngle: Single;
  141. FBranchTwist: Single;
  142. FBranchRadius: Single;
  143. FLeafThreshold: Single;
  144. FCentralLeaderBias: Single;
  145. FCentralLeader: Boolean;
  146. FSeed: Integer;
  147. FAutoCenter: Boolean;
  148. FAutoRebuild: Boolean;
  149. FCenterBranchConstant: Single;
  150. FLeaves: TGLTreeLeaves;
  151. FBranches: TGLTreeBranches;
  152. FNoise: TGLTreeBranchNoise;
  153. FMaterialLibrary: TGLMaterialLibrary;
  154. FLeafMaterialName: TGLLibMaterialName;
  155. FLeafBackMaterialName: TGLLibMaterialName;
  156. FBranchMaterialName: TGLLibMaterialName;
  157. FRebuildTree: Boolean;
  158. FAxisAlignedDimensionsCache: TGLVector;
  159. protected
  160. procedure SetDepth(const Value: Integer);
  161. procedure SetBranchFacets(const Value: Integer);
  162. procedure SetLeafSize(const Value: Single);
  163. procedure SetBranchSize(const Value: Single);
  164. procedure SetBranchNoise(const Value: Single);
  165. procedure SetBranchAngleBias(const Value: Single);
  166. procedure SetBranchAngle(const Value: Single);
  167. procedure SetBranchTwist(const Value: Single);
  168. procedure SetBranchRadius(const Value: Single);
  169. procedure SetLeafThreshold(const Value: Single);
  170. procedure SetCentralLeaderBias(const Value: Single);
  171. procedure SetCentralLeader(const Value: Boolean);
  172. procedure SetSeed(const Value: Integer);
  173. procedure SetAutoCenter(const Value: Boolean);
  174. procedure SetAutoRebuild(const Value: Boolean);
  175. procedure SetCenterBranchConstant(const Value: Single);
  176. procedure SetMaterialLibrary(const Value: TGLMaterialLibrary);
  177. procedure SetLeafMaterialName(const Value: TGLLibMaterialName);
  178. procedure SetLeafBackMaterialName(const Value: TGLLibMaterialName);
  179. procedure SetBranchMaterialName(const Value: TGLLibMaterialName);
  180. procedure Loaded; override;
  181. public
  182. constructor Create(AOwner: TComponent); override;
  183. destructor Destroy; override;
  184. procedure Notification(AComponent: TComponent;
  185. Operation: TOperation); override;
  186. procedure DoRender(var ARci: TGLRenderContextInfo;
  187. ARenderSelf, ARenderChildren: Boolean); override;
  188. procedure BuildList(var rci: TGLRenderContextInfo); override;
  189. procedure StructureChanged; override;
  190. procedure BuildMesh(GLBaseMesh: TGLBaseMesh);
  191. procedure RebuildTree;
  192. procedure ForceTotalRebuild;
  193. procedure Clear;
  194. procedure GetExtents(var min, max: TAffineVector);
  195. function AxisAlignedDimensionsUnscaled: TGLVector; override;
  196. procedure LoadFromStream(aStream: TStream);
  197. procedure SaveToStream(aStream: TStream);
  198. procedure LoadFromFile(const aFileName: String);
  199. procedure SaveToFile(const aFileName: String);
  200. property Leaves: TGLTreeLeaves read FLeaves;
  201. property Branches: TGLTreeBranches read FBranches;
  202. property Noise: TGLTreeBranchNoise read FNoise;
  203. published
  204. // The depth of tree branch recursion.
  205. property Depth: Integer read FDepth write SetDepth;
  206. // The number of facets for each branch in the tree.
  207. property BranchFacets: Integer read FBranchFacets write SetBranchFacets;
  208. // Leaf size modifier. Leaf size is also influenced by branch recursion scale.
  209. property LeafSize: Single read FLeafSize write SetLeafSize;
  210. // Branch length modifier.
  211. property BranchSize: Single read FBranchSize write SetBranchSize;
  212. // Overall branch noise influence. Relates to the 'fullness' of the tree.
  213. property BranchNoise: Single read FBranchNoise write SetBranchNoise;
  214. (* Effects the habit of the tree. Values from 0 to 1 refer to Upright to
  215. Spreading respectively. *)
  216. property BranchAngleBias: Single read FBranchAngleBias write SetBranchAngleBias;
  217. // Effects the balance of the tree.
  218. property BranchAngle: Single read FBranchAngle write SetBranchAngle;
  219. // Effects the rotation of each sub branch in recursion.
  220. property BranchTwist: Single read FBranchTwist write SetBranchTwist;
  221. // Effects the thickness of the branches.
  222. property BranchRadius: Single read FBranchRadius write SetBranchRadius;
  223. // Determines how thin a branch can get before a leaf is substituted.
  224. property LeafThreshold: Single read FLeafThreshold write SetLeafThreshold;
  225. // Determines how BranchAngle effects the central leader (CentralLeader must = True).
  226. property CentralLeaderBias: Single read FCentralLeaderBias
  227. write SetCentralLeaderBias;
  228. // Does this tree have a central leader?
  229. property CentralLeader: Boolean read FCentralLeader write SetCentralLeader;
  230. property Seed: Integer read FSeed write SetSeed;
  231. // Automatically center the tree's vertices after building them.
  232. property AutoCenter: Boolean read FAutoCenter write SetAutoCenter;
  233. // Automatically rebuild the tree after changing the settings
  234. property AutoRebuild: Boolean read FAutoRebuild write SetAutoRebuild;
  235. (* Central branch can be thinner(lower values)/thicker(->1) depending on this constant.
  236. The effect also depends on the BranchAngle variable. *)
  237. property CenterBranchConstant: Single read FCenterBranchConstant
  238. write SetCenterBranchConstant;
  239. property MaterialLibrary: TGLMaterialLibrary read FMaterialLibrary
  240. write SetMaterialLibrary;
  241. property LeafMaterialName: TGLLibMaterialName read FLeafMaterialName
  242. write SetLeafMaterialName;
  243. property LeafBackMaterialName: TGLLibMaterialName read FLeafBackMaterialName
  244. write SetLeafBackMaterialName;
  245. property BranchMaterialName: TGLLibMaterialName read FBranchMaterialName
  246. write SetBranchMaterialName;
  247. end;
  248. // -----------------------------------------------------------------------------
  249. implementation
  250. // -----------------------------------------------------------------------------
  251. // -----------------------------------------------------------------------------
  252. // TGLTreeLeaves
  253. // -----------------------------------------------------------------------------
  254. constructor TGLTreeLeaves.Create(AOwner: TGLTree);
  255. begin
  256. FOwner := AOwner;
  257. FCount := 0;
  258. FVertices := TGLAffineVectorList.Create;
  259. FNormals := TGLAffineVectorList.Create;
  260. FTexCoords := TGLAffineVectorList.Create;
  261. end;
  262. destructor TGLTreeLeaves.Destroy;
  263. begin
  264. FVertices.Free;
  265. FNormals.Free;
  266. FTexCoords.Free;
  267. inherited;
  268. end;
  269. procedure TGLTreeLeaves.AddNew(matrix: TGLMatrix);
  270. var
  271. radius: Single;
  272. pos: TGLVector;
  273. begin
  274. radius := Owner.LeafSize;
  275. Inc(FCount);
  276. pos := matrix.W;
  277. matrix.W := NullHMGPoint;
  278. matrix := Roll(matrix, FCount / 10);
  279. NormalizeMatrix(matrix);
  280. matrix.W := pos;
  281. FVertices.Add(VectorTransform(PointMake(0, -radius, 0), matrix));
  282. FVertices.Add(VectorTransform(PointMake(0, radius, 0), matrix));
  283. FVertices.Add(VectorTransform(PointMake(0, radius, 2 * radius), matrix));
  284. FVertices.Add(VectorTransform(PointMake(0, -radius, 2 * radius), matrix));
  285. FNormals.Add(VectorTransform(XHmgVector, matrix));
  286. FTexCoords.Add(XVector, NullVector);
  287. FTexCoords.Add(YVector, XYVector);
  288. end;
  289. procedure TGLTreeLeaves.BuildList(var rci: TGLRenderContextInfo);
  290. var
  291. i: Integer;
  292. n: TAffineVector;
  293. libMat: TGLLibMaterial;
  294. begin
  295. libMat := Owner.MaterialLibrary.LibMaterialByName(Owner.LeafMaterialName);
  296. if Assigned(libMat) then
  297. libMat.Apply(rci);
  298. gl.EnableClientState(GL_VERTEX_ARRAY);
  299. xgl.EnableClientState(GL_TEXTURE_COORD_ARRAY);
  300. gl.VertexPointer(3, GL_FLOAT, 0, @FVertices.List[0]);
  301. xgl.TexCoordPointer(3, GL_FLOAT, 0, @FTexCoords.List[0]);
  302. for i := 0 to (FVertices.Count div 4) - 1 do
  303. begin
  304. gl.Normal3fv(@FNormals.List[i]);
  305. gl.DrawArrays(GL_QUADS, 4 * i, 4);
  306. end;
  307. with Owner do
  308. if LeafMaterialName <> LeafBackMaterialName then
  309. begin
  310. if Assigned(libMat) then
  311. libMat.UnApply(rci);
  312. libMat := MaterialLibrary.LibMaterialByName(LeafBackMaterialName);
  313. if Assigned(libMat) then
  314. libMat.Apply(rci);
  315. end;
  316. rci.GLStates.InvertGLFrontFace;
  317. for i := 0 to (FVertices.Count div 4) - 1 do
  318. begin
  319. n := VectorNegate(FNormals[i]);
  320. gl.Normal3fv(@n);
  321. gl.DrawArrays(GL_QUADS, 4 * i, 4);
  322. end;
  323. rci.GLStates.InvertGLFrontFace;
  324. gl.DisableClientState(GL_VERTEX_ARRAY);
  325. xgl.DisableClientState(GL_TEXTURE_COORD_ARRAY);
  326. if Assigned(libMat) then
  327. libMat.UnApply(rci);
  328. end;
  329. procedure TGLTreeLeaves.Clear;
  330. begin
  331. FVertices.Clear;
  332. FNormals.Clear;
  333. FTexCoords.Clear;
  334. FCount := 0;
  335. end;
  336. // -----------------------------------------------------------------------------
  337. // TGLTreeBranch
  338. // -----------------------------------------------------------------------------
  339. constructor TGLTreeBranch.Create(AOwner: TGLTreeBranches;
  340. AParent: TGLTreeBranch);
  341. begin
  342. FOwner := AOwner;
  343. FParent := AParent;
  344. FUpper := TGLIntegerList.Create;
  345. FLower := TGLIntegerList.Create;
  346. FCentralLeader := False;
  347. // Skeletal construction helpers
  348. if Assigned(FOwner) then
  349. begin
  350. FBranchID := FOwner.Count - 1;
  351. FOwner.FBranchCache.Add(Self);
  352. end
  353. else
  354. FBranchID := -1;
  355. if Assigned(FParent) then
  356. FParentID := FParent.FBranchID
  357. else
  358. FParentID := -1;
  359. end;
  360. destructor TGLTreeBranch.Destroy;
  361. begin
  362. FUpper.Free;
  363. FLower.Free;
  364. FLeft.Free;
  365. FRight.Free;
  366. inherited;
  367. end;
  368. procedure TGLTreeBranch.BuildBranch(branchNoise: TGLTreeBranchNoise;
  369. const matrix: TGLMatrix; TexCoordY, Twist: Single; Level: Integer);
  370. var
  371. i: Integer;
  372. Tree: TGLTree;
  373. Branches: TGLTreeBranches;
  374. Facets: Integer;
  375. t, c, s: Single;
  376. radius, LeftRadius, RightRadius, CenterRadius: Single;
  377. BranchAngle, LeftAngle, RightAngle, CenterAngle: Single;
  378. BranchAngleBias, BranchTwist, Taper: Single;
  379. LeftBranchNoiseValue, RightBranchNoiseValue, CenterBranchNoiseValue: Single;
  380. LeftBranchNoise: TGLTreeBranchNoise;
  381. CenterBranchNoise: TGLTreeBranchNoise;
  382. RightBranchNoise: TGLTreeBranchNoise;
  383. LeftMatrix, RightMatrix, CenterMatrix: TGLMatrix;
  384. central_leader: Boolean;
  385. begin
  386. Assert(Assigned(FOwner), 'Incorrect use of TGLTreeBranch');
  387. Assert(Assigned(FOwner.FOwner), 'Incorrect use of TGLTreeBranches');
  388. FMatrix := matrix;
  389. Branches := FOwner;
  390. Tree := FOwner.FOwner;
  391. Facets := Tree.BranchFacets;
  392. radius := Tree.BranchRadius;
  393. FLower.Clear;
  394. FLower.Capacity := Facets + 1;
  395. FUpper.Clear;
  396. FUpper.Capacity := Facets + 1;
  397. BranchAngle := Tree.BranchAngle;
  398. BranchAngleBias := Tree.BranchAngleBias;
  399. BranchTwist := Twist + Tree.BranchTwist;
  400. LeftBranchNoise := branchNoise.Left;
  401. CenterBranchNoise := branchNoise.Center;
  402. RightBranchNoise := branchNoise.Right;
  403. LeftBranchNoiseValue := ((LeftBranchNoise.branchNoise * 0.4) - 0.1) *
  404. Tree.branchNoise;
  405. LeftRadius := Sqrt(1 - BranchAngle + LeftBranchNoiseValue);
  406. LeftRadius := ClampValue(LeftRadius, 0, 1);
  407. LeftAngle := BranchAngle * 90 * BranchAngleBias + 10 * LeftBranchNoiseValue;
  408. CenterBranchNoiseValue := ((CenterBranchNoise.branchNoise * 0.9) - 0.1) *
  409. Tree.branchNoise;
  410. CenterRadius := Sqrt(Tree.CenterBranchConstant - BranchAngle +
  411. CenterBranchNoiseValue);
  412. CenterRadius := ClampValue(CenterRadius, 0, 1);
  413. CenterAngle := (1 - BranchAngle) * 50 * CenterBranchNoiseValue *
  414. BranchAngleBias;
  415. RightBranchNoiseValue := ((RightBranchNoise.branchNoise * 0.6) - 0.1) *
  416. Tree.branchNoise;
  417. RightRadius := Sqrt(BranchAngle + RightBranchNoiseValue);
  418. RightRadius := ClampValue(RightRadius, 0, 1);
  419. RightAngle := (1 - BranchAngle) * -90 * BranchAngleBias + 10 *
  420. RightBranchNoiseValue;
  421. Taper := MaxFloat(LeftRadius, RightRadius, CenterRadius);
  422. // Build cylinder lower
  423. for i := 0 to Facets do
  424. begin
  425. t := 1 / Facets * i;
  426. c := Branches.CosList[i];
  427. s := Branches.SinList[i];
  428. Branches.Vertices.Add(VectorTransform(PointMake(c * radius, s * radius,
  429. radius), matrix));
  430. Branches.Normals.Add(VectorTransform(VectorMake(c, s, 0), matrix));
  431. Branches.TexCoords.Add(t, TexCoordY);
  432. FLower.Add(Branches.Vertices.Count - 1);
  433. Branches.FBranchIndices.Add(FBranchID);
  434. end;
  435. TexCoordY := TexCoordY + 1 - 2 * radius;
  436. // Build cylinder upper
  437. for i := 0 to Facets do
  438. begin
  439. t := 1 / Facets * i;
  440. c := Branches.CosList[i];
  441. s := Branches.SinList[i];
  442. Branches.Vertices.Add(VectorTransform(PointMake(c * radius * Taper,
  443. s * radius * Taper, 1 - radius), matrix));
  444. Branches.Normals.Add(VectorTransform(VectorMake(c, s, 0), matrix));
  445. Branches.TexCoords.Add(t, TexCoordY);
  446. FUpper.Add(Branches.Vertices.Count - 1);
  447. Branches.FBranchIndices.Add(FBranchID);
  448. end;
  449. TexCoordY := TexCoordY + 2 * radius;
  450. // BuildMatrices
  451. SinCos(DegToRad(BranchTwist), s, c);
  452. if Level = 0 then
  453. central_leader := FCentralLeader
  454. else
  455. central_leader := FParent.FCentralLeader;
  456. if central_leader then
  457. begin
  458. LeftMatrix := MatrixMultiply(CreateScaleMatrix(AffineVectorMake(LeftRadius,
  459. LeftRadius, LeftRadius)), CreateRotationMatrix(AffineVectorMake(s, c, 0),
  460. DegToRad(LeftAngle) * Tree.CentralLeaderBias));
  461. end
  462. else
  463. begin
  464. LeftMatrix := MatrixMultiply(CreateScaleMatrix(AffineVectorMake(LeftRadius,
  465. LeftRadius, LeftRadius)), CreateRotationMatrix(AffineVectorMake(s, c, 0),
  466. DegToRad(LeftAngle)));
  467. end;
  468. LeftMatrix := MatrixMultiply(LeftMatrix,
  469. MatrixMultiply(CreateTranslationMatrix(AffineVectorMake(0, 0,
  470. Tree.BranchSize * (1 - LeftBranchNoiseValue))), matrix));
  471. CenterMatrix := MatrixMultiply
  472. (CreateScaleMatrix(AffineVectorMake(CenterRadius, CenterRadius,
  473. CenterRadius)), CreateRotationMatrix(AffineVectorMake(s, c, 0),
  474. DegToRad(CenterAngle)));
  475. CenterMatrix := MatrixMultiply(CenterMatrix,
  476. MatrixMultiply(CreateTranslationMatrix(AffineVectorMake(0, 0,
  477. Tree.BranchSize * (1 - CenterBranchNoiseValue))), matrix));
  478. RightMatrix := MatrixMultiply(CreateScaleMatrix(AffineVectorMake(RightRadius,
  479. RightRadius, RightRadius)), CreateRotationMatrix(AffineVectorMake(s, c, 0),
  480. DegToRad(RightAngle)));
  481. RightMatrix := MatrixMultiply(RightMatrix,
  482. MatrixMultiply(CreateTranslationMatrix(AffineVectorMake(0, 0,
  483. Tree.BranchSize * (1 - RightBranchNoiseValue))), matrix));
  484. if (((Level + 1) >= Tree.Depth) or (LeftRadius < Tree.LeafThreshold)) then
  485. begin
  486. Tree.Leaves.AddNew(LeftMatrix);
  487. end
  488. else
  489. begin
  490. Inc(Branches.FCount);
  491. FLeft := TGLTreeBranch.Create(Owner, Self);
  492. FLeft.FCentralLeader := central_leader and (LeftRadius >= RightRadius);
  493. FLeft.BuildBranch(LeftBranchNoise, LeftMatrix, TexCoordY, BranchTwist,
  494. Level + 1);
  495. end;
  496. if (((Level + 1) >= Tree.Depth) or (CenterRadius < Tree.LeafThreshold)) then
  497. begin
  498. Tree.Leaves.AddNew(CenterMatrix);
  499. end
  500. else
  501. begin
  502. Inc(Branches.FCount);
  503. FCenter := TGLTreeBranch.Create(Owner, Self);
  504. FCenter.BuildBranch(CenterBranchNoise, CenterMatrix, TexCoordY, BranchTwist,
  505. Level + 1);
  506. end;
  507. if (((Level + 1) >= Tree.Depth) or (RightRadius < Tree.LeafThreshold)) then
  508. begin
  509. Tree.Leaves.AddNew(RightMatrix);
  510. end
  511. else
  512. begin
  513. Inc(Branches.FCount);
  514. FRight := TGLTreeBranch.Create(Owner, Self);
  515. FRight.BuildBranch(RightBranchNoise, RightMatrix, TexCoordY, BranchTwist,
  516. Level + 1);
  517. end;
  518. for i := 0 to Facets do
  519. begin
  520. Branches.FIndices.Add(Upper[i]);
  521. Branches.FIndices.Add(Lower[i]);
  522. end;
  523. if Assigned(FRight) then
  524. begin
  525. for i := 0 to Facets do
  526. begin
  527. Branches.FIndices.Add(Right.Lower[i]);
  528. Branches.FIndices.Add(Upper[i]);
  529. end;
  530. end;
  531. if Assigned(FCenter) then
  532. begin
  533. for i := 0 to Facets do
  534. begin
  535. Branches.FIndices.Add(Center.Lower[i]);
  536. Branches.FIndices.Add(Upper[i]);
  537. end;
  538. end;
  539. if Assigned(FLeft) then
  540. begin
  541. for i := 0 to Facets do
  542. begin
  543. Branches.FIndices.Add(Left.Lower[i]);
  544. Branches.FIndices.Add(Upper[i]);
  545. end;
  546. end;
  547. end;
  548. // -----------------------------------------------------------------------------
  549. // TGLTreeBranches
  550. // -----------------------------------------------------------------------------
  551. constructor TGLTreeBranches.Create(AOwner: TGLTree);
  552. begin
  553. FOwner := AOwner;
  554. FSinList := TGLSingleList.Create;
  555. FCosList := TGLSingleList.Create;
  556. FVertices := TGLAffineVectorList.Create;
  557. FNormals := TGLAffineVectorList.Create;
  558. FTexCoords := TGLAffineVectorList.Create;
  559. FIndices := TGLIntegerList.Create;
  560. FBranchCache := TList.Create;
  561. FBranchIndices := TGLIntegerList.Create;
  562. FCount := 0;
  563. end;
  564. destructor TGLTreeBranches.Destroy;
  565. begin
  566. FSinList.Free;
  567. FCosList.Free;
  568. FVertices.Free;
  569. FNormals.Free;
  570. FTexCoords.Free;
  571. FIndices.Free;
  572. FRoot.Free;
  573. FBranchCache.Free;
  574. FBranchIndices.Free;
  575. inherited;
  576. end;
  577. procedure TGLTreeBranches.BuildBranches;
  578. var
  579. i: Integer;
  580. u: Single;
  581. delta, min, max: TAffineVector;
  582. begin
  583. RandSeed := Owner.FSeed;
  584. for i := 0 to Owner.BranchFacets do
  585. begin
  586. u := 1 / Owner.BranchFacets * i;
  587. SinList.Add(Sin(PI * 2 * u));
  588. CosList.Add(Cos(PI * 2 * u));
  589. end;
  590. Inc(FCount);
  591. FRoot := TGLTreeBranch.Create(Self, nil);
  592. FRoot.FCentralLeader := Owner.CentralLeader;
  593. FRoot.BuildBranch(Owner.Noise, IdentityHMGMatrix, 0, 0, 0);
  594. delta := AffineVectorMake(0, 0, -Owner.BranchRadius);
  595. Vertices.Translate(delta);
  596. Owner.Leaves.Vertices.Translate(delta);
  597. if Owner.AutoCenter then
  598. begin
  599. Owner.GetExtents(min, max);
  600. delta := VectorCombine(min, max, -0.5, -0.5);
  601. Vertices.Translate(delta);
  602. Owner.Leaves.Vertices.Translate(delta);
  603. end;
  604. Owner.FAxisAlignedDimensionsCache.X := -1;
  605. end;
  606. procedure TGLTreeBranches.BuildList(var rci: TGLRenderContextInfo);
  607. var
  608. i, stride: Integer;
  609. libMat: TGLLibMaterial;
  610. begin
  611. stride := (Owner.BranchFacets + 1) * 2;
  612. libMat := Owner.MaterialLibrary.LibMaterialByName(Owner.BranchMaterialName);
  613. if Assigned(libMat) then
  614. libMat.Apply(rci);
  615. gl.VertexPointer(3, GL_FLOAT, 0, @FVertices.List[0]);
  616. gl.NormalPointer(GL_FLOAT, 0, @FNormals.List[0]);
  617. xgl.TexCoordPointer(3, GL_FLOAT, 0, @FTexCoords.List[0]);
  618. gl.EnableClientState(GL_VERTEX_ARRAY);
  619. gl.EnableClientState(GL_NORMAL_ARRAY);
  620. xgl.EnableClientState(GL_TEXTURE_COORD_ARRAY);
  621. repeat
  622. for i := 0 to (FIndices.Count div stride) - 1 do
  623. gl.DrawElements(GL_TRIANGLE_STRIP, stride, GL_UNSIGNED_INT,
  624. @FIndices.List[stride * i]);
  625. until (not Assigned(libMat)) or (not libMat.UnApply(rci));
  626. xgl.DisableClientState(GL_TEXTURE_COORD_ARRAY);
  627. gl.DisableClientState(GL_NORMAL_ARRAY);
  628. gl.DisableClientState(GL_VERTEX_ARRAY);
  629. end;
  630. // Clear
  631. //
  632. procedure TGLTreeBranches.Clear;
  633. begin
  634. FSinList.Clear;
  635. FCosList.Clear;
  636. FVertices.Clear;
  637. FNormals.Clear;
  638. FTexCoords.Clear;
  639. FIndices.Clear;
  640. FBranchCache.Clear;
  641. FBranchIndices.Clear;
  642. FreeAndNil(FRoot);
  643. FCount := 0;
  644. end;
  645. // -----------------------------------------------------------------------------
  646. // TGLTreeBranchNoise
  647. // -----------------------------------------------------------------------------
  648. constructor TGLTreeBranchNoise.Create;
  649. begin
  650. FBranchNoise := Random;
  651. end;
  652. destructor TGLTreeBranchNoise.Destroy;
  653. begin
  654. FLeft.Free;
  655. FRight.Free;
  656. inherited;
  657. end;
  658. function TGLTreeBranchNoise.GetLeft: TGLTreeBranchNoise;
  659. begin
  660. if not Assigned(FLeft) then
  661. FLeft := TGLTreeBranchNoise.Create;
  662. Result := FLeft;
  663. end;
  664. function TGLTreeBranchNoise.GetRight: TGLTreeBranchNoise;
  665. begin
  666. if not Assigned(FRight) then
  667. FRight := TGLTreeBranchNoise.Create;
  668. Result := FRight;
  669. end;
  670. function TGLTreeBranchNoise.GetCenter: TGLTreeBranchNoise;
  671. begin
  672. if not Assigned(FCenter) then
  673. FCenter := TGLTreeBranchNoise.Create;
  674. Result := FCenter;
  675. end;
  676. // -----------------------------------------------------------------------------
  677. // TGLTree
  678. // -----------------------------------------------------------------------------
  679. constructor TGLTree.Create(AOwner: TComponent);
  680. begin
  681. inherited;
  682. // Default tree setting
  683. FDepth := 5;
  684. FLeafThreshold := 0.02;
  685. FBranchAngleBias := 0.6;
  686. FBranchAngle := 0.4;
  687. FBranchTwist := 45;
  688. FBranchNoise := 0.7;
  689. FBranchSize := 1.0;
  690. FLeafSize := 0.1;
  691. FBranchRadius := 0.12;
  692. FBranchFacets := 6;
  693. FCentralLeader := False;
  694. FSeed := 0;
  695. FAutoCenter := False;
  696. FAutoRebuild := True;
  697. FCenterBranchConstant := 0.5;
  698. FLeaves := TGLTreeLeaves.Create(Self);
  699. FBranches := TGLTreeBranches.Create(Self);
  700. FNoise := TGLTreeBranchNoise.Create;
  701. end;
  702. destructor TGLTree.Destroy;
  703. begin
  704. FLeaves.Free;
  705. FBranches.Free;
  706. FNoise.Free;
  707. inherited;
  708. end;
  709. procedure TGLTree.Loaded;
  710. begin
  711. inherited;
  712. FBranches.BuildBranches;
  713. end;
  714. procedure TGLTree.Notification(AComponent: TComponent; Operation: TOperation);
  715. begin
  716. if (Operation = opRemove) and (AComponent = FMaterialLibrary) then
  717. MaterialLibrary := nil;
  718. inherited;
  719. end;
  720. procedure TGLTree.DoRender(var ARci: TGLRenderContextInfo;
  721. ARenderSelf, ARenderChildren: Boolean);
  722. begin
  723. MaterialLibrary.LibMaterialByName(BranchMaterialName).PrepareBuildList;
  724. MaterialLibrary.LibMaterialByName(LeafMaterialName).PrepareBuildList;
  725. MaterialLibrary.LibMaterialByName(LeafBackMaterialName).PrepareBuildList;
  726. inherited;
  727. end;
  728. procedure TGLTree.BuildList(var rci: TGLRenderContextInfo);
  729. begin
  730. if FRebuildTree then
  731. begin
  732. FBranches.BuildBranches;
  733. FRebuildTree := False;
  734. end;
  735. Branches.BuildList(rci);
  736. Leaves.BuildList(rci);
  737. end;
  738. procedure TGLTree.StructureChanged;
  739. begin
  740. FAxisAlignedDimensionsCache.X := -1;
  741. inherited;
  742. end;
  743. procedure TGLTree.BuildMesh(GLBaseMesh: TGLBaseMesh);
  744. procedure RecursBranches(Branch: TGLTreeBranch; bone: TGLSkeletonBone;
  745. Frame: TGLSkeletonFrame);
  746. var
  747. trans: TTransformations;
  748. mat: TGLMatrix;
  749. rot, pos: TAffineVector;
  750. begin
  751. bone.Name := 'Branch' + IntToStr(Branch.FBranchID);
  752. bone.BoneID := Branch.FBranchID;
  753. // Construct base frame
  754. if Assigned(Branch.FParent) then
  755. mat := Branch.FParent.FMatrix
  756. else
  757. mat := IdentityHMGMatrix;
  758. InvertMatrix(mat);
  759. NormalizeMatrix(mat);
  760. if MatrixDecompose(mat, trans) then
  761. begin
  762. SetVector(rot, trans[ttRotateX], trans[ttRotateY], trans[ttRotateZ]);
  763. SetVector(pos, mat.W);
  764. end
  765. else
  766. begin
  767. rot := NullVector;
  768. pos := NullVector;
  769. end;
  770. Frame.Rotation.Add(rot);
  771. Frame.Position.Add(pos);
  772. // Recurse with child branches
  773. if Assigned(Branch.Left) then
  774. RecursBranches(Branch.Left, TGLSkeletonBone.CreateOwned(bone), Frame);
  775. if Assigned(Branch.Right) then
  776. RecursBranches(Branch.Right, TGLSkeletonBone.CreateOwned(bone), Frame);
  777. end;
  778. var
  779. // SkelMesh : TGLSkeletonMeshObject;
  780. fg: TFGVertexIndexList;
  781. fg2: TFGVertexNormalTexIndexList;
  782. i, j, stride: Integer;
  783. // parent_id : integer;
  784. // bone : TGLSkeletonBone;
  785. begin
  786. if not Assigned(GLBaseMesh) then
  787. exit;
  788. if FRebuildTree then
  789. begin
  790. FBranches.BuildBranches;
  791. FRebuildTree := False;
  792. end;
  793. GLBaseMesh.MeshObjects.Clear;
  794. GLBaseMesh.Skeleton.Clear;
  795. // if GLBaseMesh is TGLActor then
  796. // TGLSkeletonMeshObject.CreateOwned(GLBaseMesh.MeshObjects)
  797. // else
  798. TGLMeshObject.CreateOwned(GLBaseMesh.MeshObjects);
  799. GLBaseMesh.MeshObjects[0].Mode := momFaceGroups;
  800. // Branches
  801. GLBaseMesh.MeshObjects[0].Vertices.Add(Branches.Vertices);
  802. GLBaseMesh.MeshObjects[0].Normals.Add(Branches.Normals);
  803. GLBaseMesh.MeshObjects[0].TexCoords.Add(Branches.TexCoords);
  804. { if GLBaseMesh is TGLActor then begin
  805. TGLActor(GLBaseMesh).Reference:=aarSkeleton;
  806. RecursBranches(Branches.FRoot,
  807. TGLSkeletonBone.CreateOwned(GLBaseMesh.Skeleton.RootBones),
  808. TGLSkeletonFrame.CreateOwned(GLBaseMesh.Skeleton.Frames));
  809. SkelMesh:=TGLSkeletonMeshObject(GLBaseMesh.MeshObjects[0]);
  810. SkelMesh.BonesPerVertex:=1;
  811. SkelMesh.VerticeBoneWeightCount:=Branches.FBranchIndices.Count;
  812. for i:=0 to Branches.FBranchIndices.Count-1 do
  813. SkelMesh.AddWeightedBone(Branches.FBranchIndices[i],1);
  814. GLBaseMesh.Skeleton.RootBones.PrepareGlobalMatrices;
  815. SkelMesh.PrepareBoneMatrixInvertedMeshes;
  816. SkelMesh.ApplyCurrentSkeletonFrame(True);
  817. end;// }
  818. stride := (BranchFacets + 1) * 2;
  819. for i := 0 to (FBranches.FIndices.Count div stride) - 1 do
  820. begin
  821. fg := TFGVertexIndexList.CreateOwned(GLBaseMesh.MeshObjects[0].FaceGroups);
  822. fg.MaterialName := BranchMaterialName;
  823. fg.Mode := fgmmTriangleStrip;
  824. for j := 0 to stride - 1 do
  825. fg.VertexIndices.Add(Branches.FIndices[i * stride + j]);
  826. end;
  827. // Leaves
  828. // if GLBaseMesh is TGLActor then
  829. // TGLSkeletonMeshObject.CreateOwned(GLBaseMesh.MeshObjects)
  830. // else
  831. TGLMeshObject.CreateOwned(GLBaseMesh.MeshObjects);
  832. GLBaseMesh.MeshObjects[1].Mode := momFaceGroups;
  833. GLBaseMesh.MeshObjects[1].Vertices.Add(Leaves.Vertices);
  834. GLBaseMesh.MeshObjects[1].Normals.Add(Leaves.FNormals);
  835. for i := 0 to Leaves.Normals.Count - 1 do
  836. GLBaseMesh.MeshObjects[1].Normals.Add(VectorNegate(Leaves.FNormals[i]));
  837. GLBaseMesh.MeshObjects[1].TexCoords.Add(Leaves.TexCoords);
  838. for i := 0 to (Leaves.FVertices.Count div 4) - 1 do
  839. begin
  840. // Leaf front
  841. fg2 := TFGVertexNormalTexIndexList.CreateOwned
  842. (GLBaseMesh.MeshObjects[1].FaceGroups);
  843. fg2.MaterialName := LeafMaterialName;
  844. fg2.Mode := fgmmTriangleStrip;
  845. with fg2.VertexIndices do
  846. begin
  847. Add(i * 4);
  848. Add(i * 4 + 1);
  849. Add(i * 4 + 3);
  850. Add(i * 4 + 2);
  851. end;
  852. for j := 0 to 3 do
  853. fg2.NormalIndices.Add(i);
  854. with fg2.TexCoordIndices do
  855. begin
  856. Add(0);
  857. Add(1);
  858. Add(3);
  859. Add(2);
  860. end;
  861. // Leaf back
  862. fg2 := TFGVertexNormalTexIndexList.CreateOwned
  863. (GLBaseMesh.MeshObjects[1].FaceGroups);
  864. fg2.MaterialName := LeafBackMaterialName;
  865. fg2.Mode := fgmmTriangleStrip;
  866. with fg2.VertexIndices do
  867. begin
  868. Add(i * 4);
  869. Add(i * 4 + 3);
  870. Add(i * 4 + 1);
  871. Add(i * 4 + 2);
  872. end;
  873. for j := 0 to 3 do
  874. fg2.NormalIndices.Add(i);
  875. with fg2.TexCoordIndices do
  876. begin
  877. Add(0);
  878. Add(3);
  879. Add(1);
  880. Add(2);
  881. end;
  882. end;
  883. end;
  884. procedure TGLTree.Clear;
  885. begin
  886. FLeaves.Clear;
  887. FBranches.Clear;
  888. end;
  889. procedure TGLTree.SetBranchAngle(const Value: Single);
  890. begin
  891. if Value <> FBranchAngle then
  892. begin
  893. FBranchAngle := Value;
  894. if (FAutoRebuild) then
  895. RebuildTree;
  896. end;
  897. end;
  898. procedure TGLTree.SetBranchAngleBias(const Value: Single);
  899. begin
  900. if Value <> FBranchAngleBias then
  901. begin
  902. FBranchAngleBias := Value;
  903. if (FAutoRebuild) then
  904. RebuildTree;
  905. end;
  906. end;
  907. procedure TGLTree.SetBranchNoise(const Value: Single);
  908. begin
  909. if Value <> FBranchNoise then
  910. begin
  911. FBranchNoise := Value;
  912. if (FAutoRebuild) then
  913. RebuildTree;
  914. end;
  915. end;
  916. procedure TGLTree.SetBranchRadius(const Value: Single);
  917. begin
  918. if Value <> FBranchRadius then
  919. begin
  920. FBranchRadius := Value;
  921. if (FAutoRebuild) then
  922. RebuildTree;
  923. end;
  924. end;
  925. procedure TGLTree.SetBranchSize(const Value: Single);
  926. begin
  927. if Value <> FBranchSize then
  928. begin
  929. FBranchSize := Value;
  930. if (FAutoRebuild) then
  931. RebuildTree;
  932. end;
  933. end;
  934. procedure TGLTree.SetBranchTwist(const Value: Single);
  935. begin
  936. if Value <> FBranchTwist then
  937. begin
  938. FBranchTwist := Value;
  939. if (FAutoRebuild) then
  940. RebuildTree;
  941. end;
  942. end;
  943. procedure TGLTree.SetDepth(const Value: Integer);
  944. begin
  945. if Value <> FDepth then
  946. begin
  947. FDepth := Value;
  948. if (FAutoRebuild) then
  949. RebuildTree;
  950. end;
  951. end;
  952. procedure TGLTree.SetBranchFacets(const Value: Integer);
  953. begin
  954. if Value <> FBranchFacets then
  955. begin
  956. FBranchFacets := Value;
  957. if (FAutoRebuild) then
  958. RebuildTree;
  959. end;
  960. end;
  961. procedure TGLTree.SetLeafSize(const Value: Single);
  962. begin
  963. if Value <> FLeafSize then
  964. begin
  965. FLeafSize := Value;
  966. if (FAutoRebuild) then
  967. RebuildTree;
  968. end;
  969. end;
  970. procedure TGLTree.SetLeafThreshold(const Value: Single);
  971. begin
  972. if Value <> FLeafThreshold then
  973. begin
  974. FLeafThreshold := Value;
  975. if (FAutoRebuild) then
  976. RebuildTree;
  977. end;
  978. end;
  979. procedure TGLTree.SetCentralLeaderBias(const Value: Single);
  980. begin
  981. if Value <> FCentralLeaderBias then
  982. begin
  983. FCentralLeaderBias := Value;
  984. if (FAutoRebuild) then
  985. RebuildTree;
  986. end;
  987. end;
  988. procedure TGLTree.SetCentralLeader(const Value: Boolean);
  989. begin
  990. if Value <> FCentralLeader then
  991. begin
  992. FCentralLeader := Value;
  993. if (FAutoRebuild) then
  994. RebuildTree;
  995. end;
  996. end;
  997. procedure TGLTree.SetSeed(const Value: Integer);
  998. begin
  999. if Value <> FSeed then
  1000. begin
  1001. FSeed := Value;
  1002. if (FAutoRebuild) then
  1003. ForceTotalRebuild;
  1004. end;
  1005. end;
  1006. procedure TGLTree.SetCenterBranchConstant(const Value: Single);
  1007. begin
  1008. if Value <> CenterBranchConstant then
  1009. begin
  1010. FCenterBranchConstant := Value;
  1011. if (FAutoRebuild) then
  1012. ForceTotalRebuild;
  1013. end;
  1014. end;
  1015. procedure TGLTree.SetBranchMaterialName(const Value: TGLLibMaterialName);
  1016. begin
  1017. if Value <> FBranchMaterialName then
  1018. begin
  1019. FBranchMaterialName := Value;
  1020. StructureChanged;
  1021. end;
  1022. end;
  1023. procedure TGLTree.SetLeafBackMaterialName(const Value: TGLLibMaterialName);
  1024. begin
  1025. if Value <> FLeafBackMaterialName then
  1026. begin
  1027. FLeafBackMaterialName := Value;
  1028. StructureChanged;
  1029. end;
  1030. end;
  1031. procedure TGLTree.SetLeafMaterialName(const Value: TGLLibMaterialName);
  1032. begin
  1033. if Value <> FLeafMaterialName then
  1034. begin
  1035. FLeafMaterialName := Value;
  1036. StructureChanged;
  1037. end;
  1038. end;
  1039. procedure TGLTree.SetMaterialLibrary(const Value: TGLMaterialLibrary);
  1040. begin
  1041. if Value <> FMaterialLibrary then
  1042. begin
  1043. FMaterialLibrary := Value;
  1044. StructureChanged;
  1045. end;
  1046. end;
  1047. procedure TGLTree.RebuildTree;
  1048. begin
  1049. if not FRebuildTree then
  1050. begin
  1051. Clear;
  1052. FRebuildTree := True;
  1053. StructureChanged;
  1054. end;
  1055. end;
  1056. procedure TGLTree.ForceTotalRebuild;
  1057. begin
  1058. Clear;
  1059. FNoise.Free;
  1060. RandSeed := FSeed;
  1061. FNoise := TGLTreeBranchNoise.Create;
  1062. FRebuildTree := False;
  1063. FBranches.BuildBranches;
  1064. StructureChanged;
  1065. end;
  1066. procedure TGLTree.LoadFromStream(aStream: TStream);
  1067. var
  1068. StrList, StrParse: TStringList;
  1069. str: String;
  1070. i: Integer;
  1071. begin
  1072. StrList := TStringList.Create;
  1073. StrParse := TStringList.Create;
  1074. StrList.LoadFromStream(aStream);
  1075. try
  1076. for i := 0 to StrList.Count - 1 do
  1077. begin
  1078. str := StrList[i];
  1079. if pos('#', str) > 0 then
  1080. str := Copy(str, 0, pos('#', str) - 1);
  1081. StrParse.CommaText := str;
  1082. if StrParse.Count >= 2 then
  1083. begin
  1084. str := LowerCase(StrParse[0]);
  1085. if str = 'depth' then
  1086. FDepth := StrToInt(StrParse[1])
  1087. else if str = 'branch_facets' then
  1088. FBranchFacets := StrToInt(StrParse[1])
  1089. else if str = 'leaf_size' then
  1090. FLeafSize := GLStrToFloatDef(StrParse[1])
  1091. else if str = 'branch_size' then
  1092. FBranchSize := GLStrToFloatDef(StrParse[1])
  1093. else if str = 'branch_noise' then
  1094. FBranchNoise := GLStrToFloatDef(StrParse[1])
  1095. else if str = 'branch_angle_bias' then
  1096. FBranchAngleBias := GLStrToFloatDef(StrParse[1])
  1097. else if str = 'branch_angle' then
  1098. FBranchAngle := GLStrToFloatDef(StrParse[1])
  1099. else if str = 'branch_twist' then
  1100. FBranchTwist := GLStrToFloatDef(StrParse[1])
  1101. else if str = 'branch_radius' then
  1102. FBranchRadius := GLStrToFloatDef(StrParse[1])
  1103. else if str = 'leaf_threshold' then
  1104. FLeafThreshold := GLStrToFloatDef(StrParse[1])
  1105. else if str = 'central_leader_bias' then
  1106. FCentralLeaderBias := GLStrToFloatDef(StrParse[1])
  1107. else if str = 'central_leader' then
  1108. FCentralLeader := LowerCase(StrParse[1]) = 'true'
  1109. else if str = 'seed' then
  1110. FSeed := StrToInt(StrParse[1])
  1111. else if str = 'leaf_front_material_name' then
  1112. FLeafMaterialName := StrParse[1]
  1113. else if str = 'leaf_back_material_name' then
  1114. FLeafBackMaterialName := StrParse[1]
  1115. else if str = 'branch_material_name' then
  1116. FBranchMaterialName := StrParse[1];
  1117. end;
  1118. end;
  1119. ForceTotalRebuild;
  1120. finally
  1121. StrList.Free;
  1122. StrParse.Free;
  1123. end;
  1124. end;
  1125. procedure TGLTree.SaveToStream(aStream: TStream);
  1126. var
  1127. StrList: TStringList;
  1128. begin
  1129. StrList := TStringList.Create;
  1130. StrList.Add(Format('depth, %d', [Depth]));
  1131. StrList.Add(Format('branch_facets, %d', [BranchFacets]));
  1132. StrList.Add(Format('leaf_size, %f', [LeafSize]));
  1133. StrList.Add(Format('branch_size, %f', [BranchSize]));
  1134. StrList.Add(Format('branch_noise, %f', [branchNoise]));
  1135. StrList.Add(Format('branch_angle_bias, %f', [BranchAngleBias]));
  1136. StrList.Add(Format('branch_angle, %f', [BranchAngle]));
  1137. StrList.Add(Format('branch_twist, %f', [BranchTwist]));
  1138. StrList.Add(Format('branch_radius, %f', [BranchRadius]));
  1139. StrList.Add(Format('leaf_threshold, %f', [LeafThreshold]));
  1140. StrList.Add(Format('central_leader_bias, %f', [CentralLeaderBias]));
  1141. if CentralLeader then
  1142. StrList.Add('central_leader, true')
  1143. else
  1144. StrList.Add('central_leader, false');
  1145. StrList.Add(Format('seed, %d', [Seed]));
  1146. StrList.Add('leaf_front_material_name, "' + LeafMaterialName + '"');
  1147. StrList.Add('leaf_back_material_name, "' + LeafBackMaterialName + '"');
  1148. StrList.Add('branch_material_name, "' + BranchMaterialName + '"');
  1149. StrList.SaveToStream(aStream);
  1150. StrList.Free;
  1151. end;
  1152. procedure TGLTree.LoadFromFile(const aFileName: String);
  1153. var
  1154. stream: TStream;
  1155. begin
  1156. stream := TFileStream.Create(aFileName, fmOpenRead);
  1157. try
  1158. LoadFromStream(stream);
  1159. finally
  1160. stream.Free;
  1161. end;
  1162. end;
  1163. procedure TGLTree.SaveToFile(const aFileName: String);
  1164. var
  1165. stream: TStream;
  1166. begin
  1167. stream := TFileStream.Create(aFileName, fmCreate);
  1168. try
  1169. SaveToStream(stream);
  1170. finally
  1171. stream.Free;
  1172. end;
  1173. end;
  1174. procedure TGLTree.GetExtents(var min, max: TAffineVector);
  1175. var
  1176. lmin, lmax, bmin, bmax: TAffineVector;
  1177. begin
  1178. if Branches.Vertices.Count = 0 then
  1179. begin
  1180. FBranches.BuildBranches;
  1181. FRebuildTree := False;
  1182. end;
  1183. if Leaves.Vertices.Count > 0 then
  1184. Leaves.Vertices.GetExtents(lmin, lmax)
  1185. else
  1186. begin
  1187. lmin := NullVector;
  1188. lmax := NullVector;
  1189. end;
  1190. if Branches.Vertices.Count > 0 then
  1191. Branches.Vertices.GetExtents(bmin, bmax)
  1192. else
  1193. begin
  1194. bmin := NullVector;
  1195. bmax := NullVector;
  1196. end;
  1197. min.X := MinFloat([lmin.X, lmax.X, bmin.X, bmax.X]);
  1198. min.Y := MinFloat([lmin.Y, lmax.Y, bmin.Y, bmax.Y]);
  1199. min.Z := MinFloat([lmin.Z, lmax.Z, bmin.Z, bmax.Z]);
  1200. max.X := MaxFloat([lmin.X, lmax.X, bmin.X, bmax.X]);
  1201. max.Y := MaxFloat([lmin.Y, lmax.Y, bmin.Y, bmax.Y]);
  1202. max.Z := MaxFloat([lmin.Z, lmax.Z, bmin.Z, bmax.Z]);
  1203. end;
  1204. function TGLTree.AxisAlignedDimensionsUnscaled: TGLVector;
  1205. var
  1206. dMin, dMax: TAffineVector;
  1207. begin
  1208. if FAxisAlignedDimensionsCache.X < 0 then
  1209. begin
  1210. GetExtents(dMin, dMax);
  1211. FAxisAlignedDimensionsCache.X := MaxFloat(Abs(dMin.X), Abs(dMax.X));
  1212. FAxisAlignedDimensionsCache.Y := MaxFloat(Abs(dMin.Y), Abs(dMax.Y));
  1213. FAxisAlignedDimensionsCache.Z := MaxFloat(Abs(dMin.Z), Abs(dMax.Z));
  1214. end;
  1215. SetVector(Result, FAxisAlignedDimensionsCache);
  1216. end;
  1217. procedure TGLTree.SetAutoCenter(const Value: Boolean);
  1218. begin
  1219. if Value <> FAutoCenter then
  1220. begin
  1221. FAutoCenter := Value;
  1222. if (FAutoRebuild) then
  1223. RebuildTree;
  1224. end;
  1225. end;
  1226. procedure TGLTree.SetAutoRebuild(const Value: Boolean);
  1227. begin
  1228. if Value <> FAutoRebuild then
  1229. begin
  1230. FAutoRebuild := Value;
  1231. end;
  1232. end;
  1233. initialization
  1234. RegisterClasses([TGLTree]);
  1235. end.