paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 06:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazFreeType: Add TFreeTypeStream class, allow fonts to be loaded from streams. Patch by "circular"

Browse Source 
git-svn-id: trunk@40207 -
This commit is contained in:
ask 2013-02-08 12:35:14 +00:00
parent 247bb4784b
commit 7aff56c144
7 changed files with 709 additions and 774 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/lazutils/easylazfreetype.pas
View File

@ -192,6 +192,8 @@ type
TFreeTypeFont = class(TFreeTypeRenderableFont) TFreeTypeFont = class(TFreeTypeRenderableFont)
private private
FName: String; FName: String;
FStream: TStream;
FOwnedStream: boolean;
FPointSize: single; FPointSize: single;
FHinted: boolean; FHinted: boolean;
FStyleStr: string; FStyleStr: string;
@ -217,6 +219,7 @@ type
procedure SetName(const AValue: String); procedure SetName(const AValue: String);
procedure DiscardFace; procedure DiscardFace;
procedure DiscardInstance; procedure DiscardInstance;
procedure DiscardStream;
procedure SetPixelSize(const AValue: single); procedure SetPixelSize(const AValue: single);
procedure SetPointSize(const AValue: single); procedure SetPointSize(const AValue: single);
function LoadGlyphInto(_glyph : TT_Glyph; function LoadGlyphInto(_glyph : TT_Glyph;
@ -254,6 +257,7 @@ type
SmallLinePadding: boolean; SmallLinePadding: boolean;
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure AccessFromStream(AStream: TStream; AStreamOwner: boolean);
procedure RenderText(AText: string; x,y: single; ARect: TRect; OnRender : TDirectRenderingFunction); override; procedure RenderText(AText: string; x,y: single; ARect: TRect; OnRender : TDirectRenderingFunction); override;
procedure SetNameAndStyle(AName: string; AStyle: string); overload; procedure SetNameAndStyle(AName: string; AStyle: string); overload;
procedure SetNameAndStyle(AName: string; AStyle: TFreeTypeStyles); overload; procedure SetNameAndStyle(AName: string; AStyle: TFreeTypeStyles); overload;
@ -772,6 +776,12 @@ begin
PrevDPI := DPI; PrevDPI := DPI;
DiscardFace; DiscardFace;
if FStream <> nil then
begin
errorNum := TT_Open_Face(FStream,False,FFace);
if errorNum <> TT_Err_Ok then
raise exception.Create('Cannot open font (TT_Error ' + intToStr(errorNum)+') <Stream>');
end else
if (Pos(PathDelim, AName) <> 0) or (Collection = nil) or (Collection.FontFileCount = 0) then if (Pos(PathDelim, AName) <> 0) or (Collection = nil) or (Collection.FontFileCount = 0) then
begin begin
if AName = '' then exit; if AName = '' then exit;
@ -799,6 +809,7 @@ end;
procedure TFreeTypeFont.SetName(const AValue: String); procedure TFreeTypeFont.SetName(const AValue: String);
begin begin
DiscardStream;
if FName=AValue then exit; if FName=AValue then exit;
UpdateFace(AValue); UpdateFace(AValue);
end; end;
@ -1043,6 +1054,17 @@ begin
end; end;
end; end;
procedure TFreeTypeFont.DiscardStream;
begin
if FStream <> nil then
begin
DiscardFace;
if FOwnedStream then FStream.Free;
FStream := nil;
FOwnedStream:= false;
end;
end;
procedure TFreeTypeFont.SetPixelSize(const AValue: single); procedure TFreeTypeFont.SetPixelSize(const AValue: single);
begin begin
if FInstanceCreated then if FInstanceCreated then
@ -1298,10 +1320,19 @@ destructor TFreeTypeFont.Destroy;
begin begin
DiscardInstance; DiscardInstance;
DiscardFace; DiscardFace;
DiscardStream;
FGlyphTable.Free; FGlyphTable.Free;
inherited Destroy; inherited Destroy;
end; end;
procedure TFreeTypeFont.AccessFromStream(AStream: TStream; AStreamOwner: boolean);
begin
DiscardStream;
FStream := AStream;
FOwnedStream:= AStreamOwner;
UpdateFace('');
end;
procedure TFreeTypeFont.RenderText(AText: string; x, y: single; ARect: TRect; procedure TFreeTypeFont.RenderText(AText: string; x, y: single; ARect: TRect;
OnRender: TDirectRenderingFunction); OnRender: TDirectRenderingFunction);
var var

22
components/lazutils/lazfreetype.pas
View File

@ -37,7 +37,7 @@ unit LazFreeType;
interface interface
{$R-} {$R-}
uses TTTypes; uses TTTypes, Classes;
(***********************************************************************) (***********************************************************************)
(* *) (* *)
@ -83,6 +83,9 @@ uses TTTypes;
function TT_Open_Face( fontname : string; function TT_Open_Face( fontname : string;
var _face : TT_Face ) : TT_Error; var _face : TT_Face ) : TT_Error;
function TT_Open_Face( AStream : TStream; AStreamOwner: boolean;
var _face : TT_Face ) : TT_Error;
(*****************************************************************) (*****************************************************************)
(* Open a font file embedded in a collection. *) (* Open a font file embedded in a collection. *)
(* *) (* *)
@ -527,6 +530,23 @@ uses
TT_Open_Face := error; TT_Open_Face := error;
end; end;
function TT_Open_Face(AStream: TStream; AStreamOwner: boolean;
var _face: TT_Face): TT_Error;
var
input : TFont_Input;
begin
input.fontIndex := 0;
if TT_Open_Stream( AStream, AStreamOwner, input.stream ) then
begin
TT_Open_Face := error;
exit;
end;
Cache_New( face_cache, Pointer(_face), @input );
TT_Open_Face := error;
end;
(*****************************************************************) (*****************************************************************)
(* *) (* *)

78
components/lazutils/ttcmap.pas
View File

@ -138,7 +138,7 @@ uses
num_SH, u : UShort; num_SH, u : UShort;
i : Int; i : Int;
num_segs : Int; num_segs : Int;
stream: TT_Stream; ftstream: TFreeTypeStream;
label label
Fail, SimpleExit; Fail, SimpleExit;
begin begin
@ -150,124 +150,124 @@ uses
exit; exit;
end; end;
TT_Use_Stream(cmap.StreamPtr^, stream); if TT_Use_Stream(cmap.StreamPtr^, ftstream) then exit;
if TT_Seek_File( cmap.offset ) then goto SimpleExit; if ftstream.SeekFile( cmap.offset ) then goto SimpleExit;
case cmap.format of case cmap.format of
0: with cmap.cmap0 do 0: with cmap.cmap0 do
if Alloc( glyphIdArray, 256 ) or if Alloc( glyphIdArray, 256 ) or
TT_Read_File( glyphIdArray^, 256 ) then goto Fail; ftstream.ReadFile( glyphIdArray^, 256 ) then goto Fail;
2: begin 2: begin
num_SH := 0; num_SH := 0;
with cmap.cmap2 do with cmap.cmap2 do
begin begin
if Alloc( subHeaderKeys, 256*sizeof(UShort) ) or if Alloc( subHeaderKeys, 256*sizeof(UShort) ) or
TT_Access_Frame( 512 ) then goto Fail; ftstream.AccessFrame( 512 ) then goto Fail;
for i := 0 to 255 do for i := 0 to 255 do
begin begin
u := GET_UShort shr 3; u := ftstream.GET_UShort shr 3;
subHeaderKeys^[i] := u; subHeaderKeys^[i] := u;
if num_SH < u then num_SH := u; if num_SH < u then num_SH := u;
end; end;
TT_Forget_Frame; ftstream.ForgetFrame;
(* now load sub headers *) (* now load sub headers *)
numGlyphId := ((cmap.length - 2*(256+3) - num_SH*8) and $FFFF) numGlyphId := ((cmap.length - 2*(256+3) - num_SH*8) and $FFFF)
div 2; div 2;
if Alloc( subHeaders, (num_SH+1)*sizeof(TCMap2SubHeader) ) or if Alloc( subHeaders, (num_SH+1)*sizeof(TCMap2SubHeader) ) or
TT_Access_Frame( (num_SH+1)*8 ) then goto Fail; ftstream.AccessFrame( (num_SH+1)*8 ) then goto Fail;
for i := 0 to num_SH do with subHeaders^[i] do for i := 0 to num_SH do with subHeaders^[i] do
begin begin
firstCode := GET_UShort; firstCode := ftstream.GET_UShort;
entryCount := GET_UShort; entryCount := ftstream.GET_UShort;
idDelta := GET_UShort; idDelta := ftstream.GET_UShort;
(* we apply the location offset immediately *) (* we apply the location offset immediately *)
idRangeOffset := GET_UShort - (num_SH-i)*8 - 2; idRangeOffset := ftstream.GET_UShort - (num_SH-i)*8 - 2;
end; end;
TT_Forget_Frame; ftstream.ForgetFrame;
(* load glyph ids *) (* load glyph ids *)
if Alloc( glyphIdArray, numGlyphId*sizeof(UShort) ) or if Alloc( glyphIdArray, numGlyphId*sizeof(UShort) ) or
TT_Access_Frame( numGlyphId*2 ) then goto Fail; ftstream.AccessFrame( numGlyphId*2 ) then goto Fail;
for i := 0 to numGlyphId-1 do for i := 0 to numGlyphId-1 do
glyphIdArray^[i] := GET_UShort; glyphIdArray^[i] := ftstream.GET_UShort;
TT_Forget_Frame; ftstream.ForgetFrame;
end; end;
end; end;
4: with cmap.cmap4 do 4: with cmap.cmap4 do
begin begin
if TT_Access_Frame(8) then goto Fail; if ftstream.AccessFrame(8) then goto Fail;
segCountX2 := Get_UShort; segCountX2 := ftstream.Get_UShort;
searchRange := Get_UShort; searchRange := ftstream.Get_UShort;
entrySelector := Get_UShort; entrySelector := ftstream.Get_UShort;
rangeShift := Get_UShort; rangeShift := ftstream.Get_UShort;
num_segs := segCountX2 shr 1; num_segs := segCountX2 shr 1;
TT_Forget_Frame; ftstream.ForgetFrame;
(* load segments *) (* load segments *)
if Alloc( segments, num_segs*sizeof(TCMap4Segment) ) or if Alloc( segments, num_segs*sizeof(TCMap4Segment) ) or
TT_Access_Frame( (num_segs*4+1)*2 ) then goto Fail; ftstream.AccessFrame( (num_segs*4+1)*2 ) then goto Fail;
for i := 0 to num_segs-1 do for i := 0 to num_segs-1 do
segments^[i].endCount := Get_UShort; segments^[i].endCount := ftstream.Get_UShort;
Get_UShort; ftstream.Get_UShort;
for i := 0 to num_segs-1 do for i := 0 to num_segs-1 do
segments^[i].startCount := Get_UShort; segments^[i].startCount := ftstream.Get_UShort;
for i := 0 to num_segs-1 do for i := 0 to num_segs-1 do
segments^[i].idDelta := GET_Short; segments^[i].idDelta := ftstream.GET_Short;
for i := 0 to num_segs-1 do for i := 0 to num_segs-1 do
segments^[i].idRangeOffset := GET_UShort; segments^[i].idRangeOffset := ftstream.GET_UShort;
TT_Forget_Frame; ftstream.ForgetFrame;
numGlyphId := (( cmap.length - (16+8*num_segs) ) and $FFFF) numGlyphId := (( cmap.length - (16+8*num_segs) ) and $FFFF)
div 2; div 2;
(* load glyph ids *) (* load glyph ids *)
if Alloc( glyphIdArray, numGlyphId*sizeof(UShort) ) or if Alloc( glyphIdArray, numGlyphId*sizeof(UShort) ) or
TT_Access_Frame( numGlyphId*2 ) then goto Fail; ftstream.AccessFrame( numGlyphId*2 ) then goto Fail;
for i := 0 to numGlyphId-1 do for i := 0 to numGlyphId-1 do
glyphIdArray^[i] := Get_UShort; glyphIdArray^[i] := ftstream.Get_UShort;
TT_Forget_Frame; ftstream.ForgetFrame;
end; end;
6: with cmap.cmap6 do 6: with cmap.cmap6 do
begin begin
if TT_Access_Frame(4) then goto Fail; if ftstream.AccessFrame(4) then goto Fail;
firstCode := GET_UShort; firstCode := ftstream.GET_UShort;
entryCount := GET_UShort; entryCount := ftstream.GET_UShort;
TT_Forget_Frame; ftstream.ForgetFrame;
if Alloc( glyphIdArray, entryCount*sizeof(Short) ) or if Alloc( glyphIdArray, entryCount*sizeof(Short) ) or
TT_Access_Frame( entryCount*2 ) then goto Fail; ftstream.AccessFrame( entryCount*2 ) then goto Fail;
for i := 0 to entryCount-1 do for i := 0 to entryCount-1 do
glyphIdArray^[i] := GET_UShort; glyphIdArray^[i] := ftstream.GET_UShort;
TT_Forget_Frame; ftstream.ForgetFrame;
end; end;
else else

877
components/lazutils/ttfile.pas
View File

File diff suppressed because it is too large Load Diff

110
components/lazutils/ttgload.pas
View File

@ -222,8 +222,8 @@ const
******************************************************************) ******************************************************************)
function Load_Simple_Glyph( exec : PExec_Context; function Load_Simple_Glyph( AStream : TFreeTypeStream;
{%H-}stream : TT_Stream; exec : PExec_Context;
n_contours : Int; n_contours : Int;
left_contours : Int; left_contours : Int;
left_points : Int; left_points : Int;
@ -264,7 +264,7 @@ const
(* Reading the contours endpoints *) (* Reading the contours endpoints *)
if TT_Access_Frame( (n_contours+1)*2 ) then if AStream.AccessFrame( (n_contours+1)*2 ) then
goto Fail_File; goto Fail_File;
n_points := 0; n_points := 0;
@ -272,7 +272,7 @@ const
for k := 0 to n_contours-1 do for k := 0 to n_contours-1 do
begin begin
{$IFDEF FREETYPE_DEBUG} Write( n_points,' '); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Write( n_points,' '); {$ENDIF}
n_points := GET_Short; n_points := AStream.GET_Short;
exec^.pts.conEnds^[k] := n_points; exec^.pts.conEnds^[k] := n_points;
inc( n_points ); inc( n_points );
end; end;
@ -286,9 +286,9 @@ const
(* Loading instructions *) (* Loading instructions *)
n_ins := GET_Short; n_ins := AStream.GET_Short;
TT_Forget_Frame; AStream.ForgetFrame;
{ {
if not subg^.is_hinted then if not subg^.is_hinted then
@ -312,7 +312,7 @@ const
with exec^ do with exec^ do
begin begin
if TT_Read_File( glyphIns^, n_ins ) then if AStream.ReadFile( glyphIns^, n_ins ) then
goto Fail_File; goto Fail_File;
glyphSize := n_ins; glyphSize := n_ins;
@ -327,7 +327,7 @@ const
(* read the flags *) (* read the flags *)
if TT_Check_And_Access_Frame( n_points*5 ) if AStream.CheckAndAccessFrame( n_points*5 )
then goto Fail; then goto Fail;
k := 0; k := 0;
@ -335,13 +335,13 @@ const
while ( k < n_points ) do while ( k < n_points ) do
begin begin
c := GET_Byte; c := AStream.GET_Byte;
flag^[k] := c; flag^[k] := c;
inc(k); inc(k);
if c and 8 <> 0 then if c and 8 <> 0 then
begin begin
cnt := GET_Byte; cnt := AStream.GET_Byte;
while ( cnt > 0 ) do while ( cnt > 0 ) do
begin begin
@ -361,10 +361,10 @@ const
begin begin
if flag^[k] and 2 <> 0 then if flag^[k] and 2 <> 0 then
if flag^[k] and 16 <> 0 then inc( x, GET_Byte ) if flag^[k] and 16 <> 0 then inc( x, AStream.GET_Byte )
else inc( x, -GET_Byte ) else inc( x, -AStream.GET_Byte )
else else
if flag^[k] and 16 = 0 then inc( x, GET_Short ); if flag^[k] and 16 = 0 then inc( x, AStream.GET_Short );
coords^[k].x := x; coords^[k].x := x;
end; end;
@ -377,15 +377,15 @@ const
begin begin
if flag^[k] and 4 <> 0 then if flag^[k] and 4 <> 0 then
if flag^[k] and 32 <> 0 then inc( y, GET_Byte ) if flag^[k] and 32 <> 0 then inc( y, AStream.GET_Byte )
else inc( y, -GET_Byte ) else inc( y, -AStream.GET_Byte )
else else
if flag^[k] and 32 = 0 then inc( y, GET_Short ); if flag^[k] and 32 = 0 then inc( y, AStream.GET_Short );
coords^[k].y := y; coords^[k].y := y;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
(* Now adds the two shadow points at n and n+1 *) (* Now adds the two shadow points at n and n+1 *)
(* We need the left side bearing and advance width *) (* We need the left side bearing and advance width *)
@ -490,7 +490,8 @@ const
* *
******************************************************************) ******************************************************************)
function Load_Composite_End( n_points : Int; function Load_Composite_End( AStream: TFreeTypeStream;
n_points : Int;
{%H-}n_contours : Int; {%H-}n_contours : Int;
exec : PExec_Context; exec : PExec_Context;
subg : PSubglyph_Record; subg : PSubglyph_Record;
@ -509,9 +510,9 @@ const
if subg^.is_hinted and if subg^.is_hinted and
(subg^.element_flag and WE_HAVE_INSTR <> 0) then (subg^.element_flag and WE_HAVE_INSTR <> 0) then
begin begin
if TT_Access_Frame(2) then goto Fail_File; if AStream.AccessFrame(2) then goto Fail_File;
n_ins := Get_UShort; n_ins := AStream.Get_UShort;
TT_Forget_Frame; AStream.ForgetFrame;
(* load the instructions *) (* load the instructions *)
{$IFDEF FREETYPE_DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF}
@ -528,7 +529,7 @@ const
if n_ins > 0 then with exec^ do if n_ins > 0 then with exec^ do
begin begin
if TT_Read_File( glyphIns^, n_ins ) then if AStream.ReadFile( glyphIns^, n_ins ) then
goto Fail_File; goto Fail_File;
glyphSize := n_ins; glyphSize := n_ins;
@ -680,7 +681,7 @@ const
xx, xy, yx, yy : TT_Fixed; xx, xy, yx, yy : TT_Fixed;
exec : PExec_Context; exec : PExec_Context;
stream : TT_Stream; ftstream : TFreeTypeStream;
subglyph, subglyph2 : PSubGlyph_Record; subglyph, subglyph2 : PSubGlyph_Record;
@ -779,7 +780,7 @@ const
(* now access stream *) (* now access stream *)
if TT_Use_Stream( face^.stream, stream {%H-}) then if TT_Use_Stream( face^.stream, ftstream {%H-}) then
goto Fin; goto Fin;
(* Main Loading Loop *) (* Main Loading Loop *)
@ -848,17 +849,17 @@ const
(* read first glyph header *) (* read first glyph header *)
if TT_Seek_File( offset ) or if ftstream.SeekFile( offset ) or
TT_Access_Frame( 5*sizeof(Short) ) then ftstream.AccessFrame( 5*sizeof(Short) ) then
goto Fail_File; goto Fail_File;
num_contours := GET_Short; num_contours := ftstream.GET_Short;
subglyph^.bbox.xMin := GET_Short; subglyph^.bbox.xMin := ftstream.GET_Short;
subglyph^.bbox.yMin := GET_Short; subglyph^.bbox.yMin := ftstream.GET_Short;
subglyph^.bbox.xMax := GET_Short; subglyph^.bbox.xMax := ftstream.GET_Short;
subglyph^.bbox.yMax := GET_Short; subglyph^.bbox.yMax := ftstream.GET_Short;
TT_Forget_Frame; ftstream.ForgetFrame;
{$IFDEF FREETYPE_DEBUG} {$IFDEF FREETYPE_DEBUG}
Writeln('Glyph ', i ); Writeln('Glyph ', i );
@ -925,8 +926,8 @@ const
new_flags := new_flags and not TT_Load_Debug; new_flags := new_flags and not TT_Load_Debug;
if Load_Simple_Glyph( if Load_Simple_Glyph(
ftstream,
exec, exec,
stream,
num_contours, num_contours,
left_contours, left_contours,
left_points, left_points,
@ -973,15 +974,15 @@ const
(* now read composite header *) (* now read composite header *)
if TT_Access_Frame( 4 ) then if ftstream.AccessFrame( 4 ) then
goto Fail_File; goto Fail_File;
new_flags := Get_UShort; new_flags := ftstream.Get_UShort;
subglyph^.element_flag := new_flags; subglyph^.element_flag := new_flags;
subglyph2^.index := Get_UShort; subglyph2^.index := ftstream.Get_UShort;
TT_Forget_Frame; ftstream.ForgetFrame;
k := 2; k := 2;
@ -997,18 +998,18 @@ const
if new_flags and WE_HAVE_A_2X2 <> 0 then if new_flags and WE_HAVE_A_2X2 <> 0 then
inc( k, 8 ); inc( k, 8 );
if TT_Access_Frame( k ) then if ftstream.AccessFrame( k ) then
goto Fail_File; goto Fail_File;
if new_flags and ARGS_ARE_WORDS <> 0 then if new_flags and ARGS_ARE_WORDS <> 0 then
begin begin
k := Get_Short; k := ftstream.Get_Short;
l := Get_Short; l := ftstream.Get_Short;
end end
else else
begin begin
k := Get_Byte; k := ftstream.Get_Byte;
l := Get_Byte; l := ftstream.Get_Byte;
end; end;
subglyph^.arg1 := k; subglyph^.arg1 := k;
@ -1027,24 +1028,24 @@ const
if new_flags and WE_HAVE_A_SCALE <> 0 then if new_flags and WE_HAVE_A_SCALE <> 0 then
begin begin
xx := Long(Get_Short) shl 2; xx := Long(ftstream.Get_Short) shl 2;
yy := xx; yy := xx;
subglyph2^.is_scaled := true; subglyph2^.is_scaled := true;
end end
else if new_flags and WE_HAVE_AN_XY_SCALE <> 0 then else if new_flags and WE_HAVE_AN_XY_SCALE <> 0 then
begin begin
xx := Long(Get_Short) shl 2; xx := Long(ftstream.Get_Short) shl 2;
yy := Long(Get_Short) shl 2; yy := Long(ftstream.Get_Short) shl 2;
subglyph2^.is_scaled := true; subglyph2^.is_scaled := true;
end end
else if new_flags and WE_HAVE_A_2X2 <> 0 then else if new_flags and WE_HAVE_A_2X2 <> 0 then
begin begin
xx := Long(Get_Short) shl 2; xx := Long(ftstream.Get_Short) shl 2;
xy := Long(Get_Short) shl 2; xy := Long(ftstream.Get_Short) shl 2;
yx := Long(Get_Short) shl 2; yx := Long(ftstream.Get_Short) shl 2;
yy := Long(Get_Short) shl 2; yy := Long(ftstream.Get_Short) shl 2;
subglyph2^.is_scaled := true; subglyph2^.is_scaled := true;
end; end;
@ -1060,9 +1061,9 @@ const
if abs(delta) <> 1 shl 16 then if abs(delta) <> 1 shl 16 then
subglyph2^.is_hinted := false; subglyph2^.is_hinted := false;
TT_Forget_Frame; ftstream.ForgetFrame;
subglyph^.file_offset := TT_File_Pos; subglyph^.file_offset := ftstream.Position;
phase := Load_Glyph; phase := Load_Glyph;
end; end;
@ -1186,7 +1187,7 @@ const
(* check for last component *) (* check for last component *)
if TT_Seek_File( subglyph^.file_offset ) then if ftstream.SeekFile( subglyph^.file_offset ) then
goto Fail_File; goto Fail_File;
if subglyph^.element_flag and MORE_COMPONENTS <> 0 then if subglyph^.element_flag and MORE_COMPONENTS <> 0 then
@ -1196,7 +1197,8 @@ const
debug := ( load_top = 0 ) and debug := ( load_top = 0 ) and
( load_flags and TT_Load_Debug <> 0 ); ( load_flags and TT_Load_Debug <> 0 );
if Load_Composite_End( num_points, if Load_Composite_End( ftstream,
num_points,
num_contours, num_contours,
exec, exec,
subglyph, subglyph,
@ -1344,7 +1346,7 @@ const
Load_TrueType_Glyph := Success; Load_TrueType_Glyph := Success;
Fail: Fail:
TT_Done_Stream( stream ); TT_Done_Stream( face^.stream );
Fin: Fin:

319
components/lazutils/ttload.pas
View File

@ -26,27 +26,27 @@ Unit TTLoad;
interface interface
{$R-} {$R-}
uses TTTypes, TTTables, TTCMap, TTObjs; uses TTTypes, TTTables, TTCMap, TTObjs, TTFile;
function LookUp_TrueType_Table( face : PFace; function LookUp_TrueType_Table( face : PFace;
aTag : string ) : int; aTag : string ) : int;
function Load_TrueType_Directory( face : PFace; function Load_TrueType_Directory( AStream: TFreeTypeStream; face : PFace;
faceIndex : Int ) : TError; faceIndex : Int ) : TError;
function Load_TrueType_MaxProfile( face : PFace ) : TError; function Load_TrueType_MaxProfile( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_Header ( face : PFace ) : TError; function Load_TrueType_Header ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_Locations ( face : PFace ) : TError; function Load_TrueType_Locations ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_CVT ( face : PFace ) : TError; function Load_TrueType_CVT ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_CMap ( face : PFace ) : TError; function Load_TrueType_CMap ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_Gasp ( face : PFace ) : TError; function Load_TrueType_Gasp ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_Names ( face : PFace ) : TError; function Load_TrueType_Names ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_Programs ( face : PFace ) : TError; function Load_TrueType_Programs ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_trueType_Postscript( face : PFace ) : TError; function Load_trueType_Postscript( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_OS2 ( face : PFace ) : TError; function Load_TrueType_OS2 ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_HDMX ( face : PFace ) : TError; function Load_TrueType_HDMX ( AStream: TFreeTypeStream; face : PFace ) : TError;
function Load_TrueType_Metrics_Header( face : PFace; function Load_TrueType_Metrics_Header( AStream: TFreeTypeStream; face : PFace;
vertical : Boolean ) : TError; vertical : Boolean ) : TError;
function Load_TrueType_Any( face : PFace; function Load_TrueType_Any( face : PFace;
@ -57,7 +57,7 @@ uses TTTypes, TTTables, TTCMap, TTObjs;
implementation implementation
uses TTError, TTMemory, TTFile; uses TTError, TTMemory;
(* Composite glyph decoding flags *) (* Composite glyph decoding flags *)
@ -125,7 +125,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Collection( face : PFace ) : TError; function Load_TrueType_Collection( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
n : Int; n : Int;
const const
@ -139,14 +139,14 @@ uses TTError, TTMemory, TTFile;
with face^.ttcHeader do with face^.ttcHeader do
begin begin
if TT_Seek_File( 0 ) or if AStream.SeekFile( 0 ) or
TT_Access_Frame( 12 ) then exit; AStream.AccessFrame(12 ) then exit;
Tag := Get_ULong; Tag := AStream.Get_ULong;
version := Get_Long; version := AStream.Get_Long;
dirCount := Get_Long; dirCount := AStream.Get_Long;
TT_Forget_Frame; AStream.ForgetFrame;
if Tag <> TTC_Tag then if Tag <> TTC_Tag then
begin begin
@ -160,12 +160,12 @@ uses TTError, TTMemory, TTFile;
end; end;
if Alloc( tableDirectory, dirCount * sizeof(ULong) ) or if Alloc( tableDirectory, dirCount * sizeof(ULong) ) or
TT_Access_Frame( dirCount*4 ) then exit; AStream.AccessFrame( dirCount*4 ) then exit;
for n := 0 to dirCount-1 do for n := 0 to dirCount-1 do
tableDirectory^[n] := Get_ULong; tableDirectory^[n] := AStream.Get_ULong;
TT_Forget_Frame; AStream.ForgetFrame;
end; end;
Load_TrueType_Collection := Success; Load_TrueType_Collection := Success;
@ -186,7 +186,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Directory( face : PFace; function Load_TrueType_Directory( AStream: TFreeTypeStream; face : PFace;
faceIndex : Int ) : TError; faceIndex : Int ) : TError;
var var
n : Int; n : Int;
@ -196,7 +196,7 @@ uses TTError, TTMemory, TTFile;
{$IFDEF FREETYPE_DEBUG} Write('Directory '); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Write('Directory '); {$ENDIF}
if Load_TrueType_Collection(face) then if Load_TrueType_Collection(AStream, face) then
begin begin
if error <> TT_Err_File_Is_Not_Collection then if error <> TT_Err_File_Is_Not_Collection then
exit; exit;
@ -208,7 +208,7 @@ uses TTError, TTMemory, TTFile;
error := TT_Err_Ok; error := TT_Err_Ok;
(* Now skip to the beginning of the file *) (* Now skip to the beginning of the file *)
if TT_Seek_File(0) then if AStream.SeekFile(0) then
exit; exit;
end end
else else
@ -222,23 +222,23 @@ uses TTError, TTMemory, TTFile;
end; end;
(* select a TT Font within the ttc file *) (* select a TT Font within the ttc file *)
if TT_Seek_File( face^.ttcHeader.tableDirectory^[faceIndex] ) then if AStream.SeekFile( face^.ttcHeader.tableDirectory^[faceIndex] ) then
exit; exit;
end; end;
if TT_Access_Frame( 12 ) then if AStream.AccessFrame( 12 ) then
exit; exit;
tableDir.version := GET_Long; tableDir.version := AStream.GET_Long;
tableDir.numTables := GET_UShort; tableDir.numTables := AStream.GET_UShort;
tableDir.searchRange := GET_UShort; tableDir.searchRange := AStream.GET_UShort;
tableDir.entrySelector := GET_UShort; tableDir.entrySelector := AStream.GET_UShort;
tableDir.rangeShift := GET_UShort; tableDir.rangeShift := AStream.GET_UShort;
{$IFDEF FREETYPE_DEBUG} Writeln('Tables number : ', tableDir.numTables ); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('Tables number : ', tableDir.numTables ); {$ENDIF}
TT_Forget_Frame(); AStream.ForgetFrame;
(* Check that we have a 'sfnt' format there *) (* Check that we have a 'sfnt' format there *)
if (tableDir.version <> $10000 ) and (* MS fonts *) if (tableDir.version <> $10000 ) and (* MS fonts *)
@ -249,20 +249,25 @@ uses TTError, TTMemory, TTFile;
exit; exit;
end; end;
face^.numTables := tableDir.numTables; with face^ do
if Alloc( face^.dirTables, face^.numTables * sizeof( TTableDirEntry ) ) or
TT_Access_Frame( 16 * face^.numTables ) then exit;
for n := 0 to face^.numTables-1 do
begin begin
face^.dirTables^[n].Tag := GET_ULong;
face^.dirTables^[n].Checksum := GET_ULong; numTables := tableDir.numTables;
face^.dirTables^[n].Offset := GET_Long;
face^.dirTables^[n].Length := Get_Long; if Alloc( dirTables, numTables * sizeof( TTableDirEntry ) ) or
AStream.AccessFrame( 16 * numTables ) then exit;
for n := 0 to numTables-1 do with dirTables^[n] do
begin
Tag := AStream.GET_ULong;
Checksum := AStream.GET_ULong;
Offset := AStream.GET_Long;
Length := AStream.Get_Long;
end; end;
TT_Forget_Frame(); AStream.ForgetFrame;
end;
{$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF}
@ -284,7 +289,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_MaxProfile( face : PFace ) : TError; function Load_TrueType_MaxProfile( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
table : int; table : int;
begin begin
@ -299,10 +304,10 @@ uses TTError, TTMemory, TTFile;
with face^ do with face^ do
begin begin
if TT_Seek_File( dirTables^[table].Offset ) or if astream.SeekFile( dirTables^[table].Offset ) or
TT_Access_Frame( 32 ) then exit; AStream.AccessFrame( 32 ) then exit;
with MaxProfile do with AStream, MaxProfile do
begin begin
ULong(Version) := GET_ULong; ULong(Version) := GET_ULong;
@ -325,7 +330,7 @@ uses TTError, TTMemory, TTFile;
maxComponentDepth := GET_UShort; maxComponentDepth := GET_UShort;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
(* XXX : an adjustement that is necessary to load certain */ (* XXX : an adjustement that is necessary to load certain */
/* broken fonts like "Keystrokes MT" :-( */ /* broken fonts like "Keystrokes MT" :-( */
@ -381,7 +386,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Gasp( face : PFace ) : TError; function Load_TrueType_Gasp( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
gRanges : PGaspRanges; gRanges : PGaspRanges;
table, i : Int; table, i : Int;
@ -404,33 +409,33 @@ uses TTError, TTMemory, TTFile;
exit; exit;
end; end;
if TT_Seek_File( face^.dirTables^[table].Offset ) or if astream.SeekFile( face^.dirTables^[table].Offset ) or
TT_Access_Frame( 4 ) then exit; AStream.AccessFrame( 4 ) then exit;
with face^.gasp do with AStream, face^.gasp do
begin begin
version := Get_UShort; version := Get_UShort;
numRanges := Get_UShort; numRanges := Get_UShort;
gaspRanges := nil; gaspRanges := nil;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
gRanges:=nil; gRanges:=nil;
if Alloc( gRanges, face^.gasp.numRanges * sizeof(TGaspRange) ) or if Alloc( gRanges, face^.gasp.numRanges * sizeof(TGaspRange) ) or
TT_Access_Frame( face^.gasp.numRanges * 4 ) then AStream.AccessFrame( face^.gasp.numRanges * 4 ) then
goto Fail; goto Fail;
face^.gasp.gaspRanges := gRanges; face^.gasp.gaspRanges := gRanges;
for i := 0 to face^.gasp.numRanges-1 do for i := 0 to face^.gasp.numRanges-1 do
with gRanges^[i] do with AStream, gRanges^[i] do
begin begin
maxPPEM := Get_UShort; maxPPEM := Get_UShort;
gaspFlag := Get_UShort; gaspFlag := Get_UShort;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
Load_TrueType_Gasp := Success; Load_TrueType_Gasp := Success;
exit; exit;
@ -457,7 +462,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Header( face : PFace ) : TError; function Load_TrueType_Header( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
i : int; i : int;
begin begin
@ -471,10 +476,10 @@ uses TTError, TTMemory, TTFile;
with face^ do with face^ do
begin begin
if TT_Seek_File( dirTables^[i].offset ) or if AStream.SeekFile( dirTables^[i].offset ) or
TT_Access_Frame( 54 ) then exit; AStream.AccessFrame(54 ) then exit;
with FontHeader do with AStream, FontHeader do
begin begin
ULong(Table_Version) := GET_ULong; ULong(Table_Version) := GET_ULong;
@ -505,7 +510,7 @@ uses TTError, TTMemory, TTFile;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
end; end;
@ -529,7 +534,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Metrics( face : PFace; function Load_TrueType_Metrics( AStream: TFreeTypeStream; face : PFace;
vertical : Boolean ) : TError; vertical : Boolean ) : TError;
var var
table, n : int; table, n : int;
@ -599,20 +604,20 @@ uses TTError, TTMemory, TTFile;
if Alloc( longs^, sizeof(TLongMetrics) * num_longs ) or if Alloc( longs^, sizeof(TLongMetrics) * num_longs ) or
Alloc( shorts^, sizeof(TShortMetrics)* num_shorts ) or Alloc( shorts^, sizeof(TShortMetrics)* num_shorts ) or
TT_Seek_File( face^.dirTables^[table].Offset ) or AStream.SeekFile( face^.dirTables^[table].Offset ) or
TT_Access_Frame( face^.dirTables^[table].Length ) then exit; AStream.AccessFrame( face^.dirTables^[table].Length ) then exit;
for n := 0 to num_longs-1 do with longs^^[n] do for n := 0 to num_longs-1 do with longs^^[n] do
begin begin
advance := GET_UShort; advance := AStream.GET_UShort;
bearing := GET_Short; bearing := AStream.GET_Short;
end; end;
(* do we have an inconsistent number of metric values ? *) (* do we have an inconsistent number of metric values ? *)
if num_shorts > num_shorts_checked then if num_shorts > num_shorts_checked then
begin begin
for n := 0 to num_shorts_checked-1 do for n := 0 to num_shorts_checked-1 do
shorts^^[n] := GET_Short; shorts^^[n] := AStream.GET_Short;
(* we fill up the missing left side bearings with the *) (* we fill up the missing left side bearings with the *)
(* last valid value. Since this will occur for buggy CJK *) (* last valid value. Since this will occur for buggy CJK *)
@ -625,9 +630,9 @@ uses TTError, TTMemory, TTFile;
end end
else else
for n := 0 to num_shorts-1 do for n := 0 to num_shorts-1 do
shorts^^[n] := GET_Short; shorts^^[n] := AStream.GET_Short;
TT_Forget_Frame; AStream.ForgetFrame;
{$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF}
@ -649,7 +654,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Metrics_Header( face : PFace; function Load_TrueType_Metrics_Header( AStream: TFreeTypeStream; face : PFace;
vertical : Boolean ) : TError; vertical : Boolean ) : TError;
var var
table : int; table : int;
@ -691,11 +696,11 @@ uses TTError, TTMemory, TTFile;
with face^ do with face^ do
begin begin
if TT_Seek_File( dirTables^[table].Offset ) or if AStream.SeekFile( dirTables^[table].Offset ) or
TT_Access_Frame( 36 ) then AStream.AccessFrame( 36 ) then
exit; exit;
with header^ do with AStream, header^ do
begin begin
Long(Version) := GET_ULong; Long(Version) := GET_ULong;
@ -726,13 +731,13 @@ uses TTError, TTMemory, TTFile;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
end; end;
{$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF}
Load_TrueType_Metrics_Header := Load_TrueType_Metrics( face, vertical ); Load_TrueType_Metrics_Header := Load_TrueType_Metrics( AStream, face, vertical );
end; end;
(******************************************************************* (*******************************************************************
@ -754,7 +759,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Locations( face : PFace ): TError; function Load_TrueType_Locations( AStream: TFreeTypeStream; face : PFace ): TError;
var var
t, n : int; t, n : int;
LongOffsets : int; LongOffsets : int;
@ -772,7 +777,7 @@ uses TTError, TTMemory, TTFile;
t := LookUp_Mandatory_Table( face, 'loca' ); t := LookUp_Mandatory_Table( face, 'loca' );
if t < 0 then exit; if t < 0 then exit;
if TT_Seek_File( dirTables^[T].Offset ) then exit; if AStream.SeekFile( dirTables^[T].Offset ) then exit;
if LongOffsets <> 0 then if LongOffsets <> 0 then
begin begin
@ -784,12 +789,12 @@ uses TTError, TTMemory, TTFile;
{$ENDIF} {$ENDIF}
if Alloc( glyphLocations, sizeof(Long)*numLocations ) or if Alloc( glyphLocations, sizeof(Long)*numLocations ) or
TT_Access_Frame( numLocations*4 ) then exit; AStream.AccessFrame( numLocations*4 ) then exit;
for n := 0 to numLocations-1 do for n := 0 to numLocations-1 do
glyphLocations^[n] := GET_Long; glyphLocations^[n] := AStream.GET_Long;
TT_Forget_Frame; AStream.ForgetFrame;
end end
else else
@ -801,12 +806,12 @@ uses TTError, TTMemory, TTFile;
{$ENDIF} {$ENDIF}
if Alloc( glyphLocations, sizeof(Long)*numLocations ) or if Alloc( glyphLocations, sizeof(Long)*numLocations ) or
TT_Access_Frame( numLocations*2 ) then exit; AStream.AccessFrame( numLocations*2 ) then exit;
for n := 0 to numLocations-1 do for n := 0 to numLocations-1 do
glyphLocations^[n] := Long(GET_UShort) * 2; glyphLocations^[n] := Long(AStream.GET_UShort) * 2;
TT_Forget_Frame; AStream.ForgetFrame;
end; end;
end; end;
@ -832,7 +837,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Names( face : PFace ) : TError; function Load_TrueType_Names( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
table, i : Int; table, i : Int;
bytes : Long; bytes : Long;
@ -845,17 +850,17 @@ uses TTError, TTMemory, TTFile;
with face^.nameTable do with face^.nameTable do
begin begin
(* Seek to the beginning of the table and check the frame access. *) (* Seek to the beginning of the table and check the frame access. *)
if TT_Seek_File( face^.dirTables^[table].Offset ) or if AStream.SeekFile( face^.dirTables^[table].Offset ) or
TT_Access_Frame( 6 ) then exit; AStream.AccessFrame(6 ) then exit;
format := GET_UShort; format := AStream.GET_UShort;
numNameRecords := GET_UShort; numNameRecords := AStream.GET_UShort;
storageOffset := GET_UShort; storageOffset := AStream.GET_UShort;
TT_Forget_Frame; AStream.ForgetFrame;
if Alloc( names, numNameRecords*sizeof(TName_Record) ) or if Alloc( names, numNameRecords*sizeof(TName_Record) ) or
TT_Access_Frame( numNameRecords*12 ) then AStream.AccessFrame( numNameRecords*12 ) then
begin begin
numNameRecords := 0; numNameRecords := 0;
exit; exit;
@ -865,7 +870,7 @@ uses TTError, TTMemory, TTFile;
(* to hold the strings themselves *) (* to hold the strings themselves *)
bytes := 0; bytes := 0;
for i := 0 to numNameRecords-1 do with names^[i] do for i := 0 to numNameRecords-1 do with AStream, names^[i] do
begin begin
platformID := GET_UShort; platformID := GET_UShort;
encodingID := GET_UShort; encodingID := GET_UShort;
@ -880,14 +885,14 @@ uses TTError, TTMemory, TTFile;
bytes := Offset + Length; bytes := Offset + Length;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
storage := nil; storage := nil;
if bytes > 0 then if bytes > 0 then
begin begin
if Alloc( storage, bytes ) then exit; if Alloc( storage, bytes ) then exit;
if TT_Read_At_File( face^.dirTables^[table].Offset + storageOffset, if AStream.ReadAtFile( face^.dirTables^[table].Offset + storageOffset,
storage^, bytes ) then storage^, bytes ) then
begin begin
Free(storage); Free(storage);
@ -916,7 +921,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_CVT( face : PFace ): TError; function Load_TrueType_CVT( AStream: TFreeTypeStream; face : PFace ): TError;
var var
t, n : Int; t, n : Int;
begin begin
@ -943,14 +948,14 @@ uses TTError, TTMemory, TTFile;
if Alloc( cvt, sizeof(Short)*cvtSize ) or if Alloc( cvt, sizeof(Short)*cvtSize ) or
TT_Seek_File( dirTables^[t].Offset ) or AStream.SeekFile( dirTables^[t].Offset ) or
TT_Access_Frame( 2*cvtSize ) then exit; AStream.AccessFrame(2*cvtSize ) then exit;
for n := 0 to cvtSize-1 do for n := 0 to cvtSize-1 do
cvt^[n] := GET_Short; cvt^[n] := AStream.GET_Short;
TT_Forget_Frame; AStream.ForgetFrame;
end; end;
{$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF}
@ -974,7 +979,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_CMap( face : PFace ) : TError; function Load_TrueType_CMap( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
off, table_start : Longint; off, table_start : Longint;
n, t : Int; n, t : Int;
@ -998,15 +1003,15 @@ uses TTError, TTMemory, TTFile;
table_start := dirTables^[t].offset; table_start := dirTables^[t].offset;
if TT_Seek_File( dirTables^[t].Offset ) or if AStream.SeekFile( dirTables^[t].Offset ) or
TT_Access_Frame( 4 ) then exit; AStream.AccessFrame( 4 ) then exit;
cmap_dir.tableVersionNumber := GET_UShort; cmap_dir.tableVersionNumber := AStream.GET_UShort;
cmap_dir.numCMaps := GET_UShort; cmap_dir.numCMaps := AStream.GET_UShort;
TT_Forget_Frame; AStream.ForgetFrame;
off := TT_File_Pos; off := AStream.Position;
(* save space in face data for cmap tables *) (* save space in face data for cmap tables *)
numCMaps := cmap_dir.numCMaps; numCMaps := cmap_dir.numCMaps;
@ -1015,34 +1020,34 @@ uses TTError, TTMemory, TTFile;
for n := 0 to numCMaps-1 do for n := 0 to numCMaps-1 do
begin begin
if TT_Seek_File ( off ) or if AStream.SeekFile ( off ) or
TT_Access_Frame( 8 ) then exit; AStream.AccessFrame( 8 ) then exit;
cmap := @cMaps^[n]; cmap := @cMaps^[n];
entry.platformID := GET_UShort; entry.platformID := AStream.GET_UShort;
entry.platformEncodingID := GET_UShort; entry.platformEncodingID := AStream.GET_UShort;
entry.offset := GET_Long; entry.offset := AStream.GET_Long;
cmap^.loaded := False; cmap^.loaded := False;
cmap^.platformID := entry.platformID; cmap^.platformID := entry.platformID;
cmap^.platformEncodingID := entry.platformEncodingID; cmap^.platformEncodingID := entry.platformEncodingID;
TT_Forget_Frame; AStream.ForgetFrame;
off := TT_File_Pos; off := AStream.Position;
if TT_Seek_File ( table_start + entry.offset ) or if AStream.SeekFile ( table_start + entry.offset ) or
TT_Access_Frame( 6 ) then exit; AStream.AccessFrame( 6 ) then exit;
cmap^.format := Get_UShort; cmap^.format := AStream.Get_UShort;
cmap^.length := Get_UShort; cmap^.length := AStream.Get_UShort;
cmap^.version := Get_UShort; cmap^.version := AStream.Get_UShort;
TT_Forget_Frame; AStream.ForgetFrame;
cmap^.StreamPtr := @face^.stream; cmap^.StreamPtr := @face^.stream;
cmap^.offset := TT_File_Pos; cmap^.offset := AStream.Position;
end; (* for n *) end; (* for n *)
@ -1108,7 +1113,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Programs( face : PFace ) : TError; function Load_TrueType_Programs( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
t : Int; t : Int;
begin begin
@ -1139,7 +1144,7 @@ uses TTError, TTMemory, TTFile;
fontPgmSize := dirTables^[t].Length; fontPgmSize := dirTables^[t].Length;
if Alloc( fontProgram, fontPgmSize ) or if Alloc( fontProgram, fontPgmSize ) or
TT_Read_At_File( dirTables^[t].offset, AStream.ReadAtFile( dirTables^[t].offset,
fontProgram^, fontProgram^,
fontPgmSize ) then exit; fontPgmSize ) then exit;
@ -1170,7 +1175,7 @@ uses TTError, TTMemory, TTFile;
cvtPgmSize := dirTables^[t].Length; cvtPgmSize := dirTables^[t].Length;
if Alloc( cvtProgram, cvtPgmSize ) or if Alloc( cvtProgram, cvtPgmSize ) or
TT_Read_At_File( dirTables^[t].offset, AStream.ReadAtFile( dirTables^[t].offset,
cvtProgram^, cvtProgram^,
cvtPgmSize ) then exit; cvtPgmSize ) then exit;
@ -1192,7 +1197,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_OS2( face : PFace ) : TError; function Load_TrueType_OS2( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
table : Int; table : Int;
i : Int; i : Int;
@ -1210,10 +1215,10 @@ uses TTError, TTMemory, TTFile;
exit; exit;
end; end;
if TT_Seek_File( face^.dirTables^[table].offset ) or if AStream.SeekFile( face^.dirTables^[table].offset ) or
TT_Access_Frame( 78 ) then exit; AStream.AccessFrame( 78 ) then exit;
with face^.os2 do with AStream, face^.os2 do
begin begin
version := Get_UShort; version := Get_UShort;
xAvgCharWidth := Get_Short; xAvgCharWidth := Get_Short;
@ -1250,16 +1255,16 @@ uses TTError, TTMemory, TTFile;
usWinAscent := Get_UShort; usWinAscent := Get_UShort;
usWinDescent := Get_UShort; usWinDescent := Get_UShort;
TT_Forget_Frame; AStream.ForgetFrame;
if version >= $0001 then if version >= $0001 then
begin begin
if TT_Access_Frame(8) then exit; if AStream.AccessFrame(8) then exit;
ulCodePageRange1 := Get_ULong; ulCodePageRange1 := AStream.Get_ULong;
ulCodePageRange2 := Get_ULong; ulCodePageRange2 := AStream.Get_ULong;
TT_Forget_Frame; AStream.ForgetFrame;
end end
else else
begin begin
@ -1286,7 +1291,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Postscript( face : PFace ) : TError; function Load_TrueType_Postscript( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
table : Int; table : Int;
begin begin
@ -1297,10 +1302,10 @@ uses TTError, TTMemory, TTFile;
table := LookUp_TrueType_Table( face, 'post' ); table := LookUp_TrueType_Table( face, 'post' );
if table < 0 then exit; if table < 0 then exit;
if TT_Seek_File( face^.dirTables^[table].offset ) or if AStream.SeekFile( face^.dirTables^[table].offset ) or
TT_Access_Frame(32) then exit; AStream.AccessFrame(32) then exit;
with face^.postscript do with AStream, face^.postscript do
begin begin
formatType := Get_ULong; formatType := Get_ULong;
italicAngle := Get_ULong; italicAngle := Get_ULong;
@ -1313,7 +1318,7 @@ uses TTError, TTMemory, TTFile;
maxMemType1 := Get_ULong; maxMemType1 := Get_ULong;
end; end;
TT_Forget_Frame; AStream.ForgetFrame;
{$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF}
@ -1332,7 +1337,7 @@ uses TTError, TTMemory, TTFile;
* *
******************************************************************) ******************************************************************)
function Load_TrueType_Hdmx( face : PFace ) : TError; function Load_TrueType_Hdmx( AStream: TFreeTypeStream; face : PFace ) : TError;
var var
table, n : Int; table, n : Int;
num_glyphs : Int; num_glyphs : Int;
@ -1362,14 +1367,14 @@ uses TTError, TTMemory, TTFile;
exit; exit;
end; end;
if TT_Seek_File( face^.dirTables^[table].offset ) or if AStream.SeekFile( face^.dirTables^[table].offset ) or
TT_Access_Frame( 8 ) then exit; AStream.AccessFrame(8 ) then exit;
version := Get_UShort; version := AStream.Get_UShort;
num_rec := Get_Short; num_rec := AStream.Get_Short;
rec_size := Get_Long; rec_size := AStream.Get_Long;
TT_Forget_Frame; AStream.ForgetFrame;
(* right now, we only recognize format 0 *) (* right now, we only recognize format 0 *)
@ -1390,22 +1395,22 @@ uses TTError, TTMemory, TTFile;
(* read record *) (* read record *)
if TT_Access_Frame(2) then if AStream.AccessFrame(2) then
goto Fail; goto Fail;
rec^.ppem := Get_Byte; rec^.ppem := AStream.Get_Byte;
rec^.max_width := Get_Byte; rec^.max_width := AStream.Get_Byte;
TT_Forget_Frame; AStream.ForgetFrame;
if Alloc( rec^.widths, num_glyphs ) or if Alloc( rec^.widths, num_glyphs ) or
TT_Read_File( rec^.widths^, num_glyphs ) then AStream.ReadFile( rec^.widths^, num_glyphs ) then
goto Fail; goto Fail;
(* skip padding bytes *) (* skip padding bytes *)
if rec_size > 0 then if rec_size > 0 then
if TT_Skip_File( rec_size ) then if AStream.SkipFile( rec_size ) then
goto Fail; goto Fail;
end; end;
@ -1440,7 +1445,7 @@ uses TTError, TTMemory, TTFile;
var buffer; var buffer;
var length : longint ) : TError; var length : longint ) : TError;
var var
stream : TT_Stream; ftstream : TFreeTypeStream;
found, i : integer; found, i : integer;
begin begin
if tag <> 0 then if tag <> 0 then
@ -1483,8 +1488,8 @@ uses TTError, TTMemory, TTFile;
exit; exit;
end; end;
TT_Use_Stream( face^.stream, stream {%H-}); TT_Use_Stream( face^.stream, ftstream {%H-});
Load_TrueType_Any := TT_Read_At_File( offset, buffer, length ); Load_TrueType_Any := ftstream.ReadAtFile( offset, buffer, length );
TT_Done_Stream( face^.stream ); TT_Done_Stream( face^.stream );
end; end;

42
components/lazutils/ttobjs.pas
View File

@ -682,7 +682,7 @@ type
PFont_Input = ^TFont_Input; PFont_Input = ^TFont_Input;
TFont_Input = record TFont_Input = record
stream : TT_Stream; (* inpute stream *) stream : TT_Stream; (* input stream *)
fontIndex : Int; (* index of font in collection *) fontIndex : Int; (* index of font in collection *)
end; end;
@ -1834,8 +1834,8 @@ const
var var
input : PFont_Input; input : PFont_Input;
face : PFace; face : PFace;
label ftstream: TFreeTypeStream;
Fail; label Fail;
begin begin
Face_Create := Failure; Face_Create := Failure;
@ -1843,34 +1843,38 @@ const
input := PFont_Input(_input); input := PFont_Input(_input);
face^.stream := input^.stream; face^.stream := input^.stream;
if TT_Use_Stream(face^.stream, ftstream) then exit;
if Cache_Create( objs_instance_class, face^.instances ) or if Cache_Create( objs_instance_class, face^.instances ) or
Cache_Create( objs_glyph_class, face^.glyphs ) then exit; Cache_Create( objs_glyph_class, face^.glyphs ) then goto Fail;
(* Load collection directory if present *) (* Load collection directory if present *)
if Load_TrueType_Directory( face, input^.fontIndex ) then if Load_TrueType_Directory( ftstream, face, input^.fontIndex ) then
exit; goto Fail;
if Load_TrueType_Header ( face ) or if Load_TrueType_Header ( ftstream, face ) or
Load_TrueType_MaxProfile ( face ) or Load_TrueType_MaxProfile ( ftstream, face ) or
Load_TrueType_Locations ( face ) or Load_TrueType_Locations ( ftstream, face ) or
Load_TrueType_CMap ( face ) or Load_TrueType_CMap ( ftstream, face ) or
Load_TrueType_CVT ( face ) or Load_TrueType_CVT ( ftstream, face ) or
Load_TrueType_Metrics_Header ( face, false ) or Load_TrueType_Metrics_Header ( ftstream, face, false ) or
Load_TrueType_Programs ( face ) or Load_TrueType_Programs ( ftstream, face ) or
Load_TrueType_Gasp ( face ) or Load_TrueType_Gasp ( ftstream, face ) or
Load_TrueType_Names ( face ) or Load_TrueType_Names ( ftstream, face ) or
Load_TrueType_OS2 ( face ) or Load_TrueType_OS2 ( ftstream, face ) or
Load_TrueType_Hdmx ( face ) or Load_TrueType_Hdmx ( ftstream, face ) or
Load_TrueType_Postscript ( face ) or Load_TrueType_Postscript ( ftstream, face ) or
Load_TrueType_Metrics_Header ( face, true ) then Load_TrueType_Metrics_Header ( ftstream, face, true ) then
goto Fail; goto Fail;
Face_Create := Success; Face_Create := Success;
TT_Done_Stream(face^.stream);
exit; exit;
Fail: Fail:
TT_Done_Stream(face^.stream);
Face_Destroy( face ); Face_Destroy( face );
exit;
end; end;