TAChart: Extract OpenGL text rendering code into separate unit, TAOpenGL. Improved layout of the OpenGL demo.

git-svn-id: trunk@57434 -
This commit is contained in:
wp 2018-03-03 11:40:12 +00:00
parent 486b55f999
commit 2cc5ce2d65
9 changed files with 307 additions and 263 deletions

1
.gitattributes vendored
View File

@ -5085,6 +5085,7 @@ components/tachart/talegendpanel.pas svneol=native#text/pascal
components/tachart/tamath.pas svneol=native#text/pascal
components/tachart/tamultiseries.pas svneol=native#text/pascal
components/tachart/tanavigation.pas svneol=native#text/pascal
components/tachart/taopengl.pas svneol=native#text/pascal
components/tachart/taprint.pas svneol=native#text/pascal
components/tachart/taradialseries.pas svneol=native#text/pascal
components/tachart/taseries.pas svneol=native#text/plain

View File

@ -9,19 +9,30 @@ object Form1: TForm1
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object OpenGLControl1: TOpenGLControl
Left = 344
AnchorSideLeft.Control = Bevel1
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 343
Height = 319
Top = 0
Width = 344
Align = alClient
Width = 345
Anchors = [akTop, akLeft, akRight, akBottom]
AutoResizeViewport = True
OnPaint = OpenGLControl1Paint
end
object Chart1: TChart
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Bevel1
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 319
Top = 0
Width = 344
Width = 343
AxisList = <
item
Marks.LabelFont.Color = clTeal
@ -53,7 +64,7 @@ object Form1: TForm1
)
Title.Visible = True
OnAfterPaint = Chart1AfterPaint
Align = alLeft
Anchors = [akTop, akLeft, akRight, akBottom]
Color = clSkyBlue
object Chart1LineSeries1: TLineSeries
LinePen.Color = clBlue
@ -69,6 +80,14 @@ object Form1: TForm1
Source = RandomChartSource1
end
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 343
Height = 50
Top = 73
Width = 2
end
object RandomChartSource1: TRandomChartSource
PointsNumber = 10
RandSeed = 1792875960

View File

@ -6,13 +6,14 @@ interface
uses
Classes, OpenGLContext, SysUtils, FileUtil, Forms, Controls, Graphics,
Dialogs, TAGraph, TASeries, TASources, GL, GLU;
Dialogs, ExtCtrls, TAGraph, TASeries, TASources, GL, GLU;
type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
Chart1: TChart;
Chart1BarSeries1: TBarSeries;
Chart1LineSeries1: TLineSeries;

View File

@ -39,7 +39,7 @@
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Units Count="3">
<Unit0>
<Filename Value="opengldemo.lpr"/>
<IsPartOfProject Value="True"/>
@ -51,6 +51,11 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="..\..\taopengl.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TAOpenGL"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -7,7 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, lazopenglcontext, Main, tachartlazaruspkg;
Forms, lazopenglcontext, Main, tachartlazaruspkg, TAOpenGL;
{$R *.res}

View File

@ -29,7 +29,7 @@
for details about the copyright.
"/>
<Version Major="1"/>
<Files Count="52">
<Files Count="53">
<Item1>
<Filename Value="tagraph.pas"/>
<HasRegisterProc Value="True"/>
@ -257,6 +257,10 @@
<Filename Value="taexpressionseries.pas"/>
<UnitName Value="TAExpressionSeries"/>
</Item52>
<Item53>
<Filename Value="taopengl.pas"/>
<UnitName Value="TAOpenGL"/>
</Item53>
</Files>
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/>
<i18n>

View File

@ -18,7 +18,7 @@ uses
TAAnimatedSource, TATextElements, TAAxisSource, TASeriesPropEditors,
TACustomFuncSeries, TAFitUtils, TAGUIConnector, TADiagram, TADiagramDrawing,
TADiagramLayout, TAChartStrConsts, TAChartCombos, TAHtml, TAFonts,
TAExpressionSeries, LazarusPackageIntf;
TAExpressionSeries, TAOpenGL, LazarusPackageIntf;
implementation

View File

@ -25,7 +25,7 @@ interface
{$DEFINE CHARTGL_USE_LAZFREETYPE}
uses
Classes, SysUtils, FPCanvas, FPImage,
Classes, SysUtils, FPImage, FPCanvas,
TAChartUtils, TADrawUtils;
type
@ -97,263 +97,12 @@ uses
GL, GLu, FileUtil,
Math,
{$IFDEF CHARTGL_USE_LAZFREETYPE}
LazFileUtils,
EasyLazFreeType, LazFreeTypeFPImageDrawer, LazFreeTypeFontCollection, TAFonts,
EasyLazFreeType, TAOpenGL, TAFonts,
{$ELSE}
Glut,
{$ENDIF}
TAGeometry;
{$IFDEF CHARTGL_USE_LAZFREETYPE}
type
TTextureCacheItem = class
TextureID: Gluint;
TextWidth: Integer;
TextHeight: Integer;
end;
TGLFreeTypeHelper = class
private
FFont: TFreeTypeFont;
FImg: TFPMemoryImage;
FDrawer: TFPImageFreeTypeDrawer;
FTextureCache: TStringList;
protected
function BuildTextureName(AText: String): String;
procedure CreateTexture(AText: String; out ATextWidth, ATextHeight,
ATextureWidth, ATextureHeight: Integer; out ATextureID: GLuint);
function FindTexture(AText: String; out ATextWidth, ATextHeight,
ATextureWidth, ATextureHeight: Integer): GLuint;
public
constructor Create;
destructor Destroy; override;
procedure RenderText(AText: String; Alignments: TFreeTypeAlignments);
procedure SetFont(AFontName: String; AFontSize: Integer;
ABold: Boolean = false; AItalic: Boolean = false;
AUnderline: Boolean = false; AStrikethrough: Boolean = false);
procedure TextExtent(AText: String; out AWidth, AHeight: Integer);
end;
var
GLFreeTypeHelper: TGLFreeTypeHelper = nil;
function NextPowerOf2(n: Integer): Integer;
begin
Result := 1;
while Result < n do
Result := Result * 2;
end;
{ TGLFreeTypeHelper }
constructor TGLFreeTypeHelper.Create;
begin
FImg := TFPMemoryImage.Create(8, 8); // dummy size, will be updated when needed
FDrawer := TFPImageFreeTypeDrawer.Create(FImg);
FTextureCache := TStringList.Create;
FTextureCache.Sorted := true;
end;
destructor TGLFreeTypeHelper.Destroy;
var
i: Integer;
item: TTextureCacheItem;
begin
for i:=0 to FTextureCache.Count-1 do begin
item := TTextureCacheItem(FTextureCache.Objects[i]);
glDeleteTextures(1, @item.TextureID);
item.Free;
end;
FTextureCache.Free;
if FFont <> nil then FFont.Free;
FDrawer.Free;
FImg.Free;
inherited;
end;
{ The texture items are stored in the FTextureCache list and can be identified
by means of their name which is composed of the text and font parameters.
The name of the texture items is calculated here. }
function TGLFreeTypeHelper.BuildTextureName(AText: String): String;
begin
Result := Format('%s|%s|%d|%s', [
AText, FFont.Family, round(FFont.SizeInPoints*100), FFont.StyleAsString
]);
end;
procedure TGLFreeTypeHelper.CreateTexture(AText: String; out ATextWidth, ATextHeight,
ATextureWidth, ATextureHeight: Integer; out ATextureID: GLuint);
var
expanded_data: packed array of byte;
i, j: Integer;
c: TFPColor;
begin
if FFont = nil then
raise Exception.Create('No font selected.');
ATextWidth := round(FFont.TextWidth(AText));
ATextHeight := round(FFont.TextHeight(AText));
ATextureWidth := NextPowerOf2(ATextWidth);
ATextureHeight := NextPowerOf2(ATextHeight);
FImg.SetSize(ATextureWidth, ATextureHeight);
FDrawer.FillPixels(colTransparent);
FDrawer.DrawText(AText, FFont, 0,0, colRed, [ftaLeft, ftaTop]);
SetLength(expanded_data, 2*ATextureWidth * ATextureHeight);
for j:=0 to ATextureHeight-1 do
for i:=0 to ATextureWidth-1 do
begin
expanded_data[2*(i + j*ATextureWidth)] := 255; // Luminosity
if (i > ATextWidth) or (j > ATextHeight) then
expanded_data[2*(i + j*ATextureWidth) + 1] := 0 // Alpha
else begin
c := FImg.Colors[i,j];
expanded_data[2*(i + j*ATextureWidth) + 1] := FImg.Colors[i, j].Alpha shr 8;
end;
end;
// Set up texture parameters
glGenTextures(1, @ATextureID);
glBindTexture(GL_TEXTURE_2D, ATextureID);
// Create the texture
// Note that we are using GL_LUMINANCE_ALPHA to indicate that we are using
// two-channel data
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, ATextureWidth, ATextureHeight, 0,
GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @expanded_data[0]);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
end;
{ Finds the texture id for the given text. Returns the texture id and the
size of text and texture. Note that the texture size must be a power of 2 and
thus can be different from the text size. }
function TGLFreeTypeHelper.FindTexture(AText: String;
out ATextWidth, ATextHeight, ATextureWidth, ATextureHeight: Integer): GLuint;
var
idx: Integer;
item: TTextureCacheItem;
txname: String;
begin
txname := BuildTextureName(AText);
idx := FTextureCache.IndexOf(txname);
if idx = -1 then begin
CreateTexture(AText, ATextWidth, ATextHeight, ATextureWidth, ATextureHeight, Result);
item := TTextureCacheItem.Create;
item.TextureID := Result;
item.TextWidth := ATextWidth;
item.TextHeight := ATextHeight;
FTextureCache.AddObject(txname, item);
end else begin
item := TTextureCacheItem(FTextureCache.Objects[idx]);
result := item.TextureID;
ATextWidth := item.TextWidth;
ATextHeight := item.TextHeight;
ATextureWidth := NextPowerOf2(ATextWidth);
ATextureHeight := NextPowerOf2(ATextHeight);
end;
end;
procedure TGLFreeTypeHelper.RenderText(AText: String; Alignments: TFreeTypeAlignments);
var
textureID: GLuint;
w, h: Integer;
w2, h2: Integer;
sx, sy: Double;
dx, dy: Integer;
begin
textureID := FindTexture(AText, w, h, w2, h2);
sx := w / w2;
sy := h / h2;
glMatrixMode(GL_MODELVIEW);
glPushMatrix;
// Note: We don't support ftaJustify)
if (ftaCenter in Alignments) then dx := -w div 2
else if (ftaRight in ALignments) then dx := -w
else dx := 0;
if (ftaVerticalCenter in Alignments) then dy := -h div 2
else if (ftaBottom in Alignments) then dy := -h
else if (ftaBaseline in Alignments) then dy := - h + round(FFont.Descent)
else dy := 0;
glTranslatef(dx, dy, 0);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, textureID);
glBegin(GL_QUADS);
glTexCoord2f(0.0, sy); glVertex2f(0, h);
glTexCoord2f(sx, sy); glVertex2f(w, h);
glTexCoord2f(sx, 0.0); glVertex2f(w, 0);
glTexCoord2f(0.0, 0.0); glVertex2f(0, 0);
glEnd();
glDisable(GL_TEXTURE_2D);
glPopMatrix;
end;
procedure TGLFreeTypeHelper.SetFont(AFontName: String; AFontSize: Integer;
ABold: Boolean = false; AItalic: Boolean = false;
AUnderline: Boolean = false; AStrikethrough: Boolean = false);
var
style: TFreeTypeStyles;
begin
if GLFreeTypeHelper = nil then
raise Exception.Create('InitFonts has not been called.');
style := [];
if ABold then Include(style, ftsBold);
if AItalic then Include(style, ftsItalic);
// Create a new font if not yet loaded
if (FFont = nil) or (FFont.Family <> AFontName) or (FFont.Style <> style) then
begin
FreeAndNil(FFont);
FFont := LoadFont(AFontName, style);
if FFont = nil then
raise Exception.CreateFmt('Font "%s" not found.', [AFontName]);
end;
// Set the requested font attributes.
FFont.SizeInPoints := AFontSize;
FFont.UnderlineDecoration := AUnderline;
FFont.StrikeoutDecoration := AStrikethrough;
FFont.Hinted := true;
FFont.Quality := grqHighQuality;
//FFont.ClearType := true;
end;
{ Returns the width and height of the specified text. If the text already has
been handled with the same font parameters it is stored in the FTextureCache
list. If not, the size is determined from the font. }
procedure TGLFreeTypeHelper.TextExtent(AText: String; out AWidth, AHeight: Integer);
var
txname: String;
idx: Integer;
item: TTextureCacheItem;
textureID: Gluint;
w2, h2: Integer;
begin
txname := BuildTextureName(AText);
idx := FTextureCache.IndexOf(txname);
if idx = -1 then begin
CreateTexture(AText, AWidth, AHeight, w2, h2, textureID);
item := TTextureCacheItem.Create;
item.TextureID := textureID;
item.TextWidth := AWidth;
item.TextHeight := AHeight;
idx := FTextureCache.AddObject(txname, item);
end;
item := TTextureCacheItem(FTextureCache.Objects[idx]);
AWidth := item.TextWidth;
AHeight := item.TextHeight;
end;
{$ENDIF}
{ TOpenGLDrawer }

View File

@ -0,0 +1,265 @@
unit TAOpenGL;
{$mode objfpc}{$H+}
interface
uses
Classes, LazFileUtils, FPCanvas, FPImage, gl,
EasyLazFreeType, LazFreeTypeFPImageDrawer, LazFreeTypeFontCollection, TAFonts;
type
TTextureCacheItem = class
TextureID: Gluint;
TextWidth: Integer;
TextHeight: Integer;
end;
TGLFreeTypeHelper = class
private
FFont: TFreeTypeFont;
FImg: TFPMemoryImage;
FDrawer: TFPImageFreeTypeDrawer;
FTextureCache: TStringList;
protected
function BuildTextureName(AText: String): String;
procedure CreateTexture(AText: String; out ATextWidth, ATextHeight,
ATextureWidth, ATextureHeight: Integer; out ATextureID: GLuint);
function FindTexture(AText: String; out ATextWidth, ATextHeight,
ATextureWidth, ATextureHeight: Integer): GLuint;
public
constructor Create;
destructor Destroy; override;
procedure RenderText(AText: String; Alignments: TFreeTypeAlignments);
procedure SetFont(AFontName: String; AFontSize: Integer;
ABold: Boolean = false; AItalic: Boolean = false;
AUnderline: Boolean = false; AStrikethrough: Boolean = false);
procedure TextExtent(AText: String; out AWidth, AHeight: Integer);
end;
var
GLFreeTypeHelper: TGLFreeTypeHelper = nil;
implementation
uses
SysUtils;
function NextPowerOf2(n: Integer): Integer;
begin
Result := 1;
while Result < n do
Result := Result * 2;
end;
{ TGLFreeTypeHelper }
constructor TGLFreeTypeHelper.Create;
begin
FImg := TFPMemoryImage.Create(8, 8); // dummy size, will be updated when needed
FDrawer := TFPImageFreeTypeDrawer.Create(FImg);
FTextureCache := TStringList.Create;
FTextureCache.Sorted := true;
end;
destructor TGLFreeTypeHelper.Destroy;
var
i: Integer;
item: TTextureCacheItem;
begin
for i:=0 to FTextureCache.Count-1 do begin
item := TTextureCacheItem(FTextureCache.Objects[i]);
glDeleteTextures(1, @item.TextureID);
item.Free;
end;
FTextureCache.Free;
if FFont <> nil then FFont.Free;
FDrawer.Free;
FImg.Free;
inherited;
end;
{ The texture items are stored in the FTextureCache list and can be identified
by means of their name which is composed of the text and font parameters.
The name of the texture items is calculated here. }
function TGLFreeTypeHelper.BuildTextureName(AText: String): String;
begin
Result := Format('%s|%s|%d|%s', [
AText, FFont.Family, round(FFont.SizeInPoints*100), FFont.StyleAsString
]);
end;
procedure TGLFreeTypeHelper.CreateTexture(AText: String; out ATextWidth, ATextHeight,
ATextureWidth, ATextureHeight: Integer; out ATextureID: GLuint);
var
expanded_data: packed array of byte;
i, j: Integer;
c: TFPColor;
begin
if FFont = nil then
raise Exception.Create('No font selected.');
ATextWidth := round(FFont.TextWidth(AText));
ATextHeight := round(FFont.TextHeight(AText));
ATextureWidth := NextPowerOf2(ATextWidth);
ATextureHeight := NextPowerOf2(ATextHeight);
FImg.SetSize(ATextureWidth, ATextureHeight);
FDrawer.FillPixels(colTransparent);
FDrawer.DrawText(AText, FFont, 0,0, colRed, [ftaLeft, ftaTop]);
SetLength(expanded_data, 2*ATextureWidth * ATextureHeight);
for j:=0 to ATextureHeight-1 do
for i:=0 to ATextureWidth-1 do
begin
expanded_data[2*(i + j*ATextureWidth)] := 255; // Luminosity
if (i > ATextWidth) or (j > ATextHeight) then
expanded_data[2*(i + j*ATextureWidth) + 1] := 0 // Alpha
else begin
c := FImg.Colors[i,j];
expanded_data[2*(i + j*ATextureWidth) + 1] := FImg.Colors[i, j].Alpha shr 8;
end;
end;
// Set up texture parameters
glGenTextures(1, @ATextureID);
glBindTexture(GL_TEXTURE_2D, ATextureID);
// Create the texture
// Note that we are using GL_LUMINANCE_ALPHA to indicate that we are using
// two-channel data
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, ATextureWidth, ATextureHeight, 0,
GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @expanded_data[0]);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
end;
{ Finds the texture id for the given text. Returns the texture id and the
size of text and texture. Note that the texture size must be a power of 2 and
thus can be different from the text size. }
function TGLFreeTypeHelper.FindTexture(AText: String;
out ATextWidth, ATextHeight, ATextureWidth, ATextureHeight: Integer): GLuint;
var
idx: Integer;
item: TTextureCacheItem;
txname: String;
begin
txname := BuildTextureName(AText);
idx := FTextureCache.IndexOf(txname);
if idx = -1 then begin
CreateTexture(AText, ATextWidth, ATextHeight, ATextureWidth, ATextureHeight, Result);
item := TTextureCacheItem.Create;
item.TextureID := Result;
item.TextWidth := ATextWidth;
item.TextHeight := ATextHeight;
FTextureCache.AddObject(txname, item);
end else begin
item := TTextureCacheItem(FTextureCache.Objects[idx]);
result := item.TextureID;
ATextWidth := item.TextWidth;
ATextHeight := item.TextHeight;
ATextureWidth := NextPowerOf2(ATextWidth);
ATextureHeight := NextPowerOf2(ATextHeight);
end;
end;
procedure TGLFreeTypeHelper.RenderText(AText: String; Alignments: TFreeTypeAlignments);
var
textureID: GLuint;
w, h: Integer;
w2, h2: Integer;
sx, sy: Double;
dx, dy: Integer;
begin
textureID := FindTexture(AText, w, h, w2, h2);
sx := w / w2;
sy := h / h2;
glMatrixMode(GL_MODELVIEW);
glPushMatrix;
// Note: We don't support ftaJustify)
if (ftaCenter in Alignments) then dx := -w div 2
else if (ftaRight in ALignments) then dx := -w
else dx := 0;
if (ftaVerticalCenter in Alignments) then dy := -h div 2
else if (ftaBottom in Alignments) then dy := -h
else if (ftaBaseline in Alignments) then dy := - h + round(FFont.Descent)
else dy := 0;
glTranslatef(dx, dy, 0);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, textureID);
glBegin(GL_QUADS);
glTexCoord2f(0.0, sy); glVertex2f(0, h);
glTexCoord2f(sx, sy); glVertex2f(w, h);
glTexCoord2f(sx, 0.0); glVertex2f(w, 0);
glTexCoord2f(0.0, 0.0); glVertex2f(0, 0);
glEnd();
glDisable(GL_TEXTURE_2D);
glPopMatrix;
end;
procedure TGLFreeTypeHelper.SetFont(AFontName: String; AFontSize: Integer;
ABold: Boolean = false; AItalic: Boolean = false;
AUnderline: Boolean = false; AStrikethrough: Boolean = false);
var
style: TFreeTypeStyles;
begin
if GLFreeTypeHelper = nil then
raise Exception.Create('InitFonts has not been called.');
style := [];
if ABold then Include(style, ftsBold);
if AItalic then Include(style, ftsItalic);
// Create a new font if not yet loaded
if (FFont = nil) or (FFont.Family <> AFontName) or (FFont.Style <> style) then
begin
FreeAndNil(FFont);
FFont := LoadFont(AFontName, style);
if FFont = nil then
raise Exception.CreateFmt('Font "%s" not found.', [AFontName]);
end;
// Set the requested font attributes.
FFont.SizeInPoints := AFontSize;
FFont.UnderlineDecoration := AUnderline;
FFont.StrikeoutDecoration := AStrikethrough;
FFont.Hinted := true;
FFont.Quality := grqHighQuality;
//FFont.ClearType := true;
end;
{ Returns the width and height of the specified text. If the text already has
been handled with the same font parameters it is stored in the FTextureCache
list. If not, the size is determined from the font. }
procedure TGLFreeTypeHelper.TextExtent(AText: String; out AWidth, AHeight: Integer);
var
txname: String;
idx: Integer;
item: TTextureCacheItem;
textureID: Gluint;
w2, h2: Integer;
begin
txname := BuildTextureName(AText);
idx := FTextureCache.IndexOf(txname);
if idx = -1 then begin
CreateTexture(AText, AWidth, AHeight, w2, h2, textureID);
item := TTextureCacheItem.Create;
item.TextureID := textureID;
item.TextWidth := AWidth;
item.TextHeight := AHeight;
idx := FTextureCache.AddObject(txname, item);
end;
item := TTextureCacheItem(FTextureCache.Objects[idx]);
AWidth := item.TextWidth;
AHeight := item.TextHeight;
end;
end.