Index: components/lazutils/easylazfreetype.pas
===================================================================
--- components/lazutils/easylazfreetype.pas (revision 36187)
+++ components/lazutils/easylazfreetype.pas (working copy)
@@ -17,11 +17,19 @@
interface
uses
- Classes, SysUtils, LazFreeType, AvgLvlTree, fpimage, Types, lazutf8; // Graphics, LCLType
+ Classes, SysUtils, LazFreeType, TTTypes, TTRASTER, AvgLvlTree, fpimage, Types, lazutf8; // Graphics, LCLType
type
TGlyphRenderQuality = (grqMonochrome, grqLowQuality, grqHighQuality);
ArrayOfSingle= array of single;
+ TCharPosition= record
+ x,width,
+ yTop,yBase,yBottom: single;
+ end;
+ ArrayOfCharPosition = array of TCharPosition;
+ TFreeTypeAlignment = (ftaLeft,ftaCenter,ftaRight,ftaJustify,ftaTop,ftaBaseline,ftaBottom);
+ TFreeTypeAlignments = set of TFreeTypeAlignment;
+
TFreeTypeGlyph = class;
{ TFreeTypeRenderableFont }
@@ -30,16 +38,30 @@
protected
function GetClearType: boolean; virtual; abstract;
procedure SetClearType(const AValue: boolean); virtual; abstract;
+ function GetLineFullHeight: single; virtual; abstract;
+ function GetAscent: single; virtual; abstract;
+ function GetDescent: single; virtual; abstract;
+ function GetLineSpacing: single; virtual; abstract;
+
public
+ function TextWidth(AText: string): single; virtual; abstract;
+ function TextHeight(AText: string): single; virtual; abstract;
+ procedure GetTextSize(AText: string; out w,h: single); virtual;
procedure RenderText(AText: string; x,y: single; ARect: TRect; OnRender : TDirectRenderingFunction); virtual; abstract;
property ClearType: boolean read GetClearType write SetClearType;
+ property Ascent: single read GetAscent;
+ property Descent: single read GetDescent;
+ property LineSpacing: single read GetLineSpacing;
+ property LineFullHeight: single read GetLineFullHeight;
end;
{ TFreeTypeDrawer }
TFreeTypeDrawer = class
- procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor; AOpactiy: Byte); virtual; abstract; overload;
- procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload;
+ procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor; AOpacity: Byte); virtual; overload;
+ procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor; AOpacity: Byte; AAlign: TFreeTypeAlignments); virtual; overload;
+ procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); virtual; abstract; overload;
+ procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor; AAlign: TFreeTypeAlignments); virtual; overload;
end;
{ TFreeTypeFont }
@@ -59,6 +81,7 @@
function GetPixelSize: single;
procedure SetDPI(const AValue: integer);
procedure SetHinted(const AValue: boolean);
+ procedure SetLineFullHeight(AValue: single);
procedure SetName(const AValue: String);
procedure DiscardFace;
procedure DiscardInstance;
@@ -68,6 +91,7 @@
glyph_index : Word): boolean;
procedure SetWidthFactor(const AValue: single);
procedure UpdateSizeInPoints;
+ procedure UpdateMetrics;
procedure GetCharmap;
protected
FFace: TT_Face;
@@ -77,15 +101,24 @@
FGlyphTable: TAvgLvlTree;
FCharMap: TT_CharMap;
FCharmapOk: boolean;
+ FAscentValue, FDescentValue, FLineGapValue, FLargeLineGapValue: single;
function GetClearType: boolean; override;
procedure SetClearType(const AValue: boolean); override;
+ function GetLineFullHeight: single; override;
+ function GetAscent: single; override;
+ function GetDescent: single; override;
+ function GetLineSpacing: single; override;
public
Quality : TGlyphRenderQuality;
+ SmallLinePadding: boolean;
constructor Create;
destructor Destroy; override;
procedure RenderText(AText: string; x,y: single; ARect: TRect; OnRender : TDirectRenderingFunction); override;
- function TextWidth(AText: string): single;
+ function TextWidth(AText: string): single; override;
+ function TextHeight(AText: string): single; override;
function CharsWidth(AText: string): ArrayOfSingle;
+ function CharsPosition(AText: string): ArrayOfCharPosition; overload;
+ function CharsPosition(AText: string; AAlign: TFreeTypeAlignments): ArrayOfCharPosition; overload;
property Name: String read FName write SetName;
property DPI: integer read GetDPI write SetDPI;
property SizeInPoints: single read FPointSize write SetPointSize;
@@ -95,6 +128,7 @@
property CharIndex[AChar: integer]: integer read GetCharIndex;
property Hinted: boolean read FHinted write SetHinted;
property WidthFactor: single read FWidthFactor write SetWidthFactor;
+ property LineFullHeight: single read GetLineFullHeight write SetLineFullHeight;
end;
{ TFreeTypeGlyph }
@@ -110,6 +144,7 @@
public
constructor Create(AFont: TFreeTypeFont; AIndex: integer);
function RenderDirectly(x,y: single; Rect: TRect; OnRender : TDirectRenderingFunction; quality : TGlyphRenderQuality; ClearType: boolean = false): boolean;
+ function RenderDirectly(ARasterizer: TFreeTypeRasterizer; x,y: single; Rect: TRect; OnRender : TDirectRenderingFunction; quality : TGlyphRenderQuality; ClearType: boolean = false): boolean;
destructor Destroy; override;
property Loaded: boolean read FLoaded;
property Data: TT_Glyph read FGlyphData;
@@ -124,11 +159,14 @@
TFreeTypeRasterMap = class
protected
map: TT_Raster_Map;
+ FRasterizer: TFreeTypeRasterizer;
function GetHeight: integer; virtual;
function GetWidth: integer; virtual;
function GetScanLine(y: integer): pointer;
+ procedure Init(AWidth,AHeight: integer); virtual; abstract;
public
- constructor Create(AWidth,AHeight: integer); virtual; abstract;
+ constructor Create(AWidth,AHeight: integer); virtual;
+ constructor Create(ARasterizer: TFreeTypeRasterizer; AWidth,AHeight: integer); virtual;
procedure Clear;
procedure Fill;
function RenderGlyph(glyph : TFreeTypeGlyph; x,y: single) : boolean; virtual; abstract;
@@ -148,8 +186,9 @@
ScanBit: byte;
ScanX: integer;
function GetPixelsInHorizlineNoBoundsChecking(x,y,x2: integer) : integer; inline;
+ protected
+ procedure Init(AWidth,AHeight: integer); override;
public
- constructor Create(AWidth,AHeight: integer); override;
function RenderGlyph(glyph : TFreeTypeGlyph; x,y: single) : boolean; override;
procedure ScanMoveTo(x,y: integer); override;
function ScanNextPixel: boolean;
@@ -166,9 +205,10 @@
private
ScanPtrStart: pbyte;
ScanX: integer;
+ protected
+ procedure Init(AWidth, AHeight: integer); override;
public
RenderQuality: TGlyphRenderQuality;
- constructor Create(AWidth,AHeight: integer); override;
function RenderGlyph(glyph : TFreeTypeGlyph; x,y: single) : boolean; override;
procedure ScanMoveTo(x,y: integer); override;
function ScanNextPixel: byte;
@@ -180,8 +220,6 @@
implementation
-uses TTRaster;//, LCLIntf, LCLProc;
-
var
BitCountTable: packed array[0..255] of byte;
RegularGray5: TT_Gray_Palette;
@@ -198,14 +236,66 @@
raise Exception.Create('FreeType cannot be initialized');
end;
+{ TFreeTypeRenderableFont }
+
+procedure TFreeTypeRenderableFont.GetTextSize(AText: string; out w, h: single);
+begin
+ w := TextWidth(AText);
+ h := TextHeight(AText);
+end;
+
{ TFreeTypeDrawer }
procedure TFreeTypeDrawer.DrawText(AText: string;
- AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor);
+ AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor; AOpacity: Byte);
+var col: TFPColor;
begin
- DrawText(AText, AFont, x,y, AColor, 255);
+ col := AColor;
+ col.alpha := col.alpha*AOpacity div 255;
+ DrawText(AText, AFont, x,y, col, []);
end;
+procedure TFreeTypeDrawer.DrawText(AText: string;
+ AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor; AOpacity: Byte; AAlign: TFreeTypeAlignments);
+var col: TFPColor;
+begin
+ col := AColor;
+ col.alpha := col.alpha*AOpacity div 255;
+ DrawText(AText, AFont, x,y, col, AAlign);
+end;
+
+procedure TFreeTypeDrawer.DrawText(AText: string;
+ AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor; AAlign: TFreeTypeAlignments);
+var idx : integer;
+begin
+ if not (ftaBaseline in AAlign) then
+ begin
+ if ftaTop in AAlign then
+ y += AFont.Ascent else
+ if ftaBottom in AAlign then
+ y -= AFont.TextHeight(AText) - AFont.Ascent;
+ end;
+ AAlign -= [ftaTop,ftaBaseline,ftaBottom];
+
+ idx := pos(LineEnding, AText);
+ while idx <> 0 do
+ begin
+ DrawText(copy(AText,1,idx-1), AFont, x,y, AColor, AAlign);
+ delete(AText,1,idx+length(LineEnding)-1);
+ idx := pos(LineEnding, AText);
+ y += AFont.LineFullHeight;
+ end;
+
+ if not (ftaLeft in AAlign) then
+ begin
+ if ftaCenter in AAlign then
+ x -= AFont.TextWidth(AText)/2 else
+ if ftaRight in AAlign then
+ x -= AFont.TextWidth(AText);
+ end;
+ DrawText(AText, AFont, x,y, AColor);
+end;
+
{ TFreeTypeGlyph }
{$hints off}
@@ -249,6 +339,13 @@
function TFreeTypeGlyph.RenderDirectly(x, y: single; Rect: TRect;
OnRender: TDirectRenderingFunction; quality : TGlyphRenderQuality; ClearType: boolean): boolean;
+begin
+ result := RenderDirectly(TTGetDefaultRasterizer, x,y, Rect, OnRender, quality, ClearType);
+end;
+
+function TFreeTypeGlyph.RenderDirectly(ARasterizer: TFreeTypeRasterizer; x,
+ y: single; Rect: TRect; OnRender: TDirectRenderingFunction;
+ quality: TGlyphRenderQuality; ClearType: boolean): boolean;
var mono: TFreeTypeMonochromeMap;
tx,xb,yb: integer;
pdest: pbyte;
@@ -275,7 +372,7 @@
case quality of
grqMonochrome: begin
tx := rect.right-rect.left;
- mono := TFreeTypeMonochromeMap.Create(tx,rect.bottom-rect.top);
+ mono := TFreeTypeMonochromeMap.Create(ARasterizer,tx,rect.bottom-rect.top);
result := mono.RenderGlyph(self,x-rect.left,y-rect.top);
if result then
begin
@@ -299,10 +396,10 @@
mono.Free;
end;
grqLowQuality: begin
- TT_Set_Raster_Palette(RegularGray5);
- result := TT_Render_Directly_Glyph_Gray(FGlyphData, round((x-rect.left)*64), round((rect.bottom-y)*64), rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, OnRender) = TT_Err_Ok;
+ ARasterizer.Set_Raster_Palette(RegularGray5);
+ result := TT_Render_Directly_Glyph_Gray(FGlyphData, round((x-rect.left)*64), round((rect.bottom-y)*64), rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, OnRender, ARasterizer) = TT_Err_Ok;
end;
- grqHighQuality: result := TT_Render_Directly_Glyph_HQ(FGlyphData, round((x-rect.left)*64), round((rect.bottom-y)*64), rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, OnRender) = TT_Err_Ok;
+ grqHighQuality: result := TT_Render_Directly_Glyph_HQ(FGlyphData, round((x-rect.left)*64), round((rect.bottom-y)*64), rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, OnRender, ARasterizer) = TT_Err_Ok;
else
result := false;
end;
@@ -330,6 +427,7 @@
FFaceLoaded:= true;
FName:=AValue;
+ UpdateMetrics;
GetCharmap;
errorNum := TT_New_Instance(FFace, FInstance);
@@ -374,6 +472,11 @@
end;
end;
+function TFreeTypeFont.GetAscent: single;
+begin
+ result := FAscentValue*SizeInPixels;
+end;
+
function TFreeTypeFont.GetClearType: boolean;
begin
Result:= FClearType;
@@ -387,6 +490,11 @@
result := AChar;
end;
+function TFreeTypeFont.GetDescent: single;
+begin
+ result := FDescentValue*SizeInPixels;
+end;
+
function TFreeTypeFont.GetGlyph(Index: integer): TFreeTypeGlyph;
var node: TAvgLvlTreeNode;
lGlyph: TFreeTypeGlyph;
@@ -417,6 +525,19 @@
end;
{$hints on}
+function TFreeTypeFont.GetLineFullHeight: single;
+begin
+ result := (FAscentValue + FDescentValue)*SizeInPixels + GetLineSpacing;
+end;
+
+function TFreeTypeFont.GetLineSpacing: single;
+begin
+ if not SmallLinePadding then
+ result := FLargeLineGapValue*SizeInPixels
+ else
+ result := FLineGapValue*SizeInPixels;
+end;
+
function TFreeTypeFont.GetPixelSize: single;
begin
result := SizeInPoints * DPI / 72;
@@ -445,6 +566,20 @@
FGlyphTable.FreeAndClear;
end;
+procedure TFreeTypeFont.SetLineFullHeight(AValue: single);
+var Ratio: single;
+begin
+ Ratio := FAscentValue + FDescentValue;
+ if not SmallLinePadding then
+ Ratio += FLargeLineGapValue
+ else
+ Ratio += FLineGapValue;
+ if Ratio <> 0 then
+ SizeInPixels := AValue / Ratio
+ else
+ SizeInPixels := AValue;
+end;
+
procedure TFreeTypeFont.DiscardFace;
begin
if FFaceLoaded then
@@ -514,6 +649,55 @@
end;
end;
+procedure TFreeTypeFont.UpdateMetrics;
+var prop: TT_Face_Properties;
+begin
+ if FFaceLoaded then
+ begin
+ TT_Get_Face_Properties(FFace,prop);
+ FAscentValue := prop.horizontal^.ascender;
+ FDescentValue := prop.horizontal^.descender;
+ FLineGapValue:= prop.horizontal^.line_gap;
+ FLargeLineGapValue:= FLineGapValue;
+
+ if (FAscentValue = 0) and (FDescentValue = 0) then
+ begin
+ if prop.os2^.version <> $ffff then
+ begin
+ if (prop.os2^.usWinAscent <> 0) or (prop.os2^.usWinDescent <> 0) then
+ begin
+ FAscentValue := prop.os2^.usWinAscent;
+ FDescentValue := -prop.os2^.usWinDescent;
+ end else
+ begin
+ FAscentValue := prop.os2^.sTypoAscender;
+ FDescentValue := prop.os2^.sTypoDescender;
+ end;
+ end;
+ end;
+
+ if prop.os2^.version <> $ffff then
+ begin
+ if prop.os2^.sTypoLineGap > FLargeLineGapValue then
+ FLargeLineGapValue := prop.os2^.sTypoLineGap;
+ end;
+
+ FAscentValue /= prop.header^.units_per_EM;
+ FDescentValue /= -prop.header^.units_per_EM;
+ FLineGapValue /= prop.header^.units_per_EM;
+ FLargeLineGapValue /= prop.header^.units_per_EM;
+
+ if FLargeLineGapValue = 0 then
+ FLargeLineGapValue := (FAscentValue+FDescentValue)*0.1;
+
+ end else
+ begin
+ FAscentValue := -0.5;
+ FDescentValue := 0.5;
+ FLineGapValue := 0;
+ end;
+end;
+
procedure TFreeTypeFont.GetCharmap;
var i,n: integer;
platform,encoding: integer;
@@ -585,6 +769,7 @@
FHinted := true;
FWidthFactor := 1;
FClearType := false;
+ SmallLinePadding:= true;
end;
destructor TFreeTypeFont.Destroy;
@@ -600,8 +785,17 @@
var
pstr: pchar;
left,charcode,charlen: integer;
+ idx: integer;
begin
if AText = '' then exit;
+ idx := pos(LineEnding,AText);
+ while idx <> 0 do
+ begin
+ RenderText(copy(AText,1,idx-1),x,y,ARect,OnRender);
+ delete(AText,1,idx+length(LineEnding)-1);
+ y += LineFullHeight;
+ idx := pos(LineEnding,AText);
+ end;
pstr := @AText[1];
left := length(AText);
while left > 0 do
@@ -611,7 +805,10 @@
dec(left,charlen);
with Glyph[CharIndex[charcode]] do
begin
- RenderDirectly(x,y,ARect,OnRender,quality,FClearType);
+ if Hinted then
+ RenderDirectly(x,round(y),ARect,OnRender,quality,FClearType)
+ else
+ RenderDirectly(x,y,ARect,OnRender,quality,FClearType);
if FClearType then
x += Advance/3
else
@@ -624,9 +821,27 @@
var
pstr: pchar;
left,charcode,charlen: integer;
+ maxWidth,w: single;
+ idx: integer;
begin
result := 0;
if AText = '' then exit;
+
+ maxWidth := 0;
+ idx := pos(LineEnding,AText);
+ while idx <> 0 do
+ begin
+ w := TextWidth(copy(AText,1,idx-1));
+ if w > maxWidth then maxWidth:= w;
+ delete(AText,1,idx+length(LineEnding)-1);
+ idx := pos(LineEnding,AText);
+ end;
+ if AText = '' then
+ begin
+ result := maxWidth;
+ exit;
+ end;
+
pstr := @AText[1];
left := length(AText);
while left > 0 do
@@ -642,13 +857,36 @@
result += Advance;
end;
end;
+ if maxWidth > result then
+ result := maxWidth;
end;
+function TFreeTypeFont.TextHeight(AText: string): single;
+var idx: integer;
+ nb: integer;
+begin
+ if AText= '' then result := 0
+ else
+ begin
+ result := LineFullHeight;
+ nb := 1;
+ idx := pos(LineEnding,AText);
+ while idx <> 0 do
+ begin
+ nb += 1;
+ delete(AText,1,idx+length(LineEnding)-1);
+ idx := pos(LineEnding,AText);
+ end;
+ result *= nb;
+ end;
+end;
+
function TFreeTypeFont.CharsWidth(AText: string): ArrayOfSingle;
var
pstr: pchar;
left,charcode,charlen: integer;
- resultIndex: integer;
+ resultIndex,i: integer;
+ w: single;
begin
if AText = '' then exit;
pstr := @AText[1];
@@ -664,17 +902,154 @@
with Glyph[CharIndex[charcode]] do
begin
if FClearType then
- result[resultIndex] := Advance/3
+ w := Advance/3
else
- result[resultIndex] := Advance;
+ w := Advance;
end;
- inc(resultIndex);
+
+ for i := 1 to charlen do
+ begin
+ result[resultIndex] := w;
+ inc(resultIndex);
+ end;
end;
end;
+function TFreeTypeFont.CharsPosition(AText: string): ArrayOfCharPosition;
+begin
+ result := CharsPosition(AText, []);
+end;
+
+function TFreeTypeFont.CharsPosition(AText: string; AAlign: TFreeTypeAlignments): ArrayOfCharPosition;
+var
+ resultIndex,resultLineStart: integer;
+ curX: single;
+
+ procedure ApplyHorizAlign;
+ var delta: single;
+ i: integer;
+ begin
+ if ftaLeft in AAlign then exit;
+ if ftaCenter in AAlign then
+ delta := -curX/2
+ else if ftaRight in AAlign then
+ delta := -curX
+ else
+ exit;
+
+ for i := resultLineStart to resultIndex-1 do
+ result[i].x += delta;
+ end;
+
+var
+ pstr: pchar;
+ left,charcode,charlen: integer;
+ i : integer;
+ w,h,y,yTopRel,yBottomRel: single;
+ Found: boolean;
+
+begin
+ if AText = '' then exit;
+ pstr := @AText[1];
+ left := length(AText);
+ setlength(result, UTF8Length(AText)+1);
+ resultIndex := 0;
+ resultLineStart := 0;
+ if ftaLeft in AAlign then AAlign -= [ftaLeft, ftaCenter, ftaRight];
+ if ftaBaseline in AAlign then AAlign -= [ftaTop, ftaBaseline, ftaBottom];
+ curX := 0;
+ y := 0;
+ if ftaTop in AAlign then
+ begin
+ y += Ascent;
+ AAlign -= [ftaTop, ftaBottom];
+ end;
+ yTopRel := -Ascent;
+ yBottomRel := Descent;
+ h := LineFullHeight;
+ while left > 0 do
+ begin
+ if (left > length(LineEnding)) and (pstr^ = LineEnding[1]) then
+ begin
+ Found := true;
+ for i := 2 to length(LineEnding) do
+ if (pstr+(i-1))^ <> LineEnding[i] then
+ begin
+ Found := false;
+ break;
+ end;
+ if Found then
+ begin
+ for i := 1 to length(LineEnding) do
+ begin
+ with result[resultIndex] do
+ begin
+ x := curX;
+ width := 0;
+ yTop := y+yTopRel;
+ yBase := y;
+ yBottom := y+yBottomRel;
+ end;
+ inc(resultIndex);
+ inc(pstr);
+ dec(left);
+ end;
+ ApplyHorizAlign;
+ y += h;
+ curX := 0;
+ resultLineStart := resultIndex;
+ if left <= 0 then break;
+ end;
+ end;
+ charcode := UTF8CharacterToUnicode(pstr, charlen);
+ inc(pstr,charlen);
+ dec(left,charlen);
+ with Glyph[CharIndex[charcode]] do
+ begin
+ if FClearType then
+ w := Advance/3
+ else
+ w := Advance;
+ end;
+ for i := 1 to charlen do
+ with result[resultIndex] do
+ begin
+ x := curX;
+ width := w;
+ yTop := y+yTopRel;
+ yBase := y;
+ yBottom := y+yBottomRel;
+ inc(resultIndex);
+ end;
+ curX += w;
+ end;
+ with result[resultIndex] do
+ begin
+ x := curX;
+ width := 0;
+ yTop := y+yTopRel;
+ yBase := y;
+ yBottom := y+yBottomRel;
+ end;
+ inc(resultIndex);
+ ApplyHorizAlign;
+
+ if ftaBottom in AAlign then
+ begin
+ y += LineFullHeight-Ascent;
+ for i := 0 to high(result) do
+ with result[i] do
+ begin
+ yTop -= y;
+ yBase -= y;
+ yBottom -= y;
+ end;
+ end;
+end;
+
{ TFreeTypeGrayscaleMap }
-constructor TFreeTypeGrayscaleMap.Create(AWidth,AHeight: integer);
+procedure TFreeTypeGrayscaleMap.Init(AWidth, AHeight: integer);
begin
map.Width := AWidth;
map.Rows := AHeight;
@@ -696,7 +1071,7 @@
grqMonochrome:
begin
tx := Width;
- mono := TFreeTypeMonochromeMap.Create(tx,Height);
+ mono := TFreeTypeMonochromeMap.Create(FRasterizer, tx,Height);
result := mono.RenderGlyph(glyph,x,y);
if result then
begin
@@ -723,12 +1098,12 @@
end;
grqLowQuality:
begin
- TT_Set_Raster_Palette(RegularGray5);
- result := TT_Get_Glyph_Pixmap(glyph.data, map, round(x*64), round((height-y)*64)) = TT_Err_Ok;
+ FRasterizer.Set_Raster_Palette(RegularGray5);
+ result := TT_Get_Glyph_Pixmap(glyph.data, map, round(x*64), round((height-y)*64), FRasterizer) = TT_Err_Ok;
end;
grqHighQuality:
begin
- result := TT_Get_Glyph_Pixmap_HQ(glyph.data, map, round(x*64), round((height-y)*64)) = TT_Err_Ok;
+ result := TT_Get_Glyph_Pixmap_HQ(glyph.data, map, round(x*64), round((height-y)*64), FRasterizer) = TT_Err_Ok;
end;
end;
end;
@@ -800,6 +1175,19 @@
Result:= pointer(pbyte(map.Buffer) + y*map.Cols);
end;
+constructor TFreeTypeRasterMap.Create(AWidth, AHeight: integer);
+begin
+ FRasterizer := TTGetDefaultRasterizer;
+ Init(AWidth,AHeight);
+end;
+
+constructor TFreeTypeRasterMap.Create(ARasterizer: TFreeTypeRasterizer; AWidth,
+ AHeight: integer);
+begin
+ FRasterizer := ARasterizer;
+ Init(AWidth,AHeight);
+end;
+
procedure TFreeTypeRasterMap.Clear;
begin
fillchar(map.Buffer^, map.Size, 0);
@@ -818,20 +1206,9 @@
{ TFreeTypeMonochromeMap }
-constructor TFreeTypeMonochromeMap.Create(AWidth,AHeight: integer);
-begin
- map.Width := AWidth;
- map.Rows := AHeight;
- map.Cols:= (AWidth+7) shr 3;
- map.flow:= TT_Flow_Down;
- map.Size:= map.Rows*map.Cols;
- getmem(map.Buffer,map.Size);
- Clear;
-end;
-
function TFreeTypeMonochromeMap.RenderGlyph(glyph: TFreeTypeGlyph; x,y: single): boolean;
begin
- result := TT_Get_Glyph_Bitmap(glyph.data, map, round(x*64), round((height-y)*64)) = TT_Err_Ok;
+ result := TT_Get_Glyph_Bitmap(glyph.data, map, round(x*64), round((height-y)*64), FRasterizer) = TT_Err_Ok;
end;
procedure TFreeTypeMonochromeMap.ScanMoveTo(x, y: integer);
@@ -957,6 +1334,17 @@
result += BitCountTable[ p^ and ($ff shr (x and 7)) and ($ff shl (x2 and 7 xor 7))];
end;
+procedure TFreeTypeMonochromeMap.Init(AWidth, AHeight: integer);
+begin
+ map.Width := AWidth;
+ map.Rows := AHeight;
+ map.Cols:= (AWidth+7) shr 3;
+ map.flow:= TT_Flow_Down;
+ map.Size:= map.Rows*map.Cols;
+ getmem(map.Buffer,map.Size);
+ Clear;
+end;
+
procedure TFreeTypeMonochromeMap.TogglePixel(x, y: integer);
var p: pbyte;
begin
Index: components/lazutils/lazfreetype.pas
===================================================================
--- components/lazutils/lazfreetype.pas (revision 36187)
+++ components/lazutils/lazfreetype.pas (working copy)
@@ -36,454 +36,8 @@
interface
-type
+uses TTTypes;
-{$IFDEF OS2}
- TT_Int = Longint;
-{$ELSE}
- TT_Int = Integer;
-{$ENDIF}
-
- TT_Long = longint;
- TT_ULong = longint; (* there are no unsigned longs in Pascal :-( *)
- (* it will probably be a good idea to use cardinals *)
- (* with Delphi and Virtual a bit later.. *)
- TT_Short = integer;
- TT_UShort = word;
-
- TT_Fixed = LongInt; (* Signed Fixed 16.16 Float *)
-
- TT_FWord = Integer; (* Distance in FUnits *)
- TT_UFWord = Word; (* Unsigned Distance *)
-
- TT_F2Dot14 = Integer; (* signed fixed float 2.14 used for *)
- (* unary vectors, with layout : *)
- (* *)
- (* s : 1 -- sign bit *)
- (* m : 1 -- mantissa bit *)
- (* f : 14 -- unsigned fractional *)
- (* *)
- (* 's:m' is the 2-bit signed int *)
- (* value to which the *positive* *)
- (* fractional part should be *)
- (* added. *)
- (* *)
-
- TT_F26Dot6 = LongInt; (* 26.6 fixed float, used for pixel coordinates *)
-
- TT_Pos = Longint; (* funits or 26.6, depending on context *)
-
- (******************************************************)
- (* a simple unit vector type *)
- (* *)
- TT_UnitVector = record
-
- x : TT_F2Dot14;
- y : TT_F2Dot14;
- end;
-
- (******************************************************)
- (* a simple vector type *)
- (* *)
- TT_Vector = record
-
- x : TT_Pos;
- y : TT_Pos;
- end;
-
- (******************************************************)
- (* a simple 2x2 matrix type *)
- (* *)
- TT_Matrix = record
-
- xx, xy : TT_Fixed;
- yx, yy : TT_Fixed;
- end;
-
- (******************************************************)
- (* a glyph's bounding box *)
- (* *)
- TT_BBox = record
-
- xMin, yMin : TT_Pos;
- xMax, yMax : TT_Pos;
- end;
-
- (******************************************************)
- (* the engine's error condition type - 0 always *)
- (* means success. *)
- (* *)
- TT_Error = TT_Int;
-
- TT_Points_Table = array[0..99] of TT_Vector;
- TT_Points = ^TT_Points_Table;
-
- TT_Coordinates = array[0..99] of TT_Pos;
- TT_PCoordinates = ^TT_Coordinates;
-
- TT_TouchTable = array[0..9] of byte;
- TT_PTouchTable = ^TT_TouchTable;
-
- TT_ConStarts = array[0..9] of word;
- TT_PConStarts = ^TT_ConStarts;
-
- (******************************************************)
- (* glyph outline description *)
- (* *)
- TT_Outline = record
-
- n_points : integer;
- n_contours : integer;
-
- points : TT_Points; (* array of point coordinates *)
- flags : TT_PTouchTable; (* array of point flags *)
- conEnds : TT_PConStarts; (* array of contours ends *)
-
- owner : Boolean; (* this flag is set when the outline *)
- (* owns the arrays it uses. *)
-
- high_precision : Boolean;
- second_pass : Boolean;
- dropout_mode : Byte;
- end;
-
- (******************************************************)
- (* glyph metrics structure *)
- (* *)
- TT_Glyph_Metrics = record
-
- bbox : TT_BBox;
- bearingX : TT_Pos;
- bearingY : TT_Pos;
- advance : TT_Pos;
- end;
-
- (******************************************************)
- (* big glyph metrics structure *)
- (* *)
- TT_Big_Glyph_Metrics = record
-
- bbox : TT_BBox;
- horiBearingX : TT_Pos;
- horiBearingY : TT_Pos;
- horiAdvance : TT_Pos;
- vertBearingX : TT_Pos;
- vertBearingY : TT_Pos;
- vertAdvance : TT_Pos;
- end;
-
- TDirectRenderingFunction = procedure( x,y,tx: integer;
- data: pointer ) of object;
-
-
- (******************************************************)
- (* instance metrics. used to return information to *)
- (* clients regarding an instance's important state *)
- (* *)
- TT_Instance_Metrics = record
-
- pointsize : integer;
-
- x_ppem : integer;
- y_ppem : integer;
-
- x_scale : TT_Fixed;
- y_scale : TT_Fixed;
-
- x_resolution : integer;
- y_resolution : integer;
- end;
-
-const
- TT_Flow_Down = -1;
- TT_Flow_Up = +1;
-
-type
-
- (******************************************************)
- (* a record used to describe a bitmap or pixmap to *)
- (* the rasterizer. *)
- (* *)
- TT_Raster_Map = record
-
- Rows : TT_Int; (* rows number of the bitmap *)
- Cols : TT_Int; (* columns (bytes) per row *)
- Width : TT_Int; (* pixels per row *)
- Flow : TT_Int; (* bit/pixmap's flow *)
- Buffer : pointer; (* bit/pixmap data *)
- Size : longint; (* bit/pixmap data size (bytes) *)
- end;
-
- (******************************************************)
- (* The TrueType font header table structure *)
- (* *)
- TT_Header = record
-
- table_version : TT_Fixed;
- font_revision : TT_Fixed;
-
- checksum_adjust : TT_Long;
- magic_number : TT_Long;
-
- flags : TT_UShort;
- units_per_EM : TT_UShort;
-
- created : array[0..1] of TT_Long;
- modified : array[0..1] of TT_Long;
-
- xMin, yMin : TT_FWord;
- xMax, yMax : TT_FWord;
-
- mac_style : TT_UShort;
- lowest_rec_PPEM : TT_UShort;
- font_direction : TT_Short;
-
- index_to_loc_format : TT_Short;
- glyph_data_format : TT_Short;
- end;
-
- (******************************************************)
- (* The TrueType horizontal header table structure *)
- (* *)
- TT_Horizontal_Header = record
-
- version : TT_Fixed;
- ascender : TT_FWord;
- descender : TT_FWord;
- line_gap : TT_FWord;
-
- advance_Width_Max : TT_UShort;
- min_left_side_bearing : TT_Short;
- min_right_side_bearing : TT_Short;
- xMax_extent : TT_Short;
- caret_slope_rise : TT_Short;
- caret_slope_run : TT_Short;
-
- reserved : array[0..4] of TT_SHort;
-
- metric_data_format : TT_Short;
- number_of_HMetrics : TT_UShort;
-
- (* the following are not part of the header in the file *)
-
- short_metrics : Pointer;
- long_metrics : Pointer;
- end;
-
- (******************************************************)
- (* The TrueType vertical header table structure *)
- (* *)
- TT_Vertical_Header = record
-
- version : TT_Fixed;
- ascender : TT_FWord;
- descender : TT_FWord;
- line_gap : TT_FWord;
-
- advance_Height_Max : TT_UShort;
- min_top_side_bearing : TT_Short;
- min_bottom_side_bearing : TT_Short;
- yMax_extent : TT_Short;
- caret_slope_rise : TT_Short;
- caret_slope_run : TT_Short;
-
- reserved : array[0..4] of TT_SHort;
-
- metric_data_format : TT_Short;
- number_of_VMetrics : TT_UShort;
-
- (* the following are not part of the header in the file *)
-
- short_metrics : Pointer;
- long_metrics : Pointer;
- end;
-
- (******************************************************)
- (* The TrueType OS/2 table structure *)
- (* *)
- TT_OS2 = record
- version : TT_UShort; (* $0001 *)
- xAvgCharWidth : TT_Short;
- usWeightClass : TT_UShort;
- usWidthClass : TT_UShort;
- fsType : TT_Short;
- ySubscriptXSize : TT_Short;
- ySubscriptYSize : TT_Short;
- ySubScriptXOffset : TT_Short;
- ySubscriptYOffset : TT_Short;
- ySuperscriptXSize : TT_Short;
- ySuperscriptYSize : TT_Short;
- ySuperscriptXOffset : TT_Short;
- ySuperscriptYOffset : TT_Short;
- yStrikeoutSize : TT_Short;
- yStrikeoutPosition : TT_Short;
- sFamilyClass : TT_Short;
- panose : array[0..9] of Byte;
- ulUnicodeRange1 : TT_ULong; (* bits 0-31 *)
- ulUnicodeRange2 : TT_ULong; (* bits 32-63 *)
- ulUnicodeRange3 : TT_ULong; (* bits 64-95 *)
- ulUnicodeRange4 : TT_ULong; (* bits 96-127 *)
- achVendID : array[0..3] of Byte;
- fsSelection : TT_UShort;
- usFirstCharIndex : TT_UShort;
- usLastCharIndex : TT_UShort;
- sTypoAscender : TT_Short;
- sTypoDescender : TT_Short;
- sTypoLineGap : TT_Short;
- usWinAscent : TT_UShort;
- usWinDescent : TT_UShort;
-
- (* only version 1 tables *)
- ulCodePageRange1 : TT_ULong;
- ulCodePageRange2 : TT_ULong;
- end;
-
- (******************************************************)
- (* The TrueType Postscript table structure *)
- (* *)
- TT_Postscript = record
-
- FormatType : TT_Fixed;
- italicAngle : TT_Fixed;
- underlinePosition : TT_Short;
- underlineThickness : TT_Short;
- isFixedPitch : TT_ULong;
- minMemType42 : TT_ULong;
- maxMemType42 : TT_ULong;
- minMemType1 : TT_ULong;
- maxMemType1 : TT_ULong;
- end;
-
- (******************************************************)
- (* face properties. use to report important face *)
- (* data to clients *)
- (* *)
- TT_Face_Properties = record
-
- num_glyphs : integer;
- max_points : integer;
- max_contours : integer;
- max_faces : integer;
-
- header : ^TT_Header;
- horizontal : ^TT_Horizontal_Header;
- vertical : ^TT_Vertical_Header;
- os2 : ^TT_OS2;
- postscript : ^TT_Postscript;
- end;
-
- (******************************************************)
- (* Objects handle types *)
- (* *)
- TT_Stream = record z : Pointer; end;
- TT_Face = record z : Pointer; end;
- TT_Instance = record z : Pointer; end;
- TT_Glyph = record z : Pointer; end;
- TT_CharMap = record z : Pointer; end;
-
- TT_Gray_Palette = packed array[0..4] of byte;
- PTT_Gray_Palette = ^TT_Gray_Palette;
-
- (******************************************************************)
- (* *)
- (* ERROR CODES *)
- (* *)
- (******************************************************************)
-
-const
- (* ------------------- Success is always 0 ---------------------- *)
-
- TT_Err_Ok = 0;
-
- (* -------------------------------------------------------------- *)
-
- TT_Err_Invalid_Face_Handle = $0001;
- TT_Err_Invalid_Instance_Handle = $0002;
- TT_Err_Invalid_Glyph_Handle = $0003;
- TT_Err_Invalid_CharMap_Handle = $0004;
- TT_Err_Invalid_Result_Address = $0005;
- TT_Err_Invalid_Glyph_Index = $0006;
- TT_Err_Invalid_Argument = $0007;
- TT_Err_Could_Not_Open_File = $0008;
- TT_Err_File_Is_Not_Collection = $0009;
-
- TT_Err_Table_Missing = $000A;
- TT_Err_Invalid_Horiz_Metrics = $000B;
- TT_Err_Invalid_Vert_Metrics = $000B;
- TT_Err_Invalid_CharMap_Format = $000C;
-
- TT_Err_Invalid_File_Format = $0010;
- TT_Err_File_Error = $0011;
-
- TT_Err_Invalid_Engine = $0020;
- TT_Err_Too_Many_Extensions = $0021;
- TT_Err_Extensions_Unsupported = $0022;
- TT_Err_Invalid_Extension_Id = $0023;
-
- TT_Err_No_Vertical_Data = $0030;
-
- TT_Err_Max_Profile_Missing = $0080;
- TT_Err_Header_Table_Missing = $0081;
- TT_Err_Horiz_Header_Missing = $0082;
- TT_Err_Locations_Missing = $0083;
- TT_Err_Name_Table_Missing = $0084;
- TT_Err_CMap_Table_Missing = $0085;
- TT_Err_Hmtx_Table_Missing = $0086;
- TT_Err_OS2_Table_Missing = $0087;
- TT_Err_Post_Table_Missing = $0088;
-
- (* -------------------------------------------------------------- *)
-
- TT_Err_Out_Of_Memory = $0100;
-
- (* -------------------------------------------------------------- *)
-
- TT_Err_Invalid_File_Offset = $0200;
- TT_Err_Invalid_File_Read = $0201;
- TT_Err_Invalid_Frame_Access = $0202;
-
- (* -------------------------------------------------------------- *)
-
- TT_Err_Too_Many_Points = $0300;
- TT_Err_Too_Many_Contours = $0301;
- TT_Err_Invalid_Composite = $0302;
- TT_Err_Too_Many_Ins = $0303;
-
- (* -------------------------------------------------------------- *)
-
- TT_Err_Invalid_Opcode = $0400;
- TT_Err_Too_Few_Arguments = $0401;
- TT_Err_Stack_Overflow = $0402;
- TT_Err_Code_Overflow = $0403;
- TT_Err_Bad_Argument = $0404;
- TT_Err_Divide_By_Zero = $0405;
- TT_Err_Storage_Overflow = $0406;
- TT_Err_Cvt_Overflow = $0407;
- TT_Err_Invalid_Reference = $0408;
- TT_Err_Invalid_Distance = $0409;
- TT_Err_Interpolate_Twilight = $040A;
- TT_Err_Debug_Opcode = $040B;
- TT_Err_ENDF_In_Exec_Stream = $040C;
- TT_Err_Out_Of_CodeRanges = $040D;
- TT_Err_Nested_DEFs = $040E;
- TT_Err_Invalid_CodeRange = $040F;
- TT_Err_Invalid_Displacement = $0410;
- TT_Err_Execution_Too_Long = $0411;
- TT_Err_Too_Many_FuncDefs = $0412;
- TT_Err_Too_Many_InsDefs = $0413;
-
- TT_Err_Nested_Frame_Access = $0500;
- TT_Err_Invalid_Cache_List = $0501;
- TT_Err_Could_Not_Find_Context = $0502;
- TT_Err_UNlisted_Object = $0503;
-
- TT_Err_Raster_Pool_Overflow = $0600;
- TT_Err_Raster_Negative_Height = $0601;
- TT_Err_Invalid_Value = $0602;
- TT_Err_Raster_Not_Initialised = $0603;
-
- (* -------------------------------------------------------------- *)
-
(***********************************************************************)
(* *)
(* Base Library Functions *)
@@ -539,7 +93,7 @@
(* Return face properties in 'prop' *)
(* *)
function TT_Get_Face_Properties( _face : TT_Face;
- var prop : TT_Face_Properties ) : TT_Error;
+ out prop : TT_Face_Properties ) : TT_Error;
(*****************************************************************)
(* Set face's generic pointer *)
@@ -630,7 +184,7 @@
(* Return instance metrics in 'm' *)
(* *)
function TT_Get_Instance_Metrics( _ins : TT_Instance;
- var m : TT_Instance_Metrics ) : TT_Error;
+ out m : TT_Instance_Metrics ) : TT_Error;
(*****************************************************************)
(* Set instance generic pointer *)
@@ -711,7 +265,7 @@
function TT_Get_Glyph_Bitmap( _glyph : TT_Glyph;
var map : TT_Raster_Map;
x_offset : TT_F26Dot6;
- y_offset : TT_F26Dot6 ) : TT_Error;
+ y_offset : TT_F26Dot6; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
(*****************************************************************)
(* Render a glyph's pixmap (i.e. smoothed glyph ) *)
@@ -719,24 +273,24 @@
function TT_Get_Glyph_Pixmap( _glyph : TT_Glyph;
var map : TT_Raster_Map;
x_offset : TT_F26Dot6;
- y_offset : TT_F26Dot6 ) : TT_Error;
+ y_offset : TT_F26Dot6; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
function TT_Get_Glyph_Pixmap_HQ( _glyph : TT_Glyph;
var map : TT_Raster_Map;
x_offset : TT_F26Dot6;
- y_offset : TT_F26Dot6 ) : TT_Error;
+ y_offset : TT_F26Dot6; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
function TT_Render_Directly_Glyph_Gray( var _glyph : TT_Glyph;
x_offset : TT_F26Dot6;
y_offset : TT_F26Dot6;
x,y,tx,ty: integer;
- OnRender: TDirectRenderingFunction) : TT_Error;
+ OnRender: TDirectRenderingFunction; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
function TT_Render_Directly_Glyph_HQ( var _glyph : TT_Glyph;
x_offset : TT_F26Dot6;
y_offset : TT_F26Dot6;
x,y,tx,ty: integer;
- OnRender: TDirectRenderingFunction) : TT_Error;
+ OnRender: TDirectRenderingFunction; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
(***********************************************************************)
(* *)
@@ -766,24 +320,24 @@
(* Render an outline into a bitmap *)
(* *)
function TT_Get_Outline_Bitmap( var out : TT_Outline;
- var map : TT_raster_Map ) : TT_Error;
+ var map : TT_raster_Map; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
(*****************************************************************)
(* Render an outline into a pixmap *)
(* *)
function TT_Get_Outline_Pixmap( var out : TT_Outline;
- var map : TT_raster_Map ) : TT_Error;
+ var map : TT_raster_Map; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
function TT_Get_Outline_Pixmap_HQ( var out : TT_Outline;
- var map : TT_raster_Map ) : TT_Error;
+ var map : TT_raster_Map; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
function TT_Render_Directly_Outline_Gray( var out : TT_Outline;
x, y, tx, ty: integer;
- OnRender: TDirectRenderingFunction) : TT_Error;
+ OnRender: TDirectRenderingFunction; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
function TT_Render_Directly_Outline_HQ( var out : TT_Outline;
x, y, tx, ty: integer;
- OnRender: TDirectRenderingFunction) : TT_Error;
+ OnRender: TDirectRenderingFunction; rasterizer: TFreeTypeCustomRasterizer = nil ) : TT_Error;
(*****************************************************************)
(* Get an outline's bounding box *)
@@ -895,7 +449,6 @@
implementation
uses
- TTTypes,
TTError,
TTCalc,
TTMemory,
@@ -908,9 +461,6 @@
TTGLoad,
TTRaster;
-var
- raster_palette : TT_Gray_Palette;
-
(*****************************************************************)
(* *)
(* *)
@@ -948,7 +498,7 @@
(* *)
function TT_Set_Raster_Palette( palette : TT_Gray_Palette ) : TT_Error;
begin
- raster_palette := palette;
+ TTGetDefaultRasterizer.Set_Raster_Palette( palette );
TT_Set_Raster_Palette := TT_Err_Ok;
end;
@@ -1001,7 +551,7 @@
(* *)
(* *)
function TT_Get_Face_Properties( _face : TT_Face;
- var prop : TT_Face_Properties ) : TT_Error;
+ out prop : TT_Face_Properties ) : TT_Error;
var
face : PFace;
begin
@@ -1250,10 +800,13 @@
(* *)
(* *)
function TT_Get_Instance_Metrics( _ins : TT_Instance;
- var m : TT_Instance_Metrics ) : TT_Error;
+ out m : TT_Instance_Metrics ) : TT_Error;
var
ins : PInstance;
begin
+ {$hints off}
+ fillchar(m, sizeof(m),0);
+ {$hints on}
ins := _ins.z;
if ins <> nil then
begin
@@ -1490,7 +1043,8 @@
function TT_Get_Glyph_Bitmap( _glyph : TT_Glyph;
var map : TT_raster_Map;
x_offset : TT_F26Dot6;
- y_offset : TT_F26Dot6 ) : TT_Error;
+ y_offset : TT_F26Dot6;
+ rasterizer: TFreeTypeCustomRasterizer) : TT_Error;
var
glyph : PGlyph;
outline : TT_Outline;
@@ -1498,12 +1052,13 @@
glyph := _glyph.z;
if glyph <> nil then
begin
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
outline := glyph^.outline;
(* XXX: for now, we only use dropout mode #2 *)
outline.dropout_mode := 2;
TT_Translate_Outline( outline, x_offset, y_offset );
- TT_Get_Glyph_Bitmap := TT_Get_Outline_Bitmap( outline, map );
+ TT_Get_Glyph_Bitmap := TT_Get_Outline_Bitmap( outline, map, rasterizer );
TT_Translate_Outline( outline, -x_offset, -y_offset );
end
else
@@ -1516,7 +1071,8 @@
function TT_Get_Glyph_Pixmap( _glyph : TT_Glyph;
var map : TT_raster_Map;
x_offset : TT_F26Dot6;
- y_offset : TT_F26Dot6 ) : TT_Error;
+ y_offset : TT_F26Dot6;
+ rasterizer: TFreeTypeCustomRasterizer ) : TT_Error;
var
glyph : PGlyph;
outline : TT_Outline;
@@ -1524,6 +1080,7 @@
glyph := _glyph.z;
if glyph <> nil then
begin
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
outline := glyph^.outline;
(* XXX: for now, we only use dropout mode #2 *)
outline.dropout_mode := 2;
@@ -1539,7 +1096,8 @@
function TT_Get_Glyph_Pixmap_HQ( _glyph : TT_Glyph;
var map : TT_raster_Map;
x_offset : TT_F26Dot6;
- y_offset : TT_F26Dot6 ) : TT_Error;
+ y_offset : TT_F26Dot6;
+ rasterizer: TFreeTypeCustomRasterizer ) : TT_Error;
var
glyph : PGlyph;
outline : TT_Outline;
@@ -1547,6 +1105,7 @@
glyph := _glyph.z;
if glyph <> nil then
begin
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
outline := glyph^.outline;
(* XXX: for now, we only use dropout mode #2 *)
outline.dropout_mode := 2;
@@ -1561,7 +1120,8 @@
function TT_Render_Directly_Glyph_Gray(var _glyph: TT_Glyph; x_offset: TT_F26Dot6;
y_offset: TT_F26Dot6; x, y, tx, ty: integer;
- OnRender: TDirectRenderingFunction): TT_Error;
+ OnRender: TDirectRenderingFunction;
+ rasterizer: TFreeTypeCustomRasterizer): TT_Error;
var
glyph : PGlyph;
outline : TT_Outline;
@@ -1569,6 +1129,7 @@
glyph := _glyph.z;
if glyph <> nil then
begin
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
outline := glyph^.outline;
(* XXX: for now, we only use dropout mode #2 *)
outline.dropout_mode := 2;
@@ -1585,7 +1146,8 @@
x_offset : TT_F26Dot6;
y_offset : TT_F26Dot6;
x, y, tx, ty: integer;
- OnRender: TDirectRenderingFunction): TT_Error;
+ OnRender: TDirectRenderingFunction;
+ rasterizer: TFreeTypeCustomRasterizer): TT_Error;
var
glyph : PGlyph;
outline : TT_Outline;
@@ -1593,6 +1155,7 @@
glyph := _glyph.z;
if glyph <> nil then
begin
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
outline := glyph^.outline;
(* XXX: for now, we only use dropout mode #2 *)
outline.dropout_mode := 2;
@@ -1687,9 +1250,11 @@
(* Render an outline into a bitmap *)
(* *)
function TT_Get_Outline_Bitmap( var out : TT_Outline;
- var map : TT_raster_Map ) : TT_Error;
+ var map : TT_raster_Map;
+ rasterizer: TFreeTypeCustomRasterizer ) : TT_Error;
begin
- if Render_Glyph( out, map ) then
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
+ if rasterizer.Render_Glyph( out, map ) then
TT_Get_Outline_Bitmap := error
else
TT_Get_Outline_Bitmap := TT_Err_Ok;
@@ -1699,36 +1264,44 @@
(* Render an outline into a pixmap *)
(* *)
function TT_Get_Outline_Pixmap( var out : TT_Outline;
- var map : TT_raster_Map ) : TT_Error;
+ var map : TT_raster_Map;
+ rasterizer: TFreeTypeCustomRasterizer ) : TT_Error;
begin
- if Render_Gray_Glyph( out, map, @raster_palette ) then
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
+ if rasterizer.Render_Gray_Glyph( out, map, nil ) then
TT_Get_Outline_Pixmap := error
else
TT_Get_Outline_Pixmap := TT_Err_Ok;
end;
function TT_Get_Outline_Pixmap_HQ( var out : TT_Outline;
- var map : TT_raster_Map ) : TT_Error;
+ var map : TT_raster_Map;
+ rasterizer: TFreeTypeCustomRasterizer ) : TT_Error;
begin
- if Render_Gray_Glyph_HQ( out, map ) then
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
+ if rasterizer.Render_Gray_Glyph_HQ( out, map ) then
TT_Get_Outline_Pixmap_HQ := error
else
TT_Get_Outline_Pixmap_HQ := TT_Err_Ok;
end;
function TT_Render_Directly_Outline_Gray(var out: TT_Outline; x, y, tx,
- ty: integer; OnRender: TDirectRenderingFunction): TT_Error;
+ ty: integer; OnRender: TDirectRenderingFunction;
+ rasterizer: TFreeTypeCustomRasterizer): TT_Error;
begin
- if Render_Directly_Gray_Glyph( out, x,y,tx,ty, OnRender, @raster_palette ) then
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
+ if rasterizer.Render_Directly_Gray_Glyph( out, x,y,tx,ty, OnRender, nil ) then
TT_Render_Directly_Outline_Gray := error
else
TT_Render_Directly_Outline_Gray := TT_Err_Ok;
end;
function TT_Render_Directly_Outline_HQ(var out: TT_Outline; x, y, tx,
- ty: integer; OnRender: TDirectRenderingFunction): TT_Error;
+ ty: integer; OnRender: TDirectRenderingFunction;
+ rasterizer: TFreeTypeCustomRasterizer): TT_Error;
begin
- if Render_Directly_Gray_Glyph_HQ( out, x,y,tx,ty, OnRender ) then
+ if rasterizer = nil then rasterizer := TTGetDefaultRasterizer;
+ if rasterizer.Render_Directly_Gray_Glyph_HQ( out, x,y,tx,ty, OnRender ) then
TT_Render_Directly_Outline_HQ := error
else
TT_Render_Directly_Outline_HQ := TT_Err_Ok;
Index: components/lazutils/ttcmap.pas
===================================================================
--- components/lazutils/ttcmap.pas (revision 36187)
+++ components/lazutils/ttcmap.pas (working copy)
@@ -19,7 +19,7 @@
interface
-uses LazFreeType, TTTypes;
+uses TTTypes;
type
(********************************************************************)
@@ -106,6 +106,7 @@
Version : word;
Loaded : Boolean;
CannotLoad: Boolean;
+ StreamPtr: ^TT_Stream;
Offset : Long;
case Byte of
@@ -135,8 +136,9 @@
num_SH, u : UShort;
i : Int;
num_segs : Int;
+ stream: TT_Stream;
label
- Fail;
+ Fail, SimpleExit;
begin
CharMap_Load := Failure;
@@ -146,8 +148,10 @@
exit;
end;
- if TT_Seek_File( cmap.offset ) then exit;
+ TT_Use_Stream(cmap.StreamPtr^, stream);
+ if TT_Seek_File( cmap.offset ) then goto SimpleExit;
+
case cmap.format of
0: with cmap.cmap0 do
@@ -266,15 +270,20 @@
else
error := TT_Err_Invalid_Charmap_Format;
- exit;
+ goto SimpleExit;
end;
CharMap_Load := success;
cmap.Loaded := True;
- exit;
+ goto SimpleExit;
Fail:
CharMap_Free( cmap );
+ exit;
+
+ SimpleExit:
+ TT_Done_Stream(cmap.StreamPtr^);
+
end;
@@ -309,6 +318,7 @@
cmap.format := 0;
cmap.length := 0;
cmap.version := 0;
+ cmap.StreamPtr := nil;
end;
Index: components/lazutils/tterror.pas
===================================================================
--- components/lazutils/tterror.pas (revision 36187)
+++ components/lazutils/tterror.pas (working copy)
@@ -19,7 +19,7 @@
interface
-uses LazFreeType;
+uses TTTypes;
procedure Check_Error( error : Integer );
Index: components/lazutils/ttfile.pas
===================================================================
--- components/lazutils/ttfile.pas (revision 36187)
+++ components/lazutils/ttfile.pas (working copy)
@@ -48,8 +48,7 @@
{$I TTCONFIG.INC}
-uses LazFreeType,
- TTTypes,
+uses TTTypes,
TTError;
function TTFile_Init : TError;
@@ -71,7 +70,7 @@
(* should only be used for a typeface object's main stream *)
function TT_Use_Stream( org_stream : TT_Stream;
- var stream : TT_Stream ) : TError;
+ out stream : TT_Stream ) : TError;
(* notices the component that we're going to use the file *)
(* opened in 'org_stream', and report errors to the 'error' *)
(* variable. the 'stream' variable is untouched, except in *)
@@ -498,7 +497,7 @@
******************************************************************)
function TT_Use_Stream( org_stream : TT_Stream;
- var stream : TT_Stream ) : TError;
+ out stream : TT_Stream ) : TError;
var
rec : PStream_Rec;
begin
Index: components/lazutils/ttinterp.pas
===================================================================
--- components/lazutils/ttinterp.pas (revision 36187)
+++ components/lazutils/ttinterp.pas (working copy)
@@ -27,8 +27,7 @@
{$mode Delphi}
-uses LazFreeType,
- TTTypes,
+uses TTTypes,
TTObjs;
function Run_Ins( exec : PExec_Context ) : Boolean;
@@ -38,6 +37,21 @@
uses
TTCalc;
+const
+ TT_Round_Off = 5;
+ TT_Round_To_Half_Grid = 0;
+ TT_Round_To_Grid = 1;
+ TT_Round_To_Double_Grid = 2;
+ TT_Round_Up_To_Grid = 4;
+ TT_Round_Down_To_Grid = 3;
+ TT_Round_Super = 6;
+ TT_ROund_Super_45 = 7;
+
+ TT_Flag_Touched_X = $02; (* X touched flag *)
+ TT_Flag_Touched_Y = $04; (* Y touched flag *)
+
+ TT_Flag_Touched_Both = TT_Flag_Touched_X or TT_FLag_Touched_Y;
+
type
TInstruction_Function = procedure( args : PStorage );
Index: components/lazutils/ttload.pas
===================================================================
--- components/lazutils/ttload.pas (revision 36187)
+++ components/lazutils/ttload.pas (working copy)
@@ -25,7 +25,7 @@
interface
-uses LazFreeType, TTTypes, TTTables, TTCMap, TTObjs;
+uses TTTypes, TTTables, TTCMap, TTObjs;
function LookUp_TrueType_Table( face : PFace;
aTag : string ) : int;
@@ -214,7 +214,7 @@
begin
(* file is a collection. Check the index *)
if ( faceIndex < 0 ) or
- ( faceIndex >= face^.ttcHeader.dirCount ) then
+ ( ulong(faceIndex) >= face^.ttcHeader.dirCount ) then
begin
error := TT_Err_Bad_Argument;
exit;
@@ -1045,6 +1045,7 @@
TT_Forget_Frame;
+ cmap^.StreamPtr := @face^.stream;
cmap^.offset := TT_File_Pos;
end; (* for n *)
@@ -1247,9 +1248,9 @@
fsSelection := Get_UShort;
usFirstCharIndex := Get_UShort;
usLastCharIndex := Get_UShort;
- sTypoAscender := Get_UShort;
- sTypoDescender := Get_UShort;
- sTypoLineGap := Get_UShort;
+ sTypoAscender := Get_Short;
+ sTypoDescender := Get_Short;
+ sTypoLineGap := Get_Short;
usWinAscent := Get_UShort;
usWinDescent := Get_UShort;
Index: components/lazutils/ttprofile.pas
===================================================================
--- components/lazutils/ttprofile.pas (revision 36187)
+++ components/lazutils/ttprofile.pas (working copy)
@@ -8,7 +8,6 @@
{$IFDEF VIRTUALPASCAL}
Use32,
{$ENDIF}
- LazFreeType,
TTTypes,
SysUtils;
Index: components/lazutils/ttraster.pas
===================================================================
--- components/lazutils/ttraster.pas (revision 36187)
+++ components/lazutils/ttraster.pas (working copy)
@@ -47,159 +47,217 @@
{$IFDEF VIRTUALPASCAL}
Use32,
{$ENDIF}
- LazFreeType,
- TTTypes;
+ TTTypes,
+ TTProfile;
- function Render_Glyph( var glyph : TT_Outline;
- var target : TT_Raster_Map ) : TError;
+{$IFDEF CONST_PREC}
- (* Render one glyph in the target bitmap (1-bit per pixel) *)
+const
+ Precision_Bits = 6;
+ Precision = 1 shl Precision_Bits;
+ Precision_Half = Precision div 2;
+ Precision_Step = Precision_Half;
+ Precision_Shift = 0;
+ Precision_Mask = -Precision;
+ Precision_Jitter = 2;
- function Render_Gray_Glyph( var glyph : TT_Outline;
- var target : TT_Raster_Map;
- palette : PTT_Gray_Palette ) : TError;
+{$ENDIF}
- (* Render one gray-level glyph in the target pixmap *)
- (* palette points to an array of 5 colors used for the rendering *)
- (* use nil to reuse the last palette. Default is VGA graylevels *)
+type
+ Function_Sweep_Init = procedure( var min, max : Int ) of object;
- function Render_Gray_Glyph_HQ( var glyph : TT_Outline;
- var target : TT_Raster_Map ) : TError;
+ Function_Sweep_Span = procedure( y : Int;
+ x1 : TT_F26dot6;
+ x2 : TT_F26dot6;
+ Left : TProfile;
+ Right : TProfile ) of object;
- function Render_Directly_Gray_Glyph( var glyph : TT_Outline;
- x,y,tx,ty: integer;
- OnRender: TDirectRenderingFunction;
- palette : PTT_Gray_Palette) : TError;
+ Function_Sweep_Step = procedure of object;
- function Render_Directly_Gray_Glyph_HQ( var glyph : TT_Outline;
- x,y,tx,ty: integer;
- OnRender: TDirectRenderingFunction) : TError;
+ { TFreeTypeRasterizer }
+ TFreeTypeRasterizer = class(TFreeTypeCustomRasterizer)
+ private
+ Precision_Bits : Int; (* Fractional bits of Raster coordinates *)
+ Precision : Int;
+ Precision_Half : Int;
+ Precision_Step : Int; (* Bezier subdivision minimal step *)
+ Precision_Shift : Int; (* Shift used to convert coordinates *)
+ Precision_Mask : Longint; (* integer truncatoin mask *)
+ Precision_Jitter : Int;
- procedure Set_High_Precision( High : boolean );
- (* Set rendering precision. Should be set to TRUE for small sizes only *)
- (* ( typically < 20 ppem ) *)
+ Pool : TRenderPool;(* Profiles buffer a.k.a. Render Pool *)
- procedure Set_Second_Pass( Pass : boolean );
- (* Set second pass flag *)
+ Cible : TT_Raster_Map; (* Description of target map *)
- function TTRaster_Init : TError;
- procedure TTRaster_Done;
+ BWidth : integer;
+ BCible : PByte; (* target bitmap buffer *)
+ GCible : PByte; (* target pixmap buffer *)
- function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
- function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
+ TraceBOfs : Int; (* current offset in target bitmap *)
+ TraceBIncr : Int; (* increment to next line in target bitmap *)
+ TraceGOfs : Int; (* current offset in targer pixmap *)
+ TraceGIncr : Int; (* increment to next line in target pixmap *)
+ gray_min_x : Int; (* current min x during gray rendering *)
+ gray_max_x : Int; (* current max x during gray rendering *)
-implementation
+ (* Dispatch variables : *)
-uses
- TTError,
- TTProfile,
- SysUtils;
+ Proc_Sweep_Init : Function_Sweep_Init; (* Sweep initialisation *)
+ Proc_Sweep_Span : Function_Sweep_Span; (* Span drawing *)
+ Proc_Sweep_Drop : Function_Sweep_Span; (* Drop out control *)
+ Proc_Sweep_Step : Function_Sweep_Step; (* Sweep line step *)
+ Proc_Sweep_Direct: TDirectRenderingFunction; (* Direct rendering *)
-const
- Pixel_Bits = 6; (* fractional bits of input coordinates *)
+ Direct_X, Direct_Y, Direct_TX: integer;
-const
- LMask : array[0..7] of Byte
- = ($FF,$7F,$3F,$1F,$0F,$07,$03,$01);
+ Points : TT_Points;
+ Flags : PByte; (* current flags array *)
+ Outs : TT_PConStarts; (* current endpoints array *)
- RMask : array[0..7] of Byte
- = ($80,$C0,$E0,$F0,$F8,$FC,$FE,$FF);
+ //nPoints, (* current number of points *)
+ nContours : Int; (* current number of contours *)
- (* left and right fill bitmasks *)
+ DropOutControl : Byte; (* current drop-out control mode *)
-type
- Function_Sweep_Init = procedure( var min, max : Int );
+ Grays : TT_Gray_Palette;
+ (* gray palette used during gray-levels rendering *)
+ (* 0 : background .. 4 : foreground *)
- Function_Sweep_Span = procedure( y : Int;
- x1 : TT_F26dot6;
- x2 : TT_F26dot6;
- Left : TProfile;
- Right : TProfile );
+ BGray_Data : PByte; { temporary bitmap for grayscale }
+ BGray_Incr : integer; { increment for temp bitmap }
+ BGray_End : integer; { ending offset of temporary bitmap }
+ BGray_Capacity: integer; { current capacity of temp bitmap }
- Function_Sweep_Step = procedure;
+ Second_Pass : boolean;
+ (* indicates wether an horizontal pass should be performed *)
+ (* to control drop-out accurately when calling Render_Glyph *)
+ (* Note that there is no horizontal pass during gray render *)
- (* prototypes used for sweep function dispatch *)
+ (* better set it off at ppem >= 18 *)
-{$IFNDEF CONST_PREC}
+ procedure BGray_NeedCapacity(c: integer);
+ function Draw_Sweep(MinY, MaxY: integer; PixelGrain: integer): boolean;
+ procedure Horizontal_Gray_Sweep_Drop(y: Int; x1, x2: TT_F26dot6; Left,
+ Right: TProfile);
+ procedure Horizontal_Gray_Sweep_Span(y: Int; x1, x2: TT_F26dot6; Left,
+ Right: TProfile);
+ procedure Horizontal_Sweep_Drop(y: Int; x1, x2: TT_F26dot6; Left,
+ Right: TProfile);
+ procedure Horizontal_Sweep_Init(var min, max: Int);
+ procedure Horizontal_Sweep_Span(y: Int; x1, x2: TT_F26dot6; Left,
+ Right: TProfile);
+ procedure Horizontal_Sweep_Step;
+ function ProcessCoordinate(var List: TProfile): integer;
+ procedure Raster_Object_Init;
+ procedure Raster_Object_Done;
+ function Render_Single_Pass(vertical: Boolean; OutputMinY, OutputMaxY,
+ PixelGrain: integer): boolean;
+ {$IFNDEF CONST_PREC}procedure Set_High_Precision(High: boolean);
+ procedure Set_Second_Pass(Pass: boolean);
+ procedure Vertical_Gray_Sweep_Init(var min, max: Int);
+ procedure Vertical_Gray_Sweep_Init_Direct(var min, max: Int);
+ procedure Vertical_Gray_Sweep_Init_Direct_HQ(var min, max: Int);
+ procedure Vertical_Gray_Sweep_Init_HQ(var min, max: Int);
+ procedure Vertical_Gray_Sweep_Step;
+ procedure Vertical_Gray_Sweep_Step_Direct;
+ procedure Vertical_Gray_Sweep_Step_Direct_HQ;
+ procedure Vertical_Gray_Sweep_Step_HQ;
+ procedure Vertical_Sweep_Drop(y: Int; x1, x2: TT_F26dot6; Left,
+ Right: TProfile);
+ procedure Vertical_Sweep_Init(var min, max: Int);
+ procedure Vertical_Sweep_Span(y: Int; x1, x2: TT_F26dot6; Left,
+ Right: TProfile);
+ procedure Vertical_Sweep_Step;
+{$ENDIF}
+ public
+ function Render_Glyph( var glyph : TT_Outline;
+ var target : TT_Raster_Map ) : TError; override;
-var
- Precision_Bits : Int; (* Fractional bits of Raster coordinates *)
- Precision : Int;
- Precision_Half : Int;
- Precision_Step : Int; (* Bezier subdivision minimal step *)
- Precision_Shift : Int; (* Shift used to convert coordinates *)
- Precision_Mask : Longint; (* integer truncatoin mask *)
- Precision_Jitter : Int;
+ (* Render one glyph in the target bitmap (1-bit per pixel) *)
-{$ELSE}
+ function Render_Gray_Glyph( var glyph : TT_Outline;
+ var target : TT_Raster_Map;
+ palette : PTT_Gray_Palette ) : TError; override;
-const
- Precision_Bits = 6;
- Precision = 1 shl Precision_Bits;
- Precision_Half = Precision div 2;
- Precision_Step = Precision_Half;
- Precision_Shift = 0;
- Precision_Mask = -Precision;
- Precision_Jitter = 2;
+ (* Render one gray-level glyph in the target pixmap *)
+ (* palette points to an array of 5 colors used for the rendering *)
+ (* use nil to reuse the last palette. Default is VGA graylevels *)
-{$ENDIF}
+ function Render_Gray_Glyph_HQ( var glyph : TT_Outline;
+ var target : TT_Raster_Map ) : TError; override;
-var
- Pool : TRenderPool;(* Profiles buffer a.k.a. Render Pool *)
+ function Render_Directly_Gray_Glyph( var glyph : TT_Outline;
+ x,y,tx,ty: integer;
+ OnRender: TDirectRenderingFunction;
+ palette : PTT_Gray_Palette) : TError; override;
- Cible : TT_Raster_Map; (* Description of target map *)
+ function Render_Directly_Gray_Glyph_HQ( var glyph : TT_Outline;
+ x,y,tx,ty: integer;
+ OnRender: TDirectRenderingFunction) : TError; override;
- BWidth : integer;
- BCible : PByte; (* target bitmap buffer *)
- GCible : PByte; (* target pixmap buffer *)
+ procedure Set_Raster_Palette(const palette: TT_Gray_Palette); override;
- TraceBOfs : Int; (* current offset in target bitmap *)
- TraceBIncr : Int; (* increment to next line in target bitmap *)
- TraceGOfs : Int; (* current offset in targer pixmap *)
- TraceGIncr : Int; (* increment to next line in target pixmap *)
+ constructor Create;
+ destructor Destroy; override;
+ end;
- gray_min_x : Int; (* current min x during gray rendering *)
- gray_max_x : Int; (* current max x during gray rendering *)
+ { These functions round up minimum and maximum value of an interval over
+ data which is organized by grains of constant size. For example, if
+ the size of the grain is 4, then minimum values can be 0, 4, 8, etc.
+ and maximum values can be 3, 7, 11, etc. }
+ function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
+ function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
- (* Dispatch variables : *)
+ function TTRaster_Init: TError;
+ procedure TTRaster_Done;
- Proc_Sweep_Init : Function_Sweep_Init; (* Sweep initialisation *)
- Proc_Sweep_Span : Function_Sweep_Span; (* Span drawing *)
- Proc_Sweep_Drop : Function_Sweep_Span; (* Drop out control *)
- Proc_Sweep_Step : Function_Sweep_Step; (* Sweep line step *)
- Proc_Sweep_Direct: TDirectRenderingFunction; (* Direct rendering *)
+ function TTGetDefaultRasterizer: TFreeTypeRasterizer;
- Points : TT_Points;
- Flags : PByte; (* current flags array *)
- Outs : TT_PConStarts; (* current endpoints array *)
+implementation
- //nPoints, (* current number of points *)
- nContours : Int; (* current number of contours *)
+uses
+ TTError,
+ SysUtils;
- DropOutControl : Byte; (* current drop-out control mode *)
+const
+ Pixel_Bits = 6; (* fractional bits of input coordinates *)
- Count_Table : array[0..255] of Word;
- (* Look-up table used to quickly count set bits in a gray 2x2 cell *)
+const
+ LMask : array[0..7] of Byte
+ = ($FF,$7F,$3F,$1F,$0F,$07,$03,$01);
- BitCountTable: packed array[0..255] of byte; //number of bits 'on' in a byte
+ RMask : array[0..7] of Byte
+ = ($80,$C0,$E0,$F0,$F8,$FC,$FE,$FF);
+ (* left and right fill bitmasks *)
- Grays : TT_Gray_Palette;
- (* gray palette used during gray-levels rendering *)
- (* 0 : background .. 4 : foreground *)
+var
+ Count_Table : array[0..255] of Word;
+ (* Look-up table used to quickly count set bits in a gray 2x2 cell *)
- BGray_Data : PByte; { temporary bitmap for grayscale }
- BGray_Incr : integer; { increment for temp bitmap }
- BGray_End : integer; { ending offset of temporary bitmap }
- BGray_Capacity: integer; { current capacity of temp bitmap }
+ BitCountTable: packed array[0..255] of byte; //number of bits 'on' in a byte
- Second_Pass : boolean;
- (* indicates wether an horizontal pass should be performed *)
- (* to control drop-out accurately when calling Render_Glyph *)
- (* Note that there is no horizontal pass during gray render *)
+function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
+begin
+ if minValue mod Grain <> 0 then
+ begin
+ if minValue > 0 then result := minValue - (minValue mod Grain)
+ else result := minValue - (Grain - (-minValue) mod Grain);
+ end else
+ result := minValue;
+end;
- (* better set it off at ppem >= 18 *)
+function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
+begin
+ if maxValue mod Grain <> Grain-1 then
+ begin
+ if maxValue > 0 then result := maxValue + (Grain-1 - (maxValue mod Grain))
+ else result := maxValue + (((-maxValue) mod Grain) - 1);
+ end
+ else
+ result := maxValue;
+end;
{$IFNDEF CONST_PREC}
@@ -214,7 +272,7 @@
(* *)
(****************************************************************************)
-procedure Set_High_Precision( High : boolean );
+procedure TFreeTypeRasterizer.Set_High_Precision( High : boolean );
begin
if High then
begin
@@ -238,24 +296,24 @@
{$ENDIF}
-procedure Set_Second_Pass( Pass : boolean );
+procedure TFreeTypeRasterizer.Set_Second_Pass( Pass : boolean );
begin
second_pass := pass;
end;
-
-
(************************************************)
(* *)
(* Process next coordinate *)
+ (* Returns: count *)
(* *)
(************************************************)
- procedure ProcessCoordinate( var List : TProfile );
+ function TFreeTypeRasterizer.ProcessCoordinate( var List : TProfile ): integer;
var
current : TProfile;
begin
+ result := 0;
if List = nil then exit;
current := list;
@@ -266,32 +324,11 @@
inc( offset, flow );
dec( height );
current := nextInList;
+ inc(result);
end;
until current = nil;
end;
- function IncludeFullGrainMin(minValue: integer; Grain: integer): integer;
- begin
- if minValue mod Grain <> 0 then
- begin
- if minValue > 0 then result := minValue - (minValue mod Grain)
- else result := minValue - (Grain - (-minValue) mod Grain);
- end else
- result := minValue;
- end;
-
- function IncludeFullGrainMax(maxValue: integer; Grain: integer): integer;
- begin
- if maxValue mod Grain <> Grain-1 then
- begin
- if maxValue > 0 then result := maxValue + (Grain-1 - (maxValue mod Grain))
- else result := maxValue + (((-maxValue) mod Grain) - 1);
- end
- else
- result := maxValue;
- end;
-
-
(********************************************************************)
(* *)
(* Generic Sweep Drawing routine *)
@@ -300,7 +337,7 @@
(* *)
(********************************************************************)
-function Draw_Sweep(MinY,MaxY: integer; PixelGrain: integer) : boolean;
+function TFreeTypeRasterizer.Draw_Sweep(MinY,MaxY: integer; PixelGrain: integer) : boolean;
label
Skip_To_Next;
@@ -328,6 +365,7 @@
P_Right, Q_Right : TProfile;
dropouts : Int;
+ countLeft, countRight: integer;
begin
if Pool.ProfileColl.fProfile = nil then
@@ -411,11 +449,11 @@
end;
(* Get next coordinate *)
- ProcessCoordinate( Draw_Left );
- ProcessCoordinate( Draw_Right );
+ countLeft := ProcessCoordinate( Draw_Left );
+ countRight := ProcessCoordinate( Draw_Right );
dropouts := 0;
- if ProfileList_Count(Draw_Left) = ProfileList_Count(Draw_Right) then
+ if countLeft = countRight then
begin
(* sort the drawing lists *)
@@ -571,7 +609,7 @@
(* *)
(****************************************************************************)
-function Render_Single_Pass( vertical : Boolean; OutputMinY, OutputMaxY, PixelGrain: integer ) : boolean;
+function TFreeTypeRasterizer.Render_Single_Pass( vertical : Boolean; OutputMinY, OutputMaxY, PixelGrain: integer ) : boolean;
var
OutputY, OutputBandY, BandHeight: Integer;
begin
@@ -634,7 +672,7 @@
(* *)
(****************************************************************************)
-function Render_Glyph( var glyph : TT_Outline;
+function TFreeTypeRasterizer.Render_Glyph( var glyph : TT_Outline;
var target : TT_Raster_Map ) : TError;
begin
@@ -714,7 +752,7 @@
Render_Glyph := Success;
end;
-procedure BGray_NeedCapacity(c: integer);
+procedure TFreeTypeRasterizer.BGray_NeedCapacity(c: integer);
begin
if c > BGray_Capacity then
begin
@@ -738,7 +776,7 @@
(* *)
(****************************************************************************)
- function Render_Gray_Glyph( var glyph : TT_Outline;
+ function TFreeTypeRasterizer.Render_Gray_Glyph( var glyph : TT_Outline;
var target : TT_Raster_Map;
palette : PTT_Gray_Palette ) : TError;
const Zoom = 2;
@@ -816,7 +854,7 @@
end;
-function Render_Gray_Glyph_HQ( var glyph : TT_Outline;
+function TFreeTypeRasterizer.Render_Gray_Glyph_HQ( var glyph : TT_Outline;
var target : TT_Raster_Map ) : TError;
const Zoom = 8;
begin
@@ -868,10 +906,7 @@
{************************ direct rendering ********************}
-var
- Direct_X, Direct_Y, Direct_TX: integer;
-
-procedure Vertical_Gray_Sweep_Init_Direct_HQ( var min, max : Int );
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init_Direct_HQ( var min, max : Int );
begin
Vertical_Gray_Sweep_Init_HQ ( min, max);
dec(Direct_Y, min div 8);
@@ -879,7 +914,7 @@
TraceGIncr:= 0;
end;
-procedure Vertical_Gray_Sweep_Step_Direct_HQ;
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step_Direct_HQ;
begin
Vertical_Gray_Sweep_Step_HQ;
If TraceBOfs = 0 then
@@ -890,7 +925,7 @@
end;
end;
-procedure Vertical_Gray_Sweep_Init_Direct( var min, max : Int );
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init_Direct( var min, max : Int );
begin
Vertical_Gray_Sweep_Init ( min, max);
dec(Direct_Y, min div 2);
@@ -898,7 +933,7 @@
TraceGIncr:= 0;
end;
-procedure Vertical_Gray_Sweep_Step_Direct;
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step_Direct;
begin
Vertical_Gray_Sweep_Step;
If TraceBOfs = 0 then
@@ -909,7 +944,7 @@
end;
end;
-function Render_Directly_Gray_Glyph(var glyph: TT_Outline; x, y, tx,
+function TFreeTypeRasterizer.Render_Directly_Gray_Glyph(var glyph: TT_Outline; x, y, tx,
ty: integer; OnRender: TDirectRenderingFunction; palette : PTT_Gray_Palette): TError;
const Zoom = 2;
begin
@@ -973,7 +1008,7 @@
end;
-function Render_Directly_Gray_Glyph_HQ( var glyph : TT_Outline;
+function TFreeTypeRasterizer.Render_Directly_Gray_Glyph_HQ( var glyph : TT_Outline;
x,y,tx,ty: integer;
OnRender: TDirectRenderingFunction) : TError;
const Zoom = 8;
@@ -1035,8 +1070,23 @@
end;
+procedure TFreeTypeRasterizer.Set_Raster_Palette(const palette: TT_Gray_Palette);
+begin
+ move( palette, Grays, sizeof(TT_Gray_Palette) );
+end;
+constructor TFreeTypeRasterizer.Create;
+begin
+ Raster_Object_Init;
+end;
+destructor TFreeTypeRasterizer.Destroy;
+begin
+ Raster_Object_Done;
+end;
+
+
+
(****************************************************************************)
(* *)
(* Function: Init_Rasterizer *)
@@ -1051,17 +1101,43 @@
(* *)
(****************************************************************************)
-function TTRaster_Init : TError;
-var
- i, j, c, l : integer;
+procedure TFreeTypeRasterizer.Raster_Object_Init;
const
Default_Grays : array[0..4] of Byte
= ( 0, 23, 27, 29, 31 );
+var i: integer;
begin
Pool := nil;
BGray_Data := nil;
BGray_Capacity := 0;
+ (* default Grays takes the gray levels of the standard VGA *)
+ (* 256 colors mode *)
+
+ for i := 0 to high(Grays) do
+ Grays[i] := Default_Grays[i];
+
+ Set_High_Precision(False);
+ Set_Second_Pass(False);
+ Pool := TRenderPool.Create(Precision,Precision_Step);
+
+ DropOutControl := 2;
+ Error := Err_Ras_None;
+end;
+
+procedure TFreeTypeRasterizer.Raster_Object_Done;
+begin
+ Pool.Free;
+ if BGray_Data <> nil then
+ FreeMem( BGray_Data, BGray_Capacity );
+end;
+
+var
+ DefaultRasterizer: TFreeTypeRasterizer;
+
+function TTRaster_Init: TError;
+var l,c,i,j: integer;
+begin
{ Initialisation of Count_Table }
for i := 0 to 255 do
@@ -1084,41 +1160,22 @@
(i shr 4 and 1) + (i shr 5 and 1) + (i shr 6 and 1) + (i shr 7 and 1);
end;
- (* default Grays takes the gray levels of the standard VGA *)
- (* 256 colors mode *)
+ DefaultRasterizer := nil;
- for i := 0 to high(Grays) do
- Grays[i] := Default_Grays[i];
-
- Set_High_Precision(False);
- Set_Second_Pass(False);
- Pool := TRenderPool.Create(Precision,Precision_Step);
-
- DropOutControl := 2;
- Error := Err_Ras_None;
-
- TTRaster_Init := Success;
+ result := Success;
end;
-procedure Cycle_DropOut;
+procedure TTRaster_Done;
begin
- case DropOutControl of
-
- 0 : DropOutControl := 1;
- 1 : DropOutControl := 2;
- 2 : DropOutControl := 4;
- 4 : DropOutControl := 5;
- else
- DropOutControl := 0;
- end;
+ if DefaultRasterizer <> nil then
+ DefaultRasterizer.Free;
end;
-procedure TTRaster_Done;
+function TTGetDefaultRasterizer: TFreeTypeRasterizer;
begin
- Pool.Free;
- if BGray_Data <> nil then
- FreeMem( BGray_Data, BGray_Capacity );
+ if DefaultRasterizer = nil then
+ DefaultRasterizer := TFreeTypeRasterizer.Create;
+ result := DefaultRasterizer;
end;
-
end.
Index: components/lazutils/ttraster_sweep.inc
===================================================================
--- components/lazutils/ttraster_sweep.inc (revision 36187)
+++ components/lazutils/ttraster_sweep.inc (working copy)
@@ -9,7 +9,7 @@
(* *)
(***********************************************************************)
-procedure Vertical_Sweep_Init( var min, {%H-}max : Int );
+procedure TFreeTypeRasterizer.Vertical_Sweep_Init( var min, {%H-}max : Int );
begin
case Cible.flow of
@@ -28,7 +28,7 @@
-procedure Vertical_Sweep_Span( {%H-}y : Int;
+procedure TFreeTypeRasterizer.Vertical_Sweep_Span( {%H-}y : Int;
x1,
x2 : TT_F26dot6;
{%H-}Left,
@@ -39,109 +39,6 @@
f1, f2 : Int;
base : PByte;
begin
-{$IFDEF VERTICAL_SWEEP_SPAN_ASM} {$asmmode intel}
- asm
- push esi
- push ebx
- push ecx
-
- mov eax, X1
- mov ebx, X2
- mov ecx, [Precision_Bits]
-
- sub ebx, eax
- add eax, [Precision]
- dec eax
-
- sub ebx, [Precision]
- cmp ebx, [Precision_Jitter]
- jg @No_Jitter
-
- @Do_Jitter:
- mov ebx, eax
- jmp @0
-
- @No_Jitter:
- mov ebx, X2
-
- @0:
- sar ebx, cl
- js @Sortie
-
- sar eax, cl
- mov ecx, [BWidth]
-
- cmp eax, ebx
- jg @Sortie
-
- cmp eax, ecx
- jge @Sortie
-
- test eax, eax
- jns @1
- xor eax, eax
- @1:
- cmp ebx, ecx
- jl @2
- lea ebx, [ecx-1]
- @2:
-
- mov edx, eax
- mov ecx, ebx
- and edx, 7
- sar eax, 3
- and ecx, 7
- sar ebx, 3
-
- cmp eax, [gray_min_X]
- jge @3
- mov [gray_min_X], eax
-
- @3:
- cmp ebx, [gray_max_X]
- jl @4
- mov [gray_max_X], ebx
-
- @4:
- mov esi, ebx
-
- mov ebx, [BCible]
- add ebx, [TraceBOfs]
- add ebx, eax
-
- sub esi, eax
- jz @5
-
- mov al, [LMask + edx].byte
- or [ebx], al
- inc ebx
- dec esi
- jz @6
- mov eax, -1
- @7:
- mov [ebx].byte, al
- dec esi
- lea ebx, [ebx+1]
- jnz @7
-
- @6:
- mov al, [RMask + ecx].byte
- or [ebx], al
- jmp @8
-
- @5:
- mov al, [LMask + edx].byte
- and al, [RMask + ecx].byte
- or [ebx], al
-
- @8:
- @Sortie:
- pop ecx
- pop ebx
- pop esi
- end;
-{$ELSE}
-
e1 := (( x1+Precision-1 ) and Precision_Mask) div Precision;
if ( x2-x1-Precision <= Precision_Jitter ) then
@@ -179,11 +76,10 @@
base^[0] := base^[0] or RMask[f2];
end
end;
-{$ENDIF}
end;
-procedure Vertical_Sweep_Drop( y : Int;
+procedure TFreeTypeRasterizer.Vertical_Sweep_Drop( y : Int;
x1,
x2 : TT_F26dot6;
Left,
@@ -296,7 +192,7 @@
-procedure Vertical_Sweep_Step;
+procedure TFreeTypeRasterizer.Vertical_Sweep_Step;
begin
inc( TraceBOfs, traceBIncr );
end;
@@ -311,13 +207,13 @@
(* *)
(***********************************************************************)
-procedure Horizontal_Sweep_Init( var {%H-}min, {%H-}max : Int );
+procedure TFreeTypeRasterizer.Horizontal_Sweep_Init( var {%H-}min, {%H-}max : Int );
begin
(* Nothing, really *)
end;
-procedure Horizontal_Sweep_Span( y : Int;
+procedure TFreeTypeRasterizer.Horizontal_Sweep_Span( y : Int;
x1,
x2 : TT_F26dot6;
{%H-}Left,
@@ -389,7 +285,7 @@
-procedure Horizontal_Sweep_Drop( y : Int;
+procedure TFreeTypeRasterizer.Horizontal_Sweep_Drop( y : Int;
x1,
x2 : TT_F26dot6;
Left,
@@ -484,7 +380,7 @@
-procedure Horizontal_Sweep_Step;
+procedure TFreeTypeRasterizer.Horizontal_Sweep_Step;
begin
(* Nothing, really *)
end;
@@ -506,7 +402,7 @@
(* *)
(***********************************************************************)
-procedure Vertical_Gray_Sweep_Init( var min, {%H-}max : Int );
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init( var min, {%H-}max : Int );
begin
case Cible.flow of
@@ -525,7 +421,7 @@
gray_max_x := -Cible.Cols;
end;
-procedure Vertical_Gray_Sweep_Init_HQ( var min, {%H-}max : Int );
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Init_HQ( var min, {%H-}max : Int );
begin
case Cible.flow of
@@ -551,7 +447,7 @@
end;
-procedure Vertical_Gray_Sweep_Step;
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step;
var
j, c1, c2 : Int;
begin
@@ -598,7 +494,7 @@
end;
end;
-procedure Vertical_Gray_Sweep_Step_HQ;
+procedure TFreeTypeRasterizer.Vertical_Gray_Sweep_Step_HQ;
var
j, c1 : Int;
c2, c3: byte;
@@ -669,7 +565,7 @@
(* *)
(***********************************************************************)
-procedure Horizontal_Gray_Sweep_Span( y : Int;
+procedure TFreeTypeRasterizer.Horizontal_Gray_Sweep_Span( y : Int;
x1,
x2 : TT_F26dot6;
{%H-}Left,
@@ -711,7 +607,7 @@
end;
-procedure Horizontal_Gray_Sweep_Drop( y : Int;
+procedure TFreeTypeRasterizer.Horizontal_Gray_Sweep_Drop( y : Int;
x1,
x2 : TT_F26dot6;
Left,
Index: components/lazutils/tttables.pas
===================================================================
--- components/lazutils/tttables.pas (revision 36187)
+++ components/lazutils/tttables.pas (working copy)
@@ -29,7 +29,7 @@
interface
-uses LazFreeType, TTTypes;
+uses TTTypes;
(***************************************************************************)
(* *)
Index: components/lazutils/tttypes.pas
===================================================================
--- components/lazutils/tttypes.pas (revision 36187)
+++ components/lazutils/tttypes.pas (working copy)
@@ -2,7 +2,7 @@
*
* TTTypes.pas 1.0
*
- * Global internal types definitions
+ * Global types definitions
*
* Copyright 1996, 1997 by
* David Turner, Robert Wilhelm, and Werner Lemberg.
@@ -19,10 +19,487 @@
interface
-uses LazFreeType;
+type
+ TError = boolean;
+
+{$IFDEF OS2}
+ TT_Int = Longint;
+{$ELSE}
+ TT_Int = Integer;
+{$ENDIF}
+
+ TT_Long = longint;
+ TT_ULong = longword;
+ TT_Short = integer;
+ TT_UShort = word;
+
+ TT_Fixed = LongInt; (* Signed Fixed 16.16 Float *)
+
+ TT_FWord = Integer; (* Distance in FUnits *)
+ TT_UFWord = Word; (* Unsigned Distance *)
+
+ TT_F2Dot14 = Integer; (* signed fixed float 2.14 used for *)
+ (* unary vectors, with layout : *)
+ (* *)
+ (* s : 1 -- sign bit *)
+ (* m : 1 -- mantissa bit *)
+ (* f : 14 -- unsigned fractional *)
+ (* *)
+ (* 's:m' is the 2-bit signed int *)
+ (* value to which the *positive* *)
+ (* fractional part should be *)
+ (* added. *)
+ (* *)
+
+ TT_F26Dot6 = LongInt; (* 26.6 fixed float, used for pixel coordinates *)
+
+ TT_Pos = Longint; (* funits or 26.6, depending on context *)
+
+const
+ TT_Flag_On_Curve = $01; (* Point is On curve *)
+
type
+ (******************************************************)
+ (* a simple unit vector type *)
+ (* *)
+ TT_UnitVector = record
+ x : TT_F2Dot14;
+ y : TT_F2Dot14;
+ end;
+
+ (******************************************************)
+ (* a simple vector type *)
+ (* *)
+ TT_Vector = record
+
+ x : TT_Pos;
+ y : TT_Pos;
+ end;
+
+ (******************************************************)
+ (* a simple 2x2 matrix type *)
+ (* *)
+ TT_Matrix = record
+
+ xx, xy : TT_Fixed;
+ yx, yy : TT_Fixed;
+ end;
+
+ (******************************************************)
+ (* a glyph's bounding box *)
+ (* *)
+ TT_BBox = record
+
+ xMin, yMin : TT_Pos;
+ xMax, yMax : TT_Pos;
+ end;
+
+ (******************************************************)
+ (* the engine's error condition type - 0 always *)
+ (* means success. *)
+ (* *)
+ TT_Error = TT_Int;
+
+ TT_Points_Table = array[0..99] of TT_Vector;
+ TT_Points = ^TT_Points_Table;
+
+ TT_Coordinates = array[0..99] of TT_Pos;
+ TT_PCoordinates = ^TT_Coordinates;
+
+ TT_TouchTable = array[0..9] of byte;
+ TT_PTouchTable = ^TT_TouchTable;
+
+ TT_ConStarts = array[0..9] of word;
+ TT_PConStarts = ^TT_ConStarts;
+
+ (******************************************************)
+ (* glyph outline description *)
+ (* *)
+ TT_Outline = record
+
+ n_points : integer;
+ n_contours : integer;
+
+ points : TT_Points; (* array of point coordinates *)
+ flags : TT_PTouchTable; (* array of point flags *)
+ conEnds : TT_PConStarts; (* array of contours ends *)
+
+ owner : Boolean; (* this flag is set when the outline *)
+ (* owns the arrays it uses. *)
+
+ high_precision : Boolean;
+ second_pass : Boolean;
+ dropout_mode : Byte;
+ end;
+
+ (******************************************************)
+ (* glyph metrics structure *)
+ (* *)
+ TT_Glyph_Metrics = record
+
+ bbox : TT_BBox;
+ bearingX : TT_Pos;
+ bearingY : TT_Pos;
+ advance : TT_Pos;
+ end;
+
+ (******************************************************)
+ (* big glyph metrics structure *)
+ (* *)
+ TT_Big_Glyph_Metrics = record
+
+ bbox : TT_BBox;
+ horiBearingX : TT_Pos;
+ horiBearingY : TT_Pos;
+ horiAdvance : TT_Pos;
+ vertBearingX : TT_Pos;
+ vertBearingY : TT_Pos;
+ vertAdvance : TT_Pos;
+ end;
+
+ TDirectRenderingFunction = procedure( x,y,tx: integer;
+ data: pointer ) of object;
+
+
+ (******************************************************)
+ (* instance metrics. used to return information to *)
+ (* clients regarding an instance's important state *)
+ (* *)
+ TT_Instance_Metrics = record
+
+ pointsize : integer;
+
+ x_ppem : integer;
+ y_ppem : integer;
+
+ x_scale : TT_Fixed;
+ y_scale : TT_Fixed;
+
+ x_resolution : integer;
+ y_resolution : integer;
+ end;
+
+const
+ TT_Flow_Down = -1;
+ TT_Flow_Up = +1;
+
+type
+
+ (******************************************************)
+ (* a record used to describe a bitmap or pixmap to *)
+ (* the rasterizer. *)
+ (* *)
+ TT_Raster_Map = record
+
+ Rows : TT_Int; (* rows number of the bitmap *)
+ Cols : TT_Int; (* columns (bytes) per row *)
+ Width : TT_Int; (* pixels per row *)
+ Flow : TT_Int; (* bit/pixmap's flow *)
+ Buffer : pointer; (* bit/pixmap data *)
+ Size : longint; (* bit/pixmap data size (bytes) *)
+ end;
+
+ (******************************************************)
+ (* The TrueType font header table structure *)
+ (* *)
+ TT_Header = record
+
+ table_version : TT_Fixed;
+ font_revision : TT_Fixed;
+
+ checksum_adjust : TT_Long;
+ magic_number : TT_Long;
+
+ flags : TT_UShort;
+ units_per_EM : TT_UShort;
+
+ created : array[0..1] of TT_Long;
+ modified : array[0..1] of TT_Long;
+
+ xMin, yMin : TT_FWord;
+ xMax, yMax : TT_FWord;
+
+ mac_style : TT_UShort;
+ lowest_rec_PPEM : TT_UShort;
+ font_direction : TT_Short;
+
+ index_to_loc_format : TT_Short;
+ glyph_data_format : TT_Short;
+ end;
+
+ (******************************************************)
+ (* The TrueType horizontal header table structure *)
+ (* *)
+ TT_Horizontal_Header = record
+
+ version : TT_Fixed;
+ ascender : TT_FWord;
+ descender : TT_FWord;
+ line_gap : TT_FWord;
+
+ advance_Width_Max : TT_UShort;
+ min_left_side_bearing : TT_Short;
+ min_right_side_bearing : TT_Short;
+ xMax_extent : TT_Short;
+ caret_slope_rise : TT_Short;
+ caret_slope_run : TT_Short;
+
+ reserved : array[0..4] of TT_SHort;
+
+ metric_data_format : TT_Short;
+ number_of_HMetrics : TT_UShort;
+
+ (* the following are not part of the header in the file *)
+
+ short_metrics : Pointer;
+ long_metrics : Pointer;
+ end;
+
+ (******************************************************)
+ (* The TrueType vertical header table structure *)
+ (* *)
+ TT_Vertical_Header = record
+
+ version : TT_Fixed;
+ ascender : TT_FWord;
+ descender : TT_FWord;
+ line_gap : TT_FWord;
+
+ advance_Height_Max : TT_UShort;
+ min_top_side_bearing : TT_Short;
+ min_bottom_side_bearing : TT_Short;
+ yMax_extent : TT_Short;
+ caret_slope_rise : TT_Short;
+ caret_slope_run : TT_Short;
+
+ reserved : array[0..4] of TT_SHort;
+
+ metric_data_format : TT_Short;
+ number_of_VMetrics : TT_UShort;
+
+ (* the following are not part of the header in the file *)
+
+ short_metrics : Pointer;
+ long_metrics : Pointer;
+ end;
+
+ (******************************************************)
+ (* The TrueType OS/2 table structure *)
+ (* *)
+ TT_OS2 = record
+ version : TT_UShort; (* $0001 *)
+ xAvgCharWidth : TT_Short;
+ usWeightClass : TT_UShort;
+ usWidthClass : TT_UShort;
+ fsType : TT_Short;
+ ySubscriptXSize : TT_Short;
+ ySubscriptYSize : TT_Short;
+ ySubScriptXOffset : TT_Short;
+ ySubscriptYOffset : TT_Short;
+ ySuperscriptXSize : TT_Short;
+ ySuperscriptYSize : TT_Short;
+ ySuperscriptXOffset : TT_Short;
+ ySuperscriptYOffset : TT_Short;
+ yStrikeoutSize : TT_Short;
+ yStrikeoutPosition : TT_Short;
+ sFamilyClass : TT_Short;
+ panose : array[0..9] of Byte;
+ ulUnicodeRange1 : TT_ULong; (* bits 0-31 *)
+ ulUnicodeRange2 : TT_ULong; (* bits 32-63 *)
+ ulUnicodeRange3 : TT_ULong; (* bits 64-95 *)
+ ulUnicodeRange4 : TT_ULong; (* bits 96-127 *)
+ achVendID : array[0..3] of Byte;
+ fsSelection : TT_UShort;
+ usFirstCharIndex : TT_UShort;
+ usLastCharIndex : TT_UShort;
+ sTypoAscender : TT_Short;
+ sTypoDescender : TT_Short;
+ sTypoLineGap : TT_Short;
+ usWinAscent : TT_UShort;
+ usWinDescent : TT_UShort;
+
+ (* only version 1 tables *)
+ ulCodePageRange1 : TT_ULong;
+ ulCodePageRange2 : TT_ULong;
+ end;
+
+ (******************************************************)
+ (* The TrueType Postscript table structure *)
+ (* *)
+ TT_Postscript = record
+
+ FormatType : TT_Fixed;
+ italicAngle : TT_Fixed;
+ underlinePosition : TT_Short;
+ underlineThickness : TT_Short;
+ isFixedPitch : TT_ULong;
+ minMemType42 : TT_ULong;
+ maxMemType42 : TT_ULong;
+ minMemType1 : TT_ULong;
+ maxMemType1 : TT_ULong;
+ end;
+
+ (******************************************************)
+ (* face properties. use to report important face *)
+ (* data to clients *)
+ (* *)
+ TT_Face_Properties = record
+
+ num_glyphs : integer;
+ max_points : integer;
+ max_contours : integer;
+ max_faces : integer;
+
+ header : ^TT_Header;
+ horizontal : ^TT_Horizontal_Header;
+ vertical : ^TT_Vertical_Header;
+ os2 : ^TT_OS2;
+ postscript : ^TT_Postscript;
+ end;
+
+ (******************************************************)
+ (* Objects handle types *)
+ (* *)
+ TT_Stream = record z : Pointer; end;
+ TT_Face = record z : Pointer; end;
+ TT_Instance = record z : Pointer; end;
+ TT_Glyph = record z : Pointer; end;
+ TT_CharMap = record z : Pointer; end;
+
+ TT_Gray_Palette = packed array[0..4] of byte;
+ PTT_Gray_Palette = ^TT_Gray_Palette;
+
+ (******************************************************************)
+ (* *)
+ (* ERROR CODES *)
+ (* *)
+ (******************************************************************)
+
+const
+ (* ------------------- Success is always 0 ---------------------- *)
+
+ TT_Err_Ok = 0;
+
+ (* -------------------------------------------------------------- *)
+
+ TT_Err_Invalid_Face_Handle = $0001;
+ TT_Err_Invalid_Instance_Handle = $0002;
+ TT_Err_Invalid_Glyph_Handle = $0003;
+ TT_Err_Invalid_CharMap_Handle = $0004;
+ TT_Err_Invalid_Result_Address = $0005;
+ TT_Err_Invalid_Glyph_Index = $0006;
+ TT_Err_Invalid_Argument = $0007;
+ TT_Err_Could_Not_Open_File = $0008;
+ TT_Err_File_Is_Not_Collection = $0009;
+
+ TT_Err_Table_Missing = $000A;
+ TT_Err_Invalid_Horiz_Metrics = $000B;
+ TT_Err_Invalid_Vert_Metrics = $000B;
+ TT_Err_Invalid_CharMap_Format = $000C;
+
+ TT_Err_Invalid_File_Format = $0010;
+ TT_Err_File_Error = $0011;
+
+ TT_Err_Invalid_Engine = $0020;
+ TT_Err_Too_Many_Extensions = $0021;
+ TT_Err_Extensions_Unsupported = $0022;
+ TT_Err_Invalid_Extension_Id = $0023;
+
+ TT_Err_No_Vertical_Data = $0030;
+
+ TT_Err_Max_Profile_Missing = $0080;
+ TT_Err_Header_Table_Missing = $0081;
+ TT_Err_Horiz_Header_Missing = $0082;
+ TT_Err_Locations_Missing = $0083;
+ TT_Err_Name_Table_Missing = $0084;
+ TT_Err_CMap_Table_Missing = $0085;
+ TT_Err_Hmtx_Table_Missing = $0086;
+ TT_Err_OS2_Table_Missing = $0087;
+ TT_Err_Post_Table_Missing = $0088;
+
+ (* -------------------------------------------------------------- *)
+
+ TT_Err_Out_Of_Memory = $0100;
+
+ (* -------------------------------------------------------------- *)
+
+ TT_Err_Invalid_File_Offset = $0200;
+ TT_Err_Invalid_File_Read = $0201;
+ TT_Err_Invalid_Frame_Access = $0202;
+
+ (* -------------------------------------------------------------- *)
+
+ TT_Err_Too_Many_Points = $0300;
+ TT_Err_Too_Many_Contours = $0301;
+ TT_Err_Invalid_Composite = $0302;
+ TT_Err_Too_Many_Ins = $0303;
+
+ (* -------------------------------------------------------------- *)
+
+ TT_Err_Invalid_Opcode = $0400;
+ TT_Err_Too_Few_Arguments = $0401;
+ TT_Err_Stack_Overflow = $0402;
+ TT_Err_Code_Overflow = $0403;
+ TT_Err_Bad_Argument = $0404;
+ TT_Err_Divide_By_Zero = $0405;
+ TT_Err_Storage_Overflow = $0406;
+ TT_Err_Cvt_Overflow = $0407;
+ TT_Err_Invalid_Reference = $0408;
+ TT_Err_Invalid_Distance = $0409;
+ TT_Err_Interpolate_Twilight = $040A;
+ TT_Err_Debug_Opcode = $040B;
+ TT_Err_ENDF_In_Exec_Stream = $040C;
+ TT_Err_Out_Of_CodeRanges = $040D;
+ TT_Err_Nested_DEFs = $040E;
+ TT_Err_Invalid_CodeRange = $040F;
+ TT_Err_Invalid_Displacement = $0410;
+ TT_Err_Execution_Too_Long = $0411;
+ TT_Err_Too_Many_FuncDefs = $0412;
+ TT_Err_Too_Many_InsDefs = $0413;
+
+ TT_Err_Nested_Frame_Access = $0500;
+ TT_Err_Invalid_Cache_List = $0501;
+ TT_Err_Could_Not_Find_Context = $0502;
+ TT_Err_UNlisted_Object = $0503;
+
+ TT_Err_Raster_Pool_Overflow = $0600;
+ TT_Err_Raster_Negative_Height = $0601;
+ TT_Err_Invalid_Value = $0602;
+ TT_Err_Raster_Not_Initialised = $0603;
+
+type
+ TFreeTypeCustomRasterizer = class
+ function Render_Glyph( var glyph : TT_Outline;
+ var target : TT_Raster_Map ) : TError; virtual; abstract;
+
+ (* Render one glyph in the target bitmap (1-bit per pixel) *)
+
+ function Render_Gray_Glyph( var glyph : TT_Outline;
+ var target : TT_Raster_Map;
+ palette : PTT_Gray_Palette ) : TError; virtual; abstract;
+
+ (* Render one gray-level glyph in the target pixmap *)
+ (* palette points to an array of 5 colors used for the rendering *)
+ (* use nil to reuse the last palette. Default is VGA graylevels *)
+
+ function Render_Gray_Glyph_HQ( var glyph : TT_Outline;
+ var target : TT_Raster_Map ) : TError; virtual; abstract;
+
+ function Render_Directly_Gray_Glyph( var glyph : TT_Outline;
+ x,y,tx,ty: integer;
+ OnRender: TDirectRenderingFunction;
+ palette : PTT_Gray_Palette) : TError; virtual; abstract;
+
+ function Render_Directly_Gray_Glyph_HQ( var glyph : TT_Outline;
+ x,y,tx,ty: integer;
+ OnRender: TDirectRenderingFunction) : TError; virtual; abstract;
+
+ procedure Set_Raster_Palette(const palette: TT_Gray_Palette); virtual; abstract;
+ end;
+
+type
(*********************** SIMPLE PRIMITIVE TYPES *******************)
(* BYTE is already defined in Pascal *)
@@ -55,8 +532,6 @@
PLong = PStorage;
PULong = PStorage;
- TError = boolean;
-
(***************** FreeType Internal Types *****************************)
TCoordinates = array[0..1023] of TT_F26Dot6;
@@ -75,26 +550,10 @@
(* This type is used to describe each point zone in the interpreter *)
const
-
- TT_Round_Off = 5;
- TT_Round_To_Half_Grid = 0;
- TT_Round_To_Grid = 1;
- TT_Round_To_Double_Grid = 2;
- TT_Round_Up_To_Grid = 4;
- TT_Round_Down_To_Grid = 3;
- TT_Round_Super = 6;
- TT_ROund_Super_45 = 7;
-
Success = False;
Failure = True;
- TT_Flag_Touched_X = $02; (* X touched flag *)
- TT_Flag_Touched_Y = $04; (* Y touched flag *)
- TT_Flag_Touched_Both = TT_Flag_Touched_X or TT_FLag_Touched_Y;
-
- TT_Flag_On_Curve = $01; (* Point is On curve *)
-
implementation
end.
Index: examples/lazfreetype/lazfreetypetest.lpi
===================================================================
--- examples/lazfreetype/lazfreetypetest.lpi (revision 36187)
+++ examples/lazfreetype/lazfreetypetest.lpi (working copy)
@@ -35,17 +35,15 @@
-
+
-
-
-
+
@@ -53,11 +51,12 @@
+
-
-
-
+
+
+
@@ -67,7 +66,7 @@
-
+
@@ -75,7 +74,7 @@
-
+
@@ -83,7 +82,7 @@
-
+
@@ -91,7 +90,7 @@
-
+
@@ -99,7 +98,7 @@
-
+
@@ -107,7 +106,7 @@
-
+
@@ -115,719 +114,998 @@
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: examples/lazfreetype/mainform.lfm
===================================================================
--- examples/lazfreetype/mainform.lfm (revision 36187)
+++ examples/lazfreetype/mainform.lfm (working copy)
@@ -2,11 +2,11 @@
Left = 238
Height = 240
Top = 161
- Width = 323
+ Width = 344
Align = alBottom
Caption = 'Form1'
ClientHeight = 240
- ClientWidth = 323
+ ClientWidth = 344
KeyPreview = True
OnCreate = FormCreate
OnDestroy = FormDestroy
@@ -17,16 +17,16 @@
Left = 0
Height = 40
Top = 200
- Width = 323
+ Width = 344
Align = alBottom
ClientHeight = 40
- ClientWidth = 323
+ ClientWidth = 344
TabOrder = 0
object TrackBar_Size: TTrackBar
- Left = 8
+ Left = 96
Height = 25
Top = 8
- Width = 253
+ Width = 186
Frequency = 0
Max = 300
Min = 1
@@ -36,7 +36,7 @@
TabOrder = 0
end
object LFontSize: TLabel
- Left = 266
+ Left = 287
Height = 16
Top = 12
Width = 51
@@ -46,5 +46,24 @@
Caption = 'LFontSize'
ParentColor = False
end
+ object Label1: TLabel
+ Left = 6
+ Height = 16
+ Top = 12
+ Width = 33
+ Caption = 'Zoom'
+ ParentColor = False
+ end
+ object SpinEdit_Zoom: TSpinEdit
+ Left = 48
+ Height = 23
+ Top = 8
+ Width = 40
+ MaxValue = 9
+ MinValue = 1
+ OnChange = SpinEdit_ZoomChange
+ TabOrder = 1
+ Value = 1
+ end
end
end
Index: examples/lazfreetype/mainform.pas
===================================================================
--- examples/lazfreetype/mainform.pas (revision 36187)
+++ examples/lazfreetype/mainform.pas (working copy)
@@ -6,24 +6,29 @@
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
- ComCtrls, ExtCtrls, fpimage,
+ ComCtrls, ExtCtrls, Spin, fpimage,
IntfGraphics, GraphType, //Intf basic routines
- EasyLazFreeType, LazFreeTypeIntfDrawer; //EasyFreeType with Intf
+ EasyLazFreeType, LazFreeTypeIntfDrawer //EasyFreeType with Intf
+ ;
+
type
{ TForm1 }
TForm1 = class(TForm)
+ Label1: TLabel;
LFontSize: TLabel;
Panel_Option: TPanel;
+ SpinEdit_Zoom: TSpinEdit;
TrackBar_Size: TTrackBar;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
+ procedure SpinEdit_ZoomChange(Sender: TObject);
procedure TrackBar_SizeChange(Sender: TObject);
private
procedure UpdateSizeLabel;
@@ -32,7 +37,7 @@
{ public declarations }
lazimg: TLazIntfImage;
drawer: TIntfFreeTypeDrawer;
- ftFont: TFreeTypeFont;
+ ftFont1,ftFont2,ftFont3: TFreeTypeFont;
mx,my: integer; //mouse position
end;
@@ -48,19 +53,29 @@
mx := clientwidth div 2;
my := clientheight div 2;
- lazimg := TLazIntfImage.Create(0,0, [riqfRGB,riqfAlpha]);
+ lazimg := TLazIntfImage.Create(0,0, [riqfRGB]);
drawer := TIntfFreeTypeDrawer.Create(lazimg);
- ftFont := nil;
+ ftFont1 := nil;
+ ftFont2 := nil;
+ ftFont3 := nil;
try
- ftFont := TFreeTypeFont.Create; //only one font at once for now...
- ftFont.Name := 'arial.ttf';
+ ftFont1 := TFreeTypeFont.Create;
+ ftFont1.Name := 'arial.ttf';
+
+ ftFont2 := TFreeTypeFont.Create;
+ ftFont2.Name := 'timesi.ttf';
+
+ ftFont3 := TFreeTypeFont.Create;
+ ftFont3.Name := 'verdana.ttf';
except
on ex: Exception do
begin
FreeAndNil(drawer);
FreeAndNil(lazimg);
- FreeAndNil(ftFont);
+ FreeAndNil(ftFont1);
+ FreeAndNil(ftFont2);
+ FreeAndNil(ftFont3);
MessageDlg('Font error',ex.Message,mtError,[mbOk],0);
end;
end;
@@ -70,7 +85,9 @@
procedure TForm1.FormDestroy(Sender: TObject);
begin
- ftFont.Free;
+ ftFont1.Free;
+ ftFont2.Free;
+ ftFont3.Free;
drawer.Free;
lazimg.Free;
end;
@@ -86,54 +103,78 @@
procedure TForm1.UpdateSizeLabel;
begin
LFontSize.Caption := inttostr(TrackBar_Size.Position)+'pt';
- if ftFont <> nil then ftFont.SizeInPoints := TrackBar_Size.Position;
+ if ftFont1 <> nil then ftFont1.SizeInPoints := TrackBar_Size.Position;
+ if ftFont2 <> nil then ftFont2.SizeInPoints := TrackBar_Size.Position;
+ if ftFont3 <> nil then ftFont3.SizeInPoints := TrackBar_Size.Position;
end;
procedure TForm1.FormPaint(Sender: TObject);
-const zoom = 1;
- testtext = 'Hello world!';
+const testtext = 'Enjoy'+LineEnding+'and play!';
var bmp: TBitmap;
tx,ty: integer;
- w: array of single;
- x,y,y2: single;
+ p: array of TCharPosition;
+ x,y: single;
i: integer;
+ StartTime,EndTime,EndTime2: TDateTime;
+ zoom: integer;
begin
if lazimg = nil then exit;
+ canvas.Font.Name := 'Comic Sans MS';
+ zoom := SpinEdit_Zoom.Value;
+ StartTime := Now;
+
tx := ClientWidth div zoom;
ty := Panel_Option.Top div zoom;
if (lazimg.Width <> tx) or (lazimg.Height <> ty) then
lazimg.SetSize(tx,ty);
- lazimg.FillPixels(TColorToFPColor(clWhite));
- ftFont.Hinted := true;
- ftFont.ClearType := true;
- ftFont.Quality := grqHighQuality;
- x := mx/zoom - ftFont.TextWidth(testtext)/2;
- y := round(my/zoom);
- drawer.DrawText(testtext, ftFont, x, y, colBlack, 255);
- w := ftFont.CharsWidth(testtext);
- y2 := y-ftFont.SizeInPixels;
- drawer.DrawVertLine(round(x),round(y),round(y2), TColorToFPColor(clBlue));
- for i := 0 to high(w) do
+ drawer.FillPixels(TColorToFPColor(clWhite));
+
+ x := mx/zoom;
+ y := my/zoom;
+
+ ftFont1.Hinted := true;
+ ftFont1.ClearType := true;
+ ftFont1.Quality := grqHighQuality;
+ ftFont1.SmallLinePadding := false;
+ drawer.DrawText(testtext, ftFont1, x, y, colBlack, [ftaRight, ftaBottom]);
+
+ ftFont2.Hinted := false;
+ ftFont2.ClearType := false;
+ ftFont2.Quality := grqHighQuality;
+ drawer.DrawText(testtext, ftFont2, x, y, colRed, 192, [ftaCenter, ftaBaseline]);
+
+ ftFont3.Hinted := false;
+ ftFont3.ClearType := false;
+ ftFont3.Quality := grqMonochrome;
+ drawer.DrawText(testtext, ftFont3, x, y, colBlack, 128, [ftaLeft, ftaTop]);
+
+ p := ftFont1.CharsPosition(testtext,[ftaRight, ftaBottom]);
+ for i := 0 to high(p) do
begin
- x += w[i];
- drawer.DrawVertLine(round(x),round(y),round(y2), TColorToFPColor(clBlue));
+ drawer.DrawVertLine(round(x+p[i].x),round(y+p[i].yTop),round(y+p[i].yBottom), TColorToFPColor(clBlue));
+ drawer.DrawHorizLine(round(x+p[i].x),round(y+p[i].yBase),round(x+p[i].x+p[i].width), TColorToFPColor(clBlue));
end;
- ftFont.Hinted := false;
- ftFont.ClearType := false;
- ftFont.Quality := grqLowQuality;
- drawer.DrawText(testtext, ftFont, mx/zoom - ftFont.TextWidth(testtext)/4, my/zoom + ftFont.SizeInPixels/2, colRed, 192);
- ftFont.Quality := grqMonochrome;
- drawer.DrawText(testtext, ftFont, mx/zoom, my/zoom + ftFont.SizeInPixels, colBlack, 128);
+ EndTime := Now;
bmp := TBitmap.Create;
bmp.LoadFromIntfImage(lazimg);
Canvas.StretchDraw(rect(0,0,lazimg.width*zoom,lazimg.height*zoom),bmp);
bmp.Free;
+
+ EndTime2 := Now;
+
+ Canvas.TextOut(0,0, inttostr(round((EndTime-StartTime)*24*60*60*1000))+' ms + '+inttostr(round((EndTime2-EndTime)*24*60*60*1000))+' ms');
+
end;
+procedure TForm1.SpinEdit_ZoomChange(Sender: TObject);
+begin
+ Invalidate;
+end;
+
procedure TForm1.TrackBar_SizeChange(Sender: TObject);
begin
UpdateSizeLabel;
Index: lcl/intfgraphics.pas
===================================================================
--- lcl/intfgraphics.pas (revision 36187)
+++ lcl/intfgraphics.pas (working copy)
@@ -1532,7 +1532,7 @@
then Positions := not Positions; // reverse positions
end;
- // the locations of A,R,G,B are now coded in 2 bits each: AARRBBGG
+ // the locations of A,R,G,B are now coded in 2 bits each: AARRGGBB
// the 2-bit value (0..3) represents the location of the channel,
// counting from left
case Positions of
Index: lcl/lazfreetypeintfdrawer.pas
===================================================================
--- lcl/lazfreetypeintfdrawer.pas (revision 36187)
+++ lcl/lazfreetypeintfdrawer.pas (working copy)
@@ -8,65 +8,280 @@
Classes, SysUtils, Graphics, EasyLazFreeType, IntfGraphics, FPimage;
type
+ TLazIntfImageGetPixelAtProc = procedure(p: pointer; out Color: TFPColor);
+ TLazIntfImageSetPixelAtProc = procedure(p: pointer; const Color: TFPColor);
+
{ TIntfFreeTypeDrawer }
TIntfFreeTypeDrawer = class(TFreeTypeDrawer)
private
FColor: TFPColor;
+ FDestination: TLazIntfImage;
+ FHasPixelAtProc: boolean;
+ FGetPixelAtProc: TLazIntfImageGetPixelAtProc;
+ FSetPixelAtProc: TLazIntfImageSetPixelAtProc;
+ FPixelSizeInBytes: longword;
+ FWidth, FHeight: integer;
+ procedure SetDestination(AValue: TLazIntfImage);
protected
procedure RenderDirectly(x, y, tx: integer; data: pointer);
procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer);
+ procedure InternalMergeColorOver(var merge: TFPColor; const c: TFPColor; calpha: word); inline;
procedure MergeColorOver(var merge: TFPColor; const c: TFPColor); inline;
- procedure ClearTypePixel(x,y: integer; Cr,Cg,Cb: byte; Color: TFPColor);
+ procedure MergeColorOver(var merge: TFPColor; const c: TFPColor; ApplyOpacity: byte); inline;
+ procedure DrawPixelAt(p: pointer; const c: TFPColor);
+ procedure DrawPixelAt(p: pointer; const c: TFPColor; applyOpacity: byte);
+ procedure ClearTypePixelAt(p: pointer; Cr,Cg,Cb: byte; const Color: TFPColor);
+ function UnclippedGetPixelAddress(x, y: integer): pointer; inline;
+ function ClippedGetPixelAddress(x, y: integer): pointer; inline;
public
- Destination: TLazIntfImage;
ClearTypeRGBOrder: boolean;
constructor Create(ADestination: TLazIntfImage);
procedure ClippedDrawPixel(x,y: integer; const c: TFPColor);
- procedure DrawPixel(x,y: integer; const c: TFPColor);
+ procedure UnclippedDrawPixel(x,y: integer; const c: TFPColor);
+ procedure ClippedClearTypePixel(x,y: integer; Cr,Cg,Cb: byte; const Color: TFPColor);
+ procedure UnclippedClearTypePixel(x,y: integer; Cr,Cg,Cb: byte; const Color: TFPColor);
procedure DrawVertLine(x,y1,y2: integer; const c: TFPColor);
- procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor; AOpacity: Byte); override; overload;
- procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); overload;
+ procedure SetHorizLine(x1,y,x2: integer; const c: TFPColor);
+ procedure DrawHorizLine(x1,y,x2: integer; const c: TFPColor);
+ procedure FillPixels(const c: TFPColor);
+ procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override;
+ property Destination: TLazIntfImage read FDestination write SetDestination;
destructor Destroy; override;
end;
implementation
-uses LCLType;
+uses LCLType, GraphType;
+type
+ PFPColorBytes = ^TFPColorBytes;
+ TFPColorBytes = record
+ {$ifdef ENDIAN_LITTLE}
+ Rl, Rh, Gl, Gh, Bl, Bh, Al, Ah: Byte;
+ {$else}
+ Rh, Rl, Gh, Gl, Bh, Bl, Ah, Al: Byte;
+ {$endif}
+ end;
+
+ PFourBytes = ^TFourBytes;
+ TFourBytes = record
+ B0, B1, B2, B3: Byte;
+ end;
+
{ TIntfFreeTypeDrawer }
+function TIntfFreeTypeDrawer.ClippedGetPixelAddress(x, y: integer): pointer;
+begin
+ if (x < 0) or (x >= Destination.Width) then
+ raise FPImageException.CreateFmt(ErrorText[StrInvalidIndex],[ErrorText[StrImageX],x]);
+ if (y < 0) or (y >= Destination.Height) then
+ raise FPImageException.CreateFmt(ErrorText[StrInvalidIndex],[ErrorText[StrImageY],y]);
+
+ result := pbyte(Destination.GetDataLineStart(y))+(x*FPixelSizeInBytes);
+end;
+
+procedure InternalGetPixelAtWithoutAlphaRGB(p: pointer; out Color: TFPColor);
+begin
+ with PFourBytes(p)^ do
+ begin
+ TFPColorBytes(color).Rh := B0;
+ TFPColorBytes(color).Rl := B0;
+ TFPColorBytes(color).Gh := B1;
+ TFPColorBytes(color).Gl := B1;
+ TFPColorBytes(color).Bh := B2;
+ TFPColorBytes(color).Bl := B2;
+ color.alpha := $ffff;
+ end;
+end;
+
+procedure InternalSetPixelAtWithoutAlphaRGB(p: pointer; const Color: TFPColor);
+begin
+ with PFourBytes(p)^ do
+ begin
+ B0 := TFPColorBytes(color).Rh;
+ B1 := TFPColorBytes(color).Gh;
+ B2 := TFPColorBytes(color).Bh;
+ end;
+end;
+
+procedure InternalGetPixelAtWithoutAlphaBGR(p: pointer; out Color: TFPColor);
+{$IFDEF CPUI386} assembler; {$ASMMODE INTEL}
+asm
+ mov cl, [eax+2]
+ mov [edx], cl
+ mov [edx+1], cl
+ mov cl, [eax+1]
+ mov [edx+2], cl
+ mov [edx+3], cl
+ mov cl, [eax]
+ mov [edx+4], cl
+ mov [edx+5], cl
+ xor ecx, ecx
+ not ecx
+ mov [edx+6], cx
+end;
+{$ELSE}
+begin
+ with PFourBytes(p)^ do
+ begin
+ TFPColorBytes(color).Rh := B2;
+ TFPColorBytes(color).Rl := B2;
+ TFPColorBytes(color).Gh := B1;
+ TFPColorBytes(color).Gl := B1;
+ TFPColorBytes(color).Bh := B0;
+ TFPColorBytes(color).Bl := B0;
+ color.alpha := $ffff;
+ end;
+end;
+{$ENDIF}
+
+procedure InternalSetPixelAtWithoutAlphaBGR(p: pointer; const Color: TFPColor);
+{$IFDEF CPUI386} assembler; {$ASMMODE INTEL}
+asm
+ mov cl, [edx+1]
+ mov [eax+2], cl
+ mov cl, [edx+3]
+ mov [eax+1], cl
+ mov cl, [edx+5]
+ mov [eax], cl
+end;
+{$ELSE}
+begin
+ with PFourBytes(p)^ do
+ begin
+ B2 := TFPColorBytes(color).Rh;
+ B1 := TFPColorBytes(color).Gh;
+ B0 := TFPColorBytes(color).Bh;
+ end;
+end;
+{$ENDIF}
+
+procedure InternalGetPixelAtWithAlphaRGBA(p: pointer; out Color: TFPColor);
+begin
+ with PFourBytes(p)^ do
+ begin
+ TFPColorBytes(color).Rh := B0;
+ TFPColorBytes(color).Rl := B0;
+ TFPColorBytes(color).Gh := B1;
+ TFPColorBytes(color).Gl := B1;
+ TFPColorBytes(color).Bh := B2;
+ TFPColorBytes(color).Bl := B2;
+ TFPColorBytes(color).Ah := B3;
+ TFPColorBytes(color).Al := B3;
+ end;
+end;
+
+procedure InternalSetPixelAtWithAlphaRGBA(p: pointer; const Color: TFPColor);
+begin
+ with PFourBytes(p)^ do
+ begin
+ B0 := TFPColorBytes(color).Rh;
+ B1 := TFPColorBytes(color).Gh;
+ B2 := TFPColorBytes(color).Bh;
+ B3 := TFPColorBytes(color).Ah;
+ end;
+end;
+
+procedure InternalGetPixelAtWithAlphaBGRA(p: pointer; out Color: TFPColor);
+begin
+ with PFourBytes(p)^ do
+ begin
+ TFPColorBytes(color).Rh := B2;
+ TFPColorBytes(color).Rl := B2;
+ TFPColorBytes(color).Gh := B1;
+ TFPColorBytes(color).Gl := B1;
+ TFPColorBytes(color).Bh := B0;
+ TFPColorBytes(color).Bl := B0;
+ TFPColorBytes(color).Ah := B3;
+ TFPColorBytes(color).Al := B3;
+ end;
+end;
+
+procedure InternalSetPixelAtWithAlphaBGRA(p: pointer; const Color: TFPColor);
+begin
+ with PFourBytes(p)^ do
+ begin
+ B2 := TFPColorBytes(color).Rh;
+ B1 := TFPColorBytes(color).Gh;
+ B0 := TFPColorBytes(color).Bh;
+ B3 := TFPColorBytes(color).Ah;
+ end;
+end;
+
procedure TIntfFreeTypeDrawer.MergeColorOver(var merge: TFPColor; const c: TFPColor);
+begin
+ InternalMergeColorOver(merge,c,c.alpha);
+end;
+
+procedure TIntfFreeTypeDrawer.MergeColorOver(var merge: TFPColor;
+ const c: TFPColor; ApplyOpacity: byte);
var
- a1f, a2f, a12, a12m: cardinal;
+ calpha: longword;
begin
- a12 := 65534 - ((not merge.alpha) * (not c.alpha) shr 16);
- a12m := a12 shr 1;
+ calpha := c.alpha*applyOpacity div 255;
+ InternalMergeColorOver(merge,c,calpha);
+end;
- a1f := merge.alpha * (not c.alpha) shr 16;
- a2f := c.alpha - (c.alpha shr 15);
+procedure TIntfFreeTypeDrawer.UnclippedDrawPixel(x, y: integer; const c: TFPColor);
+var
+ merge: TFPColor;
+begin
+ if c.alpha = 0 then exit;
+ if FHasPixelAtProc then
+ DrawPixelAt(UnclippedGetPixelAddress(x,y),c)
+ else
+ begin
+ if c.alpha = $ffff then
+ Destination.Colors[x,y] := c
+ else
+ begin
+ merge := Destination.Colors[x,y];
+ MergeColorOver(merge,c);
+ Destination.Colors[x,y] := merge;
+ end;
+ end;
+end;
- merge.red := (merge.red * a1f + c.red * a2f + a12m) div a12;
- merge.green := (merge.green * a1f + c.green * a2f + a12m) div a12;
- merge.blue := (merge.blue * a1f + c.blue * a2f + a12m) div a12;
- merge.alpha := a12 + (a12 shr 15);
+procedure TIntfFreeTypeDrawer.DrawPixelAt(p: pointer; const c: TFPColor; applyOpacity: byte);
+var
+ merge: TFPColor;
+ calpha: longword;
+begin
+ calpha := c.alpha*applyOpacity div 255;
+ if calpha = 0 then exit;
+ if calpha = $ffff then
+ FSetPixelAtProc(p, c)
+ else
+ begin
+ FGetPixelAtProc(p, merge);
+ InternalMergeColorOver(merge,c,calpha);
+ FSetPixelAtProc(p, merge);
+ end;
end;
-procedure TIntfFreeTypeDrawer.DrawPixel(x, y: integer; const c: TFPColor);
+procedure TIntfFreeTypeDrawer.DrawPixelAt(p: pointer; const c: TFPColor);
var
merge: TFPColor;
begin
- if c.alpha = 0 then exit;
- if c.alpha = $ffff then
- Destination.Colors[x,y] := c
+ if (c.alpha = 0) then exit;
+ if (c.alpha = $ffff) then
+ FSetPixelAtProc(p, c)
else
begin
- merge := Destination.Colors[x,y];
+ FGetPixelAtProc(p, merge);
MergeColorOver(merge,c);
- Destination.Colors[x,y] := merge;
+ FSetPixelAtProc(p, merge);
end;
end;
+procedure TIntfFreeTypeDrawer.ClippedClearTypePixel(x, y: integer; Cr, Cg,
+ Cb: byte; const Color: TFPColor);
+begin
+ if (x < 0) or (y < 0) or (x >= Destination.Width) or (y >= Destination.Height) then exit;
+ UnclippedClearTypePixel(x,y,Cr,Cg,Cb,Color);
+end;
+
procedure TIntfFreeTypeDrawer.DrawVertLine(x, y1, y2: integer; const c: TFPColor
);
var y: integer;
@@ -81,17 +296,86 @@
if y1 < 0 then y1 := 0;
if y2 >= Destination.Height then y2 := Destination.Height-1;
for y := y1 to y2 do
- DrawPixel(x,y, c);
+ UnclippedDrawPixel(x,y, c);
end;
-procedure TIntfFreeTypeDrawer.ClearTypePixel(x, y: integer; Cr, Cg, Cb: byte; Color: TFPColor);
+procedure TIntfFreeTypeDrawer.SetHorizLine(x1, y, x2: integer; const c: TFPColor);
+var i: integer;
+ pdest: pbyte;
+ step: longword;
+begin
+ if (y < 0) or (y >= Destination.Height) then exit;
+ if (x1 > x2) then
+ begin
+ i := x1;
+ x1:= x2;
+ x2 := i;
+ end;
+ if x1 < 0 then x1 := 0;
+ if x2 >= Destination.Width then x2 := Destination.Width-1;
+ if FHasPixelAtProc then
+ begin
+ pdest := UnclippedGetPixelAddress(x1,y);
+ step := FPixelSizeInBytes;
+ i := x2-x1+1;
+ while i > 0 do
+ begin
+ FSetPixelAtProc(pdest,c);
+ inc(pdest,step);
+ dec(i);
+ end;
+ end else
+ for i := x1 to x2 do
+ Destination.Colors[i,y] := c;
+end;
+
+procedure TIntfFreeTypeDrawer.DrawHorizLine(x1, y, x2: integer;
+ const c: TFPColor);
+var i: integer;
+ pdest: pbyte;
+ step: longword;
+begin
+ if (y < 0) or (y >= Destination.Height) then exit;
+ if (x1 > x2) then
+ begin
+ i := x1;
+ x1:= x2;
+ x2 := i;
+ end;
+ if x1 < 0 then x1 := 0;
+ if x2 >= Destination.Width then x2 := Destination.Width-1;
+ if FHasPixelAtProc then
+ begin
+ pdest := UnclippedGetPixelAddress(x1,y);
+ step := FPixelSizeInBytes;
+ i := x2-x1+1;
+ while i > 0 do
+ begin
+ DrawPixelAt(pdest,c);
+ inc(pdest,step);
+ dec(i);
+ end;
+ end else
+ for i := x1 to x2 do
+ UnclippedDrawPixel(i,y,c);
+end;
+
+procedure TIntfFreeTypeDrawer.FillPixels(const c: TFPColor);
+var yb: integer;
+begin
+ for yb := 0 to Destination.Height-1 do
+ SetHorizLine(0,yb,Destination.Width-1,c);
+end;
+
+procedure TIntfFreeTypeDrawer.UnclippedClearTypePixel(x, y: integer; Cr, Cg, Cb: byte; const Color: TFPColor);
var merge,mergeClearType: TFPColor;
acc: longword;
keep,dont_keep: word;
+ p: pointer;
begin
- Cr := Cr*color.alpha div 65535;
- Cg := Cg*color.alpha div 65535;
- Cb := Cb*color.alpha div 65535;
+ Cr := Cr*(color.alpha+1) shr 16;
+ Cg := Cg*(color.alpha+1) shr 16;
+ Cb := Cb*(color.alpha+1) shr 16;
acc := Cr+Cg+Cb;
if acc = 0 then exit;
@@ -109,10 +393,47 @@
else
begin
if Cg <> 0 then
+ MergeColorOver(merge,color,Cg);
+ dont_keep := mergeClearType.alpha shr 1;
+ if dont_keep > 0 then
begin
- Color.alpha := Color.alpha*Cg div 255;
- MergeColorOver(merge,color);
+ keep := 32767 - dont_keep;
+ merge.red := (merge.red * keep + mergeClearType.red * dont_keep) div 32767;
+ merge.green := (merge.green * keep + mergeClearType.green * dont_keep) div 32767;
+ merge.blue := (merge.blue * keep + mergeClearType.blue * dont_keep) div 32767;
+ merge.alpha := mergeClearType.alpha + ((not mergeClearType.alpha)*merge.alpha div 65535);
end;
+ Destination.Colors[x,y] := merge;
+ end;
+end;
+
+procedure TIntfFreeTypeDrawer.ClearTypePixelAt(p: pointer; Cr, Cg, Cb: byte;
+ const Color: TFPColor);
+var merge,mergeClearType: TFPColor;
+ acc: longword;
+ keep,dont_keep: word;
+begin
+ Cr := Cr*(color.alpha+1) shr 16;
+ Cg := Cg*(color.alpha+1) shr 16;
+ Cb := Cb*(color.alpha+1) shr 16;
+ acc := Cr+Cg+Cb;
+ if acc = 0 then exit;
+
+ FGetPixelAtProc(p, merge);
+ mergeClearType.red := (merge.red * (not byte(Cr)) +
+ color.red * Cr + 128) div 255;
+ mergeClearType.green := (merge.green * (not byte(Cg)) +
+ color.green * Cg + 128) div 255;
+ mergeClearType.blue := (merge.blue * (not byte(Cb)) +
+ color.blue * Cb + 128) div 255;
+ mergeClearType.alpha := merge.alpha;
+
+ if (mergeClearType.alpha = $ffff) then
+ FSetPixelAtProc(p, mergeClearType)
+ else
+ begin
+ if Cg <> 0 then
+ MergeColorOver(merge,color,Cg);
dont_keep := mergeClearType.alpha shr 1;
if dont_keep > 0 then
begin
@@ -122,14 +443,99 @@
merge.blue := (merge.blue * keep + mergeClearType.blue * dont_keep) div 32767;
merge.alpha := mergeClearType.alpha + ((not mergeClearType.alpha)*merge.alpha div 65535);
end;
- Destination.Colors[x,y] := merge;
+ FSetPixelAtProc(p, merge);
end;
end;
+function TIntfFreeTypeDrawer.UnclippedGetPixelAddress(x, y: integer): pointer;
+begin
+ result := pbyte(Destination.GetDataLineStart(y))+(x*FPixelSizeInBytes);
+end;
+
+procedure TIntfFreeTypeDrawer.SetDestination(AValue: TLazIntfImage);
+var CanBeOptimized: boolean;
+ RedShiftInBytes,GreenShiftInBytes,BlueShiftInBytes,AlphaShiftInBytes: integer;
+begin
+ if FDestination=AValue then Exit;
+ FDestination := AValue;
+
+ FGetPixelAtProc := nil;
+ FSetPixelAtProc := nil;
+
+ if FDestination = nil then
+ begin
+ FWidth := 0;
+ FHeight := 0;
+ end else
+ begin
+ FWidth := FDestination.Width;
+ FHeight := FDestination.Height;
+
+ with Destination.DataDescription do
+ CanBeOptimized := (BitsPerPixel and 7 = 0) and
+ (Format = ricfRGBA) and (RedPrec = 8) and (GreenPrec = 8) and (BluePrec = 8) and
+ (RedShift and 7 = 0) and (GreenPrec and 7 = 0) and (BluePrec and 7 = 0) and
+ (((AlphaPrec = 8) and (AlphaShift and 7 = 0)) or (AlphaPrec = 0));
+
+ if CanBeOptimized then
+ begin
+ FPixelSizeInBytes := Destination.DataDescription.BitsPerPixel div 8;
+
+ RedShiftInBytes := Destination.DataDescription.RedShift div 8;
+ GreenShiftInBytes := Destination.DataDescription.GreenShift div 8;
+ BlueShiftInBytes := Destination.DataDescription.BlueShift div 8;
+ AlphaShiftInBytes := Destination.DataDescription.AlphaShift div 8;
+
+ if Destination.DataDescription.ByteOrder = riboMSBFirst then
+ begin
+ RedShiftInBytes := FPixelSizeInBytes-1 - RedShiftInBytes;
+ GreenShiftInBytes := FPixelSizeInBytes-1 - GreenShiftInBytes;
+ BlueShiftInBytes := FPixelSizeInBytes-1 - BlueShiftInBytes;
+ AlphaShiftInBytes := FPixelSizeInBytes-1 - AlphaShiftInBytes;
+ end;
+
+ if Destination.DataDescription.AlphaPrec = 0 then
+ begin
+ if (RedShiftInBytes = 0) and (GreenShiftInBytes = 1) and
+ (BlueShiftInBytes = 2) then
+ begin
+ FGetPixelAtProc := @InternalGetPixelAtWithoutAlphaRGB;
+ FSetPixelAtProc := @InternalSetPixelAtWithoutAlphaRGB;
+ end else
+ if (RedShiftInBytes = 2) and (GreenShiftInBytes = 1) and
+ (BlueShiftInBytes = 0) then
+ begin
+ FGetPixelAtProc := @InternalGetPixelAtWithoutAlphaBGR;
+ FSetPixelAtProc := @InternalSetPixelAtWithoutAlphaBGR;
+ end;
+ end else
+ begin
+ if (RedShiftInBytes = 0) and (GreenShiftInBytes = 1) and
+ (BlueShiftInBytes = 2) then
+ begin
+ FGetPixelAtProc := @InternalGetPixelAtWithAlphaRGBA;
+ FSetPixelAtProc := @InternalSetPixelAtWithAlphaRGBA;
+ end else
+ if (RedShiftInBytes = 2) and (GreenShiftInBytes = 1) and
+ (BlueShiftInBytes = 0) then
+ begin
+ FGetPixelAtProc := @InternalGetPixelAtWithAlphaBGRA;
+ FSetPixelAtProc := @InternalSetPixelAtWithAlphaBGRA;
+ end;
+ end;
+ end;
+ end;
+
+ FHasPixelAtProc := (FGetPixelAtProc<>nil) and (FSetPixelAtProc <> nil);
+end;
+
procedure TIntfFreeTypeDrawer.RenderDirectly( x,y,tx: integer;
data: pointer );
var psrc: pbyte;
c: TFPColor;
+ pdest: pbyte;
+ step: longword;
+ tempValue: byte;
begin
if Destination <> nil then
begin
@@ -138,10 +544,29 @@
c := FColor;
psrc := pbyte(data);
+
+ if FHasPixelAtProc then
+ begin
+ step := FPixelSizeInBytes;
+ pdest := UnclippedGetPixelAddress(x,y);
+ inc(psrc,tx);
+ while tx > 0 do
+ begin
+ tempValue := (psrc-tx)^;
+ if tempValue <> 0 then
+ DrawPixelAt(pdest,c,tempValue);
+ inc(pdest,step);
+ dec(tx);
+ end;
+ end else
while tx > 0 do
begin
- c.alpha:= FColor.alpha * psrc^ div 255;
- DrawPixel(x,y,c);
+ tempValue := psrc^;
+ if tempValue <> 0 then
+ begin
+ c.alpha:= FColor.alpha * tempValue div 255;
+ UnclippedDrawPixel(x,y,c);
+ end;
inc(psrc);
inc(x);
dec(tx);
@@ -153,6 +578,8 @@
var xb: integer;
psrc: pbyte;
Cr,Cg,Cb: byte;
+ pdest: pbyte;
+ step: longword;
begin
if Destination <> nil then
begin
@@ -170,28 +597,79 @@
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3
else
Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
- ClearTypePixel(x,y,Cr,Cg,Cb, FColor);
- inc(x);
- inc(psrc,3);
- for xb := 1 to tx-2 do
+
+ if FHasPixelAtProc then
begin
- Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
- Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
- Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3;
- ClearTypePixel(x,y,Cr,Cg,Cb, FColor);
+ step := FPixelSizeInBytes;
+ pdest := UnclippedGetPixelAddress(x,y);
+ if Cr+Cg+Cb <> 0 then
+ ClearTypePixelAt(pdest,Cr,Cg,Cb, FColor);
+ inc(pdest,step);
+ inc(psrc,3);
+ for xb := 1 to tx-2 do
+ begin
+ Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
+ Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
+ Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3;
+ if Cr+Cg+Cb <> 0 then
+ ClearTypePixelAt(pdest,Cr,Cg,Cb, FColor);
+ inc(pdest,step);
+ inc(psrc,3);
+ end;
+ if tx > 1 then
+ begin
+ Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
+ Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
+ Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
+ if Cr+Cg+Cb <> 0 then
+ ClearTypePixelAt(pdest,Cr,Cg,Cb, FColor);
+ end;
+ end else
+ begin
+ if Cr+Cg+Cb <> 0 then
+ UnclippedClearTypePixel(x,y,Cr,Cg,Cb, FColor);
inc(x);
inc(psrc,3);
+ for xb := 1 to tx-2 do
+ begin
+ Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
+ Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
+ Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+3)^) div 3;
+ if Cr+Cg+Cb <> 0 then
+ UnclippedClearTypePixel(x,y,Cr,Cg,Cb, FColor);
+ inc(x);
+ inc(psrc,3);
+ end;
+ if tx > 1 then
+ begin
+ Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
+ Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
+ Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
+ if Cr+Cg+Cb <> 0 then
+ UnclippedClearTypePixel(x,y,Cr,Cg,Cb, FColor);
+ end;
end;
- if tx > 1 then
- begin
- Cr := ((psrc-1)^+ psrc^ + (psrc+1)^) div 3;
- Cg := (psrc^+ (psrc+1)^ + (psrc+2)^) div 3;
- Cb := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
- ClearTypePixel(x,y,Cr,Cg,Cb, FColor);
- end;
end;
end;
+procedure TIntfFreeTypeDrawer.InternalMergeColorOver(var merge: TFPColor;
+ const c: TFPColor; calpha: word);
+var
+ a1f, a2f, a12, a12m: cardinal;
+begin
+ if calpha = 0 then exit;
+ a12 := 65534 - ((not merge.alpha) * (not calpha) shr 16);
+ a12m := a12 shr 1;
+
+ a1f := merge.alpha * (not calpha) shr 16;
+ a2f := calpha - (calpha shr 15);
+
+ merge.red := (merge.red * a1f + c.red * a2f + a12m) div a12;
+ merge.green := (merge.green * a1f + c.green * a2f + a12m) div a12;
+ merge.blue := (merge.blue * a1f + c.blue * a2f + a12m) div a12;
+ merge.alpha := a12 + (a12 shr 15);
+end;
+
constructor TIntfFreeTypeDrawer.Create(ADestination: TLazIntfImage);
begin
Destination := ADestination;
@@ -202,18 +680,9 @@
);
begin
if (x < 0) or (y < 0) or (x >= Destination.Width) or (y >= Destination.Height) then exit;
- DrawPixel(x,y,c);
+ UnclippedDrawPixel(x,y,c);
end;
-procedure TIntfFreeTypeDrawer.DrawText(AText: string;
- AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor; AOpacity: Byte);
-var col: TFPColor;
-begin
- col := AColor;
- col.alpha := AOpacity + (AOpacity shl 8);
- DrawText(AText, AFont, x,y, col);
-end;
-
procedure TIntfFreeTypeDrawer.DrawText(AText: string; AFont: TFreeTypeRenderableFont; x, y: single;
AColor: TFPColor);
begin