1 {
2  *****************************************************************************
3   See the file COPYING.modifiedLGPL.txt, included in this distribution,
4   for details about the license.
5  *****************************************************************************
6 
7   Authors: Alexander Klenin, Werner Pamler
8 
9   Notes:
10   - This unit is not "used" by the TAChart package. In order to find it the
11     unit should be copied to the project folder or specified with its path
12     in the uses clause (see demo project).
13 
14   - If define CHARTGL_USE_LAZFREETYPE is activated in the package options then
15     the LazFreeType library is used for rendering text. If not, the GLUT library
16     is used instead. Note that GLUT is not available on every system.
17 }
18 
19 unit TADrawerOpenGL;
20 
21 {$H+}
22 
23 interface
24 
25 {$DEFINE CHARTGL_USE_LAZFREETYPE}
26 
27 uses
28   Classes, SysUtils, FPImage, FPCanvas,
29   TAChartUtils, TADrawUtils;
30 
31 type
32   { TOpenGLDrawer }
33 
34   TOpenGLDrawer = class(TBasicDrawer, IChartDrawer)
35   strict private
36     FBrushColor: TFPColor;
37     FFontColor: TFPColor;
38     FPenColor: TFPColor;
39     FPenStyle: TFPPenStyle;
40     FPenWidth: Integer;
41     FFontName: String;
42     FFontSize: Integer;
43     FFontStyle: TChartFontStyles;
44     FFontAngle: Double;  // in degrees
45     FPos: TPoint;
46     procedure ChartGLColor(AColor: TFPColor);
47     procedure ChartGLPenStyle(APenStyle: TFPPenStyle);
48     procedure InternalPolyline(
49       const APoints: array of TPoint; AStartIndex, ANumPts, AMode: Integer);
50     procedure SetBrush(ABrush: TFPCustomBrush);
51     procedure SetFont(AFont: TFPCustomFont);
52     procedure SetPen(APen: TFPCustomPen);
53   strict protected
SimpleTextExtentnull54     function SimpleTextExtent(const AText: String): TPoint; override;
55     procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
56   public
57     constructor Create;
58     procedure AddToFontOrientation(ADelta: Integer);
59     procedure ClippingStart;
60     procedure ClippingStart(const AClipRect: TRect);
61     procedure ClippingStop;
62     procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
63     procedure FillRect(AX1, AY1, AX2, AY2: Integer);
GetBrushColornull64     function GetBrushColor: TChartColor;
GetFontAnglenull65     function GetFontAngle: Double; override;
GetFontColornull66     function GetFontColor: TFPColor; override;
GetFontNamenull67     function GetFontName: String; override;
GetFontSizenull68     function GetFontSize: Integer; override;
GetFontStylenull69     function GetFontStyle: TChartFontStyles; override;
GetPenColornull70     function GetPenColor: TChartColor;
71     procedure Line(AX1, AY1, AX2, AY2: Integer);
72     procedure Line(const AP1, AP2: TPoint);
73     procedure LineTo(AX, AY: Integer); override;
74     procedure MoveTo(AX, AY: Integer); override;
75     procedure Polygon(
76       const APoints: array of TPoint; AStartIndex, ANumPts: Integer); override;
77     procedure Polyline(
78       const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
79     procedure PrepareSimplePen(AColor: TChartColor);
80     procedure PutPixel(AX, AY: Integer; AColor: TChartColor); override;
81     procedure RadialPie(
82       AX1, AY1, AX2, AY2: Integer;
83       AStartAngle16Deg, AAngleLength16Deg: Integer);
84     procedure Rectangle(const ARect: TRect);
85     procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
86     procedure ResetFont;
87     procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
88     procedure SetBrushColor(AColor: TChartColor);
89     procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
90     procedure SetPenColor(AColor: TChartColor);
91     procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor; AWidth: Integer = 1);
92     procedure SetPenWidth(AWidth: Integer);
93     procedure SetTransparency(ATransparency: TChartTransparency);
94   end;
95 
96 
97 implementation
98 
99 uses
100   GL, GLu, FileUtil,
101   Math,
102  {$IFDEF CHARTGL_USE_LAZFREETYPE}
103   EasyLazFreeType, TAOpenGL, TAFonts,
104  {$ELSE}
105   Glut,
106  {$ENDIF}
107   TAGeometry;
108 
109 
110 { TOpenGLDrawer }
111 
112 constructor TOpenGLDrawer.Create;
113 {$IFDEF CHARTGL_USE_LAZFREETYPE}
114 begin
115   inherited;
116   InitFonts;
117   if GLFreeTypeHelper = nil then
118     GLFreeTypeHelper := TGLFreeTypeHelper.Create;
119 end;
120 {$ELSE}
121 var
122   CmdCount : Integer;
123   Cmd : Array of Pchar;
124   I: Integer;
125 begin
126   CmdCount := Paramcount+1;
127   SetLength(Cmd,CmdCount);
128   for I := 0 to CmdCount - 1 do
129      Cmd[I] := PChar(ParamStr(I));
130   glutInit (@CmdCount,@Cmd);
131 end;
132 {$ENDIF}
133 
134 procedure TOpenGLDrawer.AddToFontOrientation(ADelta: Integer);
135 begin
136   FFontAngle := FFontAngle + ADelta / ORIENTATION_UNITS_PER_DEG;
137 end;
138 
139 procedure TOpenGLDrawer.ChartGLColor(AColor: TFPColor);
140 begin
141   with AColor do
142     glColor4us(red, green, blue, (255 - FTransparency) shl 8);
143 end;
144 
145 procedure TOpenGLDrawer.ChartGLPenStyle(APenStyle: TFPPenStyle);
146 var
147   pattern: Word;
148 begin
149   case APenStyle of
150     psClear      : pattern := %0000000000000000;
151     psDot        : pattern := %0011001100110011;
152     psDash       : pattern := %0000000011111111;
153     psDashDot    : pattern := %0001100011111111;
154     psDashDotDot : pattern := %0001101100111111;
155     else
156       glDisable(GL_LINE_STIPPLE);   // --> psSolid
157       exit;
158       // psPattern will render as psSolid because there are differences in
159       // implementations between fpc and lcl.
160       // psInsideFrame will render as psSolid - I don't know what this is...
161   end;
162   glLineStipple(1, pattern);
163   glEnable(GL_LINE_STIPPLE);
164 end;
165 
166 procedure TOpenGLDrawer.ClippingStart(const AClipRect: TRect);
167 type
168   TGLClipPlaneEqn = record A, B, C, D: GLdouble; end;
169 var
170   cp: TGLClipPlaneEqn;
171 begin
172   cp.A := 1.0;
173   cp.D := -AClipRect.Left;
174   glClipPlane(GL_CLIP_PLANE0, @cp);
175   cp.A := -1.0;
176   cp.D := AClipRect.Right;
177   glClipPlane(GL_CLIP_PLANE1, @cp);
178   cp.A := 0.0;
179   cp.B := 1.0;
180   cp.D := -AClipRect.Top;
181   glClipPlane(GL_CLIP_PLANE2, @cp);
182   cp.B := -1.0;
183   cp.D := AClipRect.Bottom;
184   glClipPlane(GL_CLIP_PLANE3, @cp);
185   ClippingStart;
186 end;
187 
188 procedure TOpenGLDrawer.ClippingStart;
189 begin
190   glEnable(GL_CLIP_PLANE0);
191   glEnable(GL_CLIP_PLANE1);
192   glEnable(GL_CLIP_PLANE2);
193   glEnable(GL_CLIP_PLANE3);
194 end;
195 
196 procedure TOpenGLDrawer.ClippingStop;
197 begin
198   glDisable(GL_CLIP_PLANE0);
199   glDisable(GL_CLIP_PLANE1);
200   glDisable(GL_CLIP_PLANE2);
201   glDisable(GL_CLIP_PLANE3);
202 end;
203 
204 procedure TOpenGLDrawer.Ellipse(AX1, AY1, AX2, AY2: Integer);
205 var
206   p: TPointArray;
207 begin
208   p := TesselateEllipse(Rect(AX1, AY1, AX2, AY2), 4);
209   Polygon(p, 0, Length(p));
210 end;
211 
212 procedure TOpenGLDrawer.FillRect(AX1, AY1, AX2, AY2: Integer);
213 begin
214   ChartGLColor(FBrushColor);
215   glRecti(AX1, AY1, AX2, AY2);
216 end;
217 
GetBrushColornull218 function TOpenGLDrawer.GetBrushColor: TChartColor;
219 begin
220   Result := FPColorToChartColor(FBrushColor);
221 end;
222 
GetFontAnglenull223 function TOpenGLDrawer.GetFontAngle: Double;
224 begin
225   {$IFDEF CHARTGL_USE_LAZFREETYPE}
226   Result := DegToRad(FFontAngle);
227   {$ELSE}
228   Result := 0.0;
229   {$ENDIF}
230 end;
231 
GetFontColornull232 function TOpenGLDrawer.GetFontColor: TFPColor;
233 begin
234   Result := FFontColor;
235 end;
236 
GetFontNamenull237 function TOpenGLDrawer.GetFontName: String;
238 begin
239   Result := FFontName;
240 end;
241 
GetFontSizenull242 function TOpenGLDrawer.GetFontSize: Integer;
243 begin
244   Result := IFThen(FFontSize = 0, DEFAULT_FONT_SIZE, FFontSize);
245 end;
246 
GetFontStylenull247 function TOpenGLDrawer.GetFontStyle: TChartFontStyles;
248 begin
249   Result := FFontStyle;
250 end;
251 
GetPenColornull252 function TOpenGLDrawer.GetPenColor: TChartColor;
253 begin
254   Result := FPColorToChartColor(FPenColor);
255 end;
256 
257 procedure TOpenGLDrawer.InternalPolyline(
258   const APoints: array of TPoint; AStartIndex, ANumPts, AMode: Integer);
259 var
260   i: Integer;
261 begin
262   if FPenStyle = psClear then exit;
263   ChartGLColor(FPenColor);
264   glBegin(AMode);
265   for i := AStartIndex to AStartIndex + ANumPts - 1 do
266     glVertex2iv(@APoints[i]);
267   glEnd();
268 end;
269 
270 procedure TOpenGLDrawer.Line(AX1, AY1, AX2, AY2: Integer);
271 begin
272   if FPenStyle = psClear then exit;
273   glBegin(GL_LINES);
274   ChartGLColor(FPenColor);
275   glVertex2i(AX1, AY1);
276   glVertex2i(AX2, AY2);
277   glEnd();
278 end;
279 
280 procedure TOpenGLDrawer.Line(const AP1, AP2: TPoint);
281 begin
282   Line(AP1.X, AP1.Y, AP2.X, AP2.Y);
283 end;
284 
285 procedure TOpenGLDrawer.LineTo(AX, AY: Integer);
286 begin
287   Line(FPos.X, FPos.Y, AX, AY);
288 end;
289 
290 procedure TOpenGLDrawer.MoveTo(AX, AY: Integer);
291 begin
292   FPos := Point(AX, AY);
293 end;
294 
295 procedure TOpenGLDrawer.Polygon(
296   const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
297 var
298   i: Integer;
299 begin
300   glBegin(GL_POLYGON);
301   ChartGLColor(FBrushColor);
302   for i := AStartIndex to AStartIndex + ANumPts - 1 do
303     glVertex2iv(@APoints[i]);
304   glEnd();
305   InternalPolyline(APoints, AStartIndex, ANumPts, GL_LINE_LOOP);
306 end;
307 
308 procedure TOpenGLDrawer.Polyline(
309   const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
310 begin
311   InternalPolyline(APoints, AStartIndex, ANumPts, GL_LINE_STRIP);
312 end;
313 
314 procedure TOpenGLDrawer.PrepareSimplePen(AColor: TChartColor);
315 begin
316   FPenWidth := 1;
317   FPenColor := FChartColorToFPColorFunc(AColor);
318   FPenStyle := psSolid;
319 end;
320 
321 procedure TOpenGLDrawer.PutPixel(AX, AY: Integer; AColor: TChartColor);
322 begin
323   ChartGLColor(FChartColorToFPColorFunc(AColor));
324   glBegin(GL_POINTS);
325   glVertex2i(AX, AY);
326   glEnd;
327 end;
328 
329 procedure TOpenGLDrawer.RadialPie(
330   AX1, AY1, AX2, AY2: Integer; AStartAngle16Deg, AAngleLength16Deg: Integer);
331 var
332   e: TEllipse;
333   p: TPointArray;
334 begin
335   e.InitBoundingBox(AX1, AY1, AX2, AY2);
336   p := e.TesselateRadialPie(
337     Deg16ToRad(AStartAngle16Deg), Deg16ToRad(AAngleLength16Deg), 4);
338   Polygon(p, 0, Length(p));
339 end;
340 
341 procedure TOpenGLDrawer.Rectangle(AX1, AY1, AX2, AY2: Integer);
342 begin
343   ChartGLColor(FBrushColor);
344   glRecti(AX1, AY1, AX2, AY2);
345   if FPenStyle = psClear then exit;
346   ChartGLColor(FPenColor);
347   glBegin(GL_LINE_LOOP);
348   glVertex2i(AX1, AY1);
349   glVertex2i(AX2, AY1);
350   glVertex2i(AX2, AY2);
351   glVertex2i(AX1, AY2);
352   glEnd();
353 end;
354 
355 procedure TOpenGLDrawer.Rectangle(const ARect: TRect);
356 begin
357   Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
358 end;
359 
360 procedure TOpenGLDrawer.ResetFont;
361 begin
362 end;
363 
364 procedure TOpenGLDrawer.SetAntialiasingMode(AValue: TChartAntialiasingMode);
365 begin
366   case AValue of
367     amOn: begin
368       glEnable(GL_LINE_SMOOTH);
369       glEnable(GL_POLYGON_SMOOTH);
370     end;
371     amOff: begin
372       glDisable(GL_LINE_SMOOTH);
373       glDisable(GL_POLYGON_SMOOTH);
374     end;
375   end;
376 end;
377 
378 procedure TOpenGLDrawer.SetBrush(ABrush: TFPCustomBrush);
379 begin
380   FBrushColor := ABrush.FPColor;
381 end;
382 
383 procedure TOpenGLDrawer.SetBrushColor(AColor: TChartColor);
384 begin
385   FBrushColor := FChartColorToFPColorFunc(AColor);
386 end;
387 
388 procedure TOpenGLDrawer.SetBrushParams(
389   AStyle: TFPBrushStyle; AColor: TChartColor);
390 begin
391   SetBrushColor(AColor);
392   Unused(AStyle);
393 end;
394 
395 procedure TOpenGLDrawer.SetFont(AFont: TFPCustomFont);
396 begin
397   FFontName := AFont.Name;
398   if SameText(FFontName, 'default') then FFontName := 'Arial';
399   FFontSize := IfThen(AFont.Size = 0, DEFAULT_FONT_SIZE, AFont.Size);
400   FFontStyle := [];
401   if AFont.Bold then Include(FFontStyle, cfsBold);
402   if AFont.Italic then Include(FFontStyle, cfsItalic);
403   if AFont.Underline then Include(FFontStyle, cfsUnderline);
404   if AFont.Strikethrough then Include(FFontStyle, cfsStrikeout);
405   FFontColor := AFont.FPColor;
406 
407  {$IFDEF CHARTGL_USE_LAZFREETYPE}
408   FFontAngle := FGetFontOrientationFunc(AFont) / ORIENTATION_UNITS_PER_DEG;
409   GLFreeTypeHelper.SetFont(FFontName, FFontSize,
410     AFont.Bold, AFont.Italic, AFont.Underline, AFont.Strikethrough);
411  {$ENDIF}
412 end;
413 
414 procedure TOpenGLDrawer.SetPen(APen: TFPCustomPen);
415 begin
416   FPenWidth := APen.Width;
417   FPenColor := APen.FPColor;
418   FPenStyle := APen.Style;
419   glLineWidth(FPenWidth);
420   ChartGLPenStyle(FPenStyle);
421 end;
422 
423 procedure TOpenGLDrawer.SetPenColor(AColor: TChartColor);
424 begin
425   FPenColor := FChartColorToFPColorFunc(AColor);
426 end;
427 
428 procedure TOpenGLDrawer.SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor;
429   AWidth: Integer = 1);
430 begin
431   FPenStyle := AStyle;
432   FPenWidth := AWidth;
433   FPenColor := FChartColorToFPColorFunc(AColor);
434   ChartGLPenStyle(AStyle);
435 end;
436 
437 procedure TOpenGLDrawer.SetPenWidth(AWidth: Integer);
438 begin
439   FPenWidth := AWidth;
440 end;
441 
442 procedure TOpenGLDrawer.SetTransparency(ATransparency: TChartTransparency);
443 begin
444   inherited;
445   if FTransparency > 0 then begin
446     glEnable(GL_BLEND);
447     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
448   end
449   else
450     glDisable(GL_BLEND);
451 end;
452 
453 {$IFDEF CHARTGL_USE_LAZFREETYPE}
454 
SimpleTextExtentnull455 function TOpenGLDrawer.SimpleTextExtent(const AText: String): TPoint;
456 begin
457   GLFreeTypeHelper.TextExtent(AText, Result.X, Result.Y);
458 end;
459 
460 procedure TOpenGLDrawer.SimpleTextOut(AX, AY: Integer; const AText: String);
461 begin
462   glEnable(GL_BLEND);
463   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
464 
465   ChartGLColor(FFontColor);
466   glMatrixMode(GL_MODELVIEW);
467   glPushMatrix;
468   glTranslatef(AX, AY, 0);
469   glRotatef(-FFontAngle, 0, 0, 1);
470   GLFreeTypeHelper.RenderText(AText, [ftaLeft, ftaTop]);
471   glPopMatrix;
472 end;
473 
474 {$ELSE}
475 
SimpleTextExtentnull476 function TOpenGLDrawer.SimpleTextExtent(const AText: String): TPoint;
477 const
478   F_WIDTH = 8;
479   F_HEIGHT = 13;
480 begin
481   Result := Point(F_WIDTH * Length(AText), F_HEIGHT);
482 end;
483 
484 procedure TOpenGLDrawer.SimpleTextOut(AX, AY: Integer; const AText: String);
485 const
486   X_OFFSET = 0;
487   Y_OFFSET = 10;
488 var
489   i: Integer;
490 begin
491   ChartGLColor(FFontColor);
492   glRasterPos2i(AX + X_OFFSET, AY + Y_OFFSET);
493   for i := 1 to Length(AText) do
494     glutBitmapCharacter(GLUT_BITMAP_8_BY_13, Ord(AText[i]));
495 end;
496 {$ENDIF}
497 
498 initialization
499 
500 finalization
501  {$IFDEF CHARTGL_USE_LAZFREETYPE}
502   FreeAndNil(GLFreeTypeHelper);
503  {$ENDIF}
504 
505 end.
506 
507