GXS.Objects.pas 98 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618
  1. //
  2. // The graphics engine GXScene https://github.com/glscene
  3. //
  4. unit GXS.Objects;
  5. (*
  6. Implementation of basic scene objects plus some management routines.
  7. All objects declared in this unit are part of the basic GLScene package,
  8. these are only simple objects and should be kept simple and lightweight.
  9. More complex or more specialized versions should be placed in dedicated
  10. units where they can grow and prosper untammed. "Generic" geometrical
  11. objects can be found GXS.GeomObjects.
  12. *)
  13. interface
  14. {$I GLScene.Defines.inc}
  15. uses
  16. Winapi.OpenGL,
  17. Winapi.OpenGLext,
  18. System.Types,
  19. System.Classes,
  20. System.SysUtils,
  21. System.Math,
  22. GXS.XOpenGL,
  23. GXS.BaseClasses,
  24. GXS.PersistentClasses,
  25. GLScene.VectorGeometry,
  26. GLScene.VectorTypes,
  27. GXS.VectorLists,
  28. GLScene.Strings,
  29. GXS.Scene,
  30. GXS.Context,
  31. GXS.Silhouette,
  32. GXS.Color,
  33. GXS.RenderContextInfo,
  34. GXS.Nodes,
  35. GXS.PipelineTransformation,
  36. GXS.Coordinates;
  37. const
  38. cDefaultPointSize: Single = 1.0;
  39. type
  40. TgxVisibilityDeterminationEvent = function(Sender: TObject;
  41. var rci: TgxRenderContextInfo): Boolean of object;
  42. PVertexRec = ^TVertexRec;
  43. TVertexRec = record
  44. Position: TVector3f;
  45. Normal: TVector3f;
  46. Binormal: TVector3f;
  47. Tangent: TVector3f;
  48. TexCoord: TVector2f;
  49. end;
  50. (* A simple cube, invisible at run-time.
  51. This is a usually non-visible object -except at design-time- used for
  52. building hierarchies or groups, when some kind of joint or movement
  53. mechanism needs be described, you can use DummyCubes.
  54. DummyCube's barycenter is its children's barycenter.
  55. The DummyCube can optionnally amalgamate all its children into a single
  56. display list (see Amalgamate property). *)
  57. TgxDummyCube = class(TgxCameraInvariantObject)
  58. private
  59. FCubeSize: Single;
  60. FEdgeColor: TgxColor;
  61. FVisibleAtRunTime, FAmalgamate: Boolean;
  62. FGroupList: TgxListHandle;
  63. FOnVisibilityDetermination: TgxVisibilityDeterminationEvent;
  64. protected
  65. procedure SetCubeSize(const val: Single); inline;
  66. procedure SetEdgeColor(const val: TgxColor); inline;
  67. procedure SetVisibleAtRunTime(const val: Boolean); inline;
  68. procedure SetAmalgamate(const val: Boolean); inline;
  69. public
  70. constructor Create(AOwner: TComponent); override;
  71. destructor Destroy; override;
  72. procedure Assign(Source: TPersistent); override;
  73. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  74. function RayCastIntersect(const rayStart, rayVector: TVector4f;
  75. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; override;
  76. procedure BuildList(var rci: TgxRenderContextInfo); override;
  77. procedure DoRender(var rci: TgxRenderContextInfo;
  78. renderSelf, renderChildren: Boolean); override;
  79. procedure StructureChanged; override;
  80. function BarycenterAbsolutePosition: TVector4f; override;
  81. published
  82. property CubeSize: Single read FCubeSize write SetCubeSize;
  83. property EdgeColor: TgxColor read FEdgeColor write SetEdgeColor;
  84. (* If true the dummycube's edges will be visible at runtime.
  85. The default behaviour of the dummycube is to be visible at design-time
  86. only, and invisible at runtime. *)
  87. property VisibleAtRunTime: Boolean read FVisibleAtRunTime write SetVisibleAtRunTime default False;
  88. (* Amalgamate the dummy's children in a single OpenGL entity.
  89. This activates a special rendering mode, which will compile
  90. the rendering of all of the dummycube's children objects into a
  91. single display list. This may provide a significant speed up in some
  92. situations, however, this means that changes to the children will
  93. be ignored untill you call StructureChanged on the dummy cube.
  94. Some objects, that have their own display list management, may not
  95. be compatible with this behaviour. This will also prevents sorting
  96. and culling to operate as usual.
  97. In short, this features is best used for static, non-transparent
  98. geometry, or when the point of view won't change over a large
  99. number of frames. *)
  100. property Amalgamate: Boolean read FAmalgamate write SetAmalgamate default False;
  101. (* Camera Invariance Options.
  102. These options allow to "deactivate" sensitivity to camera, f.i. by
  103. centering the object on the camera or ignoring camera orientation. *)
  104. property CamInvarianceMode default cimNone;
  105. (* Event for custom visibility determination.
  106. Event handler should return True if the dummycube and its children
  107. are to be considered visible for the current render. *)
  108. property OnVisibilityDetermination: TgxVisibilityDeterminationEvent
  109. read FOnVisibilityDetermination write FOnVisibilityDetermination;
  110. end;
  111. TgxPlaneStyle = (psSingleQuad, psTileTexture);
  112. TgxPlaneStyles = set of TgxPlaneStyle;
  113. (* A simple plane object.
  114. Note that a plane is always made of a single quad (two triangles) and the
  115. tiling is only applied to texture coordinates. *)
  116. TgxPlane = class(TgxSceneObject)
  117. private
  118. FXOffset, FYOffset: Single;
  119. FXScope, FYScope: Single;
  120. FWidth, FHeight: Single;
  121. FXTiles, FYTiles: Cardinal;
  122. FStyle: TgxPlaneStyles;
  123. FMesh: array of array of TVertexRec;
  124. protected
  125. procedure SetHeight(const aValue: Single);
  126. procedure SetWidth(const aValue: Single);
  127. procedure SetXOffset(const Value: Single);
  128. procedure SetXScope(const Value: Single);
  129. function StoreXScope: Boolean;
  130. procedure SetXTiles(const Value: Cardinal);
  131. procedure SetYOffset(const Value: Single);
  132. procedure SetYScope(const Value: Single);
  133. function StoreYScope: Boolean;
  134. procedure SetYTiles(const Value: Cardinal);
  135. procedure SetStyle(const val: TgxPlaneStyles);
  136. public
  137. constructor Create(AOwner: TComponent); override;
  138. procedure Assign(Source: TPersistent); override;
  139. procedure BuildList(var rci: TgxRenderContextInfo); override;
  140. function GenerateSilhouette(const silhouetteParameters
  141. : TgxSilhouetteParameters): TgxSilhouette; override;
  142. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  143. function RayCastIntersect(const rayStart, rayVector: TVector4f;
  144. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; override;
  145. (* Computes the screen coordinates of the smallest rectangle encompassing the plane.
  146. Returned extents are NOT limited to any physical screen extents. *)
  147. function ScreenRect(aBuffer: TgxSceneBuffer): TRect;
  148. (* Computes the signed distance to the point.
  149. Point coordinates are expected in absolute coordinates. *)
  150. function PointDistance(const aPoint: TVector4f): Single;
  151. published
  152. property Height: Single read FHeight write SetHeight;
  153. property Width: Single read FWidth write SetWidth;
  154. property XOffset: Single read FXOffset write SetXOffset;
  155. property XScope: Single read FXScope write SetXScope stored StoreXScope;
  156. property XTiles: Cardinal read FXTiles write SetXTiles default 1;
  157. property YOffset: Single read FYOffset write SetYOffset;
  158. property YScope: Single read FYScope write SetYScope stored StoreYScope;
  159. property YTiles: Cardinal read FYTiles write SetYTiles default 1;
  160. property Style: TgxPlaneStyles read FStyle write SetStyle default [psSingleQuad, psTileTexture];
  161. end;
  162. (* A rectangular area, perspective projected, but always facing the camera.
  163. A TgxSprite is perspective projected and as such is scaled with distance,
  164. if you want a 2D sprite that does not get scaled, see TgxHUDSprite. *)
  165. TgxSprite = class(TgxSceneObject)
  166. private
  167. FWidth: Single;
  168. FHeight: Single;
  169. FRotation: Single;
  170. FAlphaChannel: Single;
  171. FMirrorU, FMirrorV: Boolean;
  172. protected
  173. procedure SetWidth(const val: Single);
  174. procedure SetHeight(const val: Single);
  175. procedure SetRotation(const val: Single);
  176. procedure SetAlphaChannel(const val: Single);
  177. function StoreAlphaChannel: Boolean;
  178. procedure SetMirrorU(const val: Boolean);
  179. procedure SetMirrorV(const val: Boolean);
  180. public
  181. constructor Create(AOwner: TComponent); override;
  182. procedure Assign(Source: TPersistent); override;
  183. procedure BuildList(var rci: TgxRenderContextInfo); override;
  184. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  185. procedure SetSize(const Width, Height: Single);
  186. // Set width and height to "size"
  187. procedure SetSquareSize(const Size: Single);
  188. published
  189. // Sprite Width in 3D world units.
  190. property Width: Single read FWidth write SetWidth;
  191. // Sprite Height in 3D world units.
  192. property Height: Single read FHeight write SetHeight;
  193. (* This the ON-SCREEN rotation of the sprite.
  194. Rotatation=0 is handled faster. *)
  195. property Rotation: Single read FRotation write SetRotation;
  196. // If different from 1, this value will replace that of Diffuse.Alpha
  197. property AlphaChannel: Single read FAlphaChannel write SetAlphaChannel stored StoreAlphaChannel;
  198. (* Reverses the texture coordinates in the U and V direction to mirror
  199. the texture. *)
  200. property MirrorU: Boolean read FMirrorU write SetMirrorU default False;
  201. property MirrorV: Boolean read FMirrorV write SetMirrorV default False;
  202. end;
  203. TgxPointStyle = (psSquare, psRound, psSmooth, psSmoothAdditive, psSquareAdditive);
  204. (* Point parameters as in ARB_point_parameters.
  205. Make sure to read the ARB_point_parameters spec if you want to understand
  206. what each parameter does. *)
  207. TgxPointParameters = class(TgxUpdateAbleObject)
  208. private
  209. FEnabled: Boolean;
  210. FMinSize, FMaxSize: Single;
  211. FFadeTresholdSize: Single;
  212. FDistanceAttenuation: TgxCoordinates;
  213. protected
  214. procedure SetEnabled(const val: Boolean);
  215. procedure SetMinSize(const val: Single);
  216. procedure SetMaxSize(const val: Single);
  217. procedure SetFadeTresholdSize(const val: Single);
  218. procedure SetDistanceAttenuation(const val: TgxCoordinates);
  219. procedure DefineProperties(Filer: TFiler); override;
  220. procedure ReadData(Stream: TStream);
  221. procedure WriteData(Stream: TStream);
  222. public
  223. constructor Create(AOwner: TPersistent); override;
  224. destructor Destroy; override;
  225. procedure Assign(Source: TPersistent); override;
  226. procedure Apply;
  227. procedure UnApply;
  228. published
  229. property Enabled: Boolean read FEnabled write SetEnabled default False;
  230. property MinSize: Single read FMinSize write SetMinSize stored False;
  231. property MaxSize: Single read FMaxSize write SetMaxSize stored False;
  232. property FadeTresholdSize: Single read FFadeTresholdSize write SetFadeTresholdSize stored False;
  233. // Components XYZ are for constant, linear and quadratic attenuation.
  234. property DistanceAttenuation: TgxCoordinates read FDistanceAttenuation write SetDistanceAttenuation;
  235. end;
  236. (* Renders a set of non-transparent colored points.
  237. The points positions and their color are defined through the Positions
  238. and Colors properties. *)
  239. TgxPoints = class(TgxImmaterialSceneObject)
  240. private
  241. FPositions: TgxAffineVectorList;
  242. FColors: TgxVectorList;
  243. FSize: Single;
  244. FStyle: TgxPointStyle;
  245. FPointParameters: TgxPointParameters;
  246. FStatic, FNoZWrite: Boolean;
  247. protected
  248. function StoreSize: Boolean;
  249. procedure SetNoZWrite(const val: Boolean);
  250. procedure SetStatic(const val: Boolean);
  251. procedure SetSize(const val: Single);
  252. procedure SetPositions(const val: TgxAffineVectorList);
  253. procedure SetColors(const val: TgxVectorList);
  254. procedure SetStyle(const val: TgxPointStyle);
  255. procedure SetPointParameters(const val: TgxPointParameters);
  256. public
  257. constructor Create(AOwner: TComponent); override;
  258. destructor Destroy; override;
  259. procedure Assign(Source: TPersistent); override;
  260. procedure BuildList(var rci: TgxRenderContextInfo); override;
  261. // Points positions. If empty, a single point is assumed at (0, 0, 0)
  262. property Positions: TgxAffineVectorList read FPositions write SetPositions;
  263. (* Defines the points colors.
  264. if empty, point color will be opaque white
  265. if contains a single color, all points will use that color
  266. if contains N colors, the first N points (at max) will be rendered
  267. using the corresponding colors. *)
  268. property Colors: TgxVectorList read FColors write SetColors;
  269. published
  270. // If true points do not write their Z to the depth buffer.
  271. property NoZWrite: Boolean read FNoZWrite write SetNoZWrite;
  272. (* Tells the component if point coordinates are static.
  273. If static, changes to the positions should be notified via an
  274. explicit StructureChanged call, or may not refresh.
  275. Static sets of points may render faster than dynamic ones. *)
  276. property Static: Boolean read FStatic write SetStatic;
  277. // Point size, all points have a fixed size.
  278. property Size: Single read FSize write SetSize stored StoreSize;
  279. // Points style.
  280. property Style: TgxPointStyle read FStyle write SetStyle default psSquare;
  281. (* Point parameters as of ARB_point_parameters.
  282. Allows to vary the size and transparency of points depending
  283. on their distance to the observer. *)
  284. property PointParameters: TgxPointParameters read FPointParameters write SetPointParameters;
  285. end;
  286. // Possible aspects for the nodes of a TLine.
  287. TLineNodesAspect = (lnaInvisible, lnaAxes, lnaCube);
  288. // Available spline modes for a TLine.
  289. TgxLineSplineMode = (lsmLines, lsmCubicSpline, lsmBezierSpline, lsmNURBSCurve, lsmSegments, lsmLoop);
  290. // Specialized Node for use in a TgxLines objects. Adds a Color property (TgxColor).
  291. TgxLinesNode = class(TgxNode)
  292. private
  293. FColor: TgxColor;
  294. protected
  295. procedure SetColor(const val: TgxColor);
  296. procedure OnColorChange(Sender: TObject);
  297. function StoreColor: Boolean;
  298. public
  299. constructor Create(Collection: TCollection); override;
  300. destructor Destroy; override;
  301. procedure Assign(Source: TPersistent); override;
  302. published
  303. (* The node color.
  304. Can also defined the line color (interpolated between nodes) if
  305. loUseNodeColorForLines is set (in TgxLines). *)
  306. property Color: TgxColor read FColor write SetColor stored StoreColor;
  307. end;
  308. // Specialized collection for Nodes in a TgxLines objects. Stores TgxLinesNode items.
  309. TgxLinesNodes = class(TgxNodes)
  310. public
  311. constructor Create(AOwner: TComponent); overload;
  312. procedure NotifyChange; override;
  313. end;
  314. // Base class for line objects. Introduces line style properties (width, color...)
  315. TgxLineBase = class(TgxImmaterialSceneObject)
  316. private
  317. FLineColor: TgxColor;
  318. FLinePattern: GLushort;
  319. FLineWidth: Single;
  320. FAntiAliased: Boolean;
  321. protected
  322. procedure SetLineColor(const Value: TgxColor);
  323. procedure SetLinePattern(const Value: GLushort);
  324. procedure SetLineWidth(const val: Single);
  325. function StoreLineWidth: Boolean; inline;
  326. procedure SetAntiAliased(const val: Boolean);
  327. (* Setup OpenGL states according to line style.
  328. You must call RestoreLineStyle after drawing your lines.
  329. You may use nested calls with SetupLineStyle/RestoreLineStyle. *)
  330. procedure SetupLineStyle(var rci: TgxRenderContextInfo);
  331. public
  332. constructor Create(AOwner: TComponent); override;
  333. destructor Destroy; override;
  334. procedure Assign(Source: TPersistent); override;
  335. procedure NotifyChange(Sender: TObject); override;
  336. published
  337. (* Indicates if OpenGL should smooth line edges.
  338. Smoothed lines looks better but are poorly implemented in most OpenGL
  339. drivers and take *lots* of rendering time. *)
  340. property AntiAliased: Boolean read FAntiAliased write SetAntiAliased default False;
  341. // Default color of the lines.
  342. property LineColor: TgxColor read FLineColor write SetLineColor;
  343. (* Bitwise line pattern.
  344. For instance $FFFF (65535) is a white line (stipple disabled), $0000
  345. is a black line, $CCCC is the stipple used in axes and dummycube, etc. *)
  346. property LinePattern: GLushort read FLinePattern write SetLinePattern default $FFFF;
  347. // Default width of the lines.
  348. property LineWidth: Single read FLineWidth write SetLineWidth stored StoreLineWidth;
  349. property Visible;
  350. end;
  351. // Class that defines lines via a series of nodes. Base class, does not render anything.
  352. TgxNodedLines = class(TgxLineBase)
  353. private
  354. FNodes: TgxLinesNodes;
  355. FNodesAspect: TLineNodesAspect;
  356. FNodeColor: TgxColor;
  357. FNodeSize: Single;
  358. FOldNodeColor: TgxColorVector;
  359. protected
  360. procedure SetNodesAspect(const Value: TLineNodesAspect);
  361. procedure SetNodeColor(const Value: TgxColor);
  362. procedure OnNodeColorChanged(Sender: TObject);
  363. procedure SetNodes(const aNodes: TgxLinesNodes);
  364. procedure SetNodeSize(const val: Single);
  365. function StoreNodeSize: Boolean;
  366. procedure DrawNode(var rci: TgxRenderContextInfo; X, Y, Z: Single; Color: TgxColor);
  367. public
  368. constructor Create(AOwner: TComponent); override;
  369. destructor Destroy; override;
  370. procedure Assign(Source: TPersistent); override;
  371. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  372. procedure AddNode(const coords: TgxCoordinates); overload;
  373. procedure AddNode(const X, Y, Z: Single); overload;
  374. procedure AddNode(const Value: TVector4f); overload;
  375. procedure AddNode(const Value: TAffineVector); overload;
  376. published
  377. // Default color for nodes. lnaInvisible and lnaAxes ignore this setting.
  378. property NodeColor: TgxColor read FNodeColor write SetNodeColor;
  379. // The nodes list.
  380. property Nodes: TgxLinesNodes read FNodes write SetNodes;
  381. (* Default aspect of line nodes.
  382. May help you materialize nodes, segments and control points. *)
  383. property NodesAspect: TLineNodesAspect read FNodesAspect write SetNodesAspect default lnaAxes;
  384. // Size for the various node aspects.
  385. property NodeSize: Single read FNodeSize write SetNodeSize stored StoreNodeSize;
  386. end;
  387. TLinesOption = (loUseNodeColorForLines, loColorLogicXor);
  388. TgxLinesOptions = set of TLinesOption;
  389. (* Set of 3D line segments.
  390. You define a 3D Line by adding its nodes in the "Nodes" property. The line
  391. may be rendered as a set of segment or as a curve (nodes then act as spline
  392. control points).
  393. Alternatively, you can also use it to render a set of spacial nodes (points
  394. in space), just make the lines transparent and the nodes visible by picking
  395. the node aspect that suits you. *)
  396. TgxLines = class(TgxNodedLines)
  397. private
  398. FDivision: Integer;
  399. FSplineMode: TgxLineSplineMode;
  400. FOptions: TgxLinesOptions;
  401. FNURBSOrder: Integer;
  402. FNURBSTolerance: Single;
  403. FNURBSKnots: TgxSingleList;
  404. protected
  405. procedure SetSplineMode(const val: TgxLineSplineMode);
  406. procedure SetDivision(const Value: Integer);
  407. procedure SetOptions(const val: TgxLinesOptions);
  408. procedure SetNURBSOrder(const val: Integer);
  409. procedure SetNURBSTolerance(const val: Single);
  410. public
  411. constructor Create(AOwner: TComponent); override;
  412. destructor Destroy; override;
  413. procedure Assign(Source: TPersistent); override;
  414. procedure BuildList(var rci: TgxRenderContextInfo); override;
  415. property NURBSKnots: TgxSingleList read FNURBSKnots;
  416. property NURBSOrder: Integer read FNURBSOrder write SetNURBSOrder;
  417. property NURBSTolerance: Single read FNURBSTolerance write SetNURBSTolerance;
  418. published
  419. (* Number of divisions for each segment in spline modes.
  420. Minimum 1 (disabled), ignored in lsmLines mode. *)
  421. property Division: Integer read FDivision write SetDivision default 10;
  422. // Default spline drawing mode.
  423. property SplineMode: TgxLineSplineMode read FSplineMode write SetSplineMode default lsmLines;
  424. (* Rendering options for the line.
  425. loUseNodeColorForLines: if set lines will be drawn using node
  426. colors (and color interpolation between nodes), if not, LineColor
  427. will be used (single color).
  428. loColorLogicXor: enable logic operation for color of XOR type. *)
  429. property Options: TgxLinesOptions read FOptions write SetOptions;
  430. end;
  431. TgxCubePart = (cpTop, cpBottom, cpFront, cpBack, cpLeft, cpRight);
  432. TgxCubeParts = set of TgxCubePart;
  433. (* A simple cube object.
  434. This cube use the same material for each of its faces, ie. all faces look
  435. the same. If you want a multi-material cube, use a mesh in conjunction
  436. with a TgxFreeForm and a material library. *)
  437. TgxCube = class(TgxSceneObject)
  438. private
  439. FCubeSize: TAffineVector;
  440. FParts: TgxCubeParts;
  441. FNormalDirection: TgxNormalDirection;
  442. function GetCubeWHD(const Index: Integer): Single; inline;
  443. procedure SetCubeWHD(Index: Integer; AValue: Single); inline;
  444. procedure SetParts(aValue: TgxCubeParts); inline;
  445. procedure SetNormalDirection(aValue: TgxNormalDirection); inline;
  446. protected
  447. procedure DefineProperties(Filer: TFiler); override;
  448. procedure ReadData(Stream: TStream); inline;
  449. procedure WriteData(Stream: TStream); inline;
  450. public
  451. constructor Create(AOwner: TComponent); override;
  452. function GenerateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters): TgxSilhouette; override;
  453. procedure BuildList(var rci: TgxRenderContextInfo); override;
  454. procedure Assign(Source: TPersistent); override;
  455. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  456. function RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil;
  457. intersectNormal: PVector4f = nil): Boolean; override;
  458. published
  459. property CubeWidth: Single index 0 read GetCubeWHD write SetCubeWHD stored False;
  460. property CubeHeight: Single index 1 read GetCubeWHD write SetCubeWHD stored False;
  461. property CubeDepth: Single index 2 read GetCubeWHD write SetCubeWHD stored False;
  462. property NormalDirection: TgxNormalDirection read FNormalDirection write SetNormalDirection default ndOutside;
  463. property Parts: TgxCubeParts read FParts write SetParts default [cpTop, cpBottom, cpFront, cpBack, cpLeft, cpRight];
  464. end;
  465. (* Determines how and if normals are smoothed.
  466. - nsFlat : facetted look
  467. - nsSmooth : smooth look
  468. - nsNone : unlighted rendering, usefull for decla texturing *)
  469. TgxNormalSmoothing = (nsFlat, nsSmooth, nsNone);
  470. (* Base class for quadric objects.
  471. Introduces some basic Quadric interaction functions (the actual quadric
  472. math is part of the GLU library). *)
  473. TgxQuadricObject = class(TgxSceneObject)
  474. private
  475. FNormals: TgxNormalSmoothing;
  476. FNormalDirection: TgxNormalDirection;
  477. protected
  478. procedure SetNormals(aValue: TgxNormalSmoothing);
  479. procedure SetNormalDirection(aValue: TgxNormalDirection);
  480. procedure SetupQuadricParams(quadric: GLUquadricObj);
  481. procedure SetNormalQuadricOrientation(quadric: GLUquadricObj);
  482. procedure SetInvertedQuadricOrientation(quadric: GLUquadricObj);
  483. public
  484. constructor Create(AOwner: TComponent); override;
  485. procedure Assign(Source: TPersistent); override;
  486. published
  487. property Normals: TgxNormalSmoothing read FNormals write SetNormals default nsSmooth;
  488. property NormalDirection: TgxNormalDirection read FNormalDirection write SetNormalDirection default ndOutside;
  489. end;
  490. TAngleLimit1 = -90 .. 90;
  491. TAngleLimit2 = 0 .. 360;
  492. TgxCapType = (ctNone, ctCenter, ctFlat);
  493. (* A sphere object.
  494. The sphere can have to and bottom caps, as well as being just a slice
  495. of sphere. *)
  496. TgxSphere = class(TgxQuadricObject)
  497. private
  498. FRadius: Single;
  499. FSlices, FStacks: GLint;
  500. FTop: TAngleLimit1;
  501. FBottom: TAngleLimit1;
  502. FStart: TAngleLimit2;
  503. FStop: TAngleLimit2;
  504. FTopCap, FBottomCap: TgxCapType;
  505. procedure SetBottom(aValue: TAngleLimit1);
  506. procedure SetBottomCap(aValue: TgxCapType);
  507. procedure SetRadius(const aValue: Single);
  508. procedure SetSlices(aValue: GLint);
  509. procedure SetStart(aValue: TAngleLimit2);
  510. procedure SetStop(aValue: TAngleLimit2);
  511. procedure SetStacks(aValue: GLint);
  512. procedure SetTop(aValue: TAngleLimit1);
  513. procedure SetTopCap(aValue: TgxCapType);
  514. public
  515. constructor Create(AOwner: TComponent); override;
  516. procedure Assign(Source: TPersistent); override;
  517. procedure BuildList(var rci: TgxRenderContextInfo); override;
  518. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  519. function RayCastIntersect(const rayStart, rayVector: TVector4f;
  520. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil)
  521. : Boolean; override;
  522. function GenerateSilhouette(const silhouetteParameters
  523. : TgxSilhouetteParameters): TgxSilhouette; override;
  524. published
  525. property Bottom: TAngleLimit1 read FBottom write SetBottom default -90;
  526. property BottomCap: TgxCapType read FBottomCap write SetBottomCap
  527. default ctNone;
  528. property Radius: Single read FRadius write SetRadius;
  529. property Slices: GLint read FSlices write SetSlices default 16;
  530. property Stacks: GLint read FStacks write SetStacks default 16;
  531. property Start: TAngleLimit2 read FStart write SetStart default 0;
  532. property Stop: TAngleLimit2 read FStop write SetStop default 360;
  533. property Top: TAngleLimit1 read FTop write SetTop default 90;
  534. property TopCap: TgxCapType read FTopCap write SetTopCap default ctNone;
  535. end;
  536. // Base class for objects based on a polygon.
  537. TgxPolygonBase = class(TgxSceneObject)
  538. private
  539. FDivision: Integer;
  540. FSplineMode: TgxLineSplineMode;
  541. protected
  542. FNodes: TgxNodes;
  543. procedure CreateNodes; virtual;
  544. procedure SetSplineMode(const val: TgxLineSplineMode);
  545. procedure SetDivision(const Value: Integer);
  546. procedure SetNodes(const aNodes: TgxNodes);
  547. public
  548. constructor Create(AOwner: TComponent); override;
  549. destructor Destroy; override;
  550. procedure Assign(Source: TPersistent); override;
  551. procedure NotifyChange(Sender: TObject); override;
  552. procedure AddNode(const coords: TgxCoordinates); overload;
  553. procedure AddNode(const X, Y, Z: Single); overload;
  554. procedure AddNode(const Value: TVector4f); overload;
  555. procedure AddNode(const Value: TAffineVector); overload;
  556. published
  557. // The nodes list.
  558. property Nodes: TgxNodes read FNodes write SetNodes;
  559. (* Number of divisions for each segment in spline modes.
  560. Minimum 1 (disabled), ignored in lsmLines mode. *)
  561. property Division: Integer read FDivision write SetDivision default 10;
  562. (* Default spline drawing mode.
  563. This mode is used only for the curve, not for the rotation path. *)
  564. property SplineMode: TgxLineSplineMode read FSplineMode write SetSplineMode
  565. default lsmLines;
  566. end;
  567. (* A Superellipsoid object. The Superellipsoid can have top and bottom caps,
  568. as well as being just a slice of Superellipsoid. *)
  569. TgxSuperellipsoid = class(TgxQuadricObject)
  570. private
  571. FRadius, FVCurve, FHCurve: Single;
  572. FSlices, FStacks: GLInt;
  573. FTop: TAngleLimit1;
  574. FBottom: TAngleLimit1;
  575. FStart: TAngleLimit2;
  576. FStop: TAngleLimit2;
  577. FTopCap, FBottomCap: TgxCapType;
  578. procedure SetBottom(aValue: TAngleLimit1);
  579. procedure SetBottomCap(aValue: TgxCapType);
  580. procedure SetRadius(const aValue: Single);
  581. procedure SetVCurve(const aValue: Single);
  582. procedure SetHCurve(const aValue: Single);
  583. procedure SetSlices(aValue: GLInt);
  584. procedure SetStart(aValue: TAngleLimit2);
  585. procedure SetStop(aValue: TAngleLimit2);
  586. procedure SetStacks(aValue: GLint);
  587. procedure SetTop(aValue: TAngleLimit1);
  588. procedure SetTopCap(aValue: TgxCapType);
  589. public
  590. constructor Create(AOwner: TComponent); override;
  591. procedure Assign(Source: TPersistent); override;
  592. procedure BuildList(var rci: TgxRenderContextInfo); override;
  593. function AxisAlignedDimensionsUnscaled: TVector4f; override;
  594. function RayCastIntersect(const rayStart, rayVector: TVector4f;
  595. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil)
  596. : Boolean; override;
  597. function GenerateSilhouette(const silhouetteParameters
  598. : TgxSilhouetteParameters): TgxSilhouette; override;
  599. published
  600. property Bottom: TAngleLimit1 read FBottom write SetBottom default -90;
  601. property BottomCap: TgxCapType read FBottomCap write SetBottomCap
  602. default ctNone;
  603. property Radius: Single read FRadius write SetRadius;
  604. property VCurve: Single read FVCurve write SetVCurve;
  605. property HCurve: Single read FHCurve write SetHCurve;
  606. property Slices: GLInt read FSlices write SetSlices default 16;
  607. property Stacks: GLInt read FStacks write SetStacks default 16;
  608. property Start: TAngleLimit2 read FStart write SetStart default 0;
  609. property Stop: TAngleLimit2 read FStop write SetStop default 360;
  610. property Top: TAngleLimit1 read FTop write SetTop default 90;
  611. property TopCap: TgxCapType read FTopCap write SetTopCap default ctNone;
  612. end;
  613. // Issues for a unit-size cube stippled wireframe.
  614. procedure CubeWireframeBuildList(var rci: TgxRenderContextInfo; Size: Single;
  615. Stipple: Boolean; const Color: TgxColorVector);
  616. var
  617. TangentAttributeName: AnsiString = 'Tangent';
  618. BinormalAttributeName: AnsiString = 'Binormal';
  619. // -------------------------------------------------------------
  620. implementation
  621. // -------------------------------------------------------------
  622. uses
  623. GLScene.Spline,
  624. GXS.State;
  625. procedure CubeWireframeBuildList(var rci: TgxRenderContextInfo; Size: Single;
  626. Stipple: Boolean; const Color: TgxColorVector);
  627. var
  628. mi, ma: Single;
  629. begin
  630. {$IFDEF USE_OPENGL_DEBUG}
  631. if GL_GREMEDY_string_marker then
  632. glStringMarkerGREMEDY(22, 'CubeWireframeBuildList');
  633. {$ENDIF}
  634. rci.gxStates.Disable(stLighting);
  635. rci.gxStates.Enable(stLineSmooth);
  636. if stipple then
  637. begin
  638. rci.gxStates.Enable(stLineStipple);
  639. rci.gxStates.Enable(stBlend);
  640. rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  641. rci.gxStates.LineStippleFactor := 1;
  642. rci.gxStates.LineStipplePattern := $CCCC;
  643. end;
  644. rci.gxStates.LineWidth := 1;
  645. ma := 0.5 * Size;
  646. mi := -ma;
  647. glColor4fv(@Color);
  648. glBegin(GL_LINE_STRIP);
  649. // front face
  650. glVertex3f(ma, mi, mi);
  651. glVertex3f(ma, ma, mi);
  652. glVertex3f(ma, ma, ma);
  653. glVertex3f(ma, mi, ma);
  654. glVertex3f(ma, mi, mi);
  655. // partial up back face
  656. glVertex3f(mi, mi, mi);
  657. glVertex3f(mi, mi, ma);
  658. glVertex3f(mi, ma, ma);
  659. glVertex3f(mi, ma, mi);
  660. // right side low
  661. glVertex3f(ma, ma, mi);
  662. glEnd;
  663. glBegin(GL_LINES);
  664. // right high
  665. glVertex3f(ma, ma, ma);
  666. glVertex3f(mi, ma, ma);
  667. // back low
  668. glVertex3f(mi, mi, mi);
  669. glVertex3f(mi, ma, mi);
  670. // left high
  671. glVertex3f(ma, mi, ma);
  672. glVertex3f(mi, mi, ma);
  673. glEnd;
  674. end;
  675. // ------------------
  676. // ------------------ TgxDummyCube ------------------
  677. // ------------------
  678. constructor TgxDummyCube.Create(AOwner: TComponent);
  679. begin
  680. inherited;
  681. ObjectStyle := ObjectStyle + [osDirectDraw];
  682. FCubeSize := 1;
  683. FEdgeColor := TgxColor.Create(Self);
  684. FEdgeColor.Initialize(clrWhite);
  685. FGroupList := TgxListHandle.Create;
  686. CamInvarianceMode := cimNone;
  687. end;
  688. destructor TgxDummyCube.Destroy;
  689. begin
  690. FGroupList.Free;
  691. FEdgeColor.Free;
  692. inherited;
  693. end;
  694. procedure TgxDummyCube.Assign(Source: TPersistent);
  695. begin
  696. if Source is TgxDummyCube then
  697. begin
  698. FCubeSize := TgxDummyCube(Source).FCubeSize;
  699. FEdgeColor.Color := TgxDummyCube(Source).FEdgeColor.Color;
  700. FVisibleAtRunTime := TgxDummyCube(Source).FVisibleAtRunTime;
  701. NotifyChange(Self);
  702. end;
  703. inherited Assign(Source);
  704. end;
  705. function TgxDummyCube.AxisAlignedDimensionsUnscaled: TVector4f;
  706. begin
  707. Result.X := 0.5 * Abs(FCubeSize);
  708. Result.Y := Result.X;
  709. Result.Z := Result.X;
  710. Result.W := 0;
  711. end;
  712. function TgxDummyCube.RayCastIntersect(const rayStart, rayVector: TVector4f;
  713. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean;
  714. begin
  715. Result := False;
  716. end;
  717. procedure TgxDummyCube.BuildList(var rci: TgxRenderContextInfo);
  718. begin
  719. if (csDesigning in ComponentState) or (FVisibleAtRunTime) then
  720. CubeWireframeBuildList(rci, FCubeSize, True, EdgeColor.Color);
  721. end;
  722. procedure TgxDummyCube.DoRender(var rci: TgxRenderContextInfo;
  723. renderSelf, renderChildren: Boolean);
  724. begin
  725. if Assigned(FOnVisibilityDetermination) then
  726. if not FOnVisibilityDetermination(Self, rci) then
  727. Exit;
  728. if FAmalgamate and (not rci.amalgamating) then
  729. begin
  730. if FGroupList.Handle = 0 then
  731. begin
  732. FGroupList.AllocateHandle;
  733. Assert(FGroupList.Handle <> 0, 'Handle=0 for ' + ClassName);
  734. rci.gxStates.NewList(FGroupList.Handle, GL_COMPILE);
  735. rci.amalgamating := True;
  736. try
  737. inherited;
  738. finally
  739. rci.amalgamating := False;
  740. rci.gxStates.EndList;
  741. end;
  742. end;
  743. rci.gxStates.CallList(FGroupList.Handle);
  744. end
  745. else
  746. begin
  747. // proceed as usual
  748. inherited;
  749. end;
  750. end;
  751. procedure TgxDummyCube.StructureChanged;
  752. begin
  753. if FAmalgamate then
  754. FGroupList.DestroyHandle;
  755. inherited;
  756. end;
  757. function TgxDummyCube.BarycenterAbsolutePosition: TVector4f;
  758. var
  759. i: Integer;
  760. begin
  761. if Count > 0 then
  762. begin
  763. Result := Children[0].BarycenterAbsolutePosition;
  764. for i := 1 to Count - 1 do
  765. Result := VectorAdd(Result, Children[i].BarycenterAbsolutePosition);
  766. ScaleVector(Result, 1 / Count);
  767. end
  768. else
  769. Result := AbsolutePosition;
  770. end;
  771. procedure TgxDummyCube.SetCubeSize(const val: Single);
  772. begin
  773. if val <> FCubeSize then
  774. begin
  775. FCubeSize := val;
  776. StructureChanged;
  777. end;
  778. end;
  779. procedure TgxDummyCube.SetEdgeColor(const val: TgxColor);
  780. begin
  781. if val <> FEdgeColor then
  782. begin
  783. FEdgeColor.Assign(val);
  784. StructureChanged;
  785. end;
  786. end;
  787. procedure TgxDummyCube.SetVisibleAtRunTime(const val: Boolean);
  788. begin
  789. if val <> FVisibleAtRunTime then
  790. begin
  791. FVisibleAtRunTime := val;
  792. StructureChanged;
  793. end;
  794. end;
  795. procedure TgxDummyCube.SetAmalgamate(const val: Boolean);
  796. begin
  797. if val <> FAmalgamate then
  798. begin
  799. FAmalgamate := val;
  800. if not val then
  801. FGroupList.DestroyHandle;
  802. inherited StructureChanged;
  803. end;
  804. end;
  805. // ------------------
  806. // ------------------ TgxPlane ------------------
  807. // ------------------
  808. constructor TgxPlane.Create(AOwner: TComponent);
  809. begin
  810. inherited Create(AOwner);
  811. FWidth := 1;
  812. FHeight := 1;
  813. FXTiles := 1;
  814. FYTiles := 1;
  815. FXScope := 1;
  816. FYScope := 1;
  817. ObjectStyle := ObjectStyle + [osDirectDraw];
  818. FStyle := [psSingleQuad, psTileTexture];
  819. end;
  820. procedure TgxPlane.Assign(Source: TPersistent);
  821. begin
  822. if Assigned(Source) and (Source is TgxPlane) then
  823. begin
  824. FWidth := TgxPlane(Source).FWidth;
  825. FHeight := TgxPlane(Source).FHeight;
  826. FXOffset := TgxPlane(Source).FXOffset;
  827. FXScope := TgxPlane(Source).FXScope;
  828. FXTiles := TgxPlane(Source).FXTiles;
  829. FYOffset := TgxPlane(Source).FYOffset;
  830. FYScope := TgxPlane(Source).FYScope;
  831. FYTiles := TgxPlane(Source).FYTiles;
  832. FStyle := TgxPlane(Source).FStyle;
  833. StructureChanged;
  834. end;
  835. inherited Assign(Source);
  836. end;
  837. function TgxPlane.AxisAlignedDimensionsUnscaled: TVector4f;
  838. begin
  839. Result.X := 0.5 * Abs(FWidth);
  840. Result.Y := 0.5 * Abs(FHeight);
  841. Result.Z := 0;
  842. end;
  843. function TgxPlane.RayCastIntersect(const rayStart, rayVector: TVector4f;
  844. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean;
  845. var
  846. locRayStart, locRayVector, ip: TVector4f;
  847. t: Single;
  848. begin
  849. locRayStart := AbsoluteToLocal(rayStart);
  850. locRayVector := AbsoluteToLocal(rayVector);
  851. if locRayStart.Z >= 0 then
  852. begin
  853. // ray start over plane
  854. if locRayVector.Z < 0 then
  855. begin
  856. t := locRayStart.Z / locRayVector.Z;
  857. ip.X := locRayStart.X - t * locRayVector.X;
  858. ip.Y := locRayStart.Y - t * locRayVector.Y;
  859. if (Abs(ip.X) <= 0.5 * Width) and (Abs(ip.Y) <= 0.5 * Height) then
  860. begin
  861. Result := True;
  862. if Assigned(intersectNormal) then
  863. intersectNormal^ := AbsoluteDirection;
  864. end
  865. else
  866. Result := False;
  867. end
  868. else
  869. Result := False;
  870. end
  871. else
  872. begin
  873. // ray start below plane
  874. if locRayVector.Z > 0 then
  875. begin
  876. t := locRayStart.Z / locRayVector.Z;
  877. ip.X := locRayStart.X - t * locRayVector.X;
  878. ip.Y := locRayStart.Y - t * locRayVector.Y;
  879. if (Abs(ip.X) <= 0.5 * Width) and (Abs(ip.Y) <= 0.5 * Height) then
  880. begin
  881. Result := True;
  882. if Assigned(intersectNormal) then
  883. intersectNormal^ := VectorNegate(AbsoluteDirection);
  884. end
  885. else
  886. Result := False;
  887. end
  888. else
  889. Result := False;
  890. end;
  891. if Result and Assigned(intersectPoint) then
  892. begin
  893. ip.Z := 0;
  894. ip.W := 1;
  895. intersectPoint^ := LocalToAbsolute(ip);
  896. end;
  897. end;
  898. function TgxPlane.GenerateSilhouette(const silhouetteParameters
  899. : TgxSilhouetteParameters): TgxSilhouette;
  900. var
  901. hw, hh: Single;
  902. begin
  903. Result := TgxSilhouette.Create;
  904. hw := FWidth * 0.5;
  905. hh := FHeight * 0.5;
  906. with Result.vertices do
  907. begin
  908. AddPoint(hw, hh);
  909. AddPoint(hw, -hh);
  910. AddPoint(-hw, -hh);
  911. AddPoint(-hw, hh);
  912. end;
  913. with Result.Indices do
  914. begin
  915. Add(0, 1);
  916. Add(1, 2);
  917. Add(2, 3);
  918. Add(3, 0);
  919. end;
  920. if silhouetteParameters.CappingRequired then
  921. with Result.CapIndices do
  922. begin
  923. Add(0, 1, 2);
  924. Add(2, 3, 0);
  925. end;
  926. end;
  927. procedure TgxPlane.BuildList(var rci: TgxRenderContextInfo);
  928. procedure EmitVertex(ptr: PVertexRec); {$IFDEF USE_INLINE}inline;{$ENDIF}
  929. begin
  930. glTexCoord2fv(@ptr^.TexCoord);
  931. glVertex3fv(@ptr^.Position);
  932. end;
  933. var
  934. hw, hh, posXFact, posYFact, pX, pY1: Single;
  935. tx0, tx1, ty0, ty1, texSFact, texTFact: Single;
  936. texS, texT1: Single;
  937. X, Y: Integer;
  938. TanLoc, BinLoc: Integer;
  939. pVertex: PVertexRec;
  940. begin
  941. hw := FWidth * 0.5;
  942. hh := FHeight * 0.5;
  943. glNormal3fv(@ZVector);
  944. if (rci.gxStates.CurrentProgram > 0) then
  945. begin
  946. TanLoc := glGetAttribLocation(rci.gxStates.CurrentProgram, PGLChar(TangentAttributeName));
  947. BinLoc := glGetAttribLocation(rci.gxStates.CurrentProgram, PGLChar(BinormalAttributeName));
  948. if TanLoc > -1 then
  949. glVertexAttrib3fv(TanLoc, @XVector);
  950. if BinLoc > -1 then
  951. glVertexAttrib3fv(BinLoc, @YVector);
  952. end;
  953. // determine tex coords extents
  954. if psTileTexture in FStyle then
  955. begin
  956. tx0 := FXOffset;
  957. tx1 := FXTiles * FXScope + FXOffset;
  958. ty0 := FYOffset;
  959. ty1 := FYTiles * FYScope + FYOffset;
  960. end
  961. else
  962. begin
  963. tx0 := 0;
  964. ty0 := tx0;
  965. tx1 := FXScope;
  966. ty1 := FYScope;
  967. end;
  968. if psSingleQuad in FStyle then
  969. begin
  970. // single quad plane
  971. glBegin(GL_TRIANGLES);
  972. glTexCoord2f(tx1, ty1);
  973. glVertex2f(hw, hh);
  974. glTexCoord2f(tx0, ty1);
  975. glVertex2f(-hw, hh);
  976. glTexCoord2f(tx0, ty0);
  977. glVertex2f(-hw, -hh);
  978. glVertex2f(-hw, -hh);
  979. glTexCoord2f(tx1, ty0);
  980. glVertex2f(hw, -hh);
  981. glTexCoord2f(tx1, ty1);
  982. glVertex2f(hw, hh);
  983. glEnd;
  984. exit;
  985. end
  986. else
  987. begin
  988. // multi-quad plane (actually built from tri-strips)
  989. texSFact := (tx1 - tx0) / FXTiles;
  990. texTFact := (ty1 - ty0) / FYTiles;
  991. posXFact := FWidth / FXTiles;
  992. posYFact := FHeight / FYTiles;
  993. if FMesh = nil then
  994. begin
  995. SetLength(FMesh, FYTiles+1, FXTiles+1);
  996. for Y := 0 to FYTiles do
  997. begin
  998. texT1 := Y * texTFact;
  999. pY1 := Y * posYFact - hh;
  1000. for X := 0 to FXTiles do
  1001. begin
  1002. texS := X * texSFact;
  1003. pX := X * posXFact - hw;
  1004. FMesh[Y][X].Position := Vector3fMake(pX, pY1, 0.0);
  1005. FMesh[Y][X].TexCoord := Vector2fMake(texS, texT1);
  1006. end;
  1007. end;
  1008. end;
  1009. end;
  1010. glBegin(GL_TRIANGLES);
  1011. for Y := 0 to FYTiles-1 do
  1012. begin
  1013. for X := 0 to FXTiles-1 do
  1014. begin
  1015. pVertex := @FMesh[Y][X];
  1016. EmitVertex(pVertex);
  1017. pVertex := @FMesh[Y][X+1];
  1018. EmitVertex(pVertex);
  1019. pVertex := @FMesh[Y+1][X];
  1020. EmitVertex(pVertex);
  1021. pVertex := @FMesh[Y+1][X+1];
  1022. EmitVertex(pVertex);
  1023. pVertex := @FMesh[Y+1][X];
  1024. EmitVertex(pVertex);
  1025. pVertex := @FMesh[Y][X+1];
  1026. EmitVertex(pVertex);
  1027. end;
  1028. end;
  1029. glEnd;
  1030. end;
  1031. procedure TgxPlane.SetWidth(const aValue: Single);
  1032. begin
  1033. if aValue <> FWidth then
  1034. begin
  1035. FWidth := aValue;
  1036. FMesh := nil;
  1037. StructureChanged;
  1038. end;
  1039. end;
  1040. function TgxPlane.ScreenRect(aBuffer: TgxSceneBuffer): TRect;
  1041. var
  1042. v: array [0 .. 3] of TVector4f;
  1043. buf: TgxSceneBuffer;
  1044. hw, hh: Single;
  1045. begin
  1046. buf := aBuffer;
  1047. if Assigned(buf) then
  1048. begin
  1049. hw := FWidth * 0.5;
  1050. hh := FHeight * 0.5;
  1051. v[0] := LocalToAbsolute(PointMake(-hw, -hh, 0));
  1052. v[1] := LocalToAbsolute(PointMake(hw, -hh, 0));
  1053. v[2] := LocalToAbsolute(PointMake(hw, hh, 0));
  1054. v[3] := LocalToAbsolute(PointMake(-hw, hh, 0));
  1055. buf.WorldToScreen(@v[0], 4);
  1056. Result.Left := Round(MinFloat([v[0].X, v[1].X, v[2].X, v[3].X]));
  1057. Result.Right := Round(MaxFloat([v[0].X, v[1].X, v[2].X, v[3].X]));
  1058. Result.Top := Round(MinFloat([v[0].Y, v[1].Y, v[2].Y, v[3].Y]));
  1059. Result.Bottom := Round(MaxFloat([v[0].Y, v[1].Y, v[2].Y, v[3].Y]));
  1060. end
  1061. else
  1062. FillChar(Result, SizeOf(TRect), 0);
  1063. end;
  1064. function TgxPlane.PointDistance(const aPoint: TVector4f): Single;
  1065. begin
  1066. Result := VectorDotProduct(VectorSubtract(aPoint, AbsolutePosition),
  1067. AbsoluteDirection);
  1068. end;
  1069. procedure TgxPlane.SetHeight(const aValue: Single);
  1070. begin
  1071. if aValue <> FHeight then
  1072. begin
  1073. FHeight := aValue;
  1074. FMesh := nil;
  1075. StructureChanged;
  1076. end;
  1077. end;
  1078. procedure TgxPlane.SetXOffset(const Value: Single);
  1079. begin
  1080. if Value <> FXOffset then
  1081. begin
  1082. FXOffset := Value;
  1083. FMesh := nil;
  1084. StructureChanged;
  1085. end;
  1086. end;
  1087. procedure TgxPlane.SetXScope(const Value: Single);
  1088. begin
  1089. if Value <> FXScope then
  1090. begin
  1091. FXScope := Value;
  1092. if FXScope > 1 then
  1093. FXScope := 1;
  1094. FMesh := nil;
  1095. StructureChanged;
  1096. end;
  1097. end;
  1098. function TgxPlane.StoreXScope: Boolean;
  1099. begin
  1100. Result := (FXScope <> 1);
  1101. end;
  1102. procedure TgxPlane.SetXTiles(const Value: Cardinal);
  1103. begin
  1104. if Value <> FXTiles then
  1105. begin
  1106. FXTiles := Value;
  1107. FMesh := nil;
  1108. StructureChanged;
  1109. end;
  1110. end;
  1111. procedure TgxPlane.SetYOffset(const Value: Single);
  1112. begin
  1113. if Value <> FYOffset then
  1114. begin
  1115. FYOffset := Value;
  1116. FMesh := nil;
  1117. StructureChanged;
  1118. end;
  1119. end;
  1120. procedure TgxPlane.SetYScope(const Value: Single);
  1121. begin
  1122. if Value <> FYScope then
  1123. begin
  1124. FYScope := Value;
  1125. if FYScope > 1 then
  1126. FYScope := 1;
  1127. FMesh := nil;
  1128. StructureChanged;
  1129. end;
  1130. end;
  1131. function TgxPlane.StoreYScope: Boolean;
  1132. begin
  1133. Result := (FYScope <> 1);
  1134. end;
  1135. procedure TgxPlane.SetYTiles(const Value: Cardinal);
  1136. begin
  1137. if Value <> FYTiles then
  1138. begin
  1139. FYTiles := Value;
  1140. FMesh := nil;
  1141. StructureChanged;
  1142. end;
  1143. end;
  1144. procedure TgxPlane.SetStyle(const val: TgxPlaneStyles);
  1145. begin
  1146. if val <> FStyle then
  1147. begin
  1148. FStyle := val;
  1149. StructureChanged;
  1150. end;
  1151. end;
  1152. // ------------------
  1153. // ------------------ TgxSprite ------------------
  1154. // ------------------
  1155. constructor TgxSprite.Create(AOwner: TComponent);
  1156. begin
  1157. inherited Create(AOwner);
  1158. ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
  1159. FAlphaChannel := 1;
  1160. FWidth := 1;
  1161. FHeight := 1;
  1162. end;
  1163. procedure TgxSprite.Assign(Source: TPersistent);
  1164. begin
  1165. if Source is TgxSprite then
  1166. begin
  1167. FWidth := TgxSprite(Source).FWidth;
  1168. FHeight := TgxSprite(Source).FHeight;
  1169. FRotation := TgxSprite(Source).FRotation;
  1170. FAlphaChannel := TgxSprite(Source).FAlphaChannel;
  1171. end;
  1172. inherited Assign(Source);
  1173. end;
  1174. function TgxSprite.AxisAlignedDimensionsUnscaled: TVector4f;
  1175. begin
  1176. Result.X := 0.5 * Abs(FWidth);
  1177. Result.Y := 0.5 * Abs(FHeight);
  1178. // Sprites turn with the camera and can be considered to have the same depth
  1179. // as width
  1180. Result.Z := 0.5 * Abs(FWidth);
  1181. end;
  1182. procedure TgxSprite.BuildList(var rci: TgxRenderContextInfo);
  1183. var
  1184. vx, vy: TAffineVector;
  1185. w, h: Single;
  1186. mat: TMatrix4f;
  1187. u0, v0, u1, v1: Integer;
  1188. begin
  1189. if FAlphaChannel <> 1 then
  1190. rci.gxStates.SetMaterialAlphaChannel(GL_FRONT, FAlphaChannel);
  1191. mat := rci.PipelineTransformation.ModelViewMatrix^;
  1192. // extraction of the "vecteurs directeurs de la matrice"
  1193. // (dunno how they are named in english)
  1194. w := FWidth * 0.5;
  1195. h := FHeight * 0.5;
  1196. vx.X := mat.X.X;
  1197. vy.X := mat.X.Y;
  1198. vx.Y := mat.Y.X;
  1199. vy.Y := mat.Y.Y;
  1200. vx.Z := mat.Z.X;
  1201. vy.Z := mat.Z.Y;
  1202. ScaleVector(vx, w / VectorLength(vx));
  1203. ScaleVector(vy, h / VectorLength(vy));
  1204. if FMirrorU then
  1205. begin
  1206. u0 := 1;
  1207. u1 := 0;
  1208. end
  1209. else
  1210. begin
  1211. u0 := 0;
  1212. u1 := 1;
  1213. end;
  1214. if FMirrorV then
  1215. begin
  1216. v0 := 1;
  1217. v1 := 0;
  1218. end
  1219. else
  1220. begin
  1221. v0 := 0;
  1222. v1 := 1;
  1223. end;
  1224. if FRotation <> 0 then
  1225. begin
  1226. glPushMatrix;
  1227. glRotatef(FRotation, mat.X.Z, mat.Y.Z, mat.Z.Z);
  1228. end;
  1229. glBegin(GL_QUADS);
  1230. glTexCoord2f(u1, v1);
  1231. glVertex3f(vx.X + vy.X, vx.Y + vy.Y, vx.Z + vy.Z);
  1232. glTexCoord2f(u0, v1);
  1233. glVertex3f(-vx.X + vy.X, -vx.Y + vy.Y, -vx.Z + vy.Z);
  1234. glTexCoord2f(u0, v0);
  1235. glVertex3f(-vx.X - vy.X, -vx.Y - vy.Y, -vx.Z - vy.Z);
  1236. glTexCoord2f(u1, v0);
  1237. glVertex3f(vx.X - vy.X, vx.Y - vy.Y, vx.Z - vy.Z);
  1238. glEnd;
  1239. if FRotation <> 0 then
  1240. glPopMatrix;
  1241. end;
  1242. procedure TgxSprite.SetWidth(const val: Single);
  1243. begin
  1244. if FWidth <> val then
  1245. begin
  1246. FWidth := val;
  1247. NotifyChange(Self);
  1248. end;
  1249. end;
  1250. procedure TgxSprite.SetHeight(const val: Single);
  1251. begin
  1252. if FHeight <> val then
  1253. begin
  1254. FHeight := val;
  1255. NotifyChange(Self);
  1256. end;
  1257. end;
  1258. procedure TgxSprite.SetRotation(const val: Single);
  1259. begin
  1260. if FRotation <> val then
  1261. begin
  1262. FRotation := val;
  1263. NotifyChange(Self);
  1264. end;
  1265. end;
  1266. procedure TgxSprite.SetAlphaChannel(const val: Single);
  1267. begin
  1268. if val <> FAlphaChannel then
  1269. begin
  1270. if val < 0 then
  1271. FAlphaChannel := 0
  1272. else if val > 1 then
  1273. FAlphaChannel := 1
  1274. else
  1275. FAlphaChannel := val;
  1276. NotifyChange(Self);
  1277. end;
  1278. end;
  1279. function TgxSprite.StoreAlphaChannel: Boolean;
  1280. begin
  1281. Result := (FAlphaChannel <> 1);
  1282. end;
  1283. procedure TgxSprite.SetMirrorU(const val: Boolean);
  1284. begin
  1285. FMirrorU := val;
  1286. NotifyChange(Self);
  1287. end;
  1288. procedure TgxSprite.SetMirrorV(const val: Boolean);
  1289. begin
  1290. FMirrorV := val;
  1291. NotifyChange(Self);
  1292. end;
  1293. procedure TgxSprite.SetSize(const Width, Height: Single);
  1294. begin
  1295. FWidth := Width;
  1296. FHeight := Height;
  1297. NotifyChange(Self);
  1298. end;
  1299. procedure TgxSprite.SetSquareSize(const Size: Single);
  1300. begin
  1301. FWidth := Size;
  1302. FHeight := Size;
  1303. NotifyChange(Self);
  1304. end;
  1305. // ------------------
  1306. // ------------------ TgxPointParameters ------------------
  1307. // ------------------
  1308. constructor TgxPointParameters.Create(AOwner: TPersistent);
  1309. begin
  1310. inherited Create(AOwner);
  1311. FMinSize := 0;
  1312. FMaxSize := 128;
  1313. FFadeTresholdSize := 1;
  1314. FDistanceAttenuation := TgxCoordinates.CreateInitialized(Self, XHmgVector,
  1315. csVector);
  1316. end;
  1317. destructor TgxPointParameters.Destroy;
  1318. begin
  1319. FDistanceAttenuation.Free;
  1320. inherited;
  1321. end;
  1322. procedure TgxPointParameters.Assign(Source: TPersistent);
  1323. begin
  1324. if Source is TgxPointParameters then
  1325. begin
  1326. FMinSize := TgxPointParameters(Source).FMinSize;
  1327. FMaxSize := TgxPointParameters(Source).FMaxSize;
  1328. FFadeTresholdSize := TgxPointParameters(Source).FFadeTresholdSize;
  1329. FDistanceAttenuation.Assign(TgxPointParameters(Source).DistanceAttenuation);
  1330. end;
  1331. end;
  1332. procedure TgxPointParameters.DefineProperties(Filer: TFiler);
  1333. var
  1334. defaultParams: Boolean;
  1335. begin
  1336. inherited;
  1337. defaultParams := (FMaxSize = 128) and (FMinSize = 0) and
  1338. (FFadeTresholdSize = 1);
  1339. Filer.DefineBinaryProperty('PointParams', ReadData, WriteData,
  1340. not defaultParams);
  1341. end;
  1342. procedure TgxPointParameters.ReadData(Stream: TStream);
  1343. begin
  1344. with Stream do
  1345. begin
  1346. Read(FMinSize, SizeOf(Single));
  1347. Read(FMaxSize, SizeOf(Single));
  1348. Read(FFadeTresholdSize, SizeOf(Single));
  1349. end;
  1350. end;
  1351. procedure TgxPointParameters.WriteData(Stream: TStream);
  1352. begin
  1353. with Stream do
  1354. begin
  1355. Write(FMinSize, SizeOf(Single));
  1356. Write(FMaxSize, SizeOf(Single));
  1357. Write(FFadeTresholdSize, SizeOf(Single));
  1358. end;
  1359. end;
  1360. procedure TgxPointParameters.Apply;
  1361. begin
  1362. if Enabled then //and GL_ARB_point_parameters
  1363. begin
  1364. glPointParameterf(GL_POINT_SIZE_MIN_ARB, FMinSize);
  1365. glPointParameterf(GL_POINT_SIZE_MAX_ARB, FMaxSize);
  1366. glPointParameterf(GL_POINT_FADE_THRESHOLD_SIZE_ARB, FFadeTresholdSize);
  1367. glPointParameterfv(GL_DISTANCE_ATTENUATION_EXT, FDistanceAttenuation.AsAddress);
  1368. end;
  1369. end;
  1370. procedure TgxPointParameters.UnApply;
  1371. begin
  1372. if Enabled then //and GL_ARB_point_parameters
  1373. begin
  1374. glPointParameterf(GL_POINT_SIZE_MIN_ARB, 0);
  1375. glPointParameterf(GL_POINT_SIZE_MAX_ARB, 128);
  1376. glPointParameterf(GL_POINT_FADE_THRESHOLD_SIZE_ARB, 1);
  1377. glPointParameterfv(GL_DISTANCE_ATTENUATION_EXT, @XVector);
  1378. end;
  1379. end;
  1380. procedure TgxPointParameters.SetEnabled(const val: Boolean);
  1381. begin
  1382. if val <> FEnabled then
  1383. begin
  1384. FEnabled := val;
  1385. NotifyChange(Self);
  1386. end;
  1387. end;
  1388. procedure TgxPointParameters.SetMinSize(const val: Single);
  1389. begin
  1390. if val <> FMinSize then
  1391. begin
  1392. if val < 0 then
  1393. FMinSize := 0
  1394. else
  1395. FMinSize := val;
  1396. NotifyChange(Self);
  1397. end;
  1398. end;
  1399. procedure TgxPointParameters.SetMaxSize(const val: Single);
  1400. begin
  1401. if val <> FMaxSize then
  1402. begin
  1403. if val < 0 then
  1404. FMaxSize := 0
  1405. else
  1406. FMaxSize := val;
  1407. NotifyChange(Self);
  1408. end;
  1409. end;
  1410. procedure TgxPointParameters.SetFadeTresholdSize(const val: Single);
  1411. begin
  1412. if val <> FFadeTresholdSize then
  1413. begin
  1414. if val < 0 then
  1415. FFadeTresholdSize := 0
  1416. else
  1417. FFadeTresholdSize := val;
  1418. NotifyChange(Self);
  1419. end;
  1420. end;
  1421. procedure TgxPointParameters.SetDistanceAttenuation(const val: TgxCoordinates);
  1422. begin
  1423. FDistanceAttenuation.Assign(val);
  1424. end;
  1425. // ------------------
  1426. // ------------------ TgxPoints ------------------
  1427. // ------------------
  1428. constructor TgxPoints.Create(AOwner: TComponent);
  1429. begin
  1430. inherited Create(AOwner);
  1431. ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
  1432. FStyle := psSquare;
  1433. FSize := cDefaultPointSize;
  1434. FPositions := TgxAffineVectorList.Create;
  1435. FPositions.Add(NullVector);
  1436. FColors := TgxVectorList.Create;
  1437. FPointParameters := TgxPointParameters.Create(Self);
  1438. end;
  1439. destructor TgxPoints.Destroy;
  1440. begin
  1441. FPointParameters.Free;
  1442. FColors.Free;
  1443. FPositions.Free;
  1444. inherited;
  1445. end;
  1446. procedure TgxPoints.Assign(Source: TPersistent);
  1447. begin
  1448. if Source is TgxPoints then
  1449. begin
  1450. FSize := TgxPoints(Source).FSize;
  1451. FStyle := TgxPoints(Source).FStyle;
  1452. FPositions.Assign(TgxPoints(Source).FPositions);
  1453. FColors.Assign(TgxPoints(Source).FColors);
  1454. StructureChanged
  1455. end;
  1456. inherited Assign(Source);
  1457. end;
  1458. procedure TgxPoints.BuildList(var rci: TgxRenderContextInfo);
  1459. var
  1460. n: Integer;
  1461. v: TVector4f;
  1462. begin
  1463. n := FPositions.Count;
  1464. if n = 0 then
  1465. Exit;
  1466. case FColors.Count of
  1467. 0: glColor4f(1, 1, 1, 1);
  1468. 1: glColor4fv(PGLFloat(FColors.List));
  1469. else
  1470. if FColors.Count < n then
  1471. n := FColors.Count;
  1472. glColorPointer(4, GL_FLOAT, 0, FColors.List);
  1473. glEnableClientState(GL_COLOR_ARRAY);
  1474. end;
  1475. if FColors.Count < 2 then
  1476. glDisableClientState(GL_COLOR_ARRAY);
  1477. rci.gxStates.Disable(stLighting);
  1478. if n = 0 then
  1479. begin
  1480. v := NullHmgPoint;
  1481. glVertexPointer(3, GL_FLOAT, 0, @v);
  1482. n := 1;
  1483. end
  1484. else
  1485. glVertexPointer(3, GL_FLOAT, 0, FPositions.List);
  1486. glEnableClientState(GL_VERTEX_ARRAY);
  1487. if NoZWrite then
  1488. rci.gxStates.DepthWriteMask := boolean(False);
  1489. rci.gxStates.PointSize := FSize;
  1490. PointParameters.Apply;
  1491. if (n > 64) then /// and GL_EXT_compiled_vertex_array
  1492. glLockArraysEXT(0, n);
  1493. case FStyle of
  1494. psSquare:
  1495. begin
  1496. // square point (simplest method, fastest)
  1497. rci.gxStates.Disable(stBlend);
  1498. end;
  1499. psRound:
  1500. begin
  1501. rci.gxStates.Enable(stPointSmooth);
  1502. rci.gxStates.Enable(stAlphaTest);
  1503. rci.gxStates.SetAlphaFunction(cfGreater, 0.5);
  1504. rci.gxStates.Disable(stBlend);
  1505. end;
  1506. psSmooth:
  1507. begin
  1508. rci.gxStates.Enable(stPointSmooth);
  1509. rci.gxStates.Enable(stAlphaTest);
  1510. rci.gxStates.SetAlphaFunction(cfNotEqual, 0.0);
  1511. rci.gxStates.Enable(stBlend);
  1512. rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  1513. end;
  1514. psSmoothAdditive:
  1515. begin
  1516. rci.gxStates.Enable(stPointSmooth);
  1517. rci.gxStates.Enable(stAlphaTest);
  1518. rci.gxStates.SetAlphaFunction(cfNotEqual, 0.0);
  1519. rci.gxStates.Enable(stBlend);
  1520. rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne);
  1521. end;
  1522. psSquareAdditive:
  1523. begin
  1524. rci.gxStates.Enable(stBlend);
  1525. rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne);
  1526. end;
  1527. else
  1528. Assert(False);
  1529. end;
  1530. glDrawArrays(GL_POINTS, 0, n);
  1531. if (n > 64) then ///and GL_EXT_compiled_vertex_array
  1532. glUnlockArraysEXT;
  1533. PointParameters.UnApply;
  1534. glDisableClientState(GL_VERTEX_ARRAY);
  1535. if FColors.Count > 1 then
  1536. glDisableClientState(GL_COLOR_ARRAY);
  1537. end;
  1538. function TgxPoints.StoreSize: Boolean;
  1539. begin
  1540. Result := (FSize <> cDefaultPointSize);
  1541. end;
  1542. procedure TgxPoints.SetNoZWrite(const val: Boolean);
  1543. begin
  1544. if FNoZWrite <> val then
  1545. begin
  1546. FNoZWrite := val;
  1547. StructureChanged;
  1548. end;
  1549. end;
  1550. procedure TgxPoints.SetStatic(const val: Boolean);
  1551. begin
  1552. if FStatic <> val then
  1553. begin
  1554. FStatic := val;
  1555. if val then
  1556. ObjectStyle := ObjectStyle - [osDirectDraw]
  1557. else
  1558. ObjectStyle := ObjectStyle + [osDirectDraw];
  1559. StructureChanged;
  1560. end;
  1561. end;
  1562. procedure TgxPoints.SetSize(const val: Single);
  1563. begin
  1564. if FSize <> val then
  1565. begin
  1566. FSize := val;
  1567. StructureChanged;
  1568. end;
  1569. end;
  1570. procedure TgxPoints.SetPositions(const val: TgxAffineVectorList);
  1571. begin
  1572. FPositions.Assign(val);
  1573. StructureChanged;
  1574. end;
  1575. procedure TgxPoints.SetColors(const val: TgxVectorList);
  1576. begin
  1577. FColors.Assign(val);
  1578. StructureChanged;
  1579. end;
  1580. procedure TgxPoints.SetStyle(const val: TgxPointStyle);
  1581. begin
  1582. if FStyle <> val then
  1583. begin
  1584. FStyle := val;
  1585. StructureChanged;
  1586. end;
  1587. end;
  1588. procedure TgxPoints.SetPointParameters(const val: TgxPointParameters);
  1589. begin
  1590. FPointParameters.Assign(val);
  1591. end;
  1592. // ------------------
  1593. // ------------------ TgxLineBase ------------------
  1594. // ------------------
  1595. constructor TgxLineBase.Create(AOwner: TComponent);
  1596. begin
  1597. inherited Create(AOwner);
  1598. FLineColor := TgxColor.Create(Self);
  1599. FLineColor.Initialize(clrWhite);
  1600. FLinePattern := $FFFF;
  1601. FAntiAliased := False;
  1602. FLineWidth := 1.0;
  1603. end;
  1604. destructor TgxLineBase.Destroy;
  1605. begin
  1606. FLineColor.Free;
  1607. inherited Destroy;
  1608. end;
  1609. procedure TgxLineBase.NotifyChange(Sender: TObject);
  1610. begin
  1611. if Sender = FLineColor then
  1612. StructureChanged;
  1613. inherited;
  1614. end;
  1615. procedure TgxLineBase.SetLineColor(const Value: TgxColor);
  1616. begin
  1617. FLineColor.Color := Value.Color;
  1618. StructureChanged;
  1619. end;
  1620. procedure TgxLineBase.SetLinePattern(const Value: GLushort);
  1621. begin
  1622. if FLinePattern <> Value then
  1623. begin
  1624. FLinePattern := Value;
  1625. StructureChanged;
  1626. end;
  1627. end;
  1628. procedure TgxLineBase.SetLineWidth(const val: Single);
  1629. begin
  1630. if FLineWidth <> val then
  1631. begin
  1632. FLineWidth := val;
  1633. StructureChanged;
  1634. end;
  1635. end;
  1636. function TgxLineBase.StoreLineWidth: Boolean;
  1637. begin
  1638. Result := (FLineWidth <> 1.0);
  1639. end;
  1640. procedure TgxLineBase.SetAntiAliased(const val: Boolean);
  1641. begin
  1642. if FAntiAliased <> val then
  1643. begin
  1644. FAntiAliased := val;
  1645. StructureChanged;
  1646. end;
  1647. end;
  1648. procedure TgxLineBase.Assign(Source: TPersistent);
  1649. begin
  1650. if Source is TgxLineBase then
  1651. begin
  1652. LineColor := TgxLineBase(Source).FLineColor;
  1653. LinePattern := TgxLineBase(Source).FLinePattern;
  1654. LineWidth := TgxLineBase(Source).FLineWidth;
  1655. AntiAliased := TgxLineBase(Source).FAntiAliased;
  1656. end;
  1657. inherited Assign(Source);
  1658. end;
  1659. procedure TgxLineBase.SetupLineStyle(var rci: TgxRenderContextInfo);
  1660. begin
  1661. with rci.gxStates do
  1662. begin
  1663. Disable(stLighting);
  1664. if FLinePattern <> $FFFF then
  1665. begin
  1666. Enable(stLineStipple);
  1667. Enable(stBlend);
  1668. SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  1669. LineStippleFactor := 1;
  1670. LineStipplePattern := FLinePattern;
  1671. end
  1672. else
  1673. Disable(stLineStipple);
  1674. if FAntiAliased then
  1675. begin
  1676. Enable(stLineSmooth);
  1677. Enable(stBlend);
  1678. SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  1679. end
  1680. else
  1681. Disable(stLineSmooth);
  1682. LineWidth := FLineWidth;
  1683. if FLineColor.Alpha <> 1 then
  1684. begin
  1685. if not FAntiAliased then
  1686. begin
  1687. Enable(stBlend);
  1688. SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  1689. end;
  1690. glColor4fv(FLineColor.AsAddress);
  1691. end
  1692. else
  1693. glColor3fv(FLineColor.AsAddress);
  1694. end;
  1695. end;
  1696. // ------------------
  1697. // ------------------ TgxLinesNode ------------------
  1698. // ------------------
  1699. constructor TgxLinesNode.Create(Collection: TCollection);
  1700. begin
  1701. inherited Create(Collection);
  1702. FColor := TgxColor.Create(Self);
  1703. FColor.Initialize((TgxLinesNodes(Collection).GetOwner as TgxLines)
  1704. .NodeColor.Color);
  1705. FColor.OnNotifyChange := OnColorChange;
  1706. end;
  1707. destructor TgxLinesNode.Destroy;
  1708. begin
  1709. FColor.Free;
  1710. inherited Destroy;
  1711. end;
  1712. procedure TgxLinesNode.Assign(Source: TPersistent);
  1713. begin
  1714. if Source is TgxLinesNode then
  1715. FColor.Assign(TgxLinesNode(Source).FColor);
  1716. inherited;
  1717. end;
  1718. procedure TgxLinesNode.SetColor(const val: TgxColor);
  1719. begin
  1720. FColor.Assign(val);
  1721. end;
  1722. procedure TgxLinesNode.OnColorChange(Sender: TObject);
  1723. begin
  1724. (Collection as TgxNodes).NotifyChange;
  1725. end;
  1726. function TgxLinesNode.StoreColor: Boolean;
  1727. begin
  1728. Result := not VectorEquals((TgxLinesNodes(Collection).GetOwner as TgxLines)
  1729. .NodeColor.Color, FColor.Color);
  1730. end;
  1731. // ------------------
  1732. // ------------------ TgxLinesNodes ------------------
  1733. // ------------------
  1734. constructor TgxLinesNodes.Create(AOwner: TComponent);
  1735. begin
  1736. inherited Create(AOwner, TgxLinesNode);
  1737. end;
  1738. procedure TgxLinesNodes.NotifyChange;
  1739. begin
  1740. if (GetOwner <> nil) then
  1741. (GetOwner as TgxBaseSceneObject).StructureChanged;
  1742. end;
  1743. // ------------------
  1744. // ------------------ TgxNodedLines ------------------
  1745. // ------------------
  1746. constructor TgxNodedLines.Create(AOwner: TComponent);
  1747. begin
  1748. inherited Create(AOwner);
  1749. FNodes := TgxLinesNodes.Create(Self);
  1750. FNodeColor := TgxColor.Create(Self);
  1751. FNodeColor.Initialize(clrBlue);
  1752. FNodeColor.OnNotifyChange := OnNodeColorChanged;
  1753. FOldNodeColor := clrBlue;
  1754. FNodesAspect := lnaAxes;
  1755. FNodeSize := 1;
  1756. end;
  1757. destructor TgxNodedLines.Destroy;
  1758. begin
  1759. FNodes.Free;
  1760. FNodeColor.Free;
  1761. inherited Destroy;
  1762. end;
  1763. procedure TgxNodedLines.SetNodesAspect(const Value: TLineNodesAspect);
  1764. begin
  1765. if Value <> FNodesAspect then
  1766. begin
  1767. FNodesAspect := Value;
  1768. StructureChanged;
  1769. end;
  1770. end;
  1771. procedure TgxNodedLines.SetNodeColor(const Value: TgxColor);
  1772. begin
  1773. FNodeColor.Color := Value.Color;
  1774. StructureChanged;
  1775. end;
  1776. procedure TgxNodedLines.OnNodeColorChanged(Sender: TObject);
  1777. var
  1778. i: Integer;
  1779. begin
  1780. // update color for nodes...
  1781. for i := 0 to Nodes.Count - 1 do
  1782. if VectorEquals(TgxLinesNode(Nodes[i]).Color.Color, FOldNodeColor) then
  1783. TgxLinesNode(Nodes[i]).Color.Assign(FNodeColor);
  1784. SetVector(FOldNodeColor, FNodeColor.Color);
  1785. end;
  1786. procedure TgxNodedLines.SetNodes(const aNodes: TgxLinesNodes);
  1787. begin
  1788. FNodes.Assign(aNodes);
  1789. StructureChanged;
  1790. end;
  1791. procedure TgxNodedLines.SetNodeSize(const val: Single);
  1792. begin
  1793. if val <= 0 then
  1794. FNodeSize := 1
  1795. else
  1796. FNodeSize := val;
  1797. StructureChanged;
  1798. end;
  1799. function TgxNodedLines.StoreNodeSize: Boolean;
  1800. begin
  1801. Result := FNodeSize <> 1;
  1802. end;
  1803. procedure TgxNodedLines.Assign(Source: TPersistent);
  1804. begin
  1805. if Source is TgxNodedLines then
  1806. begin
  1807. SetNodes(TgxNodedLines(Source).FNodes);
  1808. FNodesAspect := TgxNodedLines(Source).FNodesAspect;
  1809. FNodeColor.Color := TgxNodedLines(Source).FNodeColor.Color;
  1810. FNodeSize := TgxNodedLines(Source).FNodeSize;
  1811. end;
  1812. inherited Assign(Source);
  1813. end;
  1814. procedure TgxNodedLines.DrawNode(var rci: TgxRenderContextInfo; X, Y, Z: Single;
  1815. Color: TgxColor);
  1816. begin
  1817. glPushMatrix;
  1818. glTranslatef(X, Y, Z);
  1819. case NodesAspect of
  1820. lnaAxes:
  1821. AxesBuildList(rci, $CCCC, FNodeSize * 0.5);
  1822. lnaCube:
  1823. CubeWireframeBuildList(rci, FNodeSize, False, Color.Color);
  1824. else
  1825. Assert(False)
  1826. end;
  1827. glPopMatrix;
  1828. end;
  1829. function TgxNodedLines.AxisAlignedDimensionsUnscaled: TVector4f;
  1830. var
  1831. i: Integer;
  1832. begin
  1833. RstVector(Result);
  1834. for i := 0 to Nodes.Count - 1 do
  1835. MaxVector(Result, VectorAbs(Nodes[i].AsVector));
  1836. // EG: commented out, line below looks suspicious, since scale isn't taken
  1837. // into account in previous loop, must have been hiding another bug... somewhere...
  1838. // DivideVector(Result, Scale.AsVector); //DanB ?
  1839. end;
  1840. procedure TgxNodedLines.AddNode(const coords: TgxCoordinates);
  1841. var
  1842. n: TgxNode;
  1843. begin
  1844. n := Nodes.Add;
  1845. if Assigned(coords) then
  1846. n.AsVector := coords.AsVector;
  1847. StructureChanged;
  1848. end;
  1849. procedure TgxNodedLines.AddNode(const X, Y, Z: Single);
  1850. var
  1851. n: TgxNode;
  1852. begin
  1853. n := Nodes.Add;
  1854. n.AsVector := VectorMake(X, Y, Z, 1);
  1855. StructureChanged;
  1856. end;
  1857. procedure TgxNodedLines.AddNode(const Value: TVector4f);
  1858. var
  1859. n: TgxNode;
  1860. begin
  1861. n := Nodes.Add;
  1862. n.AsVector := Value;
  1863. StructureChanged;
  1864. end;
  1865. procedure TgxNodedLines.AddNode(const Value: TAffineVector);
  1866. var
  1867. n: TgxNode;
  1868. begin
  1869. n := Nodes.Add;
  1870. n.AsVector := VectorMake(Value);
  1871. StructureChanged;
  1872. end;
  1873. // ------------------
  1874. // ------------------ TgxLines ------------------
  1875. // ------------------
  1876. constructor TgxLines.Create(AOwner: TComponent);
  1877. begin
  1878. inherited Create(AOwner);
  1879. FDivision := 10;
  1880. FSplineMode := lsmLines;
  1881. FNURBSKnots := TgxSingleList.Create;
  1882. FNURBSOrder := 0;
  1883. FNURBSTolerance := 50;
  1884. end;
  1885. destructor TgxLines.Destroy;
  1886. begin
  1887. FNURBSKnots.Free;
  1888. inherited Destroy;
  1889. end;
  1890. procedure TgxLines.SetDivision(const Value: Integer);
  1891. begin
  1892. if Value <> FDivision then
  1893. begin
  1894. if Value < 1 then
  1895. FDivision := 1
  1896. else
  1897. FDivision := Value;
  1898. StructureChanged;
  1899. end;
  1900. end;
  1901. procedure TgxLines.SetOptions(const val: TgxLinesOptions);
  1902. begin
  1903. FOptions := val;
  1904. StructureChanged;
  1905. end;
  1906. procedure TgxLines.SetSplineMode(const val: TgxLineSplineMode);
  1907. begin
  1908. if FSplineMode <> val then
  1909. begin
  1910. FSplineMode := val;
  1911. StructureChanged;
  1912. end;
  1913. end;
  1914. procedure TgxLines.SetNURBSOrder(const val: Integer);
  1915. begin
  1916. if val <> FNURBSOrder then
  1917. begin
  1918. FNURBSOrder := val;
  1919. StructureChanged;
  1920. end;
  1921. end;
  1922. procedure TgxLines.SetNURBSTolerance(const val: Single);
  1923. begin
  1924. if val <> FNURBSTolerance then
  1925. begin
  1926. FNURBSTolerance := val;
  1927. StructureChanged;
  1928. end;
  1929. end;
  1930. procedure TgxLines.Assign(Source: TPersistent);
  1931. begin
  1932. if Source is TgxLines then
  1933. begin
  1934. FDivision := TgxLines(Source).FDivision;
  1935. FSplineMode := TgxLines(Source).FSplineMode;
  1936. FOptions := TgxLines(Source).FOptions;
  1937. end;
  1938. inherited Assign(Source);
  1939. end;
  1940. procedure TgxLines.BuildList(var rci: TgxRenderContextInfo);
  1941. var
  1942. i, n: Integer;
  1943. A, B, C: Single;
  1944. f: Single;
  1945. Spline: TCubicSpline;
  1946. vertexColor: TVector4f;
  1947. nodeBuffer: array of TAffineVector;
  1948. colorBuffer: array of TVector4f;
  1949. nurbsRenderer : GLUNurbsObj;
  1950. begin
  1951. if Nodes.Count > 1 then
  1952. begin
  1953. // first, we setup the line color & stippling styles
  1954. SetupLineStyle(rci);
  1955. if rci.bufferDepthTest then
  1956. rci.gxStates.Enable(stDepthTest);
  1957. if loColorLogicXor in Options then
  1958. begin
  1959. rci.gxStates.Enable(stColorLogicOp);
  1960. rci.gxStates.LogicOpMode := loXOr;
  1961. end;
  1962. // Set up the control point buffer for Bezier splines and NURBS curves.
  1963. // If required this could be optimized by storing a cached node buffer.
  1964. if (FSplineMode = lsmBezierSpline) or (FSplineMode = lsmNURBSCurve) then
  1965. begin
  1966. SetLength(nodeBuffer, Nodes.Count);
  1967. SetLength(colorBuffer, Nodes.Count);
  1968. for i := 0 to Nodes.Count - 1 do
  1969. with TgxLinesNode(Nodes[i]) do
  1970. begin
  1971. nodeBuffer[i] := AsAffineVector;
  1972. colorBuffer[i] := Color.Color;
  1973. end;
  1974. end;
  1975. if FSplineMode = lsmBezierSpline then
  1976. begin
  1977. // map evaluator
  1978. glPushAttrib(GL_EVAL_BIT);
  1979. glEnable(GL_MAP1_VERTEX_3);
  1980. glEnable(GL_MAP1_COLOR_4);
  1981. glMap1f(GL_MAP1_VERTEX_3, 0, 1, 3, Nodes.Count, @nodeBuffer[0]);
  1982. glMap1f(GL_MAP1_COLOR_4, 0, 1, 4, Nodes.Count, @colorBuffer[0]);
  1983. end;
  1984. // start drawing the line
  1985. if (FSplineMode = lsmNURBSCurve) and (FDivision >= 2) then
  1986. begin
  1987. if (FNURBSOrder > 0) and (FNURBSKnots.Count > 0) then
  1988. begin
  1989. nurbsRenderer := gluNewNurbsRenderer;
  1990. try
  1991. gluNurbsProperty(nurbsRenderer, GLU_SAMPLING_TOLERANCE, FNURBSTolerance);
  1992. gluNurbsProperty(nurbsRenderer, GLU_DISPLAY_MODE, GLU_FILL);
  1993. gluBeginCurve(nurbsRenderer);
  1994. gluNurbsCurve(nurbsRenderer, FNURBSKnots.Count, @FNURBSKnots.List[0],
  1995. 3, @nodeBuffer[0], FNURBSOrder, GL_MAP1_VERTEX_3);
  1996. gluEndCurve(nurbsRenderer);
  1997. finally
  1998. gluDeleteNurbsRenderer(nurbsRenderer);
  1999. end;
  2000. end;
  2001. end
  2002. else
  2003. begin
  2004. // lines, cubic splines or bezier
  2005. if FSplineMode = lsmSegments then
  2006. glBegin(GL_LINES)
  2007. else if FSplineMode = lsmLoop then
  2008. glBegin(GL_LINE_LOOP)
  2009. else
  2010. glBegin(GL_LINE_STRIP);
  2011. if (FDivision < 2) or (FSplineMode in [lsmLines, lsmSegments,
  2012. lsmLoop]) then
  2013. begin
  2014. // standard line(s), draw directly
  2015. if loUseNodeColorForLines in Options then
  2016. begin
  2017. // node color interpolation
  2018. for i := 0 to Nodes.Count - 1 do
  2019. with TgxLinesNode(Nodes[i]) do
  2020. begin
  2021. glColor4fv(Color.AsAddress);
  2022. glVertex3f(X, Y, Z);
  2023. end;
  2024. end
  2025. else
  2026. begin
  2027. // single color
  2028. for i := 0 to Nodes.Count - 1 do
  2029. with Nodes[i] do
  2030. glVertex3f(X, Y, Z);
  2031. end;
  2032. end
  2033. else if FSplineMode = lsmCubicSpline then
  2034. begin
  2035. // cubic spline
  2036. Spline := Nodes.CreateNewCubicSpline;
  2037. try
  2038. f := 1 / FDivision;
  2039. for i := 0 to (Nodes.Count - 1) * FDivision do
  2040. begin
  2041. Spline.SplineXYZ(i * f, A, B, C);
  2042. if loUseNodeColorForLines in Options then
  2043. begin
  2044. n := (i div FDivision);
  2045. if n < Nodes.Count - 1 then
  2046. VectorLerp(TgxLinesNode(Nodes[n]).Color.Color,
  2047. TgxLinesNode(Nodes[n + 1]).Color.Color,
  2048. (i mod FDivision) * f, vertexColor)
  2049. else
  2050. SetVector(vertexColor, TgxLinesNode(Nodes[Nodes.Count - 1]).Color.Color);
  2051. glColor4fv(@vertexColor);
  2052. end;
  2053. glVertex3f(A, B, C);
  2054. end;
  2055. finally
  2056. Spline.Free;
  2057. end;
  2058. end
  2059. else if FSplineMode = lsmBezierSpline then
  2060. begin
  2061. f := 1 / FDivision;
  2062. for i := 0 to FDivision do
  2063. glEvalCoord1f(i * f);
  2064. end;
  2065. glEnd;
  2066. end;
  2067. rci.gxStates.Disable(stColorLogicOp);
  2068. if FSplineMode = lsmBezierSpline then
  2069. rci.gxStates.PopAttrib;
  2070. if Length(nodeBuffer) > 0 then
  2071. begin
  2072. SetLength(nodeBuffer, 0);
  2073. SetLength(colorBuffer, 0);
  2074. end;
  2075. if FNodesAspect <> lnaInvisible then
  2076. begin
  2077. if not rci.ignoreBlendingRequests then
  2078. begin
  2079. rci.gxStates.Enable(stBlend);
  2080. rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
  2081. end;
  2082. for i := 0 to Nodes.Count - 1 do
  2083. with TgxLinesNode(Nodes[i]) do
  2084. DrawNode(rci, X, Y, Z, Color);
  2085. end;
  2086. end;
  2087. end;
  2088. // ------------------
  2089. // ------------------ TgxCube ------------------
  2090. // ------------------
  2091. constructor TgxCube.Create(AOwner: TComponent);
  2092. begin
  2093. inherited Create(AOwner);
  2094. FCubeSize := XYZVector;
  2095. FParts := [cpTop, cpBottom, cpFront, cpBack, cpLeft, cpRight];
  2096. FNormalDirection := ndOutside;
  2097. ObjectStyle := ObjectStyle + [osDirectDraw];
  2098. end;
  2099. procedure TgxCube.BuildList(var rci: TgxRenderContextInfo);
  2100. var
  2101. v1: TAffineVector;
  2102. v2: TAffineVector;
  2103. v1d: TAffineVector;
  2104. v2d: TAffineVector;
  2105. nd: Single;
  2106. TanLoc, BinLoc: Integer;
  2107. begin
  2108. VectorScale(FCubeSize, 0.5, v2);
  2109. v1 := VectorNegate(v2);
  2110. if FNormalDirection = ndInside then
  2111. begin
  2112. v1d := v2;
  2113. v2d := v1;
  2114. nd := -1
  2115. end
  2116. else begin
  2117. v1d := v1;
  2118. v2d := v2;
  2119. nd := 1;
  2120. end;
  2121. if (rci.gxStates.CurrentProgram > 0) then //and GL_ARB_shader_objects
  2122. begin
  2123. TanLoc := glGetAttribLocation(rci.gxStates.CurrentProgram, PGLChar(TangentAttributeName));
  2124. BinLoc := glGetAttribLocation(rci.gxStates.CurrentProgram, PGLChar(BinormalAttributeName));
  2125. end
  2126. else
  2127. begin
  2128. TanLoc := -1;
  2129. BinLoc := -1;
  2130. end;
  2131. glBegin(GL_QUADS);
  2132. if cpFront in FParts then
  2133. begin
  2134. glNormal3f(0, 0, nd);
  2135. if TanLoc > -1 then
  2136. glVertexAttrib3f(TanLoc, nd, 0, 0);
  2137. if BinLoc > -1 then
  2138. glVertexAttrib3f(BinLoc, 0, nd, 0);
  2139. glTexCoord2fv(@XYTexPoint);
  2140. glVertex3fv(@v2);
  2141. glTexCoord2fv(@YTexPoint);
  2142. glVertex3f(v1d.x, v2d.y, v2.z);
  2143. glTexCoord2fv(@NullTexPoint);
  2144. glVertex3f(v1.x, v1.y, v2.z);
  2145. glTexCoord2fv(@XTexPoint);
  2146. glVertex3f(v2d.x, v1d.y, v2.z);
  2147. end;
  2148. if cpBack in FParts then
  2149. begin
  2150. glNormal3f(0, 0, -nd);
  2151. if TanLoc > -1 then
  2152. glVertexAttrib3f(TanLoc, -nd, 0, 0);
  2153. if BinLoc > -1 then
  2154. glVertexAttrib3f(BinLoc, 0, nd, 0);
  2155. glTexCoord2fv(@YTexPoint);
  2156. glVertex3f(v2.x, v2.y, v1.z);
  2157. glTexCoord2fv(@NullTexPoint);
  2158. glVertex3f(v2d.x, v1d.y, v1.z);
  2159. glTexCoord2fv(@XYTexPoint);
  2160. glVertex3fv(@v1);
  2161. glTexCoord2fv(@XYTexPoint);
  2162. glVertex3f(v1d.x, v2d.y, v1.z);
  2163. end;
  2164. if cpLeft in FParts then
  2165. begin
  2166. glNormal3f(-nd, 0, 0);
  2167. if TanLoc > -1 then
  2168. glVertexAttrib3f(TanLoc, 0, 0, nd);
  2169. if BinLoc > -1 then
  2170. glVertexAttrib3f(BinLoc, 0, nd, 0);
  2171. glTexCoord2fv(@XYTexPoint);
  2172. glVertex3f(v1.x, v2.y, v2.z);
  2173. glTexCoord2fv(@YTexPoint);
  2174. glVertex3f(v1.x, v2d.y, v1d.z);
  2175. glTexCoord2fv(@NullTexPoint);
  2176. glVertex3fv(@v1);
  2177. glTexCoord2fv(@XTexPoint);
  2178. glVertex3f(v1.x, v1d.y, v2d.z);
  2179. end;
  2180. if cpRight in FParts then
  2181. begin
  2182. glNormal3f(nd, 0, 0);
  2183. if TanLoc > -1 then
  2184. glVertexAttrib3f(TanLoc, 0, 0, -nd);
  2185. if BinLoc > -1 then
  2186. glVertexAttrib3f(BinLoc, 0, nd, 0);
  2187. glTexCoord2fv(@YTexPoint);
  2188. glVertex3fv(@v2);
  2189. glTexCoord2fv(@NullTexPoint);
  2190. glVertex3f(v2.x, v1d.y, v2d.z);
  2191. glTexCoord2fv(@XTexPoint);
  2192. glVertex3f(v2.x, v1.y, v1.z);
  2193. glTexCoord2fv(@XYTexPoint);
  2194. glVertex3f(v2.x, v2d.y, v1d.z);
  2195. end;
  2196. if cpTop in FParts then
  2197. begin
  2198. glNormal3f(0, nd, 0);
  2199. if TanLoc > -1 then
  2200. glVertexAttrib3f(TanLoc, nd, 0, 0);
  2201. if BinLoc > -1 then
  2202. glVertexAttrib3f(BinLoc, 0, 0, -nd);
  2203. glTexCoord2fv(@YTexPoint);
  2204. glVertex3f(v1.x, v2.y, v1.z);
  2205. glTexCoord2fv(@NullTexPoint);
  2206. glVertex3f(v1d.x, v2.y, v2d.z);
  2207. glTexCoord2fv(@XTexPoint);
  2208. glVertex3fv(@v2);
  2209. glTexCoord2fv(@XYTexPoint);
  2210. glVertex3f(v2d.x, v2.y, v1d.z);
  2211. end;
  2212. if cpBottom in FParts then
  2213. begin
  2214. glNormal3f(0, -nd, 0);
  2215. if TanLoc > -1 then
  2216. glVertexAttrib3f(TanLoc, -nd, 0, 0);
  2217. if BinLoc > -1 then
  2218. glVertexAttrib3f(BinLoc, 0, 0, nd);
  2219. glTexCoord2fv(@NullTexPoint);
  2220. glVertex3fv(@v1);
  2221. glTexCoord2fv(@XYTexPoint);
  2222. glVertex3f(v2d.x, v1.y, v1d.z);
  2223. glTexCoord2fv(@XYTexPoint);
  2224. glVertex3f(v2.x, v1.y, v2.z);
  2225. glTexCoord2fv(@YTexPoint);
  2226. glVertex3f(v1d.x, v1.y, v2d.z);
  2227. end;
  2228. glEnd;
  2229. end;
  2230. function TgxCube.GenerateSilhouette(const silhouetteParameters
  2231. : TgxSilhouetteParameters): TgxSilhouette;
  2232. var
  2233. hw, hh, hd: Single;
  2234. connectivity: TConnectivity;
  2235. sil: TgxSilhouette;
  2236. begin
  2237. connectivity := TConnectivity.Create(True);
  2238. hw := FCubeSize.X * 0.5;
  2239. hh := FCubeSize.Y * 0.5;
  2240. hd := FCubeSize.Z * 0.5;
  2241. if cpFront in FParts then
  2242. begin
  2243. connectivity.AddQuad(AffineVectorMake(hw, hh, hd),
  2244. AffineVectorMake(-hw, hh, hd), AffineVectorMake(-hw, -hh, hd),
  2245. AffineVectorMake(hw, -hh, hd));
  2246. end;
  2247. if cpBack in FParts then
  2248. begin
  2249. connectivity.AddQuad(AffineVectorMake(hw, hh, -hd),
  2250. AffineVectorMake(hw, -hh, -hd), AffineVectorMake(-hw, -hh, -hd),
  2251. AffineVectorMake(-hw, hh, -hd));
  2252. end;
  2253. if cpLeft in FParts then
  2254. begin
  2255. connectivity.AddQuad(AffineVectorMake(-hw, hh, hd),
  2256. AffineVectorMake(-hw, hh, -hd), AffineVectorMake(-hw, -hh, -hd),
  2257. AffineVectorMake(-hw, -hh, hd));
  2258. end;
  2259. if cpRight in FParts then
  2260. begin
  2261. connectivity.AddQuad(AffineVectorMake(hw, hh, hd),
  2262. AffineVectorMake(hw, -hh, hd), AffineVectorMake(hw, -hh, -hd),
  2263. AffineVectorMake(hw, hh, -hd));
  2264. end;
  2265. if cpTop in FParts then
  2266. begin
  2267. connectivity.AddQuad(AffineVectorMake(-hw, hh, -hd),
  2268. AffineVectorMake(-hw, hh, hd), AffineVectorMake(hw, hh, hd),
  2269. AffineVectorMake(hw, hh, -hd));
  2270. end;
  2271. if cpBottom in FParts then
  2272. begin
  2273. connectivity.AddQuad(AffineVectorMake(-hw, -hh, -hd),
  2274. AffineVectorMake(hw, -hh, -hd), AffineVectorMake(hw, -hh, hd),
  2275. AffineVectorMake(-hw, -hh, hd));
  2276. end;
  2277. sil := nil;
  2278. connectivity.CreateSilhouette(silhouetteParameters, sil, False);
  2279. Result := sil;
  2280. connectivity.Free;
  2281. end;
  2282. function TgxCube.GetCubeWHD(const Index: Integer): Single;
  2283. begin
  2284. Result := FCubeSize.V[index];
  2285. end;
  2286. procedure TgxCube.SetCubeWHD(Index: Integer; AValue: Single);
  2287. begin
  2288. if AValue <> FCubeSize.V[index] then
  2289. begin
  2290. FCubeSize.V[index] := AValue;
  2291. StructureChanged;
  2292. end;
  2293. end;
  2294. procedure TgxCube.SetParts(aValue: TgxCubeParts);
  2295. begin
  2296. if aValue <> FParts then
  2297. begin
  2298. FParts := aValue;
  2299. StructureChanged;
  2300. end;
  2301. end;
  2302. procedure TgxCube.SetNormalDirection(aValue: TgxNormalDirection);
  2303. begin
  2304. if aValue <> FNormalDirection then
  2305. begin
  2306. FNormalDirection := aValue;
  2307. StructureChanged;
  2308. end;
  2309. end;
  2310. procedure TgxCube.Assign(Source: TPersistent);
  2311. begin
  2312. if Assigned(Source) and (Source is TgxCube) then
  2313. begin
  2314. FCubeSize := TgxCube(Source).FCubeSize;
  2315. FParts := TgxCube(Source).FParts;
  2316. FNormalDirection := TgxCube(Source).FNormalDirection;
  2317. end;
  2318. inherited Assign(Source);
  2319. end;
  2320. function TgxCube.AxisAlignedDimensionsUnscaled: TVector4f;
  2321. begin
  2322. Result.X := FCubeSize.X * 0.5;
  2323. Result.Y := FCubeSize.Y * 0.5;
  2324. Result.Z := FCubeSize.Z * 0.5;
  2325. Result.W := 0;
  2326. end;
  2327. function TgxCube.RayCastIntersect(const rayStart, rayVector: TVector4f;
  2328. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean;
  2329. var
  2330. p: array [0 .. 5] of TVector4f;
  2331. rv: TVector4f;
  2332. rs, r: TVector4f;
  2333. i: Integer;
  2334. t: Single;
  2335. eSize: TAffineVector;
  2336. begin
  2337. rs := AbsoluteToLocal(rayStart);
  2338. SetVector(rv, VectorNormalize(AbsoluteToLocal(rayVector)));
  2339. eSize.X := FCubeSize.X*0.5 + 0.0001;
  2340. eSize.Y := FCubeSize.Y*0.5 + 0.0001;
  2341. eSize.Z := FCubeSize.Z*0.5 + 0.0001;
  2342. p[0] := XHmgVector;
  2343. p[1] := YHmgVector;
  2344. p[2] := ZHmgVector;
  2345. SetVector(p[3], -1, 0, 0);
  2346. SetVector(p[4], 0, -1, 0);
  2347. SetVector(p[5], 0, 0, -1);
  2348. for i := 0 to 5 do
  2349. begin
  2350. if VectorDotProduct(p[i], rv) > 0 then
  2351. begin
  2352. t := -(p[i].X * rs.X + p[i].Y * rs.Y +
  2353. p[i].Z * rs.Z + 0.5 *
  2354. FCubeSize.V[i mod 3]) / (p[i].X * rv.X +
  2355. p[i].Y * rv.Y +
  2356. p[i].Z * rv.Z);
  2357. MakePoint(r, rs.X + t * rv.X, rs.Y +
  2358. t * rv.Y, rs.Z +
  2359. t * rv.Z);
  2360. if (Abs(r.X) <= eSize.X) and
  2361. (Abs(r.Y) <= eSize.Y) and
  2362. (Abs(r.Z) <= eSize.Z) and
  2363. (VectorDotProduct(VectorSubtract(r, rs), rv) > 0) then
  2364. begin
  2365. if Assigned(intersectPoint) then
  2366. MakePoint(intersectPoint^, LocalToAbsolute(r));
  2367. if Assigned(intersectNormal) then
  2368. MakeVector(intersectNormal^, LocalToAbsolute(VectorNegate(p[i])));
  2369. Result := True;
  2370. Exit;
  2371. end;
  2372. end;
  2373. end;
  2374. Result := False;
  2375. end;
  2376. procedure TgxCube.DefineProperties(Filer: TFiler);
  2377. begin
  2378. inherited;
  2379. Filer.DefineBinaryProperty('CubeSize', ReadData, WriteData,
  2380. (FCubeSize.X <> 1) or (FCubeSize.Y <> 1) or (FCubeSize.Z <> 1));
  2381. end;
  2382. procedure TgxCube.ReadData(Stream: TStream);
  2383. begin
  2384. with Stream do
  2385. begin
  2386. Read(FCubeSize, SizeOf(TAffineVector));
  2387. end;
  2388. end;
  2389. procedure TgxCube.WriteData(Stream: TStream);
  2390. begin
  2391. with Stream do
  2392. begin
  2393. Write(FCubeSize, SizeOf(TAffineVector));
  2394. end;
  2395. end;
  2396. // ------------------
  2397. // ------------------ TgxQuadricObject ------------------
  2398. // ------------------
  2399. constructor TgxQuadricObject.Create(AOwner: TComponent);
  2400. begin
  2401. inherited;
  2402. FNormals := nsSmooth;
  2403. FNormalDirection := ndOutside;
  2404. end;
  2405. procedure TgxQuadricObject.SetNormals(aValue: TgxNormalSmoothing);
  2406. begin
  2407. if aValue <> FNormals then
  2408. begin
  2409. FNormals := aValue;
  2410. StructureChanged;
  2411. end;
  2412. end;
  2413. procedure TgxQuadricObject.SetNormalDirection(aValue: TgxNormalDirection);
  2414. begin
  2415. if aValue <> FNormalDirection then
  2416. begin
  2417. FNormalDirection := aValue;
  2418. StructureChanged;
  2419. end;
  2420. end;
  2421. procedure TgxQuadricObject.SetupQuadricParams(quadric: GLUquadricObj);
  2422. const
  2423. cNormalSmoothinToEnum: array [nsFlat .. nsNone] of Cardinal = (GLU_FLAT,
  2424. GLU_SMOOTH, GLU_NONE);
  2425. begin
  2426. gluQuadricDrawStyle(@Quadric, GLU_FILL);
  2427. gluQuadricNormals(@Quadric, cNormalSmoothinToEnum[FNormals]);
  2428. SetNormalQuadricOrientation(Quadric);
  2429. gluQuadricTexture(@Quadric, 1);
  2430. end;
  2431. procedure TgxQuadricObject.SetNormalQuadricOrientation(quadric: GLUquadricObj);
  2432. const
  2433. cNormalDirectionToEnum: array [ndInside .. ndOutside] of GLEnum =
  2434. (GLU_INSIDE, GLU_OUTSIDE);
  2435. begin
  2436. gluQuadricOrientation(@quadric, cNormalDirectionToEnum[FNormalDirection]);
  2437. end;
  2438. procedure TgxQuadricObject.SetInvertedQuadricOrientation(quadric: GLUquadricObj);
  2439. const
  2440. cNormalDirectionToEnum: array [ndInside .. ndOutside] of GLEnum =
  2441. (GLU_OUTSIDE, GLU_INSIDE);
  2442. begin
  2443. gluQuadricOrientation(@quadric, cNormalDirectionToEnum[FNormalDirection]);
  2444. end;
  2445. procedure TgxQuadricObject.Assign(Source: TPersistent);
  2446. begin
  2447. if Assigned(Source) and (Source is TgxQuadricObject) then
  2448. begin
  2449. FNormals := TgxQuadricObject(Source).FNormals;
  2450. FNormalDirection := TgxQuadricObject(Source).FNormalDirection;
  2451. end;
  2452. inherited Assign(Source);
  2453. end;
  2454. // ------------------
  2455. // ------------------ TgxSphere ------------------
  2456. // ------------------
  2457. constructor TgxSphere.Create(AOwner: TComponent);
  2458. begin
  2459. inherited Create(AOwner);
  2460. FRadius := 0.5;
  2461. FSlices := 16;
  2462. FStacks := 16;
  2463. FTop := 90;
  2464. FBottom := -90;
  2465. FStart := 0;
  2466. FStop := 360;
  2467. end;
  2468. procedure TgxSphere.BuildList(var rci: TgxRenderContextInfo);
  2469. var
  2470. V1, V2, N1 : TAffineVector;
  2471. AngTop, AngBottom, AngStart, AngStop, StepV, StepH: Double;
  2472. SinP, CosP, SinP2, CosP2, SinT, CosT, Phi, Phi2, Theta: Double;
  2473. uTexCoord, uTexFactor, vTexFactor, vTexCoord0, vTexCoord1: Single;
  2474. I, J: Integer;
  2475. DoReverse: Boolean;
  2476. begin
  2477. DoReverse := (FNormalDirection = ndInside);
  2478. glPushAttrib(GL_POLYGON_BIT);
  2479. if DoReverse then
  2480. rci.gxStates.InvertFrontFace;
  2481. // common settings
  2482. AngTop := DegToRad(1.0 * FTop);
  2483. AngBottom := DegToRad(1.0 * FBottom);
  2484. AngStart := DegToRad(1.0 * FStart);
  2485. AngStop := DegToRad(1.0 * FStop);
  2486. StepH := (AngStop - AngStart) / FSlices;
  2487. StepV := (AngTop - AngBottom) / FStacks;
  2488. glPushMatrix;
  2489. glScalef(Radius, Radius, Radius);
  2490. // top cap
  2491. if (FTop < 90) and (FTopCap in [ctCenter, ctFlat]) then
  2492. begin
  2493. glBegin(GL_TRIANGLE_FAN);
  2494. SinCosine(AngTop, SinP, CosP);
  2495. glTexCoord2f(0.5, 0.5);
  2496. if DoReverse then
  2497. glNormal3f(0, -1, 0)
  2498. else
  2499. glNormal3f(0, 1, 0);
  2500. if FTopCap = ctCenter then
  2501. glVertex3f(0, 0, 0)
  2502. else
  2503. begin
  2504. glVertex3f(0, SinP, 0);
  2505. N1 := YVector;
  2506. if DoReverse then
  2507. N1.Y := -N1.Y;
  2508. end;
  2509. v1.Y := SinP;
  2510. Theta := AngStart;
  2511. for i := 0 to FSlices do
  2512. begin
  2513. SinCosine(Theta, SinT, CosT);
  2514. v1.X := CosP * SinT;
  2515. v1.Z := CosP * CosT;
  2516. if FTopCap = ctCenter then
  2517. begin
  2518. N1 := VectorPerpendicular(YVector, v1);
  2519. if DoReverse then
  2520. NegateVector(N1);
  2521. end;
  2522. glTexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
  2523. glNormal3fv(@N1);
  2524. glVertex3fv(@v1);
  2525. Theta := Theta + StepH;
  2526. end;
  2527. glEnd;
  2528. end;
  2529. // main body
  2530. Phi := AngTop;
  2531. Phi2 := Phi - StepV;
  2532. uTexFactor := 1 / FSlices;
  2533. vTexFactor := 1 / FStacks;
  2534. for j := 0 to FStacks - 1 do
  2535. begin
  2536. Theta := AngStart;
  2537. SinCos(Phi, SinP, CosP);
  2538. SinCos(Phi2, SinP2, CosP2);
  2539. v1.Y := SinP;
  2540. V2.Y := SinP2;
  2541. vTexCoord0 := 1 - j * vTexFactor;
  2542. vTexCoord1 := 1 - (j + 1) * vTexFactor;
  2543. glBegin(GL_TRIANGLE_STRIP);
  2544. for i := 0 to FSlices do
  2545. begin
  2546. SinCos(Theta, SinT, CosT);
  2547. v1.X := CosP * SinT;
  2548. V2.X := CosP2 * SinT;
  2549. v1.Z := CosP * CosT;
  2550. V2.Z := CosP2 * CosT;
  2551. uTexCoord := i * uTexFactor;
  2552. glTexCoord2f(uTexCoord, vTexCoord0);
  2553. if DoReverse then
  2554. begin
  2555. N1 := VectorNegate(v1);
  2556. glNormal3fv(@N1);
  2557. end
  2558. else
  2559. glNormal3fv(@v1);
  2560. glVertex3fv(@v1);
  2561. glTexCoord2f(uTexCoord, vTexCoord1);
  2562. if DoReverse then
  2563. begin
  2564. N1 := VectorNegate(V2);
  2565. glNormal3fv(@N1);
  2566. end
  2567. else
  2568. glNormal3fv(@V2);
  2569. glVertex3fv(@V2);
  2570. Theta := Theta + StepH;
  2571. end;
  2572. glEnd;
  2573. Phi := Phi2;
  2574. Phi2 := Phi2 - StepV;
  2575. end;
  2576. // bottom cap
  2577. if (FBottom > -90) and (FBottomCap in [ctCenter, ctFlat]) then
  2578. begin
  2579. glBegin(GL_TRIANGLE_FAN);
  2580. SinCos(AngBottom, SinP, CosP);
  2581. glTexCoord2f(0.5, 0.5);
  2582. if DoReverse then
  2583. glNormal3f(0, 1, 0)
  2584. else
  2585. glNormal3f(0, -1, 0);
  2586. if FBottomCap = ctCenter then
  2587. glVertex3f(0, 0, 0)
  2588. else
  2589. begin
  2590. glVertex3f(0, SinP, 0);
  2591. if DoReverse then
  2592. MakeVector(N1, 0, -1, 0)
  2593. else
  2594. begin
  2595. N1 := YVector;
  2596. NegateVector(N1);
  2597. end;
  2598. end;
  2599. v1.Y := SinP;
  2600. Theta := AngStop;
  2601. for i := 0 to FSlices do
  2602. begin
  2603. SinCos(Theta, SinT, CosT);
  2604. v1.X := CosP * SinT;
  2605. v1.Z := CosP * CosT;
  2606. if FBottomCap = ctCenter then
  2607. begin
  2608. N1 := VectorPerpendicular(AffineVectorMake(0, -1, 0), v1);
  2609. if DoReverse then
  2610. NegateVector(N1);
  2611. end;
  2612. glTexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
  2613. glNormal3fv(@N1);
  2614. glVertex3fv(@v1);
  2615. Theta := Theta - StepH;
  2616. end;
  2617. glEnd;
  2618. end;
  2619. if DoReverse then
  2620. rci.gxStates.InvertFrontFace;
  2621. glPopMatrix;
  2622. rci.gxStates.PopAttrib;
  2623. end;
  2624. function TgxSphere.RayCastIntersect(const rayStart, rayVector: TVector4f;
  2625. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean;
  2626. var
  2627. i1, i2: TVector4f;
  2628. localStart, localVector: TVector4f;
  2629. begin
  2630. // compute coefficients of quartic polynomial
  2631. SetVector(localStart, AbsoluteToLocal(rayStart));
  2632. SetVector(localVector, AbsoluteToLocal(rayVector));
  2633. NormalizeVector(localVector);
  2634. if RayCastSphereIntersect(localStart, localVector, NullHmgVector, Radius, i1,
  2635. i2) > 0 then
  2636. begin
  2637. Result := True;
  2638. if Assigned(intersectPoint) then
  2639. SetVector(intersectPoint^, LocalToAbsolute(i1));
  2640. if Assigned(intersectNormal) then
  2641. begin
  2642. i1.W := 0; // vector transform
  2643. SetVector(intersectNormal^, LocalToAbsolute(i1));
  2644. end;
  2645. end
  2646. else
  2647. Result := False;
  2648. end;
  2649. function TgxSphere.GenerateSilhouette(const silhouetteParameters
  2650. : TgxSilhouetteParameters): TgxSilhouette;
  2651. var
  2652. i, j: Integer;
  2653. s, C, angleFactor: Single;
  2654. sVec, tVec: TAffineVector;
  2655. Segments: Integer;
  2656. begin
  2657. Segments := MaxInteger(FStacks, FSlices);
  2658. // determine a local orthonormal matrix, viewer-oriented
  2659. sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, XVector);
  2660. if VectorLength(sVec) < 1E-3 then
  2661. sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, YVector);
  2662. tVec := VectorCrossProduct(silhouetteParameters.SeenFrom, sVec);
  2663. NormalizeVector(sVec);
  2664. NormalizeVector(tVec);
  2665. // generate the silhouette (outline and capping)
  2666. Result := TgxSilhouette.Create;
  2667. angleFactor := (2 * PI) / Segments;
  2668. for i := 0 to Segments - 1 do
  2669. begin
  2670. SinCosine(i * angleFactor, FRadius, s, C);
  2671. Result.vertices.AddPoint(VectorCombine(sVec, tVec, s, C));
  2672. j := (i + 1) mod Segments;
  2673. Result.Indices.Add(i, j);
  2674. if silhouetteParameters.CappingRequired then
  2675. Result.CapIndices.Add(Segments, i, j)
  2676. end;
  2677. if silhouetteParameters.CappingRequired then
  2678. Result.vertices.Add(NullHmgPoint);
  2679. end;
  2680. procedure TgxSphere.SetBottom(aValue: TAngleLimit1);
  2681. begin
  2682. if FBottom <> aValue then
  2683. begin
  2684. FBottom := aValue;
  2685. StructureChanged;
  2686. end;
  2687. end;
  2688. procedure TgxSphere.SetBottomCap(aValue: TgxCapType);
  2689. begin
  2690. if FBottomCap <> aValue then
  2691. begin
  2692. FBottomCap := aValue;
  2693. StructureChanged;
  2694. end;
  2695. end;
  2696. procedure TgxSphere.SetRadius(const aValue: Single);
  2697. begin
  2698. if aValue <> FRadius then
  2699. begin
  2700. FRadius := aValue;
  2701. StructureChanged;
  2702. end;
  2703. end;
  2704. procedure TgxSphere.SetSlices(aValue: Integer);
  2705. begin
  2706. if aValue <> FSlices then
  2707. begin
  2708. if aValue <= 0 then
  2709. FSlices := 1
  2710. else
  2711. FSlices := aValue;
  2712. StructureChanged;
  2713. end;
  2714. end;
  2715. procedure TgxSphere.SetStacks(aValue: GLint);
  2716. begin
  2717. if aValue <> FStacks then
  2718. begin
  2719. if aValue <= 0 then
  2720. FStacks := 1
  2721. else
  2722. FStacks := aValue;
  2723. StructureChanged;
  2724. end;
  2725. end;
  2726. procedure TgxSphere.SetStart(aValue: TAngleLimit2);
  2727. begin
  2728. if FStart <> aValue then
  2729. begin
  2730. Assert(aValue <= FStop);
  2731. FStart := aValue;
  2732. StructureChanged;
  2733. end;
  2734. end;
  2735. procedure TgxSphere.SetStop(aValue: TAngleLimit2);
  2736. begin
  2737. if FStop <> aValue then
  2738. begin
  2739. Assert(aValue >= FStart);
  2740. FStop := aValue;
  2741. StructureChanged;
  2742. end;
  2743. end;
  2744. procedure TgxSphere.SetTop(aValue: TAngleLimit1);
  2745. begin
  2746. if FTop <> aValue then
  2747. begin
  2748. FTop := aValue;
  2749. StructureChanged;
  2750. end;
  2751. end;
  2752. procedure TgxSphere.SetTopCap(aValue: TgxCapType);
  2753. begin
  2754. if FTopCap <> aValue then
  2755. begin
  2756. FTopCap := aValue;
  2757. StructureChanged;
  2758. end;
  2759. end;
  2760. procedure TgxSphere.Assign(Source: TPersistent);
  2761. begin
  2762. if Assigned(Source) and (Source is TgxSphere) then
  2763. begin
  2764. FRadius := TgxSphere(Source).FRadius;
  2765. FSlices := TgxSphere(Source).FSlices;
  2766. FStacks := TgxSphere(Source).FStacks;
  2767. FBottom := TgxSphere(Source).FBottom;
  2768. FTop := TgxSphere(Source).FTop;
  2769. FStart := TgxSphere(Source).FStart;
  2770. FStop := TgxSphere(Source).FStop;
  2771. end;
  2772. inherited Assign(Source);
  2773. end;
  2774. function TgxSphere.AxisAlignedDimensionsUnscaled: TVector4f;
  2775. begin
  2776. Result.X := Abs(FRadius);
  2777. Result.Y := Result.X;
  2778. Result.Z := Result.X;
  2779. Result.W := 0;
  2780. end;
  2781. // ------------------
  2782. // ------------------ TgxPolygonBase ------------------
  2783. // ------------------
  2784. constructor TgxPolygonBase.Create(AOwner: TComponent);
  2785. begin
  2786. inherited Create(AOwner);
  2787. CreateNodes;
  2788. FDivision := 10;
  2789. FSplineMode := lsmLines;
  2790. end;
  2791. procedure TgxPolygonBase.CreateNodes;
  2792. begin
  2793. FNodes := TgxNodes.Create(Self);
  2794. end;
  2795. destructor TgxPolygonBase.Destroy;
  2796. begin
  2797. FNodes.Free;
  2798. inherited Destroy;
  2799. end;
  2800. procedure TgxPolygonBase.Assign(Source: TPersistent);
  2801. begin
  2802. if Source is TgxPolygonBase then
  2803. begin
  2804. SetNodes(TgxPolygonBase(Source).FNodes);
  2805. FDivision := TgxPolygonBase(Source).FDivision;
  2806. FSplineMode := TgxPolygonBase(Source).FSplineMode;
  2807. end;
  2808. inherited Assign(Source);
  2809. end;
  2810. procedure TgxPolygonBase.NotifyChange(Sender: TObject);
  2811. begin
  2812. if Sender = Nodes then
  2813. StructureChanged;
  2814. inherited;
  2815. end;
  2816. procedure TgxPolygonBase.SetDivision(const Value: Integer);
  2817. begin
  2818. if Value <> FDivision then
  2819. begin
  2820. if Value < 1 then
  2821. FDivision := 1
  2822. else
  2823. FDivision := Value;
  2824. StructureChanged;
  2825. end;
  2826. end;
  2827. procedure TgxPolygonBase.SetNodes(const aNodes: TgxNodes);
  2828. begin
  2829. FNodes.Assign(aNodes);
  2830. StructureChanged;
  2831. end;
  2832. procedure TgxPolygonBase.SetSplineMode(const val: TgxLineSplineMode);
  2833. begin
  2834. if FSplineMode <> val then
  2835. begin
  2836. FSplineMode := val;
  2837. StructureChanged;
  2838. end;
  2839. end;
  2840. procedure TgxPolygonBase.AddNode(const coords: TgxCoordinates);
  2841. var
  2842. n: TgxNode;
  2843. begin
  2844. n := Nodes.Add;
  2845. if Assigned(coords) then
  2846. n.AsVector := coords.AsVector;
  2847. StructureChanged;
  2848. end;
  2849. procedure TgxPolygonBase.AddNode(const X, Y, Z: Single);
  2850. var
  2851. n: TgxNode;
  2852. begin
  2853. n := Nodes.Add;
  2854. n.AsVector := VectorMake(X, Y, Z, 1);
  2855. StructureChanged;
  2856. end;
  2857. procedure TgxPolygonBase.AddNode(const Value: TVector4f);
  2858. var
  2859. n: TgxNode;
  2860. begin
  2861. n := Nodes.Add;
  2862. n.AsVector := Value;
  2863. StructureChanged;
  2864. end;
  2865. procedure TgxPolygonBase.AddNode(const Value: TAffineVector);
  2866. var
  2867. n: TgxNode;
  2868. begin
  2869. n := Nodes.Add;
  2870. n.AsVector := VectorMake(Value);
  2871. StructureChanged;
  2872. end;
  2873. // ------------------
  2874. // ------------------ TgxSuperellipsoid ------------------
  2875. // ------------------
  2876. constructor TgxSuperellipsoid.Create(AOwner: TComponent);
  2877. begin
  2878. inherited Create(AOwner);
  2879. FRadius := 0.5;
  2880. FVCurve := 1.0;
  2881. FHCurve := 1.0;
  2882. FSlices := 16;
  2883. FStacks := 16;
  2884. FTop := 90;
  2885. FBottom := -90;
  2886. FStart := 0;
  2887. FStop := 360;
  2888. end;
  2889. procedure TgxSuperellipsoid.BuildList(var rci: TgxRenderContextInfo);
  2890. var
  2891. CosPc1, SinPc1, CosTc2, SinTc2: Double;
  2892. tc1, tc2: integer;
  2893. v1, v2, vs, N1: TAffineVector;
  2894. AngTop, AngBottom, AngStart, AngStop, StepV, StepH: Double;
  2895. SinP, CosP, SinP2, CosP2, SinT, CosT, Phi, Phi2, Theta: Double;
  2896. uTexCoord, uTexFactor, vTexFactor, vTexCoord0, vTexCoord1: Double;
  2897. i, j: Integer;
  2898. DoReverse: Boolean;
  2899. begin
  2900. DoReverse := (FNormalDirection = ndInside);
  2901. if DoReverse then
  2902. rci.gxStates.InvertFrontFace;
  2903. // common settings
  2904. AngTop := DegToRad(1.0 * FTop);
  2905. AngBottom := DegToRad(1.0 * FBottom);
  2906. AngStart := DegToRad(1.0 * FStart);
  2907. AngStop := DegToRad(1.0 * FStop);
  2908. StepH := (AngStop - AngStart) / FSlices;
  2909. StepV := (AngTop - AngBottom) / FStacks;
  2910. { Even integer used with the Power function, only produce positive points }
  2911. tc1 := trunc(VCurve);
  2912. tc2 := trunc(HCurve);
  2913. if tc1 mod 2 = 0 then
  2914. VCurve := VCurve + 1e-6;
  2915. if tc2 mod 2 = 0 then
  2916. HCurve := HCurve - 1e-6;
  2917. // top cap
  2918. if (FTop < 90) and (FTopCap in [ctCenter, ctFlat]) then
  2919. begin
  2920. glBegin(GL_TRIANGLE_FAN);
  2921. SinCos(AngTop, SinP, CosP);
  2922. glTexCoord2f(0.5, 0.5);
  2923. if DoReverse then
  2924. glNormal3f(0, -1, 0)
  2925. else
  2926. glNormal3f(0, 1, 0);
  2927. if FTopCap = ctCenter then
  2928. glVertex3f(0, 0, 0)
  2929. else
  2930. begin { FTopCap = ctFlat }
  2931. if (Sign(SinP) = 1) or (tc1 = VCurve) then
  2932. SinPc1 := Power(SinP, VCurve)
  2933. else
  2934. SinPc1 := -Power(-SinP, VCurve);
  2935. glVertex3f(0, SinPc1*Radius, 0);
  2936. N1 := YVector;
  2937. if DoReverse then
  2938. N1.Y := -N1.Y;
  2939. end; { FTopCap = ctFlat }
  2940. // v1.Y := SinP;
  2941. if (Sign(SinP) = 1) or (tc1 = VCurve) then
  2942. SinPc1 := Power(SinP, VCurve)
  2943. else
  2944. SinPc1 := -Power(-SinP, VCurve);
  2945. v1.Y := SinPc1;
  2946. Theta := AngStart;
  2947. for i := 0 to FSlices do
  2948. begin
  2949. SinCos(Theta, SinT, CosT);
  2950. // v1.X := CosP * SinT;
  2951. if (Sign(CosP) = 1) or (tc1 = VCurve) then
  2952. CosPc1 := Power(CosP, VCurve)
  2953. else
  2954. CosPc1 := -Power(-CosP, VCurve);
  2955. if (Sign(SinT) = 1) or (tc2 = HCurve) then
  2956. SinTc2 := Power(SinT, HCurve)
  2957. else
  2958. SinTc2 := -Power(-SinT, HCurve);
  2959. v1.X := CosPc1 * SinTc2;
  2960. // v1.Z := CosP * CosT;
  2961. if (Sign(CosT) = 1) or (tc2 = HCurve) then
  2962. CosTc2 := Power(CosT, HCurve)
  2963. else
  2964. CosTc2 := -Power(-CosT, HCurve);
  2965. v1.Z := CosPc1 * CosTc2;
  2966. if FTopCap = ctCenter then
  2967. begin
  2968. N1 := VectorPerpendicular(YVector, v1);
  2969. if DoReverse then
  2970. NegateVector(N1);
  2971. end;
  2972. // xglTexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
  2973. glTexCoord2f(SinTc2 * 0.5 + 0.5, CosTc2 * 0.5 + 0.5);
  2974. glNormal3fv(@N1);
  2975. vs := v1;
  2976. ScaleVector(vs, Radius);
  2977. glVertex3fv(@vs);
  2978. Theta := Theta + StepH;
  2979. end;
  2980. glEnd;
  2981. end;
  2982. // main body
  2983. Phi := AngTop;
  2984. Phi2 := Phi - StepV;
  2985. uTexFactor := 1 / FSlices;
  2986. vTexFactor := 1 / FStacks;
  2987. for j := 0 to FStacks - 1 do
  2988. begin
  2989. Theta := AngStart;
  2990. SinCos(Phi, SinP, CosP);
  2991. SinCos(Phi2, SinP2, CosP2);
  2992. if (Sign(SinP) = 1) or (tc1 = VCurve) then
  2993. SinPc1 := Power(SinP, VCurve)
  2994. else
  2995. SinPc1 := -Power(-SinP, VCurve);
  2996. v1.Y := SinPc1;
  2997. if (Sign(SinP2) = 1) or (tc1 = VCurve) then
  2998. SinPc1 := Power(SinP2, VCurve)
  2999. else
  3000. SinPc1 := -Power(-SinP2, VCurve);
  3001. v2.Y := SinPc1;
  3002. vTexCoord0 := 1 - j * vTexFactor;
  3003. vTexCoord1 := 1 - (j + 1) * vTexFactor;
  3004. glBegin(GL_TRIANGLE_STRIP);
  3005. for i := 0 to FSlices do
  3006. begin
  3007. SinCos(Theta, SinT, CosT);
  3008. if (Sign(CosP) = 1) or (tc1 = VCurve) then
  3009. CosPc1 := Power(CosP, VCurve)
  3010. else
  3011. CosPc1 := -Power(-CosP, VCurve);
  3012. if (Sign(SinT) = 1) or (tc2 = HCurve) then
  3013. SinTc2 := Power(SinT, HCurve)
  3014. else
  3015. SinTc2 := -Power(-SinT, HCurve);
  3016. v1.X := CosPc1 * SinTc2;
  3017. if (Sign(CosP2) = 1) or (tc1 = VCurve) then
  3018. CosPc1 := Power(CosP2, VCurve)
  3019. else
  3020. CosPc1 := -Power(-CosP2, VCurve);
  3021. V2.X := CosPc1 * SinTc2;
  3022. if (Sign(CosP) = 1) or (tc1 = VCurve) then
  3023. CosPc1 := Power(CosP, VCurve)
  3024. else
  3025. CosPc1 := -Power(-CosP, VCurve);
  3026. if (Sign(CosT) = 1) or (tc2 = HCurve) then
  3027. CosTc2 := Power(CosT, HCurve)
  3028. else
  3029. CosTc2 := -Power(-CosT, HCurve);
  3030. v1.Z := CosPc1 * CosTc2;
  3031. if (Sign(CosP2) = 1) or (tc1 = VCurve) then
  3032. CosPc1 := Power(CosP2, VCurve)
  3033. else
  3034. CosPc1 := -Power(-CosP2, VCurve);
  3035. V2.Z := CosPc1 * CosTc2;
  3036. uTexCoord := i * uTexFactor;
  3037. glTexCoord2f(uTexCoord, vTexCoord0);
  3038. if DoReverse then
  3039. begin
  3040. N1 := VectorNegate(v1);
  3041. glNormal3fv(@N1);
  3042. end
  3043. else
  3044. glNormal3fv(@v1);
  3045. vs := v1;
  3046. ScaleVector(vs, Radius);
  3047. glVertex3fv(@vs);
  3048. glTexCoord2f(uTexCoord, vTexCoord1);
  3049. if DoReverse then
  3050. begin
  3051. N1 := VectorNegate(V2);
  3052. glNormal3fv(@N1);
  3053. end
  3054. else
  3055. glNormal3fv(@v2);
  3056. vs := v2;
  3057. ScaleVector(vs, Radius);
  3058. glVertex3fv(@vs);
  3059. Theta := Theta + StepH;
  3060. end;
  3061. glEnd;
  3062. Phi := Phi2;
  3063. Phi2 := Phi2 - StepV;
  3064. end;
  3065. // bottom cap
  3066. if (FBottom > -90) and (FBottomCap in [ctCenter, ctFlat]) then
  3067. begin
  3068. glBegin(GL_TRIANGLE_FAN);
  3069. SinCos(AngBottom, SinP, CosP);
  3070. glTexCoord2f(0.5, 0.5);
  3071. if DoReverse then
  3072. glNormal3f(0, 1, 0)
  3073. else
  3074. glNormal3f(0, -1, 0);
  3075. if FBottomCap = ctCenter then
  3076. glVertex3f(0, 0, 0)
  3077. else
  3078. begin { FTopCap = ctFlat }
  3079. if (Sign(SinP) = 1) or (tc1 = VCurve) then
  3080. SinPc1 := Power(SinP, VCurve)
  3081. else
  3082. SinPc1 := -Power(-SinP, VCurve);
  3083. glVertex3f(0, SinPc1*Radius, 0);
  3084. if DoReverse then
  3085. MakeVector(N1, 0, -1, 0)
  3086. else
  3087. N1 := YVector;
  3088. end;
  3089. // v1.Y := SinP;
  3090. if (Sign(SinP) = 1) or (tc1 = VCurve) then
  3091. SinPc1 := Power(SinP, VCurve)
  3092. else
  3093. SinPc1 := -Power(-SinP, VCurve);
  3094. v1.Y := SinPc1;
  3095. Theta := AngStop;
  3096. for i := 0 to FSlices do
  3097. begin
  3098. SinCos(Theta, SinT, CosT);
  3099. // v1.X := CosP * SinT;
  3100. if (Sign(CosP) = 1) or (tc1 = VCurve) then
  3101. CosPc1 := Power(CosP, VCurve)
  3102. else
  3103. CosPc1 := -Power(-CosP, VCurve);
  3104. if (Sign(SinT) = 1) or (tc2 = HCurve) then
  3105. SinTc2 := Power(SinT, HCurve)
  3106. else
  3107. SinTc2 := -Power(-SinT, HCurve);
  3108. v1.X := CosPc1 * SinTc2;
  3109. // v1.Z := CosP * CosT;
  3110. if (Sign(CosT) = 1) or (tc2 = HCurve) then
  3111. CosTc2 := Power(CosT, HCurve)
  3112. else
  3113. CosTc2 := -Power(-CosT, HCurve);
  3114. v1.Z := CosPc1 * CosTc2;
  3115. if FBottomCap = ctCenter then
  3116. begin
  3117. N1 := VectorPerpendicular(AffineVectorMake(0, -1, 0), v1);
  3118. if DoReverse then
  3119. NegateVector(N1);
  3120. glNormal3fv(@N1);
  3121. end;
  3122. // xglTexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
  3123. glTexCoord2f(SinTc2 * 0.5 + 0.5, CosTc2 * 0.5 + 0.5);
  3124. vs := v1;
  3125. ScaleVector(vs, Radius);
  3126. glVertex3fv(@vs);
  3127. Theta := Theta - StepH;
  3128. end;
  3129. glEnd;
  3130. end;
  3131. if DoReverse then
  3132. rci.gxStates.InvertFrontFace;
  3133. end;
  3134. // This will probably not work, karamba
  3135. // RayCastSphereIntersect -> RayCastSuperellipsoidIntersect ??????
  3136. function TgxSuperellipsoid.RayCastIntersect(const rayStart, rayVector: TVector4f;
  3137. intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean;
  3138. var
  3139. i1, i2: TVector4f;
  3140. localStart, localVector: TVector4f;
  3141. begin
  3142. // compute coefficients of quartic polynomial
  3143. SetVector(localStart, AbsoluteToLocal(rayStart));
  3144. SetVector(localVector, AbsoluteToLocal(rayVector));
  3145. NormalizeVector(localVector);
  3146. if RayCastSphereIntersect(localStart, localVector, NullHmgVector, Radius, i1,
  3147. i2) > 0 then
  3148. begin
  3149. Result := True;
  3150. if Assigned(intersectPoint) then
  3151. SetVector(intersectPoint^, LocalToAbsolute(i1));
  3152. if Assigned(intersectNormal) then
  3153. begin
  3154. i1.W := 0; // vector transform
  3155. SetVector(intersectNormal^, LocalToAbsolute(i1));
  3156. end;
  3157. end
  3158. else
  3159. Result := False;
  3160. end;
  3161. // This will probably not work;
  3162. function TgxSuperellipsoid.GenerateSilhouette(const silhouetteParameters
  3163. : TgxSilhouetteParameters): TgxSilhouette;
  3164. var
  3165. i, j: Integer;
  3166. s, C, angleFactor: Single;
  3167. sVec, tVec: TAffineVector;
  3168. Segments: Integer;
  3169. begin
  3170. Segments := MaxInteger(FStacks, FSlices);
  3171. // determine a local orthonormal matrix, viewer-oriented
  3172. sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, XVector);
  3173. if VectorLength(sVec) < 1E-3 then
  3174. sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, YVector);
  3175. tVec := VectorCrossProduct(silhouetteParameters.SeenFrom, sVec);
  3176. NormalizeVector(sVec);
  3177. NormalizeVector(tVec);
  3178. // generate the silhouette (outline and capping)
  3179. Result := TgxSilhouette.Create;
  3180. angleFactor := (2 * PI) / Segments;
  3181. for i := 0 to Segments - 1 do
  3182. begin
  3183. SinCosine(i * angleFactor, FRadius, s, C);
  3184. Result.vertices.AddPoint(VectorCombine(sVec, tVec, s, C));
  3185. j := (i + 1) mod Segments;
  3186. Result.Indices.Add(i, j);
  3187. if silhouetteParameters.CappingRequired then
  3188. Result.CapIndices.Add(Segments, i, j)
  3189. end;
  3190. if silhouetteParameters.CappingRequired then
  3191. Result.vertices.Add(NullHmgPoint);
  3192. end;
  3193. procedure TgxSuperellipsoid.SetBottom(aValue: TAngleLimit1);
  3194. begin
  3195. if FBottom <> aValue then
  3196. begin
  3197. FBottom := aValue;
  3198. StructureChanged;
  3199. end;
  3200. end;
  3201. procedure TgxSuperellipsoid.SetBottomCap(aValue: TgxCapType);
  3202. begin
  3203. if FBottomCap <> aValue then
  3204. begin
  3205. FBottomCap := aValue;
  3206. StructureChanged;
  3207. end;
  3208. end;
  3209. procedure TgxSuperellipsoid.SetHCurve(const aValue: Single);
  3210. begin
  3211. if aValue <> FHCurve then
  3212. begin
  3213. FHCurve := aValue;
  3214. StructureChanged;
  3215. end;
  3216. end;
  3217. procedure TgxSuperellipsoid.SetRadius(const aValue: Single);
  3218. begin
  3219. if aValue <> FRadius then
  3220. begin
  3221. FRadius := aValue;
  3222. StructureChanged;
  3223. end;
  3224. end;
  3225. procedure TgxSuperellipsoid.SetSlices(aValue: Integer);
  3226. begin
  3227. if aValue <> FSlices then
  3228. begin
  3229. if aValue <= 0 then
  3230. FSlices := 1
  3231. else
  3232. FSlices := aValue;
  3233. StructureChanged;
  3234. end;
  3235. end;
  3236. procedure TgxSuperellipsoid.SetStacks(aValue: GLint);
  3237. begin
  3238. if aValue <> FStacks then
  3239. begin
  3240. if aValue <= 0 then
  3241. FStacks := 1
  3242. else
  3243. FStacks := aValue;
  3244. StructureChanged;
  3245. end;
  3246. end;
  3247. procedure TgxSuperellipsoid.SetStart(aValue: TAngleLimit2);
  3248. begin
  3249. if FStart <> aValue then
  3250. begin
  3251. Assert(aValue <= FStop);
  3252. FStart := aValue;
  3253. StructureChanged;
  3254. end;
  3255. end;
  3256. procedure TgxSuperellipsoid.SetStop(aValue: TAngleLimit2);
  3257. begin
  3258. if FStop <> aValue then
  3259. begin
  3260. Assert(aValue >= FStart);
  3261. FStop := aValue;
  3262. StructureChanged;
  3263. end;
  3264. end;
  3265. procedure TgxSuperellipsoid.SetTop(aValue: TAngleLimit1);
  3266. begin
  3267. if FTop <> aValue then
  3268. begin
  3269. FTop := aValue;
  3270. StructureChanged;
  3271. end;
  3272. end;
  3273. procedure TgxSuperellipsoid.SetTopCap(aValue: TgxCapType);
  3274. begin
  3275. if FTopCap <> aValue then
  3276. begin
  3277. FTopCap := aValue;
  3278. StructureChanged;
  3279. end;
  3280. end;
  3281. procedure TgxSuperellipsoid.SetVCurve(const aValue: Single);
  3282. begin
  3283. if aValue <> FVCurve then
  3284. begin
  3285. FVCurve := aValue;
  3286. StructureChanged;
  3287. end;
  3288. end;
  3289. procedure TgxSuperellipsoid.Assign(Source: TPersistent);
  3290. begin
  3291. if Assigned(Source) and (Source is TgxSuperellipsoid) then
  3292. begin
  3293. FRadius := TgxSuperellipsoid(Source).FRadius;
  3294. FSlices := TgxSuperellipsoid(Source).FSlices;
  3295. FStacks := TgxSuperellipsoid(Source).FStacks;
  3296. FBottom := TgxSuperellipsoid(Source).FBottom;
  3297. FTop := TgxSuperellipsoid(Source).FTop;
  3298. FStart := TgxSuperellipsoid(Source).FStart;
  3299. FStop := TgxSuperellipsoid(Source).FStop;
  3300. end;
  3301. inherited Assign(Source);
  3302. end;
  3303. function TgxSuperellipsoid.AxisAlignedDimensionsUnscaled: TVector4f;
  3304. begin
  3305. Result.X := Abs(FRadius);
  3306. Result.Y := Result.X;
  3307. Result.Z := Result.X;
  3308. Result.W := 0;
  3309. end;
  3310. // -------------------------------------------------------------
  3311. initialization
  3312. // -------------------------------------------------------------
  3313. RegisterClasses([TgxSphere, TgxCube, TgxPlane, TgxSprite, TgxPoints,
  3314. TgxDummyCube, TgxLines, TgxSuperellipsoid]);
  3315. end.