LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Implements a basic Canvas-like interface over for OpenGL.
6
   This class can be used for generic OpenGL applications and has no dependencies
7
   to the GLScene core units (only to base units).
8

9
  History :  
10
       10/11/12 - PW - Added CPP compatibility: changed vector arrays to records,
11
                          Replaced direct access to PenAlpha property with GetPenAlpha method
12
       05/02/11 - Yar - Now PenColor setter always direct set color
13
       03/10/10 - Yar - Added RoundRect (thanks eric129)
14
       21/09/10 - Yar - Added Arc, ArcTo (thanks µAlexx)
15
       03/09/10 - Yar - Added FillRectGradient, FillEllipseGradient (thanks µAlexx)
16
       23/08/10 - Yar - Replaced OpenGL1x functions to OpenGLAdapter
17
       04/04/10 - Yar - Fixes after GLState revision
18
       07/11/09 - DaStr - Some cosmetic fixes. Overloaded TGLCanvas.EllipseBB(),
19
                             TGLCanvas.Ellipse(), TGLCanvas.FillEllipse()
20
       31/07/07 - DaStr - Added missing StopPrimitive call to TGLCanvas.FillRect
21
                             (Bugtracker ID = 1775528)
22
       06/06/07 - DaStr - Removed ConvertColorVector and ConvertWinColor (now in GLColor.pas)
23
                             Added GLColor to uses (BugtrackerID = 1732211)
24
                             Removed TColor declaration (now in GLCrossPlatform.pas)
25
       02/08/04 - LR, YHC - BCB corrections: used record instead array
26
                               Replaced direct access of some properties by a getter and a setter
27
       08/07/04 - LR - Replace Graphics and TPoint by GLCrossPlatform for Linux
28
       13/01/04 - EG - Polyline/Polygon fix
29
       07/05/03 - EG - SetPenWidth now correctly stops the primitive
30
       08/01/03 - EG - StopPrimitive now public
31
       09/12/02 - EG - Now properly disables fog
32
       20/11/02 - EG - Now uses Types/Windows TPoint (D5 & D6 tested only)
33
       01/10/02 - EG - Added Polygon & Polyline
34
       04/03/02 - EG - Added FrameRect and FillRect
35
       31/01/02 - EG - Texture3D/CubeMap only disabled if supported
36
       24/01/02 - EG - Added PenAlpha
37
       19/01/02 - EG - Creation
38
  
39
}
40
unit GLCanvas;
41

42
interface
43

44
{$I GLScene.inc}
45

46
uses
47
  Classes,
48
  Graphics,
49
  GLVectorGeometry,
50
  GLColor,
51
  GLCrossPlatform,
52
  GLState;
53

54
type
55

56
  TArcDirection = (adCounterClockWise, adClockWise);
57

58
  // TGLCanvas
59
  //
60
    { A simple Canvas-like interface for OpenGL.
61
       This class implements a small "shell" for 2D operations in OpenGL,
62
       it operates over the current OpenGL context and provides methods
63
       for drawing lines, ellipses and points. 
64
       This class is typically used by creating an instance, using it for drawing,
65
       and freeing the instance. When drawing (0, 0) is the top left corner. 
66
       All coordinates are internally maintained with floating point precision.
67
       Several states are cached and it is of primary importance not to invoke
68
       OpenGL directly throughout the life of an instance (at the cost of
69
       unespected behaviour). }
70
  TGLCanvas = class
71
  private
72
     
73
    FBufferSizeX, FBufferSizeY: Integer;
74

75
    FLastPrimitive: Integer;
76
    FCurrentPos: TAffineVector;
77
    FPenColor: TColor;
78
    FPenWidth: Integer;
79
    FCurrentPenColorVector: TVector;
80
    FArcDirection: TArcDirection;
81
  protected
82
     
83
    procedure BackupOpenGLStates;
84

85
    procedure StartPrimitive(const primitiveType: Integer);
86

87
    procedure EllipseVertices(x, y, xRadius, yRadius: Single);
88

89
    procedure SetPenColor(const val: TColor);
90

91
    function GetPenAlpha: Single;
92
    procedure SetPenAlpha(const val: Single);
93
    procedure SetPenWidth(const val: Integer);
94

95
    procedure SwapSingle(pX, pY: PSingle);
96
    procedure NormalizePoint(const x1, y1, x2, y2: Single;
97
      const x, y: Single; pX, pY: PSingle);
98

99
    procedure DrawArc(x1, y1, x2, y2, x3, y3, x4, y4: Single;
100
      UpdateCurrentPos: Boolean); overload;
101
    procedure DrawArc(x1, y1, x2, y2: Single;
102
      AngleBegin, AngleEnd: Single;
103
      UpdateCurrentPos: Boolean); overload;
104
  public
105
     
106
    constructor Create(bufferSizeX, bufferSizeY: Integer;
107
      const baseTransform: TMatrix); overload;
108
    constructor Create(bufferSizeX, bufferSizeY: Integer); overload;
109
    destructor Destroy; override;
110

111
    { Stops the current internal primitive.
112
       This function is invoked automatically by TGLCanvas when changeing
113
       primitives, you should directly call if you want to render your
114
       own stuff intertwined with TGLCanvas drawings. In that case, call
115
       it before your own OpenGL calls. }
116
    procedure StopPrimitive;
117

118
    { Inverts the orientation of the Y Axis.
119
       If (0, 0) was in the top left corner, it will move to the bottom
120
       left corner or vice-versa. }
121
    procedure InvertYAxis;
122

123
    property CanvasSizeX: Integer read FBufferSizeX;
124
    property CanvasSizeY: Integer read FBufferSizeY;
125

126
    { Current Pen Color. }
127
    property PenColor: TColor read FPenColor write SetPenColor;
128
    { Current Pen Alpha channel (from 0.0 to 1.0) }
129
    property PenAlpha : Single read GetPenAlpha write SetPenAlpha;
130
    { Current Pen Width. }
131
    property PenWidth: Integer read FPenWidth write SetPenWidth;
132

133
    { Updates the current position (absolute coords). }
134
    procedure MoveTo(const x, y: Integer); overload;
135
    procedure MoveTo(const x, y: Single); overload;
136
    { Updates the current position (relative coords). }
137
    procedure MoveToRel(const x, y: Integer); overload;
138
    procedure MoveToRel(const x, y: Single); overload;
139

140
    { Draws a line from current position to given coordinate.
141
       Current position is updated. }
142
    procedure LineTo(const x, y: Integer); overload;
143
    procedure LineTo(const x, y: Single); overload;
144
    procedure LineToRel(const x, y: Integer); overload;
145
    procedure LineToRel(const x, y: Single); overload;
146
    { Draws a line from (x1, y1) to (x2, y2).
147
       The current position is NOT updated. }
148
    procedure Line(const x1, y1, x2, y2: Integer); overload;
149
    procedure Line(const x1, y1, x2, y2: Single); overload;
150

151
    { Draws the set of lines defined by connecting the points.
152
       Similar to invoking MoveTo on the first point, then LineTo
153
       on all the following points. }
154
    procedure Polyline(const points: array of TGLPoint);
155
    { Similar to Polyline but also connects the last point to the first. }
156
    procedure Polygon(const points: array of TGLPoint);
157

158
    { Plots a pixel at given coordinate.
159
       PenWidth affects pixel size. 
160
       The current position is NOT updated. }
161
    procedure PlotPixel(const x, y: Integer); overload;
162
    procedure PlotPixel(const x, y: Single); overload;
163

164
    { Draw the (x1,y1)-(x2, y2) rectangle's frame (border). }
165
    procedure FrameRect(const x1, y1, x2, y2: Integer); overload;
166
    procedure FrameRect(const x1, y1, x2, y2: Single); overload;
167

168
    { Draw the (x1,y1)-(x2, y2) rectangle (filled with PenColor). }
169
    procedure FillRect(const x1, y1, x2, y2: Integer); overload;
170
    procedure FillRect(const x1, y1, x2, y2: Single); overload;
171

172
    { Draw the (x1,y1)-(x2, y2) rectangle (filled with given gradient's color). }
173
    procedure FillRectGradient(const x1, y1, x2, y2: Single;
174
      const x1y1Color, x2y1Color, x2y2Color, x1y2Color: TColorVector); overload;
175
    procedure FillRectGradient(const x1, y1, x2, y2: Integer;
176
      const x1y1Color, x2y1Color, x2y2Color, x1y2Color: TColorVector); overload;
177

178
    { Draws an ellipse with (x1,y1)-(x2, y2) bounding rectangle. }
179
    procedure EllipseBB(const x1, y1, x2, y2: Integer); overload;
180
    procedure EllipseBB(const x1, y1, x2, y2: Single); overload;
181

182
    { Draws and ellipse centered at (x, y) with given radiuses. }
183
    procedure Ellipse(const x, y: Integer; const xRadius, yRadius: Single);
184
      overload;
185
    procedure Ellipse(const x, y: Single; const xRadius, yRadius: Single);
186
      overload;
187
    procedure Ellipse(const x, y: Single; const Radius: Single); overload;
188

189
    { Draw a filled ellipse. }
190
    procedure FillEllipse(const x, y: Integer; const xRadius, yRadius: Single);
191
      overload;
192
    procedure FillEllipse(const x, y: Single; const xRadius, yRadius: Single);
193
      overload;
194

195
    procedure FillEllipse(const x, y: Single; const Radius: Single); overload;
196

197
    { Draw a filled gradient ellipse.
198
    OpenGL will use the last PenColor and PenAlpha as the center color and do gradient to edge of ellipse using the edgeColor parameter. }
199
    procedure FillEllipseGradient(const x, y, xRadius, yRadius: Single;
200
      const edgeColor: TColorVector); overload;
201
    procedure FillEllipseGradient(const x, y: Integer;
202
      const xRadius, yRadius: Integer; const edgeColor: TColorVector); overload;
203
    procedure FillEllipseGradient(const x, y, Radius: Single;
204
      const edgeColor: TColorVector); overload;
205
    { Draw an elliptical arc.
206
       The points (x1, y1) and (x2, y2) specify the bounding rectangle.
207
       An ellipse formed by the specified bounding rectangle defines the curve of the arc.
208
       The arc extends in the current drawing direction from the point where it intersects the radial from the center of the bounding rectangle to the (x3, y3) point.
209
       The arc ends where it intersects the radial from the center of the bounding rectangle to the (x4, y4) point.
210
       If the starting point and ending point are the same, a complete ellipse is drawn.
211
       Use the ArcDirection property to get and set the current drawing direction for a device context.
212
       The default drawing direction is counterclockwise. }
213
    procedure Arc(const x1, y1, x2, y2, x3, y3, x4, y4: Integer); overload;
214
    procedure Arc(const x1, y1, x2, y2, x3, y3, x4, y4: Single); overload;
215
    procedure Arc(const x1, y1, x2, y2: Single; AngleBegin,
216
      AngleEnd: Single); overload;
217

218
    { Same as Arc but update the current position. }
219
    procedure ArcTo(const x1, y1, x2, y2, x3, y3, x4, y4: Integer); overload;
220
    procedure ArcTo(const x1, y1, x2, y2, x3, y3, x4, y4: Single); overload;
221
    procedure ArcTo(const x1, y1, x2, y2: Single; AngleBegin,
222
      AngleEnd: Single); overload;
223

224
    procedure RoundRect(const x1, y1, x2, y2, xr, yr: Integer); overload;
225
    procedure RoundRect(const x1, y1, x2, y2, xr, yr: Single); overload;
226

227

228
    property ArcDirection: TArcDirection read FArcDirection
229
      write FArcDirection;
230
  end;
231

232
  //-------------------------------------------------------------
233
  //-------------------------------------------------------------
234
  //-------------------------------------------------------------
235
implementation
236
//-------------------------------------------------------------
237
//-------------------------------------------------------------
238
//-------------------------------------------------------------
239

240
uses
241
  OpenGLTokens,
242
  GLContext,
243
  GLVectorTypes;
244

245
const
246
  cNoPrimitive = MaxInt;
247
  pion2 = pi/2;
248
  pi3on2 = 3*pion2;
249

250
  // ------------------
251
  // ------------------ TGLCanvas ------------------
252
  // ------------------
253

254
  // Create
255
  //
256

257
constructor TGLCanvas.Create(bufferSizeX, bufferSizeY: Integer;
258
  const baseTransform: TMatrix);
259
var
260
  PM: TMatrix;
261
begin
262
  FBufferSizeX := bufferSizeX;
263
  FBufferSizeY := bufferSizeY;
264

265
  GL.MatrixMode(GL_PROJECTION);
266
  GL.PushMatrix;
267
  PM := CreateOrthoMatrix(0, bufferSizeX, bufferSizeY, 0, -1, 1);
268
  GL.LoadMatrixf(@PM);
269

270
  GL.MatrixMode(GL_MODELVIEW);
271
  GL.PushMatrix;
272
  GL.LoadMatrixf(@baseTransform);
273

274
  BackupOpenGLStates;
275

276
  FLastPrimitive := cNoPrimitive;
277
  FArcDirection := adCounterClockWise;
278
end;
279

280
// Create
281
//
282

283
constructor TGLCanvas.Create(bufferSizeX, bufferSizeY: Integer);
284
begin
285
  Create(bufferSizeX, bufferSizeY, IdentityHmgMatrix);
286
end;
287

288
// Destroy
289
//
290

291
destructor TGLCanvas.Destroy;
292
begin
293
  StopPrimitive;
294

295
  GL.MatrixMode(GL_PROJECTION);
296
  GL.PopMatrix;
297

298
  GL.MatrixMode(GL_MODELVIEW);
299
  GL.PopMatrix;
300
end;
301

302
// BackupOpenGLStates
303
//
304

305
procedure TGLCanvas.BackupOpenGLStates;
306
begin
307
  with CurrentGLContext.GLStates do
308
  begin
309
    Disable(stLighting);
310
    Disable(stFog);
311
    Disable(stCullFace);
312
    Disable(stColorMaterial);
313
    Disable(stDepthTest);
314
    Disable(stLineSmooth);
315
    Disable(stLineStipple);
316
    Disable(stPointSmooth);
317
    Enable(stBlend);
318
    SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
319

320
    // Setup and backup pen stuff
321
    FPenColor := clBlack;
322
    SetVector(FCurrentPenColorVector, NullHmgPoint);
323
    GL.Color4fv(@FCurrentPenColorVector);
324
    FPenWidth := 1;
325
    LineWidth := 1;
326
    PointSize := 1;
327
  end;
328
end;
329

330
// StartPrimitive
331
//
332

333
procedure TGLCanvas.StartPrimitive(const primitiveType: Integer);
334
begin
335
  if primitiveType <> FLastPrimitive then
336
  begin
337
    if FLastPrimitive <> cNoPrimitive then
338
      GL.End_;
339
    if primitiveType <> cNoPrimitive then
340
      GL.Begin_(primitiveType);
341
    FLastPrimitive := primitiveType;
342
  end;
343
end;
344

345
// StopPrimitive
346
//
347

348
procedure TGLCanvas.StopPrimitive;
349
begin
350
  StartPrimitive(cNoPrimitive);
351
end;
352

353
// InvertYAxis
354
//
355

356
procedure TGLCanvas.InvertYAxis;
357
var
358
  mat: TMatrix;
359
begin
360
  mat := IdentityHmgMatrix;
361
  mat.V[1].V[1] := -1;
362
  mat.V[3].V[1] := FBufferSizeY;
363
  GL.MultMatrixf(@mat);
364
end;
365

366
// SetPenColor
367
//
368

369
procedure TGLCanvas.SetPenColor(const val: TColor);
370
begin
371
  SetVector(FCurrentPenColorVector, ConvertWinColor(val,
372
    FCurrentPenColorVector.V[3]));
373
  FPenColor := val;
374
  GL.Color4fv(@FCurrentPenColorVector);
375
end;
376

377
// SetPenAlpha
378
//
379

380
procedure TGLCanvas.SetPenAlpha(const val: Single);
381
begin
382
  FCurrentPenColorVector.V[3] := val;
383
  GL.Color4fv(@FCurrentPenColorVector);
384
end;
385

386
// SetPenWidth
387
//
388

389
procedure TGLCanvas.SetPenWidth(const val: Integer);
390
begin
391
  if val < 1 then
392
    Exit;
393
  if val <> FPenWidth then
394
    with CurrentGLContext.GLStates do
395
    begin
396
      FPenWidth := val;
397
      StopPrimitive;
398
      LineWidth := val;
399
      PointSize := val;
400
    end;
401
end;
402

403
// MoveTo
404
//
405

406
procedure TGLCanvas.MoveTo(const x, y: Integer);
407
begin
408
  FCurrentPos.V[0] := x;
409
  FCurrentPos.V[1] := y;
410
end;
411

412
// MoveTo
413
//
414

415
procedure TGLCanvas.MoveTo(const x, y: Single);
416
begin
417
  FCurrentPos.V[0] := x;
418
  FCurrentPos.V[1] := y;
419
end;
420

421
// MoveToRel
422
//
423

424
procedure TGLCanvas.MoveToRel(const x, y: Integer);
425
begin
426
  FCurrentPos.V[0] := FCurrentPos.V[0] + x;
427
  FCurrentPos.V[1] := FCurrentPos.V[1] + y;
428
end;
429

430
// MoveToRel
431
//
432

433
procedure TGLCanvas.MoveToRel(const x, y: Single);
434
begin
435
  FCurrentPos.V[0] := FCurrentPos.V[0] + x;
436
  FCurrentPos.V[1] := FCurrentPos.V[1] + y;
437
end;
438

439
// LineTo
440
//
441

442
procedure TGLCanvas.LineTo(const x, y: Integer);
443
begin
444
  StartPrimitive(GL_LINES);
445
  GL.Vertex2fv(@FCurrentPos);
446
  MoveTo(x, y);
447
  GL.Vertex2fv(@FCurrentPos);
448
end;
449

450
// LineTo
451
//
452

453
procedure TGLCanvas.LineTo(const x, y: Single);
454
begin
455
  StartPrimitive(GL_LINES);
456
  GL.Vertex2fv(@FCurrentPos);
457
  MoveTo(x, y);
458
  GL.Vertex2fv(@FCurrentPos);
459
end;
460

461
// LineToRel
462
//
463

464
procedure TGLCanvas.LineToRel(const x, y: Integer);
465
begin
466
  LineTo(FCurrentPos.V[0] + x, FCurrentPos.V[1] + y);
467
end;
468

469
// LineToRel
470
//
471

472
procedure TGLCanvas.LineToRel(const x, y: Single);
473
begin
474
  LineTo(FCurrentPos.V[0] + x, FCurrentPos.V[1] + y);
475
end;
476

477
// Line
478
//
479

480
procedure TGLCanvas.Line(const x1, y1, x2, y2: Integer);
481
begin
482
  StartPrimitive(GL_LINES);
483
  GL.Vertex2i(x1, y1);
484
  GL.Vertex2i(x2, y2);
485
end;
486

487
// Line
488
//
489

490
procedure TGLCanvas.Line(const x1, y1, x2, y2: Single);
491
begin
492
  StartPrimitive(GL_LINES);
493
  GL.Vertex2f(x1, y1);
494
  GL.Vertex2f(x2, y2);
495
end;
496

497
// Polyline
498
//
499

500
procedure TGLCanvas.Polyline(const points: array of TGLPoint);
501
var
502
  i, n: Integer;
503
begin
504
  n := Length(Points);
505
  if n > 1 then
506
  begin
507
    StartPrimitive(GL_LINE_STRIP);
508
    GL.Vertex2iv(@points[Low(points)]);
509
    for i := Low(points) + 1 to High(points) do
510
      GL.Vertex2iv(@points[i]);
511
    StopPrimitive;
512
  end;
513
end;
514

515
// Polygon
516
//
517

518
procedure TGLCanvas.Polygon(const points: array of TGLPoint);
519
var
520
  i, n: Integer;
521
begin
522
  n := Length(Points);
523
  if n > 1 then
524
  begin
525
    StartPrimitive(GL_LINE_LOOP);
526
    GL.Vertex2iv(@points[Low(points)]);
527
    for i := Low(points) + 1 to High(points) do
528
      GL.Vertex2iv(@points[i]);
529
    StopPrimitive;
530
  end;
531
end;
532

533
// PlotPixel
534
//
535

536
procedure TGLCanvas.PlotPixel(const x, y: Integer);
537
begin
538
  StartPrimitive(GL_POINTS);
539
  GL.Vertex2i(x, y);
540
end;
541

542
// PlotPixel
543
//
544

545
procedure TGLCanvas.PlotPixel(const x, y: Single);
546
begin
547
  StartPrimitive(GL_POINTS);
548
  GL.Vertex2f(x, y);
549
end;
550

551
// FrameRect (integer)
552
//
553

554
procedure TGLCanvas.FrameRect(const x1, y1, x2, y2: Integer);
555
begin
556
  StartPrimitive(GL_LINE_LOOP);
557
  GL.Vertex2i(x1, y1);
558
  GL.Vertex2i(x2, y1);
559
  GL.Vertex2i(x2, y2);
560
  GL.Vertex2i(x1, y2);
561
  StopPrimitive;
562
end;
563

564
// FrameRect (single)
565
//
566

567
procedure TGLCanvas.FrameRect(const x1, y1, x2, y2: Single);
568
begin
569
  StartPrimitive(GL_LINE_LOOP);
570
  GL.Vertex2f(x1, y1);
571
  GL.Vertex2f(x2, y1);
572
  GL.Vertex2f(x2, y2);
573
  GL.Vertex2f(x1, y2);
574
  StopPrimitive;
575
end;
576

577
function TGLCanvas.GetPenAlpha: Single;
578
begin
579
  Result := FCurrentPenColorVector.V[3];
580
end;
581

582
// FillRect (integer)
583
//
584

585
procedure TGLCanvas.FillRect(const x1, y1, x2, y2: Integer);
586
begin
587
  StartPrimitive(GL_QUADS);
588
  GL.Vertex2i(x1, y1);
589
  GL.Vertex2i(x2, y1);
590
  GL.Vertex2i(x2, y2);
591
  GL.Vertex2i(x1, y2);
592
  StopPrimitive;
593
end;
594

595
// FillRect (single)
596
//
597

598
procedure TGLCanvas.FillRect(const x1, y1, x2, y2: Single);
599
begin
600
  StartPrimitive(GL_QUADS);
601
  GL.Vertex2f(x1, y1);
602
  GL.Vertex2f(x2, y1);
603
  GL.Vertex2f(x2, y2);
604
  GL.Vertex2f(x1, y2);
605
  StopPrimitive;
606
end;
607

608
// EllipseVertices
609
//
610

611
procedure TGLCanvas.EllipseVertices(x, y, xRadius, yRadius: Single);
612
var
613
  i, n: Integer;
614
  s, c: TSingleArray;
615
begin
616
  n := Round(MaxFloat(xRadius, yRadius) * 0.1) + 5;
617
  SetLength(s, n);
618
  SetLength(c, n);
619
  Dec(n);
620
  PrepareSinCosCache(s, c, 0, 90);
621
  ScaleFloatArray(s, yRadius);
622
  ScaleFloatArray(c, xRadius);
623
  // first quadrant (top right)
624
  for i := 0 to n do
625
    GL.Vertex2f(x + c[i], y - s[i]);
626
  // second quadrant (top left)
627
  for i := n - 1 downto 0 do
628
    GL.Vertex2f(x - c[i], y - s[i]);
629
  // third quadrant (bottom left)
630
  for i := 1 to n do
631
    GL.Vertex2f(x - c[i], y + s[i]);
632
  // fourth quadrant (bottom right)
633
  for i := n - 1 downto 0 do
634
    GL.Vertex2f(x + c[i], y + s[i]);
635
end;
636

637
// EllipseBB
638
//
639

640
procedure TGLCanvas.EllipseBB(const x1, y1, x2, y2: Integer);
641
begin
642
  Ellipse((x1 + x2) * 0.5, (y1 + y2) * 0.5, Abs(x2 - x1) * 0.5, Abs(y2 - y1) *
643
    0.5);
644
end;
645

646
// EllipseBB
647
//
648

649
procedure TGLCanvas.EllipseBB(const x1, y1, x2, y2: Single);
650
begin
651
  Ellipse((x1 + x2) * 0.5, (y1 + y2) * 0.5, Abs(x2 - x1) * 0.5, Abs(y2 - y1) *
652
    0.5);
653
end;
654

655
// Ellipse
656
//
657

658
procedure TGLCanvas.Ellipse(const x, y: Single; const Radius: Single);
659
begin
660
  Ellipse(x, y, Radius, Radius);
661
end;
662

663
// Ellipse
664
//
665

666
procedure TGLCanvas.Ellipse(const x, y: Integer; const xRadius, yRadius:
667
  Single);
668
var
669
  sx, sy: Single;
670
begin
671
  sx := x;
672
  sy := y;
673
  Ellipse(sx, sy, xRadius, yRadius);
674
end;
675

676
// Ellipse
677
//
678

679
procedure TGLCanvas.Ellipse(const x, y: Single; const xRadius, yRadius: Single);
680
begin
681
  StartPrimitive(GL_LINE_STRIP);
682
  EllipseVertices(x, y, xRadius, yRadius);
683
  StopPrimitive;
684
end;
685

686
// FillEllipse
687
//
688

689
procedure TGLCanvas.FillEllipse(const x, y: Integer; const xRadius, yRadius:
690
  Single);
691
begin
692
  StartPrimitive(GL_TRIANGLE_FAN);
693
  GL.Vertex2f(x, y); // not really necessary, but may help with memory stride
694
  EllipseVertices(x, y, xRadius, yRadius);
695
  StopPrimitive;
696
end;
697

698
// FillEllipse
699
//
700

701
procedure TGLCanvas.FillEllipse(const x, y, xRadius, yRadius: Single);
702
begin
703
  StartPrimitive(GL_TRIANGLE_FAN);
704
  GL.Vertex2f(x, y); // not really necessary, but may help with memory stride
705
  EllipseVertices(x, y, xRadius, yRadius);
706
  StopPrimitive;
707
end;
708

709
// FillEllipse
710
//
711

712
procedure TGLCanvas.FillEllipse(const x, y, Radius: Single);
713
begin
714
  FillEllipse(x, y, Radius, Radius);
715
end;
716

717
// FillRectGradient
718
//
719

720
procedure TGLCanvas.FillRectGradient(const x1, y1, x2, y2: Single;
721
  const x1y1Color, x2y1Color, x2y2Color, x1y2Color: TColorVector);
722
begin
723
  StartPrimitive(GL_QUADS);
724
  GL.Color4f(x1y1Color.V[0], x1y1Color.V[1], x1y1Color.V[2], x1y1Color.V[3]);
725
  GL.Vertex2f(x1, y1);
726
  GL.Color4f(x2y1Color.V[0], x2y1Color.V[1], x2y1Color.V[2], x2y1Color.V[3]);
727
  GL.Vertex2f(x2, y1);
728
  GL.Color4f(x2y2Color.V[0], x2y2Color.V[1], x2y2Color.V[2], x2y2Color.V[3]);
729
  GL.Vertex2f(x2, y2);
730
  GL.Color4f(x1y2Color.V[0], x1y2Color.V[1], x1y2Color.V[2], x1y2Color.V[3]);
731
  GL.Vertex2f(x1, y2);
732
  StopPrimitive;
733

734
  // restore pen color
735
  GL.Color4fv(@FCurrentPenColorVector);
736
end;
737

738
// FillRectGradient
739
//
740

741
procedure TGLCanvas.FillRectGradient(const x1, y1, x2, y2: Integer;
742
  const x1y1Color, x2y1Color, x2y2Color, x1y2Color: TColorVector);
743
begin
744
  StartPrimitive(GL_QUADS);
745
  GL.Color4f(x1y1Color.V[0], x1y1Color.V[1], x1y1Color.V[2], x1y1Color.V[3]);
746
  GL.Vertex2i(x1, y1);
747
  GL.Color4f(x2y1Color.V[0], x2y1Color.V[1], x2y1Color.V[2], x2y1Color.V[3]);
748
  GL.Vertex2i(x2, y1);
749
  GL.Color4f(x2y2Color.V[0], x2y2Color.V[1], x2y2Color.V[2], x2y2Color.V[3]);
750
  GL.Vertex2i(x2, y2);
751
  GL.Color4f(x1y2Color.V[0], x1y2Color.V[1], x1y2Color.V[2], x1y2Color.V[3]);
752
  GL.Vertex2i(x1, y2);
753
  StopPrimitive;
754

755
  // restore pen color
756
  GL.Color4fv(@FCurrentPenColorVector);
757
end;
758

759
// FillEllipseGradient (integer)
760
//
761

762
procedure TGLCanvas.FillEllipseGradient(const x, y: Integer; const xRadius, yRadius: Integer; const edgeColor: TColorVector);
763
begin
764
  StartPrimitive(GL_TRIANGLE_FAN);
765

766
  // the center will use the last set PenColor and PenAlpha
767
  GL.Vertex2f(x, y); // really necessary now :)
768

769
  // then openGL will do a gradient from the center to the edge using the edgeColor
770
  GL.Color4f(edgeColor.V[0], edgeColor.V[1], edgeColor.V[2], edgeColor.V[3]);
771
  EllipseVertices(x, y, xRadius, yRadius);
772
  StopPrimitive;
773

774
  // restore pen color
775
  GL.Color4fv(@FCurrentPenColorVector);
776
end;
777

778
// FillEllipseGradient (single)
779
//
780

781
procedure TGLCanvas.FillEllipseGradient(const x, y, xRadius, yRadius: Single; const edgeColor: TColorVector);
782
begin
783
  StartPrimitive(GL_TRIANGLE_FAN);
784
  GL.Vertex2f(x, y); // really necessary now :)
785
  GL.Color4f(edgeColor.V[0], edgeColor.V[1], edgeColor.V[2], edgeColor.V[3]);
786
  EllipseVertices(x, y, xRadius, yRadius);
787
  StopPrimitive;
788

789
  // restore pen color
790
  GL.Color4fv(@FCurrentPenColorVector);
791
end;
792

793
// FillEllipseGradient (single)
794
//
795

796
procedure TGLCanvas.FillEllipseGradient(const x, y, Radius: Single; const edgeColor: TColorVector);
797
begin
798
  FillEllipseGradient(x, y, Radius, Radius, edgeColor);
799
end;
800

801
// Arc
802
//
803

804
procedure TGLCanvas.Arc(const x1, y1, x2, y2, x3, y3, x4, y4: Integer);
805
begin
806
  DrawArc(x1, y1, x2, y2, x3, y3, x4, y4, False);
807
end;
808

809
procedure TGLCanvas.Arc(const x1, y1, x2, y2, x3, y3, x4, y4: Single);
810
begin
811
  DrawArc(x1, y1, x2, y2, x3, y3, x4, y4, False);
812
end;
813

814
procedure TGLCanvas.Arc(const x1, y1, x2, y2: Single; AngleBegin, AngleEnd: Single);
815
begin
816
  DrawArc(x1, y1, x2, y2, AngleBegin, AngleEnd, False);
817
end;
818

819
// ArcTo
820
//
821

822
procedure TGLCanvas.ArcTo(const x1, y1, x2, y2, x3, y3, x4, y4: Integer);
823
begin
824
  DrawArc(x1, y1, x2, y2, x3, y3, x4, y4, True);
825
end;
826

827
procedure TGLCanvas.ArcTo(const x1, y1, x2, y2, x3, y3, x4, y4: Single);
828
begin
829
  DrawArc(x1, y1, x2, y2, x3, y3, x4, y4, True);
830
end;
831

832
procedure TGLCanvas.ArcTo(const x1, y1, x2, y2: Single; AngleBegin, AngleEnd: Single);
833
begin
834
  DrawArc(x1, y1, x2, y2, AngleBegin, AngleEnd, True);
835
end;
836

837
procedure TGLCanvas.RoundRect(const x1, y1, x2, y2, xr, yr: Integer);
838
var
839
  x2r, y2r, x, y: integer;
840
begin
841
  x2r := 2*xr;
842
  y2r := 2*yr;
843
  x := x1 -1;
844
  y := y2 +1;
845
  Arc(x, y1, x + x2r, y1 + y2r, pi3on2, pi);
846
  Line(x1, y1 + yr, x1, y - yr);
847
  Arc(x, y, x + x2r,  y - y2r, pi, pion2);
848
  Line(x + xr, y2, x2 - xr, y2);
849
  Arc(x2, y, x2 - x2r, y - y2r, pion2, 0);
850
  Line(x2, y1 + yr, x2, y - yr);
851
  Arc(x2, y1, x2 - x2r, y1 + y2r, 0, pi3on2);
852
  Line(x + xr, y1, x2 - xr, y1);
853
end;
854

855
procedure TGLCanvas.RoundRect(const x1, y1, x2, y2, xr, yr: Single);
856
var
857
  x2r, y2r, x, y: Single;
858
begin
859
  x2r := 2*xr;
860
  y2r := 2*yr;
861
  x := x1 -1;
862
  y := y2 +1;
863
  Arc(x, y1, x + x2r, y1 + y2r, pi3on2, pi);
864
  Line(x1, y1 + yr, x1, y - yr);
865
  Arc(x, y, x + x2r,  y - y2r, pi, pion2);
866
  Line(x + xr, y2, x2 - xr, y2);
867
  Arc(x2, y, x2 - x2r, y - y2r, pion2, 0);
868
  Line(x2, y1 + yr, x2, y - yr);
869
  Arc(x2, y1, x2 - x2r, y1 + y2r, 0, pi3on2);
870
  Line(x + xr, y1, x2 - xr, y1);
871
end;
872

873

874
// Arc Draw
875
//
876

877
// wrapper from "ByPoints" methode
878

879
procedure TGLCanvas.DrawArc(x1, y1, x2, y2, x3, y3, x4, y4: Single; UpdateCurrentPos: Boolean);
880
var
881
  x, y: Single;
882
  AngleBegin, AngleEnd: Single;
883
begin
884
  if x1 > x2 then
885
    SwapSingle(@x1, @x2);
886
  if y1 > y2 then
887
    SwapSingle(@y1, @y2);
888

889
  NormalizePoint(x1, y1, x2, y2, x3, y3, @x, @y);
890
  AngleBegin := ArcTan2(y, x);
891

892
  NormalizePoint(x1, y1, x2, y2, x4, y4, @x, @y);
893
  AngleEnd := ArcTan2(y, x);
894

895
  DrawArc(x1, y1, x2, y2, AngleBegin, AngleEnd, UpdateCurrentPos);
896
end;
897

898
// Real work is here
899

900
procedure TGLCanvas.DrawArc(x1, y1, x2, y2: Single; AngleBegin, AngleEnd: Single; UpdateCurrentPos: Boolean);
901
var
902
  Xc, Yc, Rx, Ry, x, y, s, c: Single;
903
  AngleCurrent, AngleDiff, AngleStep: Single;
904
begin
905
  // check that our box is well set (as the original Arc function do)
906
  if x1 > x2 then
907
    SwapSingle(@x1, @x2);
908
  if y1 > y2 then
909
    SwapSingle(@y1, @y2);
910

911
  if (x1 = x2) or (y1 = y2) then
912
    exit;
913

914
  Xc := (x1 + x2) * 0.5;
915
  Yc := (y1 + y2) * 0.5;
916

917
  Rx := Abs(x2 - x1) * 0.5;
918
  Ry := Abs(y2 - y1) * 0.5;
919

920
  // if ClockWise then swap AngleBegin and AngleEnd to simulate it.
921
  if FArcDirection = adClockWise then
922
  begin
923
    AngleCurrent := AngleBegin;
924
    AngleBegin := AngleEnd;
925
    AngleEnd := AngleCurrent;
926
  end;
927

928
  if (AngleEnd >= AngleBegin) then
929
  begin // if end sup to begin, remove 2*Pi (360°)
930
    AngleEnd := AngleEnd - 2 * Pi;
931
  end;
932

933
  AngleDiff := Abs(AngleEnd - AngleBegin); // the amount radian to travel
934
  AngleStep := AngleDiff / Round(MaxFloat(Rx, Ry) * 0.1 + 5); // granulity of drawing, not too much, not too less
935

936
  AngleCurrent := AngleBegin;
937

938
  StartPrimitive(GL_LINE_STRIP);
939
  while AngleCurrent >= AngleBegin - AngleDiff do
940
  begin
941
    SinCos(AngleCurrent, s, c);
942
    x := Xc + (Rx * c);
943
    y := Yc + (Ry * s);
944

945
    GL.Vertex2f(x, y);
946

947
    AngleCurrent := AngleCurrent - AngleStep; // always step down, rotate only one way to draw it
948
  end;
949

950
  SinCos(AngleEnd, s, c);
951
  x := Xc + (Rx * c);
952
  y := Yc + (Ry * s);
953

954
  GL.Vertex2f(x, y);
955

956
  StopPrimitive();
957

958
  if UpdateCurrentPos then
959
    MoveTo(x, y); //FCurrentPos := CurrentPos;
960
end;
961

962
// for internal need
963

964
procedure TGLCanvas.NormalizePoint(const x1, y1, x2, y2: Single; const x, y: Single; pX, pY: PSingle);
965
begin
966
  pX^ := (x - x1) / (x2 - x1) * 2.0 - 1.0;
967
  pY^ := (y - y1) / (y2 - y1) * 2.0 - 1.0;
968
end;
969

970
procedure TGLCanvas.SwapSingle(pX, pY: PSingle);
971
var
972
  tmp: Single;
973
begin
974
  tmp := pX^;
975
  pX^ := pY^;
976
  pY^ := tmp;
977
end;
978

979
end.
980

981