GLMultiProxy.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411
  1. //
  2. // This unit is part of the GLScene Engine, http://glscene.org
  3. //
  4. unit GLMultiProxy;
  5. (* Implements a multi-proxy objects, useful for discreet LOD. *)
  6. interface
  7. {$I GLScene.inc}
  8. uses
  9. System.Classes,
  10. System.SysUtils,
  11. OpenGLTokens,
  12. GLPersistentClasses,
  13. GLContext,
  14. GLScene,
  15. GLVectorGeometry,
  16. GLSilhouette,
  17. GLRenderContextInfo,
  18. GLBaseClasses,
  19. GLVectorTypes;
  20. type
  21. TGLMultiProxy = class;
  22. (* MasterObject description for a MultiProxy object. *)
  23. TGLMultiProxyMaster = class (TCollectionItem)
  24. private
  25. FMasterObject : TGLBaseSceneObject;
  26. FDistanceMin, FDistanceMin2 : Single;
  27. FDistanceMax, FDistanceMax2 : Single;
  28. FVisible : Boolean;
  29. protected
  30. function GetDisplayName : String; override;
  31. procedure SetMasterObject(const val : TGLBaseSceneObject);
  32. procedure SetDistanceMin(const val : Single);
  33. procedure SetDistanceMax(const val : Single);
  34. procedure SetVisible(const val : Boolean);
  35. public
  36. constructor Create(Collection : TCollection); override;
  37. destructor Destroy; override;
  38. procedure Assign(Source: TPersistent); override;
  39. function OwnerObject : TGLMultiProxy;
  40. procedure NotifyChange;
  41. published
  42. {Specifies the Master object which will be proxy'ed. }
  43. property MasterObject : TGLBaseSceneObject read FMasterObject write SetMasterObject;
  44. {Minimum visibility distance (inclusive). }
  45. property DistanceMin : Single read FDistanceMin write SetDistanceMin;
  46. {Maximum visibility distance (exclusive). }
  47. property DistanceMax : Single read FDistanceMax write SetDistanceMax;
  48. {Determines if the master object can be visible (proxy'ed).
  49. Note: the master object's distance also has to be within DistanceMin
  50. and DistanceMax.}
  51. property Visible : Boolean read FVisible write SetVisible default True;
  52. end;
  53. {Collection of TGLMultiProxyMaster. }
  54. TGLMultiProxyMasters = class (TOwnedCollection)
  55. protected
  56. procedure SetItems(index : Integer; const val : TGLMultiProxyMaster);
  57. function GetItems(index : Integer) : TGLMultiProxyMaster;
  58. procedure Update(Item: TCollectionItem); override;
  59. public
  60. constructor Create(AOwner : TPersistent);
  61. function Add : TGLMultiProxyMaster; overload;
  62. function Add(master : TGLBaseSceneObject; distanceMin, distanceMax : Single) : TGLMultiProxyMaster; overload;
  63. property Items[index : Integer] : TGLMultiProxyMaster read GetItems write SetItems; default;
  64. procedure Notification(AComponent: TComponent);
  65. procedure NotifyChange;
  66. procedure EndUpdate; override;
  67. end;
  68. {Multiple Proxy object.
  69. This proxy has multiple master objects, which are individually made visible
  70. depending on a distance to the camera criterion. It can be used to implement
  71. discreet level of detail directly for static objects, or objects that
  72. go through cyclic animation.
  73. For dimensionsn raycasting and silhouette purposes, the first master is used
  74. (item zero in the MasterObjects collection). }
  75. TGLMultiProxy = class (TGLSceneObject)
  76. private
  77. FMasterObjects : TGLMultiProxyMasters;
  78. FRendering : Boolean; // internal use (loop protection)
  79. protected
  80. procedure SetMasterObjects(const val : TGLMultiProxyMasters);
  81. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  82. function PrimaryMaster : TGLBaseSceneObject;
  83. public
  84. constructor Create(AOwner: TComponent); override;
  85. destructor Destroy; override;
  86. procedure Assign(Source: TPersistent); override;
  87. procedure DoRender(var rci : TGLRenderContextInfo;
  88. renderSelf, renderChildren : Boolean); override;
  89. function AxisAlignedDimensionsUnscaled : TVector; override;
  90. function RayCastIntersect(const rayStart, rayVector : TVector;
  91. intersectPoint : PVector = nil;
  92. intersectNormal : PVector = nil) : Boolean; override;
  93. function GenerateSilhouette(const silhouetteParameters : TGLSilhouetteParameters) : TGLSilhouette; override;
  94. published
  95. property MasterObjects : TGLMultiProxyMasters read FMasterObjects write SetMasterObjects;
  96. property ObjectsSorting;
  97. property Direction;
  98. property PitchAngle;
  99. property Position;
  100. property RollAngle;
  101. property Scale;
  102. property ShowAxes;
  103. property TurnAngle;
  104. property Up;
  105. property Visible;
  106. property OnProgress;
  107. property Behaviours;
  108. end;
  109. //-------------------------------------------------------------
  110. implementation
  111. //-------------------------------------------------------------
  112. // ------------------
  113. // ------------------ TGLMultiProxyMaster ------------------
  114. // ------------------
  115. constructor TGLMultiProxyMaster.Create(Collection : TCollection);
  116. begin
  117. inherited Create(Collection);
  118. FVisible:=True;
  119. end;
  120. destructor TGLMultiProxyMaster.Destroy;
  121. begin
  122. MasterObject:=nil;
  123. inherited Destroy;
  124. end;
  125. procedure TGLMultiProxyMaster.Assign(Source: TPersistent);
  126. begin
  127. if Source is TGLMultiProxyMaster then begin
  128. MasterObject:=TGLMultiProxyMaster(Source).MasterObject;
  129. FDistanceMin:=TGLMultiProxyMaster(Source).FDistanceMin;
  130. FDistanceMin2:=TGLMultiProxyMaster(Source).FDistanceMin2;
  131. FDistanceMax:=TGLMultiProxyMaster(Source).FDistanceMax;
  132. FDistanceMax2:=TGLMultiProxyMaster(Source).FDistanceMax2;
  133. FVisible:=TGLMultiProxyMaster(Source).FVisible;
  134. NotifyChange;
  135. end else inherited;
  136. end;
  137. function TGLMultiProxyMaster.OwnerObject : TGLMultiProxy;
  138. begin
  139. Result:=TGLMultiProxy(TGLMultiProxyMasters(Collection).GetOwner);
  140. end;
  141. procedure TGLMultiProxyMaster.NotifyChange;
  142. begin
  143. TGLMultiProxyMasters(Collection).NotifyChange;
  144. end;
  145. function TGLMultiProxyMaster.GetDisplayName : String;
  146. begin
  147. if MasterObject<>nil then
  148. Result:=MasterObject.Name
  149. else Result:='???';
  150. Result:=Result+Format(' [%.2f; %.2f[', [DistanceMin, DistanceMax]);
  151. if not Visible then
  152. Result:=Result+' (hidden)';
  153. end;
  154. procedure TGLMultiProxyMaster.SetMasterObject(const val : TGLBaseSceneObject);
  155. begin
  156. if FMasterObject<>val then begin
  157. if Assigned(FMasterObject) then
  158. FMasterObject.RemoveFreeNotification(OwnerObject);
  159. FMasterObject:=val;
  160. if Assigned(FMasterObject) then
  161. FMasterObject.FreeNotification(OwnerObject);
  162. NotifyChange;
  163. end;
  164. end;
  165. procedure TGLMultiProxyMaster.SetDistanceMin(const val : Single);
  166. begin
  167. if FDistanceMin<>val then begin
  168. FDistanceMin:=val;
  169. FDistanceMin2:=Sqr(val);
  170. NotifyChange;
  171. end;
  172. end;
  173. procedure TGLMultiProxyMaster.SetDistanceMax(const val : Single);
  174. begin
  175. if FDistanceMax<>val then begin
  176. FDistanceMax:=val;
  177. FDistanceMax2:=Sqr(val);
  178. NotifyChange;
  179. end;
  180. end;
  181. procedure TGLMultiProxyMaster.SetVisible(const val : Boolean);
  182. begin
  183. if FVisible<>val then begin
  184. FVisible:=val;
  185. NotifyChange;
  186. end;
  187. end;
  188. // ------------------
  189. // ------------------ TGLMultiProxyMasters ------------------
  190. // ------------------
  191. constructor TGLMultiProxyMasters.Create(AOwner : TPersistent);
  192. begin
  193. inherited Create(AOwner, TGLMultiProxyMaster)
  194. end;
  195. procedure TGLMultiProxyMasters.SetItems(index : Integer; const val : TGLMultiProxyMaster);
  196. begin
  197. inherited Items[index]:=val;
  198. end;
  199. function TGLMultiProxyMasters.GetItems(index : Integer) : TGLMultiProxyMaster;
  200. begin
  201. Result:=TGLMultiProxyMaster(inherited Items[index]);
  202. end;
  203. procedure TGLMultiProxyMasters.Update(Item : TCollectionItem);
  204. begin
  205. inherited;
  206. NotifyChange;
  207. end;
  208. function TGLMultiProxyMasters.Add : TGLMultiProxyMaster;
  209. begin
  210. Result:=(inherited Add) as TGLMultiProxyMaster;
  211. end;
  212. function TGLMultiProxyMasters.Add(master : TGLBaseSceneObject; distanceMin, distanceMax : Single) : TGLMultiProxyMaster;
  213. begin
  214. BeginUpdate;
  215. Result:=(inherited Add) as TGLMultiProxyMaster;
  216. Result.MasterObject:=master;
  217. Result.DistanceMin:=distanceMin;
  218. Result.DistanceMax:=distanceMax;
  219. EndUpdate;
  220. end;
  221. procedure TGLMultiProxyMasters.Notification(AComponent: TComponent);
  222. var
  223. i : Integer;
  224. begin
  225. for i:=0 to Count-1 do with Items[i] do
  226. if FMasterObject=AComponent then FMasterObject:=nil;
  227. end;
  228. procedure TGLMultiProxyMasters.NotifyChange;
  229. begin
  230. if (UpdateCount=0) and (GetOwner<>nil) and (GetOwner is TGLUpdateAbleComponent) then
  231. TGLUpdateAbleComponent(GetOwner).NotifyChange(Self);
  232. end;
  233. procedure TGLMultiProxyMasters.EndUpdate;
  234. begin
  235. inherited EndUpdate;
  236. // Workaround for a bug in VCL's EndUpdate
  237. if UpdateCount=0 then NotifyChange;
  238. end;
  239. // ------------------
  240. // ------------------ TGLMultiProxy ------------------
  241. // ------------------
  242. constructor TGLMultiProxy.Create(AOwner: TComponent);
  243. begin
  244. inherited Create(AOwner);
  245. ObjectStyle:=ObjectStyle+[osDirectDraw];
  246. FMasterObjects:=TGLMultiProxyMasters.Create(Self);
  247. end;
  248. destructor TGLMultiProxy.Destroy;
  249. begin
  250. inherited Destroy;
  251. FMasterObjects.Free;
  252. end;
  253. procedure TGLMultiProxy.Notification(AComponent: TComponent; Operation: TOperation);
  254. begin
  255. if Operation=opRemove then
  256. FMasterObjects.Notification(AComponent);
  257. inherited;
  258. end;
  259. procedure TGLMultiProxy.SetMasterObjects(const val : TGLMultiProxyMasters);
  260. begin
  261. FMasterObjects.Assign(val);
  262. StructureChanged;
  263. end;
  264. procedure TGLMultiProxy.Assign(Source: TPersistent);
  265. begin
  266. if Source is TGLMultiProxy then begin
  267. MasterObjects:=TGLMultiProxy(Source).MasterObjects;
  268. end;
  269. inherited;
  270. end;
  271. procedure TGLMultiProxy.DoRender(var rci : TGLRenderContextInfo;
  272. renderSelf, renderChildren : Boolean);
  273. var
  274. i : Integer;
  275. oldProxySubObject : Boolean;
  276. mpMaster : TGLMultiProxyMaster;
  277. master : TGLBaseSceneObject;
  278. d2 : Single;
  279. begin
  280. if FRendering then Exit;
  281. FRendering:=True;
  282. try
  283. d2:=VectorDistance2(rci.cameraPosition, AbsolutePosition);
  284. for i:=0 to MasterObjects.Count-1 do begin
  285. mpMaster:=MasterObjects[i];
  286. if mpMaster.Visible then begin
  287. master:=mpMaster.MasterObject;
  288. if (master<>nil) and (d2>=mpMaster.FDistanceMin2) and (d2<mpMaster.FDistanceMax2) then begin
  289. oldProxySubObject:=rci.proxySubObject;
  290. rci.proxySubObject:=True;
  291. gl.MultMatrixf(PGLFloat(master.Matrix));
  292. master.DoRender(rci, renderSelf, (master.Count>0));
  293. rci.proxySubObject:=oldProxySubObject;
  294. end;
  295. end;
  296. end;
  297. // now render self stuff (our children, our effects, etc.)
  298. if renderChildren and (Count>0) then
  299. Self.RenderChildren(0, Count-1, rci);
  300. // if masterGotEffects then
  301. // FMasterObject.Effects.RenderPostEffects(Scene.CurrentBuffer, rci);
  302. finally
  303. FRendering:=False;
  304. end;
  305. ClearStructureChanged;
  306. end;
  307. function TGLMultiProxy.PrimaryMaster : TGLBaseSceneObject;
  308. begin
  309. if MasterObjects.Count>0 then
  310. Result:=MasterObjects[0].MasterObject
  311. else Result:=nil;
  312. end;
  313. function TGLMultiProxy.AxisAlignedDimensionsUnscaled : TVector;
  314. var
  315. master : TGLBaseSceneObject;
  316. begin
  317. master:=PrimaryMaster;
  318. if Assigned(master) then begin
  319. Result:=master.AxisAlignedDimensionsUnscaled;
  320. end else Result:=inherited AxisAlignedDimensionsUnscaled;
  321. end;
  322. function TGLMultiProxy.RayCastIntersect(const rayStart, rayVector : TVector;
  323. intersectPoint : PVector = nil;
  324. intersectNormal : PVector = nil) : Boolean;
  325. var
  326. localRayStart, localRayVector : TVector;
  327. master : TGLBaseSceneObject;
  328. begin
  329. master:=PrimaryMaster;
  330. if Assigned(master) then begin
  331. SetVector(localRayStart, AbsoluteToLocal(rayStart));
  332. SetVector(localRayStart, master.LocalToAbsolute(localRayStart));
  333. SetVector(localRayVector, AbsoluteToLocal(rayVector));
  334. SetVector(localRayVector, master.LocalToAbsolute(localRayVector));
  335. NormalizeVector(localRayVector);
  336. Result:=master.RayCastIntersect(localRayStart, localRayVector,
  337. intersectPoint, intersectNormal);
  338. if Result then begin
  339. if Assigned(intersectPoint) then begin
  340. SetVector(intersectPoint^, master.AbsoluteToLocal(intersectPoint^));
  341. SetVector(intersectPoint^, LocalToAbsolute(intersectPoint^));
  342. end;
  343. if Assigned(intersectNormal) then begin
  344. SetVector(intersectNormal^, master.AbsoluteToLocal(intersectNormal^));
  345. SetVector(intersectNormal^, LocalToAbsolute(intersectNormal^));
  346. end;
  347. end;
  348. end else Result:=False;
  349. end;
  350. function TGLMultiProxy.GenerateSilhouette(const silhouetteParameters : TGLSilhouetteParameters) : TGLSilhouette;
  351. var
  352. master : TGLBaseSceneObject;
  353. begin
  354. master:=PrimaryMaster;
  355. if Assigned(master) then
  356. Result:=master.GenerateSilhouette(silhouetteParameters)
  357. else Result:=nil;
  358. end;
  359. //-------------------------------------------------------------
  360. initialization
  361. //-------------------------------------------------------------
  362. RegisterClasses([TGLMultiProxy]);
  363. end.