2
// This unit is part of the GLScene Engine https://github.com/glscene
5
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.
10
More complex or more specialized versions should be placed in dedicated
11
units where they can grow and prosper untammed. "Generic" geometrical
12
objects can be found GLGeomObjects.
15
12/03/13 - Yar - Added TGLSuperellipsoid (contributed by Eric Hardinge)
16
10/03/13 - PW - Added OctahedronBuildList and TetrahedronBuildList
17
20/11/12 - PW - CPP compatibility: replaced direct access to some properties with
18
getter and a setter methods
19
23/03/11 - Yar - Bugfixed TGLPlane.Assign (thanks ltyrosine)
20
Replaced plane primitives to triangles, added tangent and binormal attributes
21
29/11/10 - Yar - Bugfixed client color array enabling in TGLPoints.BuildList when it not used (thanks rbenetis)
22
23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
23
29/06/10 - Yar - Added loColorLogicXor to TGLLines.Options
24
22/04/10 - Yar - Fixes after GLState revision
25
11/04/10 - Yar - Replaced glNewList to GLState.NewList in TGLDummyCube.DoRender
26
05/03/10 - DanB - More state added to TGLStateCache
27
22/02/10 - Yar - Removed NoZWrite in TGLPlane, TGLSprite
28
Now use Material.DepthProperties
29
28/12/09 - DanB - Modifying TGLLineBase.LineColor now calls StructureChanged
30
13/03/09 - DanB - ScreenRect now accepts a buffer parameter, rather than using CurrentBuffer
31
05/10/08 - DaStr - Added lsmLoop support to TGLLines
32
(thanks Alejandro Leon Escalera) (BugtrackerID = 2084250)
33
22/01/08 - DaStr - Fixed rendering of TGLPoints
34
(thanks Kapitan) (BugtrackerID = 1876920)
35
06/06/07 - DaStr - Added GLColor to uses (BugtrackerID = 1732211)
36
14/03/07 - DaStr - Added explicit pointer dereferencing
37
(thanks Burkhard Carstens) (Bugtracker ID = 1678644)
38
15/02/07 - DaStr - Global $R- removed, added default values to
39
TGLSprite.NoZWrite, MirrorU, MirrorV
40
14/01/07 - DaStr - Fixed TGLCube.BuildList. Bugtracker ID=1623743 (Thanks Pete Jones)
41
19/10/06 - LC - Fixed IcosahedronBuildList. Bugtracker ID=1490784 (thanks EPA_Couzijn)
42
19/10/06 - LC - Fixed TGLLineBase.Assign problem. Bugtracker ID=1549354 (thanks Zapology)
43
08/10/05 - Mathx - Fixed TGLLines.nodes.assign problem (thanks to Yong Yoon Kit);
44
Also fixed a TGLLineBase.assign problem (object being assigned to
45
was refering the base lists, not copying them).
47
17/01/05 - SG - Added color support for bezier style TGLLines
48
03/12/04 - MF - Added TGLSprite.AxisAlignedDimensionsUnscaled override
49
06/07/04 - SG - TGLCube.RayCastIntersect fix (Eric Pascual)
50
20/01/04 - SG - Added IcosahedronBuildList
51
30/11/03 - MF - Added TGLSphere.GenerateSilhouette - it now takes the
52
stacks/slices of the sphere into account
53
10/09/03 - EG - Introduced TGLNodedLines
54
18/08/03 - SG - Added MirrorU and MirrorV to TGLSprite for mirroring textures
55
21/07/03 - EG - TGLTeapot moved to new GLTeapot unit,
56
TGLDodecahedron moved to new GLPolyhedron unit,
57
TGLCylinder, TGLCone, TGLTorus, TGLDisk, TGLArrowLine,
58
TGLAnnulus, TGLFrustrum and TGLPolygon moved to new
60
16/07/03 - EG - Style changes and cleanups
61
19/06/03 - MF - Added GenerateSilhouette to TGLCube and TGLPlane.
62
13/06/03 - EG - Fixed TGLAnnulus.RayCastIntersect (Alexandre Hirzel)
63
03/06/03 - EG - Added TGLAnnulus.RayCastIntersect (Alexandre Hirzel)
64
01/05/03 - SG - Added NURBS Curve to TGLLines (color not supported yet)
65
14/04/03 - SG - Added a Simple Bezier Spline to TGLLines (color not supported yet)
66
02/04/03 - EG - TGLPlane.RayCastIntersect fix (Erick Schuitema)
67
13/02/03 - DanB - added AxisAlignedDimensionsUnscaled functions
68
22/01/03 - EG - TGLCube.RayCastIntersect fixes (Dan Bartlett)
69
10/01/03 - EG - TGLCube.RayCastIntersect (Stuart Gooding)
70
08/01/03 - RC - Added TGLPlane.XScope and YScope, to use just a part of the texture
71
27/09/02 - EG - Added TGLPointParameters
72
24/07/02 - EG - Added TGLCylinder.Alignment
73
23/07/02 - EG - Added TGLPoints (experimental)
74
20/07/02 - EG - TGLCylinder.RayCastIntersect and TGLPlane.RayCastIntersect
75
18/07/02 - EG - Added TGLCylinder.Align methods
76
07/07/02 - EG - Added TGLPlane.Style
77
03/07/02 - EG - TGLPolygon now properly setups normals (filippo)
78
17/03/02 - EG - Support for transparent lines
79
02/02/02 - EG - Fixed TGLSprite change notification
80
26/01/02 - EG - TGLPlane & TGLCube now osDirectDraw
81
20/01/02 - EG - TGLSpaceText moved to GLSpaceText
82
22/08/01 - EG - TGLTorus.RayCastIntersect fixes
83
30/07/01 - EG - Updated AxisAlignedDimensions implems
84
16/03/01 - EG - TGLCylinderBase, changed default Stacks from 8 to 4
85
27/02/01 - EG - Fix in TGLCube texcoords, added TGLFrustrum (thx Robin Gerrets)
86
22/02/01 - EG - Added AxisAlignedDimensions overrides by Uwe Raabe
87
05/02/01 - EG - Minor changes to TGLCube.BuildList
88
21/01/01 - EG - BaseProjectionMatrix fix for TGLHUDSprite (picking issue),
89
TGLHUDSprite moved to GLHUDObjects
90
14/01/01 - EG - Fixed TGLSphere texture coordinates
91
13/01/01 - EG - TGLSprite matrix compatibility update
92
09/01/01 - EG - TGLSpaceText now handles its TFont.OnFontChange
93
08/01/01 - EG - Added TGLLinesNode (color support) and Node size control
94
22/12/00 - EG - Sprites are no longer texture enabled by default,
95
updated TGLSprite.BuildList to work with new matrices
96
14/11/00 - EG - Added TGLDummyCube.Destroy (thx Airatz)
97
08/10/00 - EG - Fixed call to wglUseFontOutlines
98
06/08/00 - EG - TRotationSolid renamed to TGLRevolutionSolid & moved to GLExtrusion
99
04/08/00 - EG - Fixed sphere main body texture coords + slight speedup
100
02/08/00 - EG - Added TGLPolygonBase
101
19/07/00 - EG - Added TGLHUDSprite
102
18/07/00 - EG - Added TGLRevolutionSolid
103
15/07/00 - EG - Code reduction and minor speedup for all quadric objects,
104
Added TGLLineBase (split of TGLLines),
105
TGLDummyCube now uses osDirectDraw instead of special behaviour
106
13/07/00 - EG - Added TGLArrowLine (code by Aaron Hochwimmer)
107
28/06/00 - EG - Support for "ObjectStyle"
108
23/06/00 - EG - Reduced default Loop count for TGLDisk
109
18/06/00 - EG - TGLMesh and accompanying stuff moved to GLMesh
110
14/06/00 - EG - Added Capacity to TGLVertexList
111
09/06/00 - EG - First row of Geometry-related upgrades
112
08/06/00 - EG - Added ReleaseFontManager, fixed TGLSpaceText DestroyList,
113
01/06/00 - EG - Added TGLAnnulus (code by Aaron Hochwimmer)
114
29/05/00 - EG - TGLLines now uses TGLNode/TGLNodes
115
28/05/00 - EG - Added persistence ability to TGLLines,
116
Added defaults for all TGLLines properties
117
27/05/00 - EG - Moved in RogerCao's TGLLines object, added a TLineNode
118
class (currently private) and various enhancements + fixes,
119
DodecahedronBuildList now available as a procedure,
120
CubeWireframeBuildList now available as a procedure
121
26/05/00 - RoC - Added division property to TGLLines, and Spline supported
122
26/05/00 - EG - Moved vectorfile remnants to GLVectorFiles
123
14/05/00 - EG - Removed Top/Bottom checks for TGLSphere,
124
Added mmTriangleStrip support in CalcNormals
125
08/05/00 - EG - Uncommented DisableAutoTexture in TGLSpaceText.BuildList
126
07/05/00 - RoC - TGLLines added, to show a list of vertex
127
26/04/00 - EG - Reactivated stuff in SetupQuadricParams (thanks Nelson Chu)
128
18/04/00 - EG - Overriden TGLDummyCube.Render
129
16/04/00 - EG - FontManager now published and auto-creating
130
12/04/00 - EG - Added TGLCylinderBase.Loops (fixes a bug, thanks Uwe)
131
24/03/00 - EG - Added Rotation to TGLSprite, fixed sprite size
132
20/03/00 - EG - Enhanced FontManager
133
17/03/00 - EG - Fixed SpaceText glBaseList bug,
134
TGLSprite now uses a transposition of the globalmatrix
135
16/03/00 - EG - Enhanced TFontManager to allow lower quality
136
14/03/00 - EG - Added subobjects Barycenter support for TGLDummyCube
137
09/02/00 - EG - ObjectManager stuff moved to GLSceneRegister,
138
FreeForm and vector file stuff moved to new GLVectorFileObjects
139
08/02/00 - EG - Added TGLDummyCube
140
05/02/00 - EG - Javadocisation, fixes and enhancements :
141
TGLVertexList.AddVertex, "default"s to properties
152
GLVectorGeometry, GLVectorTypes, GLScene, OpenGLAdapter,
153
OpenGLTokens, GLVectorLists, GLCrossPlatform, GLContext, GLSilhouette,
154
GLColor, GLRenderContextInfo, GLBaseClasses, GLNodes, GLCoordinates;
158
// TGLVisibilityDeterminationEvent
160
TGLVisibilityDeterminationEvent = function(Sender: TObject;
161
var rci: TGLRenderContextInfo): Boolean of object;
163
PVertexRec = ^TVertexRec;
174
{ : A simple cube, invisible at run-time.175
This is a usually non-visible object -except at design-time- used for
176
building hierarchies or groups, when some kind of joint or movement
177
mechanism needs be described, you can use DummyCubes.
178
DummyCube's barycenter is its children's barycenter.
179
The DummyCube can optionnally amalgamate all its children into a single
180
display list (see Amalgamate property). }
181
TGLDummyCube = class(TGLCameraInvariantObject)
185
FEdgeColor: TGLColor;
186
FVisibleAtRunTime, FAmalgamate: Boolean;
187
FGroupList: TGLListHandle;
188
FOnVisibilityDetermination: TGLVisibilityDeterminationEvent;
192
procedure SetCubeSize(const val: TGLFloat);
193
procedure SetEdgeColor(const val: TGLColor);
194
procedure SetVisibleAtRunTime(const val: Boolean);
195
procedure SetAmalgamate(const val: Boolean);
199
constructor Create(AOwner: TComponent); override;
200
destructor Destroy; override;
202
procedure Assign(Source: TPersistent); override;
204
function AxisAlignedDimensionsUnscaled: TVector; override;
205
function RayCastIntersect(const rayStart, rayVector: TVector;
206
intersectPoint: PVector = nil; intersectNormal: PVector = nil)
208
procedure BuildList(var rci: TGLRenderContextInfo); override;
209
procedure DoRender(var rci: TGLRenderContextInfo;
210
renderSelf, renderChildren: Boolean); override;
211
procedure StructureChanged; override;
212
function BarycenterAbsolutePosition: TVector; override;
216
property CubeSize: TGLFloat read FCubeSize write SetCubeSize;
217
property EdgeColor: TGLColor read FEdgeColor write SetEdgeColor;
218
{ : If true the dummycube's edges will be visible at runtime.219
The default behaviour of the dummycube is to be visible at design-time
220
only, and invisible at runtime. }
221
property VisibleAtRunTime: Boolean read FVisibleAtRunTime
222
write SetVisibleAtRunTime default False;
223
{ : Amalgamate the dummy's children in a single OpenGL entity.224
This activates a special rendering mode, which will compile
225
the rendering of all of the dummycube's children objects into a
226
single display list. This may provide a significant speed up in some
227
situations, however, this means that changes to the children will
228
be ignored untill you call StructureChanged on the dummy cube.
229
Some objects, that have their own display list management, may not
230
be compatible with this behaviour. This will also prevents sorting
231
and culling to operate as usual.
232
In short, this features is best used for static, non-transparent
233
geometry, or when the point of view won't change over a large
235
property Amalgamate: Boolean read FAmalgamate write SetAmalgamate
237
{ : Camera Invariance Options.238
These options allow to "deactivate" sensitivity to camera, f.i. by
239
centering the object on the camera or ignoring camera orientation. }
240
property CamInvarianceMode default cimNone;
241
{ : Event for custom visibility determination.242
Event handler should return True if the dummycube and its children
243
are to be considered visible for the current render. }
244
property OnVisibilityDetermination: TGLVisibilityDeterminationEvent
245
read FOnVisibilityDetermination write FOnVisibilityDetermination;
250
TPlaneStyle = (psSingleQuad, psTileTexture);
251
TPlaneStyles = set of TPlaneStyle;
255
{ : A simple plane object.256
Note that a plane is always made of a single quad (two triangles) and the
257
tiling is only applied to texture coordinates. }
258
TGLPlane = class(TGLSceneObject)
261
FXOffset, FYOffset: TGLFloat;
262
FXScope, FYScope: TGLFloat;
263
FWidth, FHeight: TGLFloat;
264
FXTiles, FYTiles: Cardinal;
265
FStyle: TPlaneStyles;
266
FMesh: array of array of TVertexRec;
269
procedure SetHeight(const aValue: Single);
270
procedure SetWidth(const aValue: Single);
271
procedure SetXOffset(const Value: TGLFloat);
272
procedure SetXScope(const Value: TGLFloat);
273
function StoreXScope: Boolean;
274
procedure SetXTiles(const Value: Cardinal);
275
procedure SetYOffset(const Value: TGLFloat);
276
procedure SetYScope(const Value: TGLFloat);
277
function StoreYScope: Boolean;
278
procedure SetYTiles(const Value: Cardinal);
279
procedure SetStyle(const val: TPlaneStyles);
283
constructor Create(AOwner: TComponent); override;
285
procedure Assign(Source: TPersistent); override;
287
procedure BuildList(var rci: TGLRenderContextInfo); override;
288
function GenerateSilhouette(const silhouetteParameters
289
: TGLSilhouetteParameters): TGLSilhouette; override;
291
function AxisAlignedDimensionsUnscaled: TVector; override;
292
function RayCastIntersect(const rayStart, rayVector: TVector;
293
intersectPoint: PVector = nil; intersectNormal: PVector = nil)
295
{ : Computes the screen coordinates of the smallest rectangle encompassing the plane.296
Returned extents are NOT limited to any physical screen extents. }
297
function ScreenRect(aBuffer: TGLSceneBuffer): TGLRect;
299
{ : Computes the signed distance to the point.300
Point coordinates are expected in absolute coordinates. }
301
function PointDistance(const aPoint: TVector): Single;
305
property Height: TGLFloat read FHeight write SetHeight;
306
property Width: TGLFloat read FWidth write SetWidth;
307
property XOffset: TGLFloat read FXOffset write SetXOffset;
308
property XScope: TGLFloat read FXScope write SetXScope stored StoreXScope;
309
property XTiles: Cardinal read FXTiles write SetXTiles default 1;
310
property YOffset: TGLFloat read FYOffset write SetYOffset;
311
property YScope: TGLFloat read FYScope write SetYScope stored StoreYScope;
312
property YTiles: Cardinal read FYTiles write SetYTiles default 1;
313
property Style: TPlaneStyles read FStyle write SetStyle
314
default [psSingleQuad, psTileTexture];
319
{ : A rectangular area, perspective projected, but always facing the camera.320
A TGLSprite is perspective projected and as such is scaled with distance,
321
if you want a 2D sprite that does not get scaled, see TGLHUDSprite. }
322
TGLSprite = class(TGLSceneObject)
328
FAlphaChannel: Single;
329
FMirrorU, FMirrorV: Boolean;
333
procedure SetWidth(const val: TGLFloat);
334
procedure SetHeight(const val: TGLFloat);
335
procedure SetRotation(const val: TGLFloat);
336
procedure SetAlphaChannel(const val: Single);
337
function StoreAlphaChannel: Boolean;
338
procedure SetMirrorU(const val: Boolean);
339
procedure SetMirrorV(const val: Boolean);
343
constructor Create(AOwner: TComponent); override;
345
procedure Assign(Source: TPersistent); override;
346
procedure BuildList(var rci: TGLRenderContextInfo); override;
348
function AxisAlignedDimensionsUnscaled: TVector; override;
350
procedure SetSize(const Width, Height: TGLFloat);
351
// : Set width and height to "size"
352
procedure SetSquareSize(const Size: TGLFloat);
356
{ : Sprite Width in 3D world units. }357
property Width: TGLFloat read FWidth write SetWidth;
358
{ : Sprite Height in 3D world units. }359
property Height: TGLFloat read FHeight write SetHeight;
360
{ : This the ON-SCREEN rotation of the sprite.361
Rotatation=0 is handled faster. }
362
property Rotation: TGLFloat read FRotation write SetRotation;
363
{ : If different from 1, this value will replace that of Diffuse.Alpha }364
property AlphaChannel: Single read FAlphaChannel write SetAlphaChannel
365
stored StoreAlphaChannel;
366
{ : Reverses the texture coordinates in the U and V direction to mirror368
property MirrorU: Boolean read FMirrorU write SetMirrorU default False;
369
property MirrorV: Boolean read FMirrorV write SetMirrorV default False;
374
TGLPointStyle = (psSquare, psRound, psSmooth, psSmoothAdditive,
377
// TGLPointParameters
379
{ : Point parameters as in ARB_point_parameters.380
Make sure to read the ARB_point_parameters spec if you want to understand
381
what each parameter does. }
382
TGLPointParameters = class(TGLUpdateAbleObject)
386
FMinSize, FMaxSize: Single;
387
FFadeTresholdSize: Single;
388
FDistanceAttenuation: TGLCoordinates;
392
procedure SetEnabled(const val: Boolean);
393
procedure SetMinSize(const val: Single);
394
procedure SetMaxSize(const val: Single);
395
procedure SetFadeTresholdSize(const val: Single);
396
procedure SetDistanceAttenuation(const val: TGLCoordinates);
398
procedure DefineProperties(Filer: TFiler); override;
399
procedure ReadData(Stream: TStream);
400
procedure WriteData(Stream: TStream);
404
constructor Create(AOwner: TPersistent); override;
405
destructor Destroy; override;
407
procedure Assign(Source: TPersistent); override;
414
property Enabled: Boolean read FEnabled write SetEnabled default False;
415
property MinSize: Single read FMinSize write SetMinSize stored False;
416
property MaxSize: Single read FMaxSize write SetMaxSize stored False;
417
property FadeTresholdSize: Single read FFadeTresholdSize
418
write SetFadeTresholdSize stored False;
419
{ : Components XYZ are for constant, linear and quadratic attenuation. }420
property DistanceAttenuation: TGLCoordinates read FDistanceAttenuation
421
write SetDistanceAttenuation;
426
{ : Renders a set of non-transparent colored points.427
The points positions and their color are defined through the Positions
428
and Colors properties. }
429
TGLPoints = class(TGLImmaterialSceneObject)
432
FPositions: TAffineVectorList;
433
FColors: TVectorList;
435
FStyle: TGLPointStyle;
436
FPointParameters: TGLPointParameters;
437
FStatic, FNoZWrite: Boolean;
441
function StoreSize: Boolean;
442
procedure SetNoZWrite(const val: Boolean);
443
procedure SetStatic(const val: Boolean);
444
procedure SetSize(const val: Single);
445
procedure SetPositions(const val: TAffineVectorList);
446
procedure SetColors(const val: TVectorList);
447
procedure SetStyle(const val: TGLPointStyle);
448
procedure SetPointParameters(const val: TGLPointParameters);
452
constructor Create(AOwner: TComponent); override;
453
destructor Destroy; override;
455
procedure Assign(Source: TPersistent); override;
456
procedure BuildList(var rci: TGLRenderContextInfo); override;
458
{ : Points positions.459
If empty, a single point is assumed at (0, 0, 0) }
460
property Positions: TAffineVectorList read FPositions write SetPositions;
461
{ : Defines the points colors.463
if empty, point color will be opaque white
464
if contains a single color, all points will use that color
465
if contains N colors, the first N points (at max) will be rendered
466
using the corresponding colors.
468
property Colors: TVectorList read FColors write SetColors;
472
{ : If true points do not write their Z to the depth buffer. }473
property NoZWrite: Boolean read FNoZWrite write SetNoZWrite;
474
{ : Tells the component if point coordinates are static.475
If static, changes to the positions should be notified via an
476
explicit StructureChanged call, or may not refresh.
477
Static sets of points may render faster than dynamic ones. }
478
property Static: Boolean read FStatic write SetStatic;
479
{ : Point size, all points have a fixed size. }480
property Size: Single read FSize write SetSize stored StoreSize;
482
property Style: TGLPointStyle read FStyle write SetStyle default psSquare;
483
{ : Point parameters as of ARB_point_parameters.484
Allows to vary the size and transparency of points depending
485
on their distance to the observer. }
486
property PointParameters: TGLPointParameters read FPointParameters
487
write SetPointParameters;
493
{ : Possible aspects for the nodes of a TLine. }494
TLineNodesAspect = (lnaInvisible, lnaAxes, lnaCube, lnaDodecahedron);
498
{ : Available spline modes for a TLine. }499
TGLLineSplineMode = (lsmLines, lsmCubicSpline, lsmBezierSpline, lsmNURBSCurve,
500
lsmSegments, lsmLoop);
504
{ : Specialized Node for use in a TGLLines objects.505
Adds a Color property (TGLColor). }
506
TGLLinesNode = class(TGLNode)
513
procedure SetColor(const val: TGLColor);
514
procedure OnColorChange(Sender: TObject);
515
function StoreColor: Boolean;
519
constructor Create(Collection: TCollection); override;
520
destructor Destroy; override;
521
procedure Assign(Source: TPersistent); override;
527
Can also defined the line color (interpolated between nodes) if
528
loUseNodeColorForLines is set (in TGLLines). }
529
property Color: TGLColor read FColor write SetColor stored StoreColor;
534
{ : Specialized collection for Nodes in a TGLLines objects.535
Stores TGLLinesNode items. }
536
TGLLinesNodes = class(TGLNodes)
539
constructor Create(AOwner: TComponent); overload;
541
procedure NotifyChange; override;
546
{ : Base class for line objects.547
Introduces line style properties (width, color...). }
548
TGLLineBase = class(TGLImmaterialSceneObject)
551
FLineColor: TGLColor;
552
FLinePattern: TGLushort;
554
FAntiAliased: Boolean;
558
procedure SetLineColor(const Value: TGLColor);
559
procedure SetLinePattern(const Value: TGLushort);
560
procedure SetLineWidth(const val: Single);
561
function StoreLineWidth: Boolean;
562
procedure SetAntiAliased(const val: Boolean);
564
{ : Setup OpenGL states according to line style.565
You must call RestoreLineStyle after drawing your lines.
566
You may use nested calls with SetupLineStyle/RestoreLineStyle. }
567
procedure SetupLineStyle(var rci: TGLRenderContextInfo);
571
constructor Create(AOwner: TComponent); override;
572
destructor Destroy; override;
573
procedure Assign(Source: TPersistent); override;
574
procedure NotifyChange(Sender: TObject); override;
578
{ : Indicates if OpenGL should smooth line edges.579
Smoothed lines looks better but are poorly implemented in most OpenGL
580
drivers and take *lots* of rendering time. }
581
property AntiAliased: Boolean read FAntiAliased write SetAntiAliased
583
{ : Default color of the lines. }584
property LineColor: TGLColor read FLineColor write SetLineColor;
585
{ : Bitwise line pattern.586
For instance $FFFF (65535) is a white line (stipple disabled), $0000
587
is a black line, $CCCC is the stipple used in axes and dummycube, etc. }
588
property LinePattern: TGLushort read FLinePattern write SetLinePattern
590
{ : Default width of the lines. }591
property LineWidth: Single read FLineWidth write SetLineWidth
592
stored StoreLineWidth;
598
{ : Class that defines lines via a series of nodes.599
Base class, does not render anything. }
600
TGLNodedLines = class(TGLLineBase)
603
FNodes: TGLLinesNodes;
604
FNodesAspect: TLineNodesAspect;
605
FNodeColor: TGLColor;
607
FOldNodeColor: TColorVector;
611
procedure SetNodesAspect(const Value: TLineNodesAspect);
612
procedure SetNodeColor(const Value: TGLColor);
613
procedure OnNodeColorChanged(Sender: TObject);
614
procedure SetNodes(const aNodes: TGLLinesNodes);
615
procedure SetNodeSize(const val: Single);
616
function StoreNodeSize: Boolean;
618
procedure DrawNode(var rci: TGLRenderContextInfo; X, Y, Z: Single;
623
constructor Create(AOwner: TComponent); override;
624
destructor Destroy; override;
625
procedure Assign(Source: TPersistent); override;
627
function AxisAlignedDimensionsUnscaled: TVector; override;
629
procedure AddNode(const coords: TGLCoordinates); overload;
630
procedure AddNode(const X, Y, Z: TGLFloat); overload;
631
procedure AddNode(const Value: TVector); overload;
632
procedure AddNode(const Value: TAffineVector); overload;
636
{ : Default color for nodes.637
lnaInvisible and lnaAxes ignore this setting. }
638
property NodeColor: TGLColor read FNodeColor write SetNodeColor;
639
{ : The nodes list. }640
property Nodes: TGLLinesNodes read FNodes write SetNodes;
642
{ : Default aspect of line nodes.643
May help you materialize nodes, segments and control points. }
644
property NodesAspect: TLineNodesAspect read FNodesAspect
645
write SetNodesAspect default lnaAxes;
646
{ : Size for the various node aspects. }647
property NodeSize: Single read FNodeSize write SetNodeSize
648
stored StoreNodeSize;
653
TLinesOption = (loUseNodeColorForLines, loColorLogicXor);
654
TLinesOptions = set of TLinesOption;
658
{ : Set of 3D line segments.659
You define a 3D Line by adding its nodes in the "Nodes" property. The line
660
may be rendered as a set of segment or as a curve (nodes then act as spline
662
Alternatively, you can also use it to render a set of spacial nodes (points
663
in space), just make the lines transparent and the nodes visible by picking
664
the node aspect that suits you. }
665
TGLLines = class(TGLNodedLines)
669
FSplineMode: TGLLineSplineMode;
670
FOptions: TLinesOptions;
671
FNURBSOrder: Integer;
672
FNURBSTolerance: Single;
673
FNURBSKnots: TSingleList;
677
procedure SetSplineMode(const val: TGLLineSplineMode);
678
procedure SetDivision(const Value: Integer);
679
procedure SetOptions(const val: TLinesOptions);
680
procedure SetNURBSOrder(const val: Integer);
681
procedure SetNURBSTolerance(const val: Single);
685
constructor Create(AOwner: TComponent); override;
686
destructor Destroy; override;
687
procedure Assign(Source: TPersistent); override;
689
procedure BuildList(var rci: TGLRenderContextInfo); override;
691
property NURBSKnots: TSingleList read FNURBSKnots;
692
property NURBSOrder: Integer read FNURBSOrder write SetNURBSOrder;
693
property NURBSTolerance: Single read FNURBSTolerance
694
write SetNURBSTolerance;
698
{ : Number of divisions for each segment in spline modes.699
Minimum 1 (disabled), ignored in lsmLines mode. }
700
property Division: Integer read FDivision write SetDivision default 10;
701
{ : Default spline drawing mode. }702
property SplineMode: TGLLineSplineMode read FSplineMode write SetSplineMode
705
{ : Rendering options for the line.707
loUseNodeColorForLines: if set lines will be drawn using node
708
colors (and color interpolation between nodes), if not, LineColor
709
will be used (single color).
710
loColorLogicXor: enable logic operation for color of XOR type.
712
property Options: TLinesOptions read FOptions write SetOptions;
715
TCubePart = (cpTop, cpBottom, cpFront, cpBack, cpLeft, cpRight);
716
TCubeParts = set of TCubePart;
720
{ : A simple cube object.721
This cube use the same material for each of its faces, ie. all faces look
722
the same. If you want a multi-material cube, use a mesh in conjunction
723
with a TGLFreeForm and a material library. }
724
TGLCube = class(TGLSceneObject)
727
FCubeSize: TAffineVector;
729
FNormalDirection: TNormalDirection;
730
function GetCubeWHD(const Index: Integer): TGLFloat;
731
procedure SetCubeWHD(Index: Integer; AValue: TGLFloat);
732
procedure SetParts(aValue: TCubeParts);
733
procedure SetNormalDirection(aValue: TNormalDirection);
736
procedure DefineProperties(Filer: TFiler); override;
737
procedure ReadData(Stream: TStream);
738
procedure WriteData(Stream: TStream);
742
constructor Create(AOwner: TComponent); override;
744
function GenerateSilhouette(const silhouetteParameters
745
: TGLSilhouetteParameters): TGLSilhouette; override;
746
procedure BuildList(var rci: TGLRenderContextInfo); override;
748
procedure Assign(Source: TPersistent); override;
749
function AxisAlignedDimensionsUnscaled: TVector; override;
750
function RayCastIntersect(const rayStart, rayVector: TVector;
751
intersectPoint: PVector = nil; intersectNormal: PVector = nil)
756
property CubeWidth: TGLFloat index 0 read GetCubeWHD write SetCubeWHD
758
property CubeHeight: TGLFloat index 1 read GetCubeWHD write SetCubeWHD
760
property CubeDepth: TGLFloat index 2 read GetCubeWHD write SetCubeWHD
762
property NormalDirection: TNormalDirection read FNormalDirection
763
write SetNormalDirection default ndOutside;
764
property Parts: TCubeParts read FParts write SetParts
765
default [cpTop, cpBottom, cpFront, cpBack, cpLeft, cpRight];
770
{ : Determines how and if normals are smoothed.771
- nsFlat : facetted look
772
- nsSmooth : smooth look
773
- nsNone : unlighted rendering, usefull for decla texturing }
774
TNormalSmoothing = (nsFlat, nsSmooth, nsNone);
778
{ : Base class for quadric objects.779
Introduces some basic Quadric interaction functions (the actual quadric
780
math is part of the GLU library). }
781
TGLQuadricObject = class(TGLSceneObject)
784
FNormals: TNormalSmoothing;
785
FNormalDirection: TNormalDirection;
789
procedure SetNormals(aValue: TNormalSmoothing);
790
procedure SetNormalDirection(aValue: TNormalDirection);
791
procedure SetupQuadricParams(quadric: PGLUquadricObj);
792
procedure SetNormalQuadricOrientation(quadric: PGLUquadricObj);
793
procedure SetInvertedQuadricOrientation(quadric: PGLUquadricObj);
797
constructor Create(AOwner: TComponent); override;
798
procedure Assign(Source: TPersistent); override;
802
property Normals: TNormalSmoothing read FNormals write SetNormals
804
property NormalDirection: TNormalDirection read FNormalDirection
805
write SetNormalDirection default ndOutside;
808
TAngleLimit1 = -90 .. 90;
809
TAngleLimit2 = 0 .. 360;
810
TCapType = (ctNone, ctCenter, ctFlat);
815
The sphere can have to and bottom caps, as well as being just a slice
817
TGLSphere = class(TGLQuadricObject)
821
FSlices, FStacks: TGLInt;
823
FBottom: TAngleLimit1;
824
FStart: TAngleLimit2;
826
FTopCap, FBottomCap: TCapType;
827
procedure SetBottom(aValue: TAngleLimit1);
828
procedure SetBottomCap(aValue: TCapType);
829
procedure SetRadius(const aValue: TGLFloat);
830
procedure SetSlices(aValue: TGLInt);
831
procedure SetStart(aValue: TAngleLimit2);
832
procedure SetStop(aValue: TAngleLimit2);
833
procedure SetStacks(aValue: TGLInt);
834
procedure SetTop(aValue: TAngleLimit1);
835
procedure SetTopCap(aValue: TCapType);
839
constructor Create(AOwner: TComponent); override;
840
procedure Assign(Source: TPersistent); override;
842
procedure BuildList(var rci: TGLRenderContextInfo); override;
843
function AxisAlignedDimensionsUnscaled: TVector; override;
844
function RayCastIntersect(const rayStart, rayVector: TVector;
845
intersectPoint: PVector = nil; intersectNormal: PVector = nil)
848
function GenerateSilhouette(const silhouetteParameters
849
: TGLSilhouetteParameters): TGLSilhouette; override;
852
property Bottom: TAngleLimit1 read FBottom write SetBottom default -90;
853
property BottomCap: TCapType read FBottomCap write SetBottomCap
855
property Radius: TGLFloat read FRadius write SetRadius;
856
property Slices: TGLInt read FSlices write SetSlices default 16;
857
property Stacks: TGLInt read FStacks write SetStacks default 16;
858
property Start: TAngleLimit2 read FStart write SetStart default 0;
859
property Stop: TAngleLimit2 read FStop write SetStop default 360;
860
property Top: TAngleLimit1 read FTop write SetTop default 90;
861
property TopCap: TCapType read FTopCap write SetTopCap default ctNone;
866
{ : Base class for objects based on a polygon. }867
TGLPolygonBase = class(TGLSceneObject)
871
FSplineMode: TGLLineSplineMode;
876
procedure CreateNodes; dynamic;
877
procedure SetSplineMode(const val: TGLLineSplineMode);
878
procedure SetDivision(const Value: Integer);
879
procedure SetNodes(const aNodes: TGLNodes);
883
constructor Create(AOwner: TComponent); override;
884
destructor Destroy; override;
885
procedure Assign(Source: TPersistent); override;
886
procedure NotifyChange(Sender: TObject); override;
888
procedure AddNode(const coords: TGLCoordinates); overload;
889
procedure AddNode(const X, Y, Z: TGLFloat); overload;
890
procedure AddNode(const Value: TVector); overload;
891
procedure AddNode(const Value: TAffineVector); overload;
895
{ : The nodes list. }896
property Nodes: TGLNodes read FNodes write SetNodes;
897
{ : Number of divisions for each segment in spline modes.898
Minimum 1 (disabled), ignored in lsmLines mode. }
899
property Division: Integer read FDivision write SetDivision default 10;
900
{ : Default spline drawing mode.901
This mode is used only for the curve, not for the rotation path. }
902
property SplineMode: TGLLineSplineMode read FSplineMode write SetSplineMode
909
{ : A Superellipsoid object.910
The Superellipsoid can have top and bottom caps,
911
as well as being just a slice of Superellipsoid. }
912
TGLSuperellipsoid = class(TGLQuadricObject)
915
FRadius, FxyCurve, FzCurve: TGLFloat;
916
FSlices, FStacks: TGLInt;
918
FBottom: TAngleLimit1;
919
FStart: TAngleLimit2;
921
FTopCap, FBottomCap: TCapType;
922
procedure SetBottom(aValue: TAngleLimit1);
923
procedure SetBottomCap(aValue: TCapType);
924
procedure SetRadius(const aValue: TGLFloat);
925
procedure SetxyCurve(const aValue: TGLFloat);
926
procedure SetzCurve(const aValue: TGLFloat);
927
procedure SetSlices(aValue: TGLInt);
928
procedure SetStart(aValue: TAngleLimit2);
929
procedure SetStop(aValue: TAngleLimit2);
930
procedure SetStacks(aValue: TGLInt);
931
procedure SetTop(aValue: TAngleLimit1);
932
procedure SetTopCap(aValue: TCapType);
936
constructor Create(AOwner: TComponent); override;
937
procedure Assign(Source: TPersistent); override;
939
procedure BuildList(var rci: TGLRenderContextInfo); override;
940
function AxisAlignedDimensionsUnscaled: TVector; override;
941
function RayCastIntersect(const rayStart, rayVector: TVector;
942
intersectPoint: PVector = nil; intersectNormal: PVector = nil)
945
function GenerateSilhouette(const silhouetteParameters
946
: TGLSilhouetteParameters): TGLSilhouette; override;
949
property Bottom: TAngleLimit1 read FBottom write SetBottom default -90;
950
property BottomCap: TCapType read FBottomCap write SetBottomCap
952
property Radius: TGLFloat read FRadius write SetRadius;
953
property xyCurve: TGLFloat read FxyCurve write SetxyCurve;
954
property zCurve: TGLFloat read FzCurve write SetzCurve;
955
property Slices: TGLInt read FSlices write SetSlices default 16;
956
property Stacks: TGLInt read FStacks write SetStacks default 16;
957
property Start: TAngleLimit2 read FStart write SetStart default 0;
958
property Stop: TAngleLimit2 read FStop write SetStop default 360;
959
property Top: TAngleLimit1 read FTop write SetTop default 90;
960
property TopCap: TCapType read FTopCap write SetTopCap default ctNone;
964
{ : Issues OpenGL for a unit-size cube stippled wireframe. }965
procedure CubeWireframeBuildList(var rci: TGLRenderContextInfo; Size: TGLFloat;
966
Stipple: Boolean; const Color: TColorVector);
967
{ : Issues OpenGL for a unit-size dodecahedron. }968
procedure DodecahedronBuildList;
969
{ : Issues OpenGL for a unit-size icosahedron. }970
procedure IcosahedronBuildList;
971
{ : Issues OpenGL for a unit-size octahedron. }972
procedure OctahedronBuildList;
973
{ : Issues OpenGL for a unit-size tetrahedron. }974
procedure TetrahedronBuildList;
979
TangentAttributeName: AnsiString = 'Tangent';
980
BinormalAttributeName: AnsiString = 'Binormal';
982
// -------------------------------------------------------------
983
// -------------------------------------------------------------
984
// -------------------------------------------------------------
987
// -------------------------------------------------------------
988
// -------------------------------------------------------------
989
// -------------------------------------------------------------
997
cDefaultPointSize: Single = 1.0;
999
// CubeWireframeBuildList
1002
procedure CubeWireframeBuildList(var rci: TGLRenderContextInfo; Size: TGLFloat;
1003
Stipple: Boolean; const Color: TColorVector);
1007
{$IFDEF GLS_OPENGL_DEBUG}1008
if GL.GREMEDY_string_marker then
1009
GL.StringMarkerGREMEDY(22, 'CubeWireframeBuildList');
1011
rci.GLStates.Disable(stLighting);
1012
rci.GLStates.Enable(stLineSmooth);
1015
rci.GLStates.Enable(stLineStipple);
1016
rci.GLStates.Enable(stBlend);
1017
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1018
rci.GLStates.LineStippleFactor := 1;
1019
rci.GLStates.LineStipplePattern := $CCCC;
1021
rci.GLStates.LineWidth := 1;
1025
GL.Color4fv(@Color);
1026
GL.Begin_(GL_LINE_STRIP);
1028
GL.Vertex3f(ma, mi, mi);
1029
GL.Vertex3f(ma, ma, mi);
1030
GL.Vertex3f(ma, ma, ma);
1031
GL.Vertex3f(ma, mi, ma);
1032
GL.Vertex3f(ma, mi, mi);
1033
// partial up back face
1034
GL.Vertex3f(mi, mi, mi);
1035
GL.Vertex3f(mi, mi, ma);
1036
GL.Vertex3f(mi, ma, ma);
1037
GL.Vertex3f(mi, ma, mi);
1039
GL.Vertex3f(ma, ma, mi);
1041
GL.Begin_(GL_LINES);
1043
GL.Vertex3f(ma, ma, ma);
1044
GL.Vertex3f(mi, ma, ma);
1046
GL.Vertex3f(mi, mi, mi);
1047
GL.Vertex3f(mi, ma, mi);
1049
GL.Vertex3f(ma, mi, ma);
1050
GL.Vertex3f(mi, mi, ma);
1054
// DodecahedronBuildList
1056
procedure DodecahedronBuildList;
1058
A = 1.61803398875 * 0.3; // (Sqrt(5)+1)/2
1059
B = 0.61803398875 * 0.3; // (Sqrt(5)-1)/2
1062
Vertices: packed array [0 .. 19] of TAffineVector = ((X: - A; Y: 0; Z: B),
1063
(X: - A; Y: 0; Z: - B), (X: A; Y: 0; Z: - B), (X: A; Y: 0; Z: B), (X: B;
1064
Y: - A; Z: 0), (X: - B; Y: - A; Z: 0), (X: - B; Y: A; Z: 0), (X: B; Y: A;
1065
Z: 0), (X: 0; Y: B; Z: - A), (X: 0; Y: - B; Z: - A), (X: 0; Y: - B; Z: A),
1066
(X: 0; Y: B; Z: A), (X: - C; Y: - C; Z: C), (X: - C; Y: - C; Z: - C), (X: C;
1067
Y: - C; Z: - C), (X: C; Y: - C; Z: C), (X: - C; Y: C; Z: C), (X: - C; Y: C;
1068
Z: - C), (X: C; Y: C; Z: - C), (X: C; Y: C; Z: C));
1070
Polygons: packed array [0 .. 11] of packed array [0 .. 4]
1071
of Byte = ((0, 12, 10, 11, 16), (1, 17, 8, 9, 13), (2, 14, 9, 8, 18),
1072
(3, 19, 11, 10, 15), (4, 14, 2, 3, 15), (5, 12, 0, 1, 13),
1073
(6, 17, 1, 0, 16), (7, 19, 3, 2, 18), (8, 17, 6, 7, 18), (9, 14, 4, 5, 13),
1074
(10, 12, 5, 4, 15), (11, 19, 7, 6, 16));
1078
faceIndices: PByteArray;
1082
faceIndices := @polygons[i, 0];
1084
n := CalcPlaneNormal(vertices[faceIndices^[0]], vertices[faceIndices^[1]],
1085
vertices[faceIndices^[2]]);
1088
// GL.Begin_(GL_TRIANGLE_FAN);
1089
// for j := 0 to 4 do
1090
// GL.Vertex3fv(@vertices[faceIndices^[j]]);
1093
GL.Begin_(GL_TRIANGLES);
1097
GL.Vertex3fv(@vertices[faceIndices^[0]]);
1098
GL.Vertex3fv(@vertices[faceIndices^[j]]);
1099
GL.Vertex3fv(@vertices[faceIndices^[j+1]]);
1105
// IcosahedronBuildList
1107
procedure IcosahedronBuildList;
1110
B = 0.30901699437; // 1/(1+Sqrt(5))
1112
Vertices: packed array [0 .. 11] of TAffineVector = ((X: 0; Y: - B; Z: - A),
1113
(X: 0; Y: - B; Z: A), (X: 0; Y: B; Z: - A), (X: 0; Y: B; Z: A), (X: - A;
1114
Y: 0; Z: - B), (X: - A; Y: 0; Z: B), (X: A; Y: 0; Z: - B), (X: A; Y: 0;
1115
Z: B), (X: - B; Y: - A; Z: 0), (X: - B; Y: A; Z: 0), (X: B; Y: - A; Z: 0),
1116
(X: B; Y: A; Z: 0));
1117
Triangles: packed array [0 .. 19] of packed array [0 .. 2]
1118
of Byte = ((2, 9, 11), (3, 11, 9), (3, 5, 1), (3, 1, 7), (2, 6, 0),
1119
(2, 0, 4), (1, 8, 10), (0, 10, 8), (9, 4, 5), (8, 5, 4), (11, 7, 6),
1120
(10, 6, 7), (3, 9, 5), (3, 7, 11), (2, 4, 9), (2, 11, 6), (0, 8, 4),
1121
(0, 6, 10), (1, 5, 8), (1, 10, 7));
1126
faceIndices: PByteArray;
1130
faceIndices := @triangles[i, 0];
1132
n := CalcPlaneNormal(vertices[faceIndices^[0]], vertices[faceIndices^[1]],
1133
vertices[faceIndices^[2]]);
1136
GL.Begin_(GL_TRIANGLES);
1138
GL.Vertex3fv(@vertices[faceIndices^[j]]);
1143
// OctahedronBuildList
1145
procedure OctahedronBuildList;
1147
Vertices: packed array [0 .. 5] of TAffineVector =
1148
((X: 1.0; Y: 0.0; Z: 0.0),
1149
(X: -1.0; Y: 0.0; Z: 0.0),
1150
(X: 0.0; Y: 1.0; Z: 0.0),
1151
(X: 0.0; Y: -1.0; Z: 0.0),
1152
(X: 0.0; Y: 0.0; Z: 1.0),
1153
(X: 0.0; Y: 0.0; Z: -1.0));
1155
Triangles: packed array [0 .. 7] of packed array [0 .. 2]
1156
of Byte = ((0, 4, 2), (1, 2, 4), (0, 3, 4), (1, 4, 3),
1157
(0, 2, 5), (1, 5, 2), (0, 5, 3), (1, 3, 5));
1162
faceIndices: PByteArray;
1166
faceIndices := @triangles[i, 0];
1168
n := CalcPlaneNormal(vertices[faceIndices^[0]], vertices[faceIndices^[1]],
1169
vertices[faceIndices^[2]]);
1172
GL.Begin_(GL_TRIANGLES);
1174
GL.Vertex3fv(@vertices[faceIndices^[j]]);
1179
// TetrahedronBuildList
1181
procedure TetrahedronBuildList;
1183
TetT = 1.73205080756887729;
1185
Vertices: packed array [0 .. 3] of TAffineVector =
1187
((X: TetT; Y: TetT; Z: TetT),
1188
(X: TetT; Y: -TetT; Z: -TetT),
1189
(X: -TetT; Y: TetT; Z: -TetT),
1190
(X: -TetT; Y: -TetT; Z: TetT));
1192
((X: 1.0; Y: 1.0; Z: 1.0),
1193
(X: 1.0; Y: -1.0; Z: -1.0),
1194
(X: -1.0; Y: 1.0; Z: -1.0),
1195
(X: -1.0; Y: -1.0; Z: 1.0));
1197
Triangles: packed array [0 .. 3] of packed array [0 .. 2]
1198
of Byte = ((0, 1, 3), (2, 1, 0), (3, 2, 0), (1, 2, 3));
1203
faceIndices: PByteArray;
1207
faceIndices := @triangles[i, 0];
1209
n := CalcPlaneNormal(vertices[faceIndices^[0]], vertices[faceIndices^[1]],
1210
vertices[faceIndices^[2]]);
1213
GL.Begin_(GL_TRIANGLES);
1215
GL.Vertex3fv(@vertices[faceIndices^[j]]);
1220
// ------------------
1221
// ------------------ TGLDummyCube ------------------
1222
// ------------------
1227
constructor TGLDummyCube.Create(AOwner: TComponent);
1230
ObjectStyle := ObjectStyle + [osDirectDraw];
1232
FEdgeColor := TGLColor.Create(Self);
1233
FEdgeColor.Initialize(clrWhite);
1234
FGroupList := TGLListHandle.Create;
1235
CamInvarianceMode := cimNone;
1241
destructor TGLDummyCube.Destroy;
1251
procedure TGLDummyCube.Assign(Source: TPersistent);
1253
if Source is TGLDummyCube then
1255
FCubeSize := TGLDummyCube(Source).FCubeSize;
1256
FEdgeColor.Color := TGLDummyCube(Source).FEdgeColor.Color;
1257
FVisibleAtRunTime := TGLDummyCube(Source).FVisibleAtRunTime;
1260
inherited Assign(Source);
1263
// AxisAlignedDimensionsUnscaled
1266
function TGLDummyCube.AxisAlignedDimensionsUnscaled: TVector;
1268
Result.X := 0.5 * Abs(FCubeSize);
1269
Result.Y := Result.X;
1270
Result.Z := Result.X;
1277
function TGLDummyCube.RayCastIntersect(const rayStart, rayVector: TVector;
1278
intersectPoint: PVector = nil; intersectNormal: PVector = nil): Boolean;
1286
procedure TGLDummyCube.BuildList(var rci: TGLRenderContextInfo);
1288
if (csDesigning in ComponentState) or (FVisibleAtRunTime) then
1289
CubeWireframeBuildList(rci, FCubeSize, True, EdgeColor.Color);
1295
procedure TGLDummyCube.DoRender(var rci: TGLRenderContextInfo;
1296
renderSelf, renderChildren: Boolean);
1298
if Assigned(FOnVisibilityDetermination) then
1299
if not FOnVisibilityDetermination(Self, rci) then
1301
if FAmalgamate and (not rci.amalgamating) then
1303
if FGroupList.Handle = 0 then
1305
FGroupList.AllocateHandle;
1306
Assert(FGroupList.Handle <> 0, 'Handle=0 for ' + ClassName);
1307
rci.GLStates.NewList(FGroupList.Handle, GL_COMPILE);
1308
rci.amalgamating := True;
1312
rci.amalgamating := False;
1313
rci.GLStates.EndList;
1316
rci.GLStates.CallList(FGroupList.Handle);
1328
procedure TGLDummyCube.StructureChanged;
1331
FGroupList.DestroyHandle;
1335
// BarycenterAbsolutePosition
1338
function TGLDummyCube.BarycenterAbsolutePosition: TVector;
1344
Result := Children[0].BarycenterAbsolutePosition;
1345
for i := 1 to Count - 1 do
1346
Result := VectorAdd(Result, Children[i].BarycenterAbsolutePosition);
1347
ScaleVector(Result, 1 / Count);
1350
Result := AbsolutePosition;
1356
procedure TGLDummyCube.SetCubeSize(const val: TGLFloat);
1358
if val <> FCubeSize then
1368
procedure TGLDummyCube.SetEdgeColor(const val: TGLColor);
1370
if val <> FEdgeColor then
1372
FEdgeColor.Assign(val);
1377
// SetVisibleAtRunTime
1380
procedure TGLDummyCube.SetVisibleAtRunTime(const val: Boolean);
1382
if val <> FVisibleAtRunTime then
1384
FVisibleAtRunTime := val;
1392
procedure TGLDummyCube.SetAmalgamate(const val: Boolean);
1394
if val <> FAmalgamate then
1398
FGroupList.DestroyHandle;
1399
inherited StructureChanged;
1403
// ------------------
1404
// ------------------ TGLPlane ------------------
1405
// ------------------
1410
constructor TGLPlane.Create(AOwner: TComponent);
1412
inherited Create(AOwner);
1419
ObjectStyle := ObjectStyle + [osDirectDraw];
1420
FStyle := [psSingleQuad, psTileTexture];
1426
procedure TGLPlane.Assign(Source: TPersistent);
1428
if Assigned(Source) and (Source is TGLPlane) then
1430
FWidth := TGLPlane(Source).FWidth;
1431
FHeight := TGLPlane(Source).FHeight;
1432
FXOffset := TGLPlane(Source).FXOffset;
1433
FXScope := TGLPlane(Source).FXScope;
1434
FXTiles := TGLPlane(Source).FXTiles;
1435
FYOffset := TGLPlane(Source).FYOffset;
1436
FYScope := TGLPlane(Source).FYScope;
1437
FYTiles := TGLPlane(Source).FYTiles;
1438
FStyle := TGLPlane(Source).FStyle;
1441
inherited Assign(Source);
1444
// AxisAlignedDimensions
1447
function TGLPlane.AxisAlignedDimensionsUnscaled: TVector;
1449
Result.V[0] := 0.5 * Abs(FWidth);
1450
Result.V[1] := 0.5 * Abs(FHeight);
1457
function TGLPlane.RayCastIntersect(const rayStart, rayVector: TVector;
1458
intersectPoint: PVector = nil; intersectNormal: PVector = nil): Boolean;
1460
locRayStart, locRayVector, ip: TVector;
1463
locRayStart := AbsoluteToLocal(rayStart);
1464
locRayVector := AbsoluteToLocal(rayVector);
1465
if locRayStart.V[2] >= 0 then
1467
// ray start over plane
1468
if locRayVector.V[2] < 0 then
1470
t := locRayStart.V[2] / locRayVector.V[2];
1471
ip.V[0] := locRayStart.V[0] - t * locRayVector.V[0];
1472
ip.V[1] := locRayStart.V[1] - t * locRayVector.V[1];
1473
if (Abs(ip.V[0]) <= 0.5 * Width) and (Abs(ip.V[1]) <= 0.5 * Height) then
1476
if Assigned(intersectNormal) then
1477
intersectNormal^ := AbsoluteDirection;
1487
// ray start below plane
1488
if locRayVector.V[2] > 0 then
1490
t := locRayStart.V[2] / locRayVector.V[2];
1491
ip.V[0] := locRayStart.V[0] - t * locRayVector.V[0];
1492
ip.V[1] := locRayStart.V[1] - t * locRayVector.V[1];
1493
if (Abs(ip.V[0]) <= 0.5 * Width) and (Abs(ip.V[1]) <= 0.5 * Height) then
1496
if Assigned(intersectNormal) then
1497
intersectNormal^ := VectorNegate(AbsoluteDirection);
1505
if Result and Assigned(intersectPoint) then
1509
intersectPoint^ := LocalToAbsolute(ip);
1513
// GenerateSilhouette
1516
function TGLPlane.GenerateSilhouette(const silhouetteParameters
1517
: TGLSilhouetteParameters): TGLSilhouette;
1521
Result := TGLSilhouette.Create;
1524
hh := FHeight * 0.5;
1526
with Result.vertices do
1534
with Result.Indices do
1542
if silhouetteParameters.CappingRequired then
1543
with Result.CapIndices do
1553
procedure TGLPlane.BuildList(var rci: TGLRenderContextInfo);
1555
procedure EmitVertex(ptr: PVertexRec); {$IFDEF GLS_INLINE}inline;{$ENDIF}1557
XGL.TexCoord2fv(@ptr^.TexCoord);
1558
GL.Vertex3fv(@ptr^.Position);
1562
hw, hh, posXFact, posYFact, pX, pY1: TGLFloat;
1563
tx0, tx1, ty0, ty1, texSFact, texTFact: TGLFloat;
1564
texS, texT1: TGLFloat;
1566
TanLoc, BinLoc: Integer;
1567
pVertex: PVertexRec;
1570
hh := FHeight * 0.5;
1574
Normal3fv(@ZVector);
1575
if ARB_shader_objects and (rci.GLStates.CurrentProgram > 0) then
1577
TanLoc := GetAttribLocation(rci.GLStates.CurrentProgram, PGLChar(TangentAttributeName));
1578
BinLoc := GetAttribLocation(rci.GLStates.CurrentProgram, PGLChar(BinormalAttributeName));
1580
VertexAttrib3fv(TanLoc, @XVector);
1582
VertexAttrib3fv(BinLoc, @YVector);
1585
// determine tex coords extents
1586
if psTileTexture in FStyle then
1589
tx1 := FXTiles * FXScope + FXOffset;
1591
ty1 := FYTiles * FYScope + FYOffset;
1601
if psSingleQuad in FStyle then
1603
// single quad plane
1604
GL.Begin_(GL_TRIANGLES);
1605
xgl.TexCoord2f(tx1, ty1);
1606
GL.Vertex2f(hw, hh);
1607
xgl.TexCoord2f(tx0, ty1);
1608
GL.Vertex2f(-hw, hh);
1609
xgl.TexCoord2f(tx0, ty0);
1610
GL.Vertex2f(-hw, -hh);
1612
GL.Vertex2f(-hw, -hh);
1613
xgl.TexCoord2f(tx1, ty0);
1614
GL.Vertex2f(hw, -hh);
1615
xgl.TexCoord2f(tx1, ty1);
1616
GL.Vertex2f(hw, hh);
1622
// multi-quad plane (actually built from tri-strips)
1623
texSFact := (tx1 - tx0) / FXTiles;
1624
texTFact := (ty1 - ty0) / FYTiles;
1625
posXFact := FWidth / FXTiles;
1626
posYFact := FHeight / FYTiles;
1629
SetLength(FMesh, FYTiles+1, FXTiles+1);
1630
for Y := 0 to FYTiles do
1632
texT1 := Y * texTFact;
1633
pY1 := Y * posYFact - hh;
1634
for X := 0 to FXTiles do
1636
texS := X * texSFact;
1637
pX := X * posXFact - hw;
1638
FMesh[Y][X].Position := Vector3fMake(pX, pY1, 0.0);
1639
FMesh[Y][X].TexCoord := Vector2fMake(texS, texT1);
1647
Begin_(GL_TRIANGLES);
1648
for Y := 0 to FYTiles-1 do
1650
for X := 0 to FXTiles-1 do
1652
pVertex := @FMesh[Y][X];
1653
EmitVertex(pVertex);
1655
pVertex := @FMesh[Y][X+1];
1656
EmitVertex(pVertex);
1658
pVertex := @FMesh[Y+1][X];
1659
EmitVertex(pVertex);
1661
pVertex := @FMesh[Y+1][X+1];
1662
EmitVertex(pVertex);
1664
pVertex := @FMesh[Y+1][X];
1665
EmitVertex(pVertex);
1667
pVertex := @FMesh[Y][X+1];
1668
EmitVertex(pVertex);
1678
procedure TGLPlane.SetWidth(const aValue: Single);
1680
if aValue <> FWidth then
1691
function TGLPlane.ScreenRect(aBuffer: TGLSceneBuffer): TGLRect;
1693
v: array [0 .. 3] of TVector;
1694
buf: TGLSceneBuffer;
1698
if Assigned(buf) then
1701
hh := FHeight * 0.5;
1702
v[0] := LocalToAbsolute(PointMake(-hw, -hh, 0));
1703
v[1] := LocalToAbsolute(PointMake(hw, -hh, 0));
1704
v[2] := LocalToAbsolute(PointMake(hw, hh, 0));
1705
v[3] := LocalToAbsolute(PointMake(-hw, hh, 0));
1706
buf.WorldToScreen(@v[0], 4);
1707
Result.Left := Round(MinFloat([v[0].V[0], v[1].V[0], v[2].V[0], v[3].V[0]]));
1708
Result.Right := Round(MaxFloat([v[0].V[0], v[1].V[0], v[2].V[0], v[3].V[0]]));
1709
Result.Top := Round(MinFloat([v[0].V[1], v[1].V[1], v[2].V[1], v[3].V[1]]));
1710
Result.Bottom := Round(MaxFloat([v[0].V[1], v[1].V[1], v[2].V[1], v[3].V[1]]));
1713
FillChar(Result, SizeOf(TGLRect), 0);
1719
function TGLPlane.PointDistance(const aPoint: TVector): Single;
1721
Result := VectorDotProduct(VectorSubtract(aPoint, AbsolutePosition),
1728
procedure TGLPlane.SetHeight(const aValue: Single);
1730
if aValue <> FHeight then
1741
procedure TGLPlane.SetXOffset(const Value: TGLFloat);
1743
if Value <> FXOffset then
1754
procedure TGLPlane.SetXScope(const Value: TGLFloat);
1756
if Value <> FXScope then
1769
function TGLPlane.StoreXScope: Boolean;
1771
Result := (FXScope <> 1);
1777
procedure TGLPlane.SetXTiles(const Value: Cardinal);
1779
if Value <> FXTiles then
1790
procedure TGLPlane.SetYOffset(const Value: TGLFloat);
1792
if Value <> FYOffset then
1803
procedure TGLPlane.SetYScope(const Value: TGLFloat);
1805
if Value <> FYScope then
1818
function TGLPlane.StoreYScope: Boolean;
1820
Result := (FYScope <> 1);
1826
procedure TGLPlane.SetYTiles(const Value: Cardinal);
1828
if Value <> FYTiles then
1839
procedure TGLPlane.SetStyle(const val: TPlaneStyles);
1841
if val <> FStyle then
1848
// ------------------
1849
// ------------------ TGLSprite ------------------
1850
// ------------------
1855
constructor TGLSprite.Create(AOwner: TComponent);
1857
inherited Create(AOwner);
1858
ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
1867
procedure TGLSprite.Assign(Source: TPersistent);
1869
if Source is TGLSprite then
1871
FWidth := TGLSprite(Source).FWidth;
1872
FHeight := TGLSprite(Source).FHeight;
1873
FRotation := TGLSprite(Source).FRotation;
1874
FAlphaChannel := TGLSprite(Source).FAlphaChannel;
1876
inherited Assign(Source);
1879
function TGLSprite.AxisAlignedDimensionsUnscaled: TVector;
1881
Result.V[0] := 0.5 * Abs(FWidth);
1882
Result.V[1] := 0.5 * Abs(FHeight);
1883
// Sprites turn with the camera and can be considered to have the same depth
1885
Result.V[2] := 0.5 * Abs(FWidth);
1891
procedure TGLSprite.BuildList(var rci: TGLRenderContextInfo);
1893
vx, vy: TAffineVector;
1896
u0, v0, u1, v1: Integer;
1898
if FAlphaChannel <> 1 then
1899
rci.GLStates.SetGLMaterialAlphaChannel(GL_FRONT, FAlphaChannel);
1901
mat := rci.PipelineTransformation.ModelViewMatrix;
1902
// extraction of the "vecteurs directeurs de la matrice"
1903
// (dunno how they are named in english)
1906
vx.V[0] := mat.V[0].V[0];
1907
vy.V[0] := mat.V[0].V[1];
1908
vx.V[1] := mat.V[1].V[0];
1909
vy.V[1] := mat.V[1].V[1];
1910
vx.V[2] := mat.V[2].V[0];
1911
vy.V[2] := mat.V[2].V[1];
1912
ScaleVector(vx, w / VectorLength(vx));
1913
ScaleVector(vy, h / VectorLength(vy));
1935
if FRotation <> 0 then
1938
GL.Rotatef(FRotation, mat.V[0].V[2], mat.V[1].V[2], mat.V[2].V[2]);
1940
GL.Begin_(GL_QUADS);
1941
xgl.TexCoord2f(u1, v1);
1942
GL.Vertex3f(vx.V[0] + vy.V[0], vx.V[1] + vy.V[1], vx.V[2] + vy.V[2]);
1943
xgl.TexCoord2f(u0, v1);
1944
GL.Vertex3f(-vx.V[0] + vy.V[0], -vx.V[1] + vy.V[1], -vx.V[2] + vy.V[2]);
1945
xgl.TexCoord2f(u0, v0);
1946
GL.Vertex3f(-vx.V[0] - vy.V[0], -vx.V[1] - vy.V[1], -vx.V[2] - vy.V[2]);
1947
xgl.TexCoord2f(u1, v0);
1948
GL.Vertex3f(vx.V[0] - vy.V[0], vx.V[1] - vy.V[1], vx.V[2] - vy.V[2]);
1950
if FRotation <> 0 then
1957
procedure TGLSprite.SetWidth(const val: TGLFloat);
1959
if FWidth <> val then
1969
procedure TGLSprite.SetHeight(const val: TGLFloat);
1971
if FHeight <> val then
1981
procedure TGLSprite.SetRotation(const val: TGLFloat);
1983
if FRotation <> val then
1993
procedure TGLSprite.SetAlphaChannel(const val: Single);
1995
if val <> FAlphaChannel then
1999
else if val > 1 then
2002
FAlphaChannel := val;
2010
function TGLSprite.StoreAlphaChannel: Boolean;
2012
Result := (FAlphaChannel <> 1);
2018
procedure TGLSprite.SetMirrorU(const val: Boolean);
2027
procedure TGLSprite.SetMirrorV(const val: Boolean);
2036
procedure TGLSprite.SetSize(const Width, Height: TGLFloat);
2046
procedure TGLSprite.SetSquareSize(const Size: TGLFloat);
2053
// ------------------
2054
// ------------------ TGLPointParameters ------------------
2055
// ------------------
2060
constructor TGLPointParameters.Create(AOwner: TPersistent);
2062
inherited Create(AOwner);
2065
FFadeTresholdSize := 1;
2066
FDistanceAttenuation := TGLCoordinates.CreateInitialized(Self, XHmgVector,
2073
destructor TGLPointParameters.Destroy;
2075
FDistanceAttenuation.Free;
2082
procedure TGLPointParameters.Assign(Source: TPersistent);
2084
if Source is TGLPointParameters then
2086
FMinSize := TGLPointParameters(Source).FMinSize;
2087
FMaxSize := TGLPointParameters(Source).FMaxSize;
2088
FFadeTresholdSize := TGLPointParameters(Source).FFadeTresholdSize;
2089
FDistanceAttenuation.Assign(TGLPointParameters(Source).DistanceAttenuation);
2096
procedure TGLPointParameters.DefineProperties(Filer: TFiler);
2098
defaultParams: Boolean;
2101
defaultParams := (FMaxSize = 128) and (FMinSize = 0) and
2102
(FFadeTresholdSize = 1);
2103
Filer.DefineBinaryProperty('PointParams', ReadData, WriteData,2110
procedure TGLPointParameters.ReadData(Stream: TStream);
2114
Read(FMinSize, SizeOf(Single));
2115
Read(FMaxSize, SizeOf(Single));
2116
Read(FFadeTresholdSize, SizeOf(Single));
2123
procedure TGLPointParameters.WriteData(Stream: TStream);
2127
Write(FMinSize, SizeOf(Single));
2128
Write(FMaxSize, SizeOf(Single));
2129
Write(FFadeTresholdSize, SizeOf(Single));
2136
procedure TGLPointParameters.Apply;
2138
if Enabled and GL.ARB_point_parameters then
2140
GL.PointParameterf(GL_POINT_SIZE_MIN_ARB, FMinSize);
2141
GL.PointParameterf(GL_POINT_SIZE_MAX_ARB, FMaxSize);
2142
GL.PointParameterf(GL_POINT_FADE_THRESHOLD_SIZE_ARB, FFadeTresholdSize);
2143
GL.PointParameterfv(GL_DISTANCE_ATTENUATION_ARB,
2144
FDistanceAttenuation.AsAddress);
2151
procedure TGLPointParameters.UnApply;
2153
if Enabled and GL.ARB_point_parameters then
2155
GL.PointParameterf(GL_POINT_SIZE_MIN_ARB, 0);
2156
GL.PointParameterf(GL_POINT_SIZE_MAX_ARB, 128);
2157
GL.PointParameterf(GL_POINT_FADE_THRESHOLD_SIZE_ARB, 1);
2158
GL.PointParameterfv(GL_DISTANCE_ATTENUATION_ARB, @XVector);
2165
procedure TGLPointParameters.SetEnabled(const val: Boolean);
2167
if val <> FEnabled then
2177
procedure TGLPointParameters.SetMinSize(const val: Single);
2179
if val <> FMinSize then
2192
procedure TGLPointParameters.SetMaxSize(const val: Single);
2194
if val <> FMaxSize then
2204
// SetFadeTresholdSize
2207
procedure TGLPointParameters.SetFadeTresholdSize(const val: Single);
2209
if val <> FFadeTresholdSize then
2212
FFadeTresholdSize := 0
2214
FFadeTresholdSize := val;
2219
// SetDistanceAttenuation
2222
procedure TGLPointParameters.SetDistanceAttenuation(const val: TGLCoordinates);
2224
FDistanceAttenuation.Assign(val);
2227
// ------------------
2228
// ------------------ TGLPoints ------------------
2229
// ------------------
2234
constructor TGLPoints.Create(AOwner: TComponent);
2236
inherited Create(AOwner);
2237
ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
2239
FSize := cDefaultPointSize;
2240
FPositions := TAffineVectorList.Create;
2241
FPositions.Add(NullVector);
2242
FColors := TVectorList.Create;
2243
FPointParameters := TGLPointParameters.Create(Self);
2249
destructor TGLPoints.Destroy;
2251
FPointParameters.Free;
2260
procedure TGLPoints.Assign(Source: TPersistent);
2262
if Source is TGLPoints then
2264
FSize := TGLPoints(Source).FSize;
2265
FStyle := TGLPoints(Source).FStyle;
2266
FPositions.Assign(TGLPoints(Source).FPositions);
2267
FColors.Assign(TGLPoints(Source).FColors);
2270
inherited Assign(Source);
2276
procedure TGLPoints.BuildList(var rci: TGLRenderContextInfo);
2281
n := FPositions.Count;
2285
case FColors.Count of
2287
GL.Color4f(1, 1, 1, 1);
2289
GL.Color4fv(PGLFloat(FColors.List));
2291
if FColors.Count < n then
2293
GL.ColorPointer(4, GL_FLOAT, 0, FColors.List);
2294
GL.EnableClientState(GL_COLOR_ARRAY);
2296
if FColors.Count < 2 then
2297
GL.DisableClientState(GL_COLOR_ARRAY);
2299
rci.GLStates.Disable(stLighting);
2303
GL.VertexPointer(3, GL_FLOAT, 0, @v);
2307
GL.VertexPointer(3, GL_FLOAT, 0, FPositions.List);
2308
GL.EnableClientState(GL_VERTEX_ARRAY);
2311
rci.GLStates.DepthWriteMask := False;
2312
rci.GLStates.PointSize := FSize;
2313
PointParameters.Apply;
2314
if GL.EXT_compiled_vertex_array and (n > 64) then
2315
GL.LockArrays(0, n);
2319
// square point (simplest method, fastest)
2320
rci.GLStates.Disable(stBlend);
2324
rci.GLStates.Enable(stPointSmooth);
2325
rci.GLStates.Enable(stAlphaTest);
2326
rci.GLStates.SetGLAlphaFunction(cfGreater, 0.5);
2327
rci.GLStates.Disable(stBlend);
2331
rci.GLStates.Enable(stPointSmooth);
2332
rci.GLStates.Enable(stAlphaTest);
2333
rci.GLStates.SetGLAlphaFunction(cfNotEqual, 0.0);
2334
rci.GLStates.Enable(stBlend);
2335
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
2339
rci.GLStates.Enable(stPointSmooth);
2340
rci.GLStates.Enable(stAlphaTest);
2341
rci.GLStates.SetGLAlphaFunction(cfNotEqual, 0.0);
2342
rci.GLStates.Enable(stBlend);
2343
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
2347
rci.GLStates.Enable(stBlend);
2348
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
2353
GL.DrawArrays(GL_POINTS, 0, n);
2354
if GL.EXT_compiled_vertex_array and (n > 64) then
2356
PointParameters.UnApply;
2357
GL.DisableClientState(GL_VERTEX_ARRAY);
2358
if FColors.Count > 1 then
2359
GL.DisableClientState(GL_COLOR_ARRAY);
2365
function TGLPoints.StoreSize: Boolean;
2367
Result := (FSize <> cDefaultPointSize);
2373
procedure TGLPoints.SetNoZWrite(const val: Boolean);
2375
if FNoZWrite <> val then
2385
procedure TGLPoints.SetStatic(const val: Boolean);
2387
if FStatic <> val then
2391
ObjectStyle := ObjectStyle - [osDirectDraw]
2393
ObjectStyle := ObjectStyle + [osDirectDraw];
2401
procedure TGLPoints.SetSize(const val: Single);
2403
if FSize <> val then
2413
procedure TGLPoints.SetPositions(const val: TAffineVectorList);
2415
FPositions.Assign(val);
2422
procedure TGLPoints.SetColors(const val: TVectorList);
2424
FColors.Assign(val);
2431
procedure TGLPoints.SetStyle(const val: TGLPointStyle);
2433
if FStyle <> val then
2440
// SetPointParameters
2443
procedure TGLPoints.SetPointParameters(const val: TGLPointParameters);
2445
FPointParameters.Assign(val);
2448
// ------------------
2449
// ------------------ TGLLineBase ------------------
2450
// ------------------
2455
constructor TGLLineBase.Create(AOwner: TComponent);
2457
inherited Create(AOwner);
2458
FLineColor := TGLColor.Create(Self);
2459
FLineColor.Initialize(clrWhite);
2460
FLinePattern := $FFFF;
2461
FAntiAliased := False;
2468
destructor TGLLineBase.Destroy;
2474
procedure TGLLineBase.NotifyChange(Sender: TObject);
2476
if Sender = FLineColor then
2484
procedure TGLLineBase.SetLineColor(const Value: TGLColor);
2486
FLineColor.Color := Value.Color;
2493
procedure TGLLineBase.SetLinePattern(const Value: TGLushort);
2495
if FLinePattern <> Value then
2497
FLinePattern := Value;
2505
procedure TGLLineBase.SetLineWidth(const val: Single);
2507
if FLineWidth <> val then
2517
function TGLLineBase.StoreLineWidth: Boolean;
2519
Result := (FLineWidth <> 1.0);
2525
procedure TGLLineBase.SetAntiAliased(const val: Boolean);
2527
if FAntiAliased <> val then
2529
FAntiAliased := val;
2537
procedure TGLLineBase.Assign(Source: TPersistent);
2539
if Source is TGLLineBase then
2541
LineColor := TGLLineBase(Source).FLineColor;
2542
LinePattern := TGLLineBase(Source).FLinePattern;
2543
LineWidth := TGLLineBase(Source).FLineWidth;
2544
AntiAliased := TGLLineBase(Source).FAntiAliased;
2546
inherited Assign(Source);
2552
procedure TGLLineBase.SetupLineStyle(var rci: TGLRenderContextInfo);
2554
with rci.GLStates do
2556
Disable(stLighting);
2557
if FLinePattern <> $FFFF then
2559
Enable(stLineStipple);
2561
SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
2562
LineStippleFactor := 1;
2563
LineStipplePattern := FLinePattern;
2566
Disable(stLineStipple);
2567
if FAntiAliased then
2569
Enable(stLineSmooth);
2571
SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
2574
Disable(stLineSmooth);
2575
LineWidth := FLineWidth;
2577
if FLineColor.Alpha <> 1 then
2579
if not FAntiAliased then
2582
SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
2584
GL.Color4fv(FLineColor.AsAddress);
2587
GL.Color3fv(FLineColor.AsAddress);
2592
// ------------------
2593
// ------------------ TGLLinesNode ------------------
2594
// ------------------
2599
constructor TGLLinesNode.Create(Collection: TCollection);
2601
inherited Create(Collection);
2602
FColor := TGLColor.Create(Self);
2603
FColor.Initialize((TGLLinesNodes(Collection).GetOwner as TGLLines)
2605
FColor.OnNotifyChange := OnColorChange;
2611
destructor TGLLinesNode.Destroy;
2620
procedure TGLLinesNode.Assign(Source: TPersistent);
2622
if Source is TGLLinesNode then
2623
FColor.Assign(TGLLinesNode(Source).FColor);
2630
procedure TGLLinesNode.SetColor(const val: TGLColor);
2638
procedure TGLLinesNode.OnColorChange(Sender: TObject);
2640
(Collection as TGLNodes).NotifyChange;
2646
function TGLLinesNode.StoreColor: Boolean;
2648
Result := not VectorEquals((TGLLinesNodes(Collection).GetOwner as TGLLines)
2649
.NodeColor.Color, FColor.Color);
2652
// ------------------
2653
// ------------------ TGLLinesNodes ------------------
2654
// ------------------
2659
constructor TGLLinesNodes.Create(AOwner: TComponent);
2661
inherited Create(AOwner, TGLLinesNode);
2667
procedure TGLLinesNodes.NotifyChange;
2669
if (GetOwner <> nil) then
2670
(GetOwner as TGLBaseSceneObject).StructureChanged;
2673
// ------------------
2674
// ------------------ TGLNodedLines ------------------
2675
// ------------------
2680
constructor TGLNodedLines.Create(AOwner: TComponent);
2682
inherited Create(AOwner);
2683
FNodes := TGLLinesNodes.Create(Self);
2684
FNodeColor := TGLColor.Create(Self);
2685
FNodeColor.Initialize(clrBlue);
2686
FNodeColor.OnNotifyChange := OnNodeColorChanged;
2687
FOldNodeColor := clrBlue;
2688
FNodesAspect := lnaAxes;
2695
destructor TGLNodedLines.Destroy;
2705
procedure TGLNodedLines.SetNodesAspect(const Value: TLineNodesAspect);
2707
if Value <> FNodesAspect then
2709
FNodesAspect := Value;
2717
procedure TGLNodedLines.SetNodeColor(const Value: TGLColor);
2719
FNodeColor.Color := Value.Color;
2723
// OnNodeColorChanged
2726
procedure TGLNodedLines.OnNodeColorChanged(Sender: TObject);
2730
// update color for nodes...
2731
for i := 0 to Nodes.Count - 1 do
2732
if VectorEquals(TGLLinesNode(Nodes[i]).Color.Color, FOldNodeColor) then
2733
TGLLinesNode(Nodes[i]).Color.Assign(FNodeColor);
2734
SetVector(FOldNodeColor, FNodeColor.Color);
2740
procedure TGLNodedLines.SetNodes(const aNodes: TGLLinesNodes);
2742
FNodes.Assign(aNodes);
2749
procedure TGLNodedLines.SetNodeSize(const val: Single);
2761
function TGLNodedLines.StoreNodeSize: Boolean;
2763
Result := FNodeSize <> 1;
2769
procedure TGLNodedLines.Assign(Source: TPersistent);
2771
if Source is TGLNodedLines then
2773
SetNodes(TGLNodedLines(Source).FNodes);
2774
FNodesAspect := TGLNodedLines(Source).FNodesAspect;
2775
FNodeColor.Color := TGLNodedLines(Source).FNodeColor.Color;
2776
FNodeSize := TGLNodedLines(Source).FNodeSize;
2778
inherited Assign(Source);
2784
procedure TGLNodedLines.DrawNode(var rci: TGLRenderContextInfo; X, Y, Z: Single;
2788
GL.Translatef(X, Y, Z);
2791
AxesBuildList(rci, $CCCC, FNodeSize * 0.5);
2793
CubeWireframeBuildList(rci, FNodeSize, False, Color.Color);
2796
if FNodeSize <> 1 then
2799
GL.Scalef(FNodeSize, FNodeSize, FNodeSize);
2800
rci.GLStates.SetGLMaterialColors(cmFront, clrBlack, clrGray20,
2801
Color.Color, clrBlack, 0);
2802
DodecahedronBuildList;
2807
rci.GLStates.SetGLMaterialColors(cmFront, clrBlack, clrGray20,
2808
Color.Color, clrBlack, 0);
2809
DodecahedronBuildList;
2818
// AxisAlignedDimensionsUnscaled
2821
function TGLNodedLines.AxisAlignedDimensionsUnscaled: TVector;
2826
for i := 0 to Nodes.Count - 1 do
2827
MaxVector(Result, VectorAbs(Nodes[i].AsVector));
2828
// EG: commented out, line below looks suspicious, since scale isn't taken
2829
// into account in previous loop, must have been hiding another bug... somewhere...
2830
// DivideVector(Result, Scale.AsVector); //DanB ?
2836
procedure TGLNodedLines.AddNode(const coords: TGLCoordinates);
2841
if Assigned(coords) then
2842
n.AsVector := coords.AsVector;
2849
procedure TGLNodedLines.AddNode(const X, Y, Z: TGLFloat);
2854
n.AsVector := VectorMake(X, Y, Z, 1);
2861
procedure TGLNodedLines.AddNode(const Value: TVector);
2866
n.AsVector := Value;
2870
// AddNode (affine vector)
2873
procedure TGLNodedLines.AddNode(const Value: TAffineVector);
2878
n.AsVector := VectorMake(Value);
2882
// ------------------
2883
// ------------------ TGLLines ------------------
2884
// ------------------
2889
constructor TGLLines.Create(AOwner: TComponent);
2891
inherited Create(AOwner);
2893
FSplineMode := lsmLines;
2894
FNURBSKnots := TSingleList.Create;
2896
FNURBSTolerance := 50;
2902
destructor TGLLines.Destroy;
2911
procedure TGLLines.SetDivision(const Value: Integer);
2913
if Value <> FDivision then
2926
procedure TGLLines.SetOptions(const val: TLinesOptions);
2935
procedure TGLLines.SetSplineMode(const val: TGLLineSplineMode);
2937
if FSplineMode <> val then
2947
procedure TGLLines.SetNURBSOrder(const val: Integer);
2949
if val <> FNURBSOrder then
2959
procedure TGLLines.SetNURBSTolerance(const val: Single);
2961
if val <> FNURBSTolerance then
2963
FNURBSTolerance := val;
2971
procedure TGLLines.Assign(Source: TPersistent);
2973
if Source is TGLLines then
2975
FDivision := TGLLines(Source).FDivision;
2976
FSplineMode := TGLLines(Source).FSplineMode;
2977
FOptions := TGLLines(Source).FOptions;
2979
inherited Assign(Source);
2985
procedure TGLLines.BuildList(var rci: TGLRenderContextInfo);
2990
Spline: TCubicSpline;
2991
vertexColor: TVector;
2992
nodeBuffer: array of TAffineVector;
2993
colorBuffer: array of TVector;
2994
nurbsRenderer: PGLUNurbs;
2996
if Nodes.Count > 1 then
2998
// first, we setup the line color & stippling styles
2999
SetupLineStyle(rci);
3000
if rci.bufferDepthTest then
3001
rci.GLStates.Enable(stDepthTest);
3002
if loColorLogicXor in Options then
3004
rci.GLStates.Enable(stColorLogicOp);
3005
rci.GLStates.LogicOpMode := loXOr;
3007
// Set up the control point buffer for Bezier splines and NURBS curves.
3008
// If required this could be optimized by storing a cached node buffer.
3009
if (FSplineMode = lsmBezierSpline) or (FSplineMode = lsmNURBSCurve) then
3011
SetLength(nodeBuffer, Nodes.Count);
3012
SetLength(colorBuffer, Nodes.Count);
3013
for i := 0 to Nodes.Count - 1 do
3014
with TGLLinesNode(Nodes[i]) do
3016
nodeBuffer[i] := AsAffineVector;
3017
colorBuffer[i] := Color.Color;
3021
if FSplineMode = lsmBezierSpline then
3024
rci.GLStates.PushAttrib([sttEval]);
3025
GL.Enable(GL_MAP1_VERTEX_3);
3026
GL.Enable(GL_MAP1_COLOR_4);
3028
GL.Map1f(GL_MAP1_VERTEX_3, 0, 1, 3, Nodes.Count, @nodeBuffer[0]);
3029
GL.Map1f(GL_MAP1_COLOR_4, 0, 1, 4, Nodes.Count, @colorBuffer[0]);
3032
// start drawing the line
3033
if (FSplineMode = lsmNURBSCurve) and (FDivision >= 2) then
3035
if (FNURBSOrder > 0) and (FNURBSKnots.Count > 0) then
3038
nurbsRenderer := gluNewNurbsRenderer;
3040
gluNurbsProperty(nurbsRenderer, GLU_SAMPLING_TOLERANCE,
3042
gluNurbsProperty(nurbsRenderer, GLU_DISPLAY_MODE, GLU_FILL);
3043
gluBeginCurve(nurbsRenderer);
3044
gluNurbsCurve(nurbsRenderer, FNURBSKnots.Count, @FNURBSKnots.List[0],
3045
3, @nodeBuffer[0], FNURBSOrder, GL_MAP1_VERTEX_3);
3046
gluEndCurve(nurbsRenderer);
3048
gluDeleteNurbsRenderer(nurbsRenderer);
3054
// lines, cubic splines or bezier
3055
if FSplineMode = lsmSegments then
3057
else if FSplineMode = lsmLoop then
3058
GL.Begin_(GL_LINE_LOOP)
3060
GL.Begin_(GL_LINE_STRIP);
3061
if (FDivision < 2) or (FSplineMode in [lsmLines, lsmSegments,
3064
// standard line(s), draw directly
3065
if loUseNodeColorForLines in Options then
3067
// node color interpolation
3068
for i := 0 to Nodes.Count - 1 do
3069
with TGLLinesNode(Nodes[i]) do
3071
GL.Color4fv(Color.AsAddress);
3072
GL.Vertex3f(X, Y, Z);
3078
for i := 0 to Nodes.Count - 1 do
3080
GL.Vertex3f(X, Y, Z);
3083
else if FSplineMode = lsmCubicSpline then
3086
Spline := Nodes.CreateNewCubicSpline;
3089
for i := 0 to (Nodes.Count - 1) * FDivision do
3091
Spline.SplineXYZ(i * f, A, B, C);
3092
if loUseNodeColorForLines in Options then
3094
n := (i div FDivision);
3095
if n < Nodes.Count - 1 then
3096
VectorLerp(TGLLinesNode(Nodes[n]).Color.Color,
3097
TGLLinesNode(Nodes[n + 1]).Color.Color, (i mod FDivision) * f,
3100
SetVector(vertexColor, TGLLinesNode(Nodes[Nodes.Count - 1])
3102
GL.Color4fv(@vertexColor);
3104
GL.Vertex3f(A, B, C);
3110
else if FSplineMode = lsmBezierSpline then
3113
for i := 0 to FDivision do
3114
GL.EvalCoord1f(i * f);
3118
rci.GLStates.Disable(stColorLogicOp);
3120
if FSplineMode = lsmBezierSpline then
3121
rci.GLStates.PopAttrib;
3122
if Length(nodeBuffer) > 0 then
3124
SetLength(nodeBuffer, 0);
3125
SetLength(colorBuffer, 0);
3128
if FNodesAspect <> lnaInvisible then
3130
if not rci.ignoreBlendingRequests then
3132
rci.GLStates.Enable(stBlend);
3133
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
3136
for i := 0 to Nodes.Count - 1 do
3137
with TGLLinesNode(Nodes[i]) do
3138
DrawNode(rci, X, Y, Z, Color);
3143
// ------------------
3144
// ------------------ TGLCube ------------------
3145
// ------------------
3150
constructor TGLCube.Create(AOwner: TComponent);
3152
inherited Create(AOwner);
3153
FCubeSize := XYZVector;
3154
FParts := [cpTop, cpBottom, cpFront, cpBack, cpLeft, cpRight];
3155
FNormalDirection := ndOutside;
3156
ObjectStyle := ObjectStyle + [osDirectDraw];
3162
procedure TGLCube.BuildList(var rci: TGLRenderContextInfo);
3164
hw, hh, hd, nd: TGLFloat;
3165
TanLoc, BinLoc: Integer;
3167
if FNormalDirection = ndInside then
3171
hw := FCubeSize.X * 0.5;
3172
hh := FCubeSize.Y * 0.5;
3173
hd := FCubeSize.Z * 0.5;
3177
if ARB_shader_objects and (rci.GLStates.CurrentProgram > 0) then
3179
TanLoc := GetAttribLocation(rci.GLStates.CurrentProgram, PGLChar(TangentAttributeName));
3180
BinLoc := GetAttribLocation(rci.GLStates.CurrentProgram, PGLChar(BinormalAttributeName));
3188
Begin_(GL_TRIANGLES);
3189
if cpFront in FParts then
3193
VertexAttrib3f(TanLoc, nd, 0, 0);
3195
VertexAttrib3f(BinLoc, 0, nd, 0);
3196
xgl.TexCoord2fv(@XYTexPoint);
3197
Vertex3f(hw, hh, hd);
3198
xgl.TexCoord2fv(@YTexPoint);
3199
Vertex3f(-hw * nd, hh * nd, hd);
3200
xgl.TexCoord2fv(@NullTexPoint);
3201
Vertex3f(-hw, -hh, hd);
3202
Vertex3f(-hw, -hh, hd);
3203
xgl.TexCoord2fv(@XTexPoint);
3204
Vertex3f(hw * nd, -hh * nd, hd);
3205
xgl.TexCoord2fv(@XYTexPoint);
3206
Vertex3f(hw, hh, hd);
3208
if cpBack in FParts then
3210
Normal3f(0, 0, -nd);
3212
VertexAttrib3f(TanLoc, -nd, 0, 0);
3214
VertexAttrib3f(BinLoc, 0, nd, 0);
3215
xgl.TexCoord2fv(@YTexPoint);
3216
Vertex3f(hw, hh, -hd);
3217
xgl.TexCoord2fv(@NullTexPoint);
3218
Vertex3f(hw * nd, -hh * nd, -hd);
3219
xgl.TexCoord2fv(@XTexPoint);
3220
Vertex3f(-hw, -hh, -hd);
3221
Vertex3f(-hw, -hh, -hd);
3222
xgl.TexCoord2fv(@XYTexPoint);
3223
Vertex3f(-hw * nd, hh * nd, -hd);
3224
xgl.TexCoord2fv(@YTexPoint);
3225
Vertex3f(hw, hh, -hd);
3227
if cpLeft in FParts then
3229
Normal3f(-nd, 0, 0);
3231
VertexAttrib3f(TanLoc, 0, 0, nd);
3233
VertexAttrib3f(BinLoc, 0, nd, 0);
3234
xgl.TexCoord2fv(@XYTexPoint);
3235
Vertex3f(-hw, hh, hd);
3236
xgl.TexCoord2fv(@YTexPoint);
3237
Vertex3f(-hw, hh * nd, -hd * nd);
3238
xgl.TexCoord2fv(@NullTexPoint);
3239
Vertex3f(-hw, -hh, -hd);
3240
Vertex3f(-hw, -hh, -hd);
3241
xgl.TexCoord2fv(@XTexPoint);
3242
Vertex3f(-hw, -hh * nd, hd * nd);
3243
xgl.TexCoord2fv(@XYTexPoint);
3244
Vertex3f(-hw, hh, hd);
3246
if cpRight in FParts then
3250
VertexAttrib3f(TanLoc, 0, 0, -nd);
3252
VertexAttrib3f(BinLoc, 0, nd, 0);
3253
xgl.TexCoord2fv(@YTexPoint);
3254
Vertex3f(hw, hh, hd);
3255
xgl.TexCoord2fv(@NullTexPoint);
3256
Vertex3f(hw, -hh * nd, hd * nd);
3257
xgl.TexCoord2fv(@XTexPoint);
3258
Vertex3f(hw, -hh, -hd);
3259
Vertex3f(hw, -hh, -hd);
3260
xgl.TexCoord2fv(@XYTexPoint);
3261
Vertex3f(hw, hh * nd, -hd * nd);
3262
xgl.TexCoord2fv(@YTexPoint);
3263
Vertex3f(hw, hh, hd);
3265
if cpTop in FParts then
3269
VertexAttrib3f(TanLoc, nd, 0, 0);
3271
VertexAttrib3f(BinLoc, 0, 0, -nd);
3272
xgl.TexCoord2fv(@YTexPoint);
3273
Vertex3f(-hw, hh, -hd);
3274
xgl.TexCoord2fv(@NullTexPoint);
3275
Vertex3f(-hw * nd, hh, hd * nd);
3276
xgl.TexCoord2fv(@XTexPoint);
3277
Vertex3f(hw, hh, hd);
3278
Vertex3f(hw, hh, hd);
3279
xgl.TexCoord2fv(@XYTexPoint);
3280
Vertex3f(hw * nd, hh, -hd * nd);
3281
xgl.TexCoord2fv(@YTexPoint);
3282
Vertex3f(-hw, hh, -hd);
3284
if cpBottom in FParts then
3286
Normal3f(0, -nd, 0);
3288
VertexAttrib3f(TanLoc, -nd, 0, 0);
3290
VertexAttrib3f(BinLoc, 0, 0, nd);
3291
xgl.TexCoord2fv(@NullTexPoint);
3292
Vertex3f(-hw, -hh, -hd);
3293
xgl.TexCoord2fv(@XTexPoint);
3294
Vertex3f(hw * nd, -hh, -hd * nd);
3295
xgl.TexCoord2fv(@XYTexPoint);
3296
Vertex3f(hw, -hh, hd);
3297
Vertex3f(hw, -hh, hd);
3298
xgl.TexCoord2fv(@YTexPoint);
3299
Vertex3f(-hw * nd, -hh, hd * nd);
3300
xgl.TexCoord2fv(@NullTexPoint);
3301
Vertex3f(-hw, -hh, -hd);
3307
// GenerateSilhouette
3310
function TGLCube.GenerateSilhouette(const silhouetteParameters
3311
: TGLSilhouetteParameters): TGLSilhouette;
3313
hw, hh, hd: TGLFloat;
3314
connectivity: TConnectivity;
3317
connectivity := TConnectivity.Create(True);
3319
hw := FCubeSize.X * 0.5;
3320
hh := FCubeSize.Y * 0.5;
3321
hd := FCubeSize.Z * 0.5;
3323
if cpFront in FParts then
3325
connectivity.AddQuad(AffineVectorMake(hw, hh, hd),
3326
AffineVectorMake(-hw, hh, hd), AffineVectorMake(-hw, -hh, hd),
3327
AffineVectorMake(hw, -hh, hd));
3329
if cpBack in FParts then
3331
connectivity.AddQuad(AffineVectorMake(hw, hh, -hd),
3332
AffineVectorMake(hw, -hh, -hd), AffineVectorMake(-hw, -hh, -hd),
3333
AffineVectorMake(-hw, hh, -hd));
3335
if cpLeft in FParts then
3337
connectivity.AddQuad(AffineVectorMake(-hw, hh, hd),
3338
AffineVectorMake(-hw, hh, -hd), AffineVectorMake(-hw, -hh, -hd),
3339
AffineVectorMake(-hw, -hh, hd));
3341
if cpRight in FParts then
3343
connectivity.AddQuad(AffineVectorMake(hw, hh, hd),
3344
AffineVectorMake(hw, -hh, hd), AffineVectorMake(hw, -hh, -hd),
3345
AffineVectorMake(hw, hh, -hd));
3347
if cpTop in FParts then
3349
connectivity.AddQuad(AffineVectorMake(-hw, hh, -hd),
3350
AffineVectorMake(-hw, hh, hd), AffineVectorMake(hw, hh, hd),
3351
AffineVectorMake(hw, hh, -hd));
3353
if cpBottom in FParts then
3355
connectivity.AddQuad(AffineVectorMake(-hw, -hh, -hd),
3356
AffineVectorMake(hw, -hh, -hd), AffineVectorMake(hw, -hh, hd),
3357
AffineVectorMake(-hw, -hh, hd));
3361
connectivity.CreateSilhouette(silhouetteParameters, sil, False);
3370
function TGLCube.GetCubeWHD(const Index: Integer): TGLFloat;
3372
Result := FCubeSize.V[index];
3378
procedure TGLCube.SetCubeWHD(Index: Integer; AValue: TGLFloat);
3380
if AValue <> FCubeSize.V[index] then
3382
FCubeSize.V[index] := AValue;
3390
procedure TGLCube.SetParts(aValue: TCubeParts);
3392
if aValue <> FParts then
3399
// SetNormalDirection
3402
procedure TGLCube.SetNormalDirection(aValue: TNormalDirection);
3404
if aValue <> FNormalDirection then
3406
FNormalDirection := aValue;
3414
procedure TGLCube.Assign(Source: TPersistent);
3416
if Assigned(Source) and (Source is TGLCube) then
3418
FCubeSize := TGLCube(Source).FCubeSize;
3419
FParts := TGLCube(Source).FParts;
3420
FNormalDirection := TGLCube(Source).FNormalDirection;
3422
inherited Assign(Source);
3425
// AxisAlignedDimensions
3428
function TGLCube.AxisAlignedDimensionsUnscaled: TVector;
3430
Result.X := FCubeSize.X * 0.5;
3431
Result.Y := FCubeSize.Y * 0.5;
3432
Result.Z := FCubeSize.Z * 0.5;
3439
function TGLCube.RayCastIntersect(const rayStart, rayVector: TVector;
3440
intersectPoint: PVector = nil; intersectNormal: PVector = nil): Boolean;
3442
p: array [0 .. 5] of TVector;
3447
eSize: TAffineVector;
3449
rs := AbsoluteToLocal(rayStart);
3450
SetVector(rv, VectorNormalize(AbsoluteToLocal(rayVector)));
3451
e := 0.5 + 0.0001; // Small value for floating point imprecisions
3452
eSize.X := FCubeSize.X * e;
3453
eSize.Y := FCubeSize.Y * e;
3454
eSize.Z := FCubeSize.Z * e;
3458
SetVector(p[3], -1, 0, 0);
3459
SetVector(p[4], 0, -1, 0);
3460
SetVector(p[5], 0, 0, -1);
3463
if VectorDotProduct(p[i], rv) > 0 then
3465
t := -(p[i].X * rs.X + p[i].Y * rs.Y +
3466
p[i].Z * rs.Z + 0.5 *
3467
FCubeSize.V[i mod 3]) / (p[i].X * rv.X +
3470
MakePoint(r, rs.V[0] + t * rv.X, rs.Y +
3473
if (Abs(r.X) <= eSize.X) and
3474
(Abs(r.Y) <= eSize.Y) and
3475
(Abs(r.Z) <= eSize.Z) and
3476
(VectorDotProduct(VectorSubtract(r, rs), rv) > 0) then
3478
if Assigned(intersectPoint) then
3479
MakePoint(intersectPoint^, LocalToAbsolute(r));
3480
if Assigned(intersectNormal) then
3481
MakeVector(intersectNormal^, LocalToAbsolute(VectorNegate(p[i])));
3493
procedure TGLCube.DefineProperties(Filer: TFiler);
3496
Filer.DefineBinaryProperty('CubeSize', ReadData, WriteData,3497
(FCubeSize.V[0] <> 1) or (FCubeSize.V[1] <> 1) or (FCubeSize.V[2] <> 1));
3503
procedure TGLCube.ReadData(Stream: TStream);
3507
Read(FCubeSize, SizeOf(TAffineVector));
3514
procedure TGLCube.WriteData(Stream: TStream);
3518
Write(FCubeSize, SizeOf(TAffineVector));
3522
// ------------------
3523
// ------------------ TGLQuadricObject ------------------
3524
// ------------------
3529
constructor TGLQuadricObject.Create(AOwner: TComponent);
3532
FNormals := nsSmooth;
3533
FNormalDirection := ndOutside;
3539
procedure TGLQuadricObject.SetNormals(aValue: TNormalSmoothing);
3541
if aValue <> FNormals then
3548
// SetNormalDirection
3551
procedure TGLQuadricObject.SetNormalDirection(aValue: TNormalDirection);
3553
if aValue <> FNormalDirection then
3555
FNormalDirection := aValue;
3560
// SetupQuadricParams
3563
procedure TGLQuadricObject.SetupQuadricParams(quadric: PGLUquadricObj);
3565
cNormalSmoothinToEnum: array [nsFlat .. nsNone] of TGLEnum = (GLU_FLAT,
3566
GLU_SMOOTH, GLU_NONE);
3568
gluQuadricDrawStyle(quadric, GLU_FILL);
3569
gluQuadricNormals(quadric, cNormalSmoothinToEnum[FNormals]);
3570
SetNormalQuadricOrientation(quadric);
3571
gluQuadricTexture(quadric, True);
3574
// SetNormalQuadricOrientation
3577
procedure TGLQuadricObject.SetNormalQuadricOrientation(quadric: PGLUquadricObj);
3579
cNormalDirectionToEnum: array [ndInside .. ndOutside] of TGLEnum =
3580
(GLU_INSIDE, GLU_OUTSIDE);
3582
gluQuadricOrientation(quadric, cNormalDirectionToEnum[FNormalDirection]);
3585
// SetInvertedQuadricOrientation
3588
procedure TGLQuadricObject.SetInvertedQuadricOrientation
3589
(quadric: PGLUquadricObj);
3591
cNormalDirectionToEnum: array [ndInside .. ndOutside] of TGLEnum =
3592
(GLU_OUTSIDE, GLU_INSIDE);
3594
gluQuadricOrientation(quadric, cNormalDirectionToEnum[FNormalDirection]);
3600
procedure TGLQuadricObject.Assign(Source: TPersistent);
3602
if Assigned(Source) and (Source is TGLQuadricObject) then
3604
FNormals := TGLQuadricObject(Source).FNormals;
3605
FNormalDirection := TGLQuadricObject(Source).FNormalDirection;
3607
inherited Assign(Source);
3610
// ------------------
3611
// ------------------ TGLSphere ------------------
3612
// ------------------
3617
constructor TGLSphere.Create(AOwner: TComponent);
3619
inherited Create(AOwner);
3632
procedure TGLSphere.BuildList(var rci: TGLRenderContextInfo);
3634
v1, V2, N1: TAffineVector;
3635
AngTop, AngBottom, AngStart, AngStop, StepV, StepH: Double;
3636
SinP, CosP, SinP2, CosP2, SinT, CosT, Phi, Phi2, Theta: Double;
3637
uTexCoord, uTexFactor, vTexFactor, vTexCoord0, vTexCoord1: Single;
3641
DoReverse := (FNormalDirection = ndInside);
3642
rci.GLStates.PushAttrib([sttPolygon]);
3644
rci.GLStates.InvertGLFrontFace;
3647
AngTop := DegToRad(1.0 * FTop);
3648
AngBottom := DegToRad(1.0 * FBottom);
3649
AngStart := DegToRad(1.0 * FStart);
3650
AngStop := DegToRad(1.0 * FStop);
3651
StepH := (AngStop - AngStart) / FSlices;
3652
StepV := (AngTop - AngBottom) / FStacks;
3654
GL.Scalef(Radius, Radius, Radius);
3657
if (FTop < 90) and (FTopCap in [ctCenter, ctFlat]) then
3659
GL.Begin_(GL_TRIANGLE_FAN);
3660
GLVectorGeometry.SinCos(AngTop, SinP, CosP);
3661
xgl.TexCoord2f(0.5, 0.5);
3663
GL.Normal3f(0, -1, 0)
3665
GL.Normal3f(0, 1, 0);
3666
if FTopCap = ctCenter then
3667
GL.Vertex3f(0, 0, 0)
3670
GL.Vertex3f(0, SinP, 0);
3673
N1.V[1] := -N1.V[1];
3677
for i := 0 to FSlices do
3679
GLVectorGeometry.SinCos(Theta, SinT, CosT);
3680
v1.V[0] := CosP * SinT;
3681
v1.V[2] := CosP * CosT;
3682
if FTopCap = ctCenter then
3684
N1 := VectorPerpendicular(YVector, v1);
3688
xgl.TexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
3691
Theta := Theta + StepH;
3698
Phi2 := Phi - StepV;
3699
uTexFactor := 1 / FSlices;
3700
vTexFactor := 1 / FStacks;
3702
for j := 0 to FStacks - 1 do
3705
GLVectorGeometry.SinCos(Phi, SinP, CosP);
3706
GLVectorGeometry.SinCos(Phi2, SinP2, CosP2);
3709
vTexCoord0 := 1 - j * vTexFactor;
3710
vTexCoord1 := 1 - (j + 1) * vTexFactor;
3712
GL.Begin_(GL_TRIANGLE_STRIP);
3713
for i := 0 to FSlices do
3716
SinCos(Theta, SinT, CosT);
3717
v1.V[0] := CosP * SinT;
3718
V2.V[0] := CosP2 * SinT;
3719
v1.V[2] := CosP * CosT;
3720
V2.V[2] := CosP2 * CosT;
3722
uTexCoord := i * uTexFactor;
3723
xgl.TexCoord2f(uTexCoord, vTexCoord0);
3726
N1 := VectorNegate(v1);
3733
xgl.TexCoord2f(uTexCoord, vTexCoord1);
3736
N1 := VectorNegate(V2);
3743
Theta := Theta + StepH;
3747
Phi2 := Phi2 - StepV;
3751
if (FBottom > -90) and (FBottomCap in [ctCenter, ctFlat]) then
3753
GL.Begin_(GL_TRIANGLE_FAN);
3754
SinCos(AngBottom, SinP, CosP);
3755
xgl.TexCoord2f(0.5, 0.5);
3757
GL.Normal3f(0, 1, 0)
3759
GL.Normal3f(0, -1, 0);
3760
if FBottomCap = ctCenter then
3761
GL.Vertex3f(0, 0, 0)
3764
GL.Vertex3f(0, SinP, 0);
3766
MakeVector(N1, 0, -1, 0)
3775
for i := 0 to FSlices do
3777
SinCos(Theta, SinT, CosT);
3778
v1.V[0] := CosP * SinT;
3779
v1.V[2] := CosP * CosT;
3780
if FBottomCap = ctCenter then
3782
N1 := VectorPerpendicular(AffineVectorMake(0, -1, 0), v1);
3786
xgl.TexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
3789
Theta := Theta - StepH;
3794
rci.GLStates.InvertGLFrontFace;
3796
rci.GLStates.PopAttrib;
3802
function TGLSphere.RayCastIntersect(const rayStart, rayVector: TVector;
3803
intersectPoint: PVector = nil; intersectNormal: PVector = nil): Boolean;
3806
localStart, localVector: TVector;
3808
// compute coefficients of quartic polynomial
3809
SetVector(localStart, AbsoluteToLocal(rayStart));
3810
SetVector(localVector, AbsoluteToLocal(rayVector));
3811
NormalizeVector(localVector);
3812
if RayCastSphereIntersect(localStart, localVector, NullHmgVector, Radius, i1,
3816
if Assigned(intersectPoint) then
3817
SetVector(intersectPoint^, LocalToAbsolute(i1));
3818
if Assigned(intersectNormal) then
3820
i1.V[3] := 0; // vector transform
3821
SetVector(intersectNormal^, LocalToAbsolute(i1));
3828
// GenerateSilhouette
3831
function TGLSphere.GenerateSilhouette(const silhouetteParameters
3832
: TGLSilhouetteParameters): TGLSilhouette;
3835
s, C, angleFactor: Single;
3836
sVec, tVec: TAffineVector;
3839
Segments := MaxInteger(FStacks, FSlices);
3841
// determine a local orthonormal matrix, viewer-oriented
3842
sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, XVector);
3843
if VectorLength(sVec) < 1E-3 then
3844
sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, YVector);
3845
tVec := VectorCrossProduct(silhouetteParameters.SeenFrom, sVec);
3846
NormalizeVector(sVec);
3847
NormalizeVector(tVec);
3848
// generate the silhouette (outline and capping)
3849
Result := TGLSilhouette.Create;
3850
angleFactor := (2 * PI) / Segments;
3851
for i := 0 to Segments - 1 do
3853
SinCos(i * angleFactor, FRadius, s, C);
3854
Result.vertices.AddPoint(VectorCombine(sVec, tVec, s, C));
3855
j := (i + 1) mod Segments;
3856
Result.Indices.Add(i, j);
3857
if silhouetteParameters.CappingRequired then
3858
Result.CapIndices.Add(Segments, i, j)
3860
if silhouetteParameters.CappingRequired then
3861
Result.vertices.Add(NullHmgPoint);
3867
procedure TGLSphere.SetBottom(aValue: TAngleLimit1);
3869
if FBottom <> aValue then
3879
procedure TGLSphere.SetBottomCap(aValue: TCapType);
3881
if FBottomCap <> aValue then
3883
FBottomCap := aValue;
3891
procedure TGLSphere.SetRadius(const aValue: TGLFloat);
3893
if aValue <> FRadius then
3903
procedure TGLSphere.SetSlices(aValue: Integer);
3905
if aValue <> FSlices then
3918
procedure TGLSphere.SetStacks(aValue: TGLInt);
3920
if aValue <> FStacks then
3933
procedure TGLSphere.SetStart(aValue: TAngleLimit2);
3935
if FStart <> aValue then
3937
Assert(aValue <= FStop);
3946
procedure TGLSphere.SetStop(aValue: TAngleLimit2);
3948
if FStop <> aValue then
3950
Assert(aValue >= FStart);
3959
procedure TGLSphere.SetTop(aValue: TAngleLimit1);
3961
if FTop <> aValue then
3971
procedure TGLSphere.SetTopCap(aValue: TCapType);
3973
if FTopCap <> aValue then
3983
procedure TGLSphere.Assign(Source: TPersistent);
3985
if Assigned(Source) and (Source is TGLSphere) then
3987
FRadius := TGLSphere(Source).FRadius;
3988
FSlices := TGLSphere(Source).FSlices;
3989
FStacks := TGLSphere(Source).FStacks;
3990
FBottom := TGLSphere(Source).FBottom;
3991
FTop := TGLSphere(Source).FTop;
3992
FStart := TGLSphere(Source).FStart;
3993
FStop := TGLSphere(Source).FStop;
3995
inherited Assign(Source);
3998
// AxisAlignedDimensions
4001
function TGLSphere.AxisAlignedDimensionsUnscaled: TVector;
4003
Result.V[0] := Abs(FRadius);
4004
Result.V[1] := Result.V[0];
4005
Result.V[2] := Result.V[0];
4009
// ------------------
4010
// ------------------ TGLPolygonBase ------------------
4011
// ------------------
4016
constructor TGLPolygonBase.Create(AOwner: TComponent);
4018
inherited Create(AOwner);
4021
FSplineMode := lsmLines;
4027
procedure TGLPolygonBase.CreateNodes;
4029
FNodes := TGLNodes.Create(Self);
4035
destructor TGLPolygonBase.Destroy;
4044
procedure TGLPolygonBase.Assign(Source: TPersistent);
4046
if Source is TGLPolygonBase then
4048
SetNodes(TGLPolygonBase(Source).FNodes);
4049
FDivision := TGLPolygonBase(Source).FDivision;
4050
FSplineMode := TGLPolygonBase(Source).FSplineMode;
4052
inherited Assign(Source);
4058
procedure TGLPolygonBase.NotifyChange(Sender: TObject);
4060
if Sender = Nodes then
4068
procedure TGLPolygonBase.SetDivision(const Value: Integer);
4070
if Value <> FDivision then
4083
procedure TGLPolygonBase.SetNodes(const aNodes: TGLNodes);
4085
FNodes.Assign(aNodes);
4092
procedure TGLPolygonBase.SetSplineMode(const val: TGLLineSplineMode);
4094
if FSplineMode <> val then
4104
procedure TGLPolygonBase.AddNode(const coords: TGLCoordinates);
4109
if Assigned(coords) then
4110
n.AsVector := coords.AsVector;
4117
procedure TGLPolygonBase.AddNode(const X, Y, Z: TGLFloat);
4122
n.AsVector := VectorMake(X, Y, Z, 1);
4129
procedure TGLPolygonBase.AddNode(const Value: TVector);
4134
n.AsVector := Value;
4138
// AddNode (affine vector)
4141
procedure TGLPolygonBase.AddNode(const Value: TAffineVector);
4146
n.AsVector := VectorMake(Value);
4150
// ------------------
4151
// ------------------ TGLSuperellipsoid ------------------
4152
// ------------------
4157
constructor TGLSuperellipsoid.Create(AOwner: TComponent);
4159
inherited Create(AOwner);
4174
procedure TGLSuperellipsoid.BuildList(var rci: TGLRenderContextInfo);
4176
CosPc1, SinPc1, CosTc2, SinTc2: Double;
4179
v1, v2, vs, N1: TAffineVector;
4180
AngTop, AngBottom, AngStart, AngStop, StepV, StepH: Double;
4181
SinP, CosP, SinP2, CosP2, SinT, CosT, Phi, Phi2, Theta: Double;
4182
uTexCoord, uTexFactor, vTexFactor, vTexCoord0, vTexCoord1: Double;
4187
DoReverse := (FNormalDirection = ndInside);
4189
rci.GLStates.InvertGLFrontFace;
4192
AngTop := DegToRad(1.0 * FTop);
4193
AngBottom := DegToRad(1.0 * FBottom);
4194
AngStart := DegToRad(1.0 * FStart);
4195
AngStop := DegToRad(1.0 * FStop);
4196
StepH := (AngStop - AngStart) / FSlices;
4197
StepV := (AngTop - AngBottom) / FStacks;
4199
{ Even integer used with the Power function, only produce positive points }4200
tc1 := trunc(xyCurve);
4201
tc2 := trunc(zCurve);
4202
if tc1 mod 2 = 0 then
4203
xyCurve := xyCurve + 1e-6;
4204
if tc2 mod 2 = 0 then
4205
zCurve := zCurve - 1e-6;
4208
if (FTop < 90) and (FTopCap in [ctCenter, ctFlat]) then
4210
GL.Begin_(GL_TRIANGLE_FAN);
4211
SinCos(AngTop, SinP, CosP);
4212
xgl.TexCoord2f(0.5, 0.5);
4214
GL.Normal3f(0, -1, 0)
4216
GL.Normal3f(0, 1, 0);
4218
if FTopCap = ctCenter then
4219
GL.Vertex3f(0, 0, 0)
4221
begin { FTopCap = ctFlat }4222
if (Sign(SinP) = 1) or (tc1 = xyCurve) then
4223
SinPc1 := Power(SinP, xyCurve)
4225
SinPc1 := -Power(-SinP, xyCurve);
4226
GL.Vertex3f(0, SinPc1*Radius, 0);
4231
end; { FTopCap = ctFlat }4234
if (Sign(SinP) = 1) or (tc1 = xyCurve) then
4235
SinPc1 := Power(SinP, xyCurve)
4237
SinPc1 := -Power(-SinP, xyCurve);
4242
for i := 0 to FSlices do
4244
SinCos(Theta, SinT, CosT);
4245
// v1.X := CosP * SinT;
4246
if (Sign(CosP) = 1) or (tc1 = xyCurve) then
4247
CosPc1 := Power(CosP, xyCurve)
4249
CosPc1 := -Power(-CosP, xyCurve);
4251
if (Sign(SinT) = 1) or (tc2 = zCurve) then
4252
SinTc2 := Power(SinT, zCurve)
4254
SinTc2 := -Power(-SinT, zCurve);
4255
v1.X := CosPc1 * SinTc2;
4257
// v1.Z := CosP * CosT;
4258
if (Sign(CosT) = 1) or (tc2 = zCurve) then
4259
CosTc2 := Power(CosT, zCurve)
4261
CosTc2 := -Power(-CosT, zCurve);
4262
v1.Z := CosPc1 * CosTc2;
4264
if FTopCap = ctCenter then
4266
N1 := VectorPerpendicular(YVector, v1);
4270
// xgl.TexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
4271
xgl.TexCoord2f(SinTc2 * 0.5 + 0.5, CosTc2 * 0.5 + 0.5);
4274
ScaleVector(vs, Radius);
4276
Theta := Theta + StepH;
4283
Phi2 := Phi - StepV;
4284
uTexFactor := 1 / FSlices;
4285
vTexFactor := 1 / FStacks;
4287
for j := 0 to FStacks - 1 do
4290
SinCos(Phi, SinP, CosP);
4291
SinCos(Phi2, SinP2, CosP2);
4293
if (Sign(SinP) = 1) or (tc1 = xyCurve) then
4294
SinPc1 := Power(SinP, xyCurve)
4296
SinPc1 := -Power(-SinP, xyCurve);
4299
if (Sign(SinP2) = 1) or (tc1 = xyCurve) then
4300
SinPc1 := Power(SinP2, xyCurve)
4302
SinPc1 := -Power(-SinP2, xyCurve);
4305
vTexCoord0 := 1 - j * vTexFactor;
4306
vTexCoord1 := 1 - (j + 1) * vTexFactor;
4308
GL.Begin_(GL_TRIANGLE_STRIP);
4309
for i := 0 to FSlices do
4311
SinCos(Theta, SinT, CosT);
4313
if (Sign(CosP) = 1) or (tc1 = xyCurve) then
4314
CosPc1 := Power(CosP, xyCurve)
4316
CosPc1 := -Power(-CosP, xyCurve);
4318
if (Sign(SinT) = 1) or (tc2 = zCurve) then
4319
SinTc2 := Power(SinT, zCurve)
4321
SinTc2 := -Power(-SinT, zCurve);
4322
v1.X := CosPc1 * SinTc2;
4324
if (Sign(CosP2) = 1) or (tc1 = xyCurve) then
4325
CosPc1 := Power(CosP2, xyCurve)
4327
CosPc1 := -Power(-CosP2, xyCurve);
4328
V2.X := CosPc1 * SinTc2;
4330
if (Sign(CosP) = 1) or (tc1 = xyCurve) then
4331
CosPc1 := Power(CosP, xyCurve)
4333
CosPc1 := -Power(-CosP, xyCurve);
4335
if (Sign(CosT) = 1) or (tc2 = zCurve) then
4336
CosTc2 := Power(CosT, zCurve)
4338
CosTc2 := -Power(-CosT, zCurve);
4339
v1.Z := CosPc1 * CosTc2;
4341
if (Sign(CosP2) = 1) or (tc1 = xyCurve) then
4342
CosPc1 := Power(CosP2, xyCurve)
4344
CosPc1 := -Power(-CosP2, xyCurve);
4345
V2.Z := CosPc1 * CosTc2;
4347
uTexCoord := i * uTexFactor;
4348
xgl.TexCoord2f(uTexCoord, vTexCoord0);
4351
N1 := VectorNegate(v1);
4357
ScaleVector(vs, Radius);
4360
xgl.TexCoord2f(uTexCoord, vTexCoord1);
4363
N1 := VectorNegate(V2);
4369
ScaleVector(vs, Radius);
4372
Theta := Theta + StepH;
4376
Phi2 := Phi2 - StepV;
4380
if (FBottom > -90) and (FBottomCap in [ctCenter, ctFlat]) then
4382
GL.Begin_(GL_TRIANGLE_FAN);
4383
SinCos(AngBottom, SinP, CosP);
4384
xgl.TexCoord2f(0.5, 0.5);
4386
GL.Normal3f(0, 1, 0)
4388
GL.Normal3f(0, -1, 0);
4389
if FBottomCap = ctCenter then
4390
GL.Vertex3f(0, 0, 0)
4392
begin { FTopCap = ctFlat }4393
if (Sign(SinP) = 1) or (tc1 = xyCurve) then
4394
SinPc1 := Power(SinP, xyCurve)
4396
SinPc1 := -Power(-SinP, xyCurve);
4397
GL.Vertex3f(0, SinPc1*Radius, 0);
4400
MakeVector(N1, 0, -1, 0)
4405
if (Sign(SinP) = 1) or (tc1 = xyCurve) then
4406
SinPc1 := Power(SinP, xyCurve)
4408
SinPc1 := -Power(-SinP, xyCurve);
4412
for i := 0 to FSlices do
4414
SinCos(Theta, SinT, CosT);
4415
// v1.X := CosP * SinT;
4416
if (Sign(CosP) = 1) or (tc1 = xyCurve) then
4417
CosPc1 := Power(CosP, xyCurve)
4419
CosPc1 := -Power(-CosP, xyCurve);
4421
if (Sign(SinT) = 1) or (tc2 = zCurve) then
4422
SinTc2 := Power(SinT, zCurve)
4424
SinTc2 := -Power(-SinT, zCurve);
4425
v1.X := CosPc1 * SinTc2;
4427
// v1.Z := CosP * CosT;
4428
if (Sign(CosT) = 1) or (tc2 = zCurve) then
4429
CosTc2 := Power(CosT, zCurve)
4431
CosTc2 := -Power(-CosT, zCurve);
4432
v1.Z := CosPc1 * CosTc2;
4434
if FBottomCap = ctCenter then
4436
N1 := VectorPerpendicular(AffineVectorMake(0, -1, 0), v1);
4441
// xgl.TexCoord2f(SinT * 0.5 + 0.5, CosT * 0.5 + 0.5);
4442
xgl.TexCoord2f(SinTc2 * 0.5 + 0.5, CosTc2 * 0.5 + 0.5);
4444
ScaleVector(vs, Radius);
4446
Theta := Theta - StepH;
4451
rci.GLStates.InvertGLFrontFace;
4455
// This will probably not work, karamba
4456
// RayCastSphereIntersect -> RayCastSuperellipsoidIntersect ??????
4458
function TGLSuperellipsoid.RayCastIntersect(const rayStart, rayVector: TVector;
4459
intersectPoint: PVector = nil; intersectNormal: PVector = nil): Boolean;
4462
localStart, localVector: TVector;
4464
// compute coefficients of quartic polynomial
4465
SetVector(localStart, AbsoluteToLocal(rayStart));
4466
SetVector(localVector, AbsoluteToLocal(rayVector));
4467
NormalizeVector(localVector);
4468
if RayCastSphereIntersect(localStart, localVector, NullHmgVector, Radius, i1,
4472
if Assigned(intersectPoint) then
4473
SetVector(intersectPoint^, LocalToAbsolute(i1));
4474
if Assigned(intersectNormal) then
4476
i1.W := 0; // vector transform
4477
SetVector(intersectNormal^, LocalToAbsolute(i1));
4484
// GenerateSilhouette
4485
// This will probably not work;
4487
function TGLSuperellipsoid.GenerateSilhouette(const silhouetteParameters
4488
: TGLSilhouetteParameters): TGLSilhouette;
4491
s, C, angleFactor: Single;
4492
sVec, tVec: TAffineVector;
4495
Segments := MaxInteger(FStacks, FSlices);
4497
// determine a local orthonormal matrix, viewer-oriented
4498
sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, XVector);
4499
if VectorLength(sVec) < 1E-3 then
4500
sVec := VectorCrossProduct(silhouetteParameters.SeenFrom, YVector);
4501
tVec := VectorCrossProduct(silhouetteParameters.SeenFrom, sVec);
4502
NormalizeVector(sVec);
4503
NormalizeVector(tVec);
4504
// generate the silhouette (outline and capping)
4505
Result := TGLSilhouette.Create;
4506
angleFactor := (2 * PI) / Segments;
4507
for i := 0 to Segments - 1 do
4509
SinCos(i * angleFactor, FRadius, s, C);
4510
Result.vertices.AddPoint(VectorCombine(sVec, tVec, s, C));
4511
j := (i + 1) mod Segments;
4512
Result.Indices.Add(i, j);
4513
if silhouetteParameters.CappingRequired then
4514
Result.CapIndices.Add(Segments, i, j)
4516
if silhouetteParameters.CappingRequired then
4517
Result.vertices.Add(NullHmgPoint);
4523
procedure TGLSuperellipsoid.SetBottom(aValue: TAngleLimit1);
4525
if FBottom <> aValue then
4535
procedure TGLSuperellipsoid.SetBottomCap(aValue: TCapType);
4537
if FBottomCap <> aValue then
4539
FBottomCap := aValue;
4547
procedure TGLSuperellipsoid.SetRadius(const aValue: TGLFloat);
4549
if aValue <> FRadius then
4559
procedure TGLSuperellipsoid.SetxyCurve(const aValue: TGLFloat);
4561
if aValue <> FxyCurve then
4571
procedure TGLSuperellipsoid.SetzCurve(const aValue: TGLFloat);
4573
if aValue <> FzCurve then
4583
procedure TGLSuperellipsoid.SetSlices(aValue: Integer);
4585
if aValue <> FSlices then
4598
procedure TGLSuperellipsoid.SetStacks(aValue: TGLInt);
4600
if aValue <> FStacks then
4613
procedure TGLSuperellipsoid.SetStart(aValue: TAngleLimit2);
4615
if FStart <> aValue then
4617
Assert(aValue <= FStop);
4626
procedure TGLSuperellipsoid.SetStop(aValue: TAngleLimit2);
4628
if FStop <> aValue then
4630
Assert(aValue >= FStart);
4639
procedure TGLSuperellipsoid.SetTop(aValue: TAngleLimit1);
4641
if FTop <> aValue then
4651
procedure TGLSuperellipsoid.SetTopCap(aValue: TCapType);
4653
if FTopCap <> aValue then
4663
procedure TGLSuperellipsoid.Assign(Source: TPersistent);
4665
if Assigned(Source) and (Source is TGLSuperellipsoid) then
4667
FRadius := TGLSuperellipsoid(Source).FRadius;
4668
FSlices := TGLSuperellipsoid(Source).FSlices;
4669
FStacks := TGLSuperellipsoid(Source).FStacks;
4670
FBottom := TGLSuperellipsoid(Source).FBottom;
4671
FTop := TGLSuperellipsoid(Source).FTop;
4672
FStart := TGLSuperellipsoid(Source).FStart;
4673
FStop := TGLSuperellipsoid(Source).FStop;
4675
inherited Assign(Source);
4678
// AxisAlignedDimensions
4681
function TGLSuperellipsoid.AxisAlignedDimensionsUnscaled: TVector;
4683
Result.X := Abs(FRadius);
4684
Result.Y := Result.X;
4685
Result.Z := Result.X;
4689
// -------------------------------------------------------------
4690
// -------------------------------------------------------------
4691
// -------------------------------------------------------------
4695
// -------------------------------------------------------------
4696
// -------------------------------------------------------------
4697
// -------------------------------------------------------------
4699
RegisterClasses([TGLSphere, TGLCube, TGLPlane, TGLSprite, TGLPoints,
4700
TGLDummyCube, TGLLines, TGLSuperellipsoid]);