From 7aff56c144ba4c1d05be37623d1b6bce6813806e Mon Sep 17 00:00:00 2001 From: ask Date: Fri, 8 Feb 2013 12:35:14 +0000 Subject: [PATCH] LazFreeType: Add TFreeTypeStream class, allow fonts to be loaded from streams. Patch by "circular" git-svn-id: trunk@40207 - --- components/lazutils/easylazfreetype.pas | 31 + components/lazutils/lazfreetype.pas | 22 +- components/lazutils/ttcmap.pas | 78 +-- components/lazutils/ttfile.pas | 879 ++++++++++-------------- components/lazutils/ttgload.pas | 110 +-- components/lazutils/ttload.pas | 321 ++++----- components/lazutils/ttobjs.pas | 42 +- 7 files changed, 709 insertions(+), 774 deletions(-) diff --git a/components/lazutils/easylazfreetype.pas b/components/lazutils/easylazfreetype.pas index 90493b688a..c7e582fa16 100644 --- a/components/lazutils/easylazfreetype.pas +++ b/components/lazutils/easylazfreetype.pas @@ -192,6 +192,8 @@ type TFreeTypeFont = class(TFreeTypeRenderableFont) private FName: String; + FStream: TStream; + FOwnedStream: boolean; FPointSize: single; FHinted: boolean; FStyleStr: string; @@ -217,6 +219,7 @@ type procedure SetName(const AValue: String); procedure DiscardFace; procedure DiscardInstance; + procedure DiscardStream; procedure SetPixelSize(const AValue: single); procedure SetPointSize(const AValue: single); function LoadGlyphInto(_glyph : TT_Glyph; @@ -254,6 +257,7 @@ type SmallLinePadding: boolean; constructor Create; destructor Destroy; override; + procedure AccessFromStream(AStream: TStream; AStreamOwner: boolean); procedure RenderText(AText: string; x,y: single; ARect: TRect; OnRender : TDirectRenderingFunction); override; procedure SetNameAndStyle(AName: string; AStyle: string); overload; procedure SetNameAndStyle(AName: string; AStyle: TFreeTypeStyles); overload; @@ -772,6 +776,12 @@ begin PrevDPI := DPI; 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)+') '); + end else if (Pos(PathDelim, AName) <> 0) or (Collection = nil) or (Collection.FontFileCount = 0) then begin if AName = '' then exit; @@ -799,6 +809,7 @@ end; procedure TFreeTypeFont.SetName(const AValue: String); begin + DiscardStream; if FName=AValue then exit; UpdateFace(AValue); end; @@ -1043,6 +1054,17 @@ begin 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); begin if FInstanceCreated then @@ -1298,10 +1320,19 @@ destructor TFreeTypeFont.Destroy; begin DiscardInstance; DiscardFace; + DiscardStream; FGlyphTable.Free; inherited Destroy; 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; OnRender: TDirectRenderingFunction); var diff --git a/components/lazutils/lazfreetype.pas b/components/lazutils/lazfreetype.pas index 3f5fe48c73..5255741617 100644 --- a/components/lazutils/lazfreetype.pas +++ b/components/lazutils/lazfreetype.pas @@ -37,7 +37,7 @@ unit LazFreeType; interface {$R-} -uses TTTypes; +uses TTTypes, Classes; (***********************************************************************) (* *) @@ -83,6 +83,9 @@ uses TTTypes; function TT_Open_Face( fontname : string; 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. *) (* *) @@ -527,6 +530,23 @@ uses TT_Open_Face := error; 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; (*****************************************************************) (* *) diff --git a/components/lazutils/ttcmap.pas b/components/lazutils/ttcmap.pas index e518698659..832bfb8f3d 100644 --- a/components/lazutils/ttcmap.pas +++ b/components/lazutils/ttcmap.pas @@ -138,7 +138,7 @@ uses num_SH, u : UShort; i : Int; num_segs : Int; - stream: TT_Stream; + ftstream: TFreeTypeStream; label Fail, SimpleExit; begin @@ -150,124 +150,124 @@ uses exit; 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 0: with cmap.cmap0 do if Alloc( glyphIdArray, 256 ) or - TT_Read_File( glyphIdArray^, 256 ) then goto Fail; + ftstream.ReadFile( glyphIdArray^, 256 ) then goto Fail; 2: begin num_SH := 0; with cmap.cmap2 do begin 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 begin - u := GET_UShort shr 3; + u := ftstream.GET_UShort shr 3; subHeaderKeys^[i] := u; if num_SH < u then num_SH := u; end; - TT_Forget_Frame; + ftstream.ForgetFrame; (* now load sub headers *) numGlyphId := ((cmap.length - 2*(256+3) - num_SH*8) and $FFFF) div 2; 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 begin - firstCode := GET_UShort; - entryCount := GET_UShort; - idDelta := GET_UShort; + firstCode := ftstream.GET_UShort; + entryCount := ftstream.GET_UShort; + idDelta := ftstream.GET_UShort; (* we apply the location offset immediately *) - idRangeOffset := GET_UShort - (num_SH-i)*8 - 2; + idRangeOffset := ftstream.GET_UShort - (num_SH-i)*8 - 2; end; - TT_Forget_Frame; + ftstream.ForgetFrame; (* load glyph ids *) 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 - glyphIdArray^[i] := GET_UShort; + glyphIdArray^[i] := ftstream.GET_UShort; - TT_Forget_Frame; + ftstream.ForgetFrame; end; end; 4: with cmap.cmap4 do begin - if TT_Access_Frame(8) then goto Fail; + if ftstream.AccessFrame(8) then goto Fail; - segCountX2 := Get_UShort; - searchRange := Get_UShort; - entrySelector := Get_UShort; - rangeShift := Get_UShort; + segCountX2 := ftstream.Get_UShort; + searchRange := ftstream.Get_UShort; + entrySelector := ftstream.Get_UShort; + rangeShift := ftstream.Get_UShort; num_segs := segCountX2 shr 1; - TT_Forget_Frame; + ftstream.ForgetFrame; (* load segments *) 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 - segments^[i].endCount := Get_UShort; + segments^[i].endCount := ftstream.Get_UShort; - Get_UShort; + ftstream.Get_UShort; 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 - segments^[i].idDelta := GET_Short; + segments^[i].idDelta := ftstream.GET_Short; 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) div 2; (* load glyph ids *) 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 - glyphIdArray^[i] := Get_UShort; + glyphIdArray^[i] := ftstream.Get_UShort; - TT_Forget_Frame; + ftstream.ForgetFrame; end; 6: with cmap.cmap6 do begin - if TT_Access_Frame(4) then goto Fail; + if ftstream.AccessFrame(4) then goto Fail; - firstCode := GET_UShort; - entryCount := GET_UShort; + firstCode := ftstream.GET_UShort; + entryCount := ftstream.GET_UShort; - TT_Forget_Frame; + ftstream.ForgetFrame; 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 - glyphIdArray^[i] := GET_UShort; + glyphIdArray^[i] := ftstream.GET_UShort; - TT_Forget_Frame; + ftstream.ForgetFrame; end; else diff --git a/components/lazutils/ttfile.pas b/components/lazutils/ttfile.pas index 937cb8f7ef..db7af6f1ad 100644 --- a/components/lazutils/ttfile.pas +++ b/components/lazutils/ttfile.pas @@ -1,6 +1,6 @@ (******************************************************************* * - * TTFile.Pas 1.2 + * TTFile.Pas 1.3 * * File I/O Component (specification) * @@ -14,6 +14,9 @@ * * NOTES : * + * Changes from 1.2 to 1.3 : + * + * - Moved stream into TFreeTypeStream object * * Changes from 1.1 to 1.2 : * @@ -50,7 +53,78 @@ interface {$R-} uses TTTypes, - TTError; + TTError, + Classes; + +type + { TFreeTypeStream } + + TFreeTypeStream = class + private + function GetSize: longint; + private + FCurrentFrame : PByte; + FFrameCursor : Longint; + FFrameSize : LongInt; + FFrameCache : PByte; + + FOpen: boolean; + FName: string; + FStream: TStream; + FOwnedStream: boolean; + FBase,FStoredSize,FPosit: Longint; + FUsed: boolean; + function GetFilePos: longint; + function GetFileSize: longint; + function GetPosition: longint; + property Size: longint read GetSize; + procedure Init; + public + constructor Create(APathName: string); + constructor Create(AStream: TStream; AStreamOwner: boolean); + destructor Destroy; override; + function Activate: TError; + function Deactivate: TError; + function SeekFile(APos: Longint): TError; + function SkipFile(ADist: Longint): TError; + function ReadFile( var ABuff; ACount : Int ) : TError; + function ReadAtFile( APos : Long; var ABuff; ACount : Int ) : TError; + + (*********************************************************************) + (* *) + (* Frame Functions *) + (* *) + (*********************************************************************) + + (* Access the next aSize bytes *) + function AccessFrame( aSize : Int ) : TError; + + (* Access the next min(aSize,file_size-file_pos) bytes *) + function CheckAndAccessFrame( aSize : Int ) : TError; + + (* Forget the previously cached frame *) + function ForgetFrame : TError; + + (* The following functions should only be used after a *) + (* AccessFrame and before a ForgetFrame *) + + (* They do not provide error handling, intentionnaly, and are much faster *) + (* moreover, they could be converted to MACROS in the C version *) + + function GET_Byte : Byte; + function GET_Char : ShortInt; + function GET_Short : Short; + function GET_UShort : UShort; + function GET_Long : Long; + function GET_ULong : ULong; + function GET_Tag4 : ULong; + + property Open: boolean read FOpen; + property Name: string read FName; + property Base: longint read FBase; + property Position: longint read GetPosition; + property Used: boolean read FUsed; + end; function TTFile_Init : TError; procedure TTFile_Done; @@ -65,13 +139,15 @@ uses TTTypes, var stream : TT_Stream ) : TError; (* Open a file and return a stream handle for it *) (* should only be used for a new typeface object's main stream *) + function TT_Open_Stream( AStream: TStream; AStreamOwner: boolean; + var stream : TT_Stream ) : TError; procedure TT_Close_Stream( var stream : TT_Stream ); (* closes, then discards a stream, when it becomes unuseful *) (* should only be used for a typeface object's main stream *) function TT_Use_Stream( org_stream : TT_Stream; - out stream : TT_Stream ) : TError; + out ftstream: TFreeTypeStream ) : 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 *) @@ -92,73 +168,12 @@ uses TTTypes, (* *) (* in re-entrant builds, should also discard the stream *) - (*********************************************************************) - (* *) - (* File Functions *) - (* *) - (* the following functions perform file operations on the *) - (* currently 'used' stream. In thread-safe builds, only one *) - (* stream can be used at a time. Synchronisation is performed *) - (* through the Use_Stream/Done_Stream functions *) - (* *) - (* Note: *) - (* re-entrant versions of these functions are only available *) - (* in the C source tree. There, a macro is used to add a 'stream' *) - (* parameter to each of these routines.. *) - (* *) - (*********************************************************************) - - function TT_Read_File( var ABuff; ACount : Int ) : TError; - (* Read a chunk of bytes directly from the file *) - - function TT_Seek_File( APos : LongInt ) : TError; - (* Seek a new file position *) - - function TT_Skip_File( ADist : LongInt ) : TError; - (* Skip to a new file position *) - - function TT_Read_At_File( APos : Long; var ABuff; ACount : Int ) : TError; - (* Seek and read a chunk of bytes *) - - function TT_File_Size : Longint; - - function TT_File_Pos : Longint; - function TT_Stream_Size( stream : TT_Stream ) : longint; - (*********************************************************************) - (* *) - (* Frame Functions *) - (* *) - (*********************************************************************) - - function TT_Access_Frame( aSize : Int ) : TError; - (* Access the next aSize bytes *) - - function TT_Check_And_Access_Frame( aSize : Int ) : TError; - (* Access the next min(aSize,file_size-file_pos) bytes *) - - function TT_Forget_Frame : TError; - (* Forget the previously cached frame *) - - (* The four following functions should only be used after a *) - (* TT_Access_Frame and before a TT_Forget_Frame *) - - (* They do not provide error handling, intentionnaly, and are much faster *) - (* moreover, they could be converted to MACROS in the C version *) - - function GET_Byte : Byte; - function GET_Char : ShortInt; - function GET_Short : Short; - function GET_UShort : UShort; - function GET_Long : Long; - function GET_ULong : ULong; - function GET_Tag4 : ULong; - implementation uses - TTMemory; + TTMemory, SysUtils; (* THREADS: TTMutex, *) @@ -169,51 +184,15 @@ const (* frames that are bigger than this constant are effectively *) (* allocated in the heap.. *) -type - PString = ^string; - PFile = ^FILE; - - PStream_Rec = ^TStream_Rec; - TStream_Rec = record - name : PString; (* file pathname *) - open : Boolean; (* is the stream currently opened *) - font : PFILE; (* file handle for opened stream *) - base : Longint; (* base offset for embedding *) - size : Longint; (* size of font in resource *) - posit : Longint; (* current offset for closed streams *) - end; - -var - (* THREADS: File_Mutex : TMutex *) - - font_file : PFile; - cur_stream : PStream_Rec; - - current_frame : PByte; - frame_cursor : Longint; - frame_size : LongInt; - - frame_cache : PByte; - - function TT_File_Size : Longint; - begin - TT_File_Size := FileSize( font_file^ ); - end; - - function TT_File_Pos : Longint; - begin - TT_File_Pos := FilePos( font_file^ ); - end; - function TT_Stream_Size( stream : TT_Stream ) : longint; var - rec : PStream_Rec; + rec : TFreeTypeStream; begin - rec := PStream_Rec(stream); + rec := TFreeTypeStream(stream.z); if rec = nil then TT_Stream_Size := 0 else - TT_Stream_Size := rec^.size; + TT_Stream_Size := rec.Size; end; (******************************************************************* @@ -222,24 +201,10 @@ var * * Description : Init the file component * - * - create a file mutex for thread-safe builds - * ******************************************************************) function TTFile_Init : TError; begin - (* empty current file *) - font_file := nil; - cur_stream := nil; - - (* empty frame *) - current_frame := nil; - frame_cursor := 0; - frame_size := 0; - - (* create frame cache *) - GetMem( frame_cache, frame_cache_size ); - TTFile_Init := Success; end; @@ -249,176 +214,11 @@ var * * Description : Finalize the file component * - * - destroys the file mutex for thread-safe builds - * ******************************************************************) procedure TTFile_Done; begin - (* empty current file *) - font_file := nil; - cur_stream := nil; - - (* empty frame *) - current_frame := nil; - frame_cursor := 0; - frame_size := 0; - - if frame_cache <> nil then - FreeMem( frame_cache, frame_cache_size ); - frame_cache := nil; - end; - -(******************************************************************* - * - * Function : Stream_New - * - * Description : allocates a new stream record - * - * Input : stream : the target stream variable - * - * Output : True on sucess. - * - ******************************************************************) - - function Stream_New( pathname : string; - var stream : PStream_Rec ) : TError; - var - font : PFile; - name : PString; - len : Integer; - label - Fail_Memory; - begin - name := nil; - font := nil; - stream := nil; - len := length(pathname)+1; - - (* allocate a new stream_rec in the heap *) - if Alloc( pointer(stream), sizeof(TStream_Rec) ) or - Alloc( pointer(font), sizeof(FILE) ) or - Alloc( pointer(name), len ) then - goto Fail_Memory; - - move( pathname, name^, len ); - - stream^.font := font; - stream^.name := name; - stream^.open := false; - stream^.base := 0; - stream^.size := 0; - stream^.posit := 0; - - Stream_New := Success; - exit; - - Fail_Memory: - Free( pointer(name) ); - Free( pointer(font) ); - Free( pointer(stream) ); - Stream_New := Failure; - end; - -(******************************************************************* - * - * Function : Stream_Activate - * - * Description : activates a stream, if it needs it - * - * Input : stream : the target stream variable - * - * Output : Error condition - * - ******************************************************************) - - function Stream_Activate( stream : PStream_Rec ) : TError; - var - old_filemode : Long; - begin - Stream_Activate := Failure; - if stream = nil then exit; - - with stream^ do - begin - Stream_Activate := Success; - if open then exit; - - old_filemode := System.FileMode; - System.FileMode := 0; - (* read-only mode *) - - Assign( font^, name^ ); - {$I-} - Reset( font^, 1 ); - {$I+} - - System.FileMode := old_filemode; - - if IOResult <> 0 then - begin - error := TT_Err_Could_Not_Open_File; - Stream_Activate := Failure; - exit; - end; - - open := true; - base := 0; - if size = -1 then size := FileSize(font^); - - if posit <> 0 then - Seek( font^, posit ); - end; - end; - -(******************************************************************* - * - * Function : Stream_Deactivate - * - * Description : closes an active stream - * - * Input : stream : the target stream variable - * - * Output : Error condition - * - ******************************************************************) - - function Stream_Deactivate( stream : PStream_Rec ) : TError; - begin - Stream_Deactivate := Failure; - if stream = nil then exit; - - Stream_Deactivate := Success; - if not stream^.open then exit; - - stream^.posit := FilePos( stream^.font^ ); - close( stream^.font^ ); - stream^.open := false; - end; - -(******************************************************************* - * - * Function : Stream_Done - * - * Description : frees an active stream_rec - * - * Input : stream : the target stream variable - * - * Output : True on sucess. - * - * Notes : 'stream' is set to nil on exit.. - * - ******************************************************************) - - function Stream_Done( var stream : PStream_Rec ) : TError; - begin - Stream_Deactivate( stream ); - - Free( pointer(stream^.name) ); - Free( pointer(stream^.font) ); - Free( pointer(stream) ); - - Stream_Done := Success; + //nothing end; (******************************************************************* @@ -439,24 +239,52 @@ var function TT_Open_Stream( name : String; var stream : TT_Stream ) : TError; var - rec : PStream_Rec; + ftstream : TFreeTypeStream; begin TT_Open_Stream := Failure; + stream.z := nil; + ftstream := nil; - if Stream_New( name, rec {%H-}) then exit; - - if Stream_Activate( rec ) then - begin - Stream_Done(rec); - stream.z := nil; - exit; + try + ftstream := TFreeTypeStream.Create(name); + if ftstream.Activate then + raise exception.Create('Cannot activate'); + except + on ex: Exception do + begin + ftstream.free; + exit; + end; end; - cur_stream := rec; - font_file := rec^.font; - stream := TT_Stream(rec); + stream.z:= ftstream; + TT_Open_Stream := Success; + end; + function TT_Open_Stream(AStream: TStream; AStreamOwner: boolean; + var stream: TT_Stream): TError; + var + ftstream : TFreeTypeStream; + + begin + TT_Open_Stream := Failure; + stream.z := nil; + ftstream := nil; + + try + ftstream := TFreeTypeStream.Create(AStream,AStreamOwner); + if ftstream.Activate then + raise exception.Create('Cannot activate'); + except + on ex: Exception do + begin + ftstream.free; + exit; + end; + end; + + stream.z:= ftstream; TT_Open_Stream := Success; end; @@ -475,10 +303,7 @@ var procedure TT_Close_Stream( var stream : TT_Stream ); begin if stream.z = nil then exit; - - Stream_Done( PStream_Rec(stream) ); - font_file := nil; - cur_stream := nil; + TFreeTypeStream(stream.z).Free; stream.z := nil; end; @@ -498,21 +323,23 @@ var ******************************************************************) function TT_Use_Stream( org_stream : TT_Stream; - out stream : TT_Stream ) : TError; + out ftstream: TFreeTypeStream) : TError; var - rec : PStream_Rec; + rec : TFreeTypeStream; begin TT_Use_Stream := Failure; - stream := org_stream; - if org_stream.z = nil then exit; + ftstream:= TFreeTypeStream(org_stream.z); + if ftstream= nil then exit; + if ftstream.FUsed then + begin + error := TT_Err_File_Error; + ftstream := nil; + exit; + end; + ftstream.FUsed := true; - rec := PStream_Rec(stream); - Stream_Activate(rec); - cur_stream := rec; - font_file := rec^.font; - - TT_Use_Stream := Success; + result := ftstream.Activate; end; (******************************************************************* @@ -529,8 +356,8 @@ var procedure TT_Flush_Stream( stream : TT_Stream ); begin - if stream.Z <> nil then - Stream_Deactivate( PStream_Rec(stream.z) ); + if stream.z <> nil then + TFreeTypeStream(stream.z).Deactivate; end; (******************************************************************* @@ -541,124 +368,19 @@ var * * Input : stream : the stream * - * Output : True on success. False on failure + * Output : Nothing. * ******************************************************************) procedure TT_Done_Stream( stream : TT_Stream ); begin - if stream.z <> cur_stream then exit; - cur_stream := nil; - font_file := nil; + if stream.z = nil then exit; + TFreeTypeStream(stream.z).FUsed := false; end; (******************************************************************* * - * Function : TT_Seek_File - * - * Description : Seek the file cursor to a different position - * - * Input : APos new position on file - * - * Output : True on success. False if out of range - * - * Notes : Does not set the error variable - * - ******************************************************************) - -function TT_Seek_File( APos : LongInt ) : TError; -begin - {$I-} - Seek( Font_File^, APos ); - {$I+} - if IOResult <> 0 then - begin - error := TT_Err_Invalid_File_Offset; - TT_Seek_File := Failure; - exit; - end; - - TT_Seek_File := Success; -end; - -(******************************************************************* - * - * Function : TT_Skip_File - * - * Description : Skip forward the file cursor - * - * Input : ADist number of bytes to skip - * - * Output : see Seek_Font_File - * - ******************************************************************) - -function TT_Skip_File( ADist : LongInt ) : TError; -begin - TT_Skip_File := TT_Seek_File( FilePos(Font_File^)+ADist ); -end; - -(******************************************************************* - * - * Function : TT_Read_File - * - * Description : Reads a chunk of the file and copy it to memory - * - * Input : ABuff target buffer - * ACount length in bytes to read - * - * Output : True if success. False if out of range - * - * Notes : Current version prints an error message even if the - * debug state isn't on. - * - ******************************************************************) - -function TT_Read_File( var ABuff; ACount : Int ) : TError; -begin - TT_Read_File := Failure; - {$I-} - BlockRead( Font_File^, ABuff, ACount ); - {$I+} - - if IOResult <> 0 then - begin - error := TT_Err_Invalid_File_Read; - exit; - end; - - TT_Read_File := Success; -end; - -(******************************************************************* - * - * Function : TT_Read_At_File - * - * Description : Read file at a specified position - * - * Input : APos position to seek to before read - * ABuff target buffer - * ACount number of bytes to read - * - * Output : True on success. False if error. - * - * Notes : prints an error message if seek failed. - * - ******************************************************************) - -function TT_Read_At_File( APos : Long; var ABuff; ACount : Int ) : TError; -begin - TT_Read_At_File := Failure; - - if TT_Seek_File( APos ) or - TT_Read_File( ABuff, ACount ) then exit; - - TT_Read_At_File := Success; -end; - -(******************************************************************* - * - * Function : TT_Access_Frame + * Function : AccessFrame * * Description : Notifies the component that we're going to read * aSize bytes from the current file position. @@ -676,16 +398,16 @@ end; * too big in both cases ). * * It will also fail if you make two consecutive calls - * to TT_Access_Frame, without a TT_Forget_Frame between + * to AccessFrame, without a ForgetFrame between * them. * ******************************************************************) - function TT_Access_Frame( aSize : Int ) : TError; + function TFreeTypeStream.AccessFrame( aSize : Int ) : TError; begin - TT_Access_Frame := Failure; + result := Failure; - if current_frame <> nil then + if FCurrentFrame <> nil then begin error := TT_Err_Nested_Frame_Access; exit; @@ -693,28 +415,28 @@ end; (* We already are accessing one frame *) if aSize > frame_cache_size then - GetMem( current_frame, aSize ) + GetMem( FCurrentFrame, aSize ) else - current_frame := frame_cache; + FCurrentFrame := FFrameCache; - if TT_Read_File( current_frame^, aSize ) then + if ReadFile( FCurrentFrame^, aSize ) then begin if aSize > frame_cache_size then - FreeMem( current_frame, aSize ); + FreeMem( FCurrentFrame, aSize ); - current_frame := nil; + FCurrentFrame := nil; exit; end; - frame_size := aSize; - frame_cursor := 0; + FFrameSize := aSize; + FFrameCursor := 0; - TT_Access_Frame := Success; + result := Success; end; (******************************************************************* * - * Function : TT_Check_And_Access_Frame + * Function : CheckAndAccess_Frame * * Description : Notifies the component that we're going to read * aSize bytes from the current file position. @@ -732,53 +454,28 @@ end; * too big in both cases ). * * It will also fail if you make two consecutive calls - * to TT_Access_Frame, without a TT_Forget_Frame between + * to AccessFrame, without a ForgetFrame between * them. * * - * NOTE : The only difference with TT_Access_Frame is that we check + * NOTE : The only difference with AccessFrame is that we check * that the frame is within the current file. We otherwise * truncate it.. * ******************************************************************) - function TT_Check_And_Access_Frame( aSize : Int ) : TError; + function TFreeTypeStream.CheckAndAccessFrame( aSize : Int ) : TError; var readBytes : Longint; begin - TT_Check_And_Access_Frame := Failure; - - if current_frame <> nil then - begin - error := TT_Err_Nested_Frame_Access; - exit; - end; - (* We already are accessing one frame *) - - readBytes := TT_File_Size - TT_File_Pos; + readBytes := Size - Position; if aSize > readBytes then aSize := readBytes; - - if aSize > frame_cache_size then - GetMem( current_frame, aSize ) - else - current_frame := frame_cache; - - if TT_Read_File( current_frame^, aSize ) then - begin - if aSize > frame_cache_size then - FreeMem( current_frame, aSize ); - exit; - end; - - frame_size := aSize; - frame_cursor := 0; - - TT_Check_And_Access_Frame := Success; + result := AccessFrame( aSize); end; (******************************************************************* * - * Function : TT_Forget_Frame + * Function : ForgetFrame * * Description : Releases a cached frame after reading * @@ -788,18 +485,18 @@ end; * ******************************************************************) - function TT_Forget_Frame : TError; + function TFreeTypeStream.ForgetFrame : TError; begin - TT_Forget_Frame := Failure; + result := Failure; - if current_frame = nil then exit; + if FCurrentFrame = nil then exit; - if frame_size > frame_cache_size then - FreeMem( current_frame, frame_size ); + if FFrameSize > frame_cache_size then + FreeMem( FCurrentFrame, FFrameSize ); - frame_size := 0; - current_frame := nil; - frame_cursor := 0; + FFrameSize := 0; + FCurrentFrame := nil; + FFrameCursor := 0; end; (******************************************************************* @@ -819,10 +516,10 @@ end; * ******************************************************************) - function GET_Byte : Byte; + function TFreeTypeStream.GET_Byte : Byte; begin - GET_Byte := current_frame^[frame_cursor]; - inc( frame_cursor ); + GET_Byte := FCurrentFrame^[FFrameCursor]; + inc( FFrameCursor ); end; (******************************************************************* @@ -842,10 +539,10 @@ end; * ******************************************************************) - function GET_Char : ShortInt; + function TFreeTypeStream.GET_Char : ShortInt; begin - GET_Char := ShortInt( current_frame^[frame_cursor] ); - inc( frame_cursor ); + GET_Char := ShortInt( FCurrentFrame^[FFrameCursor] ); + inc( FFrameCursor ); end; (******************************************************************* @@ -865,11 +562,11 @@ end; * ******************************************************************) - function GET_Short : Short; + function TFreeTypeStream.GET_Short : Short; begin - GET_Short := (Short(current_frame^[ frame_cursor ]) shl 8) or - Short(current_frame^[frame_cursor+1]); - inc( frame_cursor, 2 ); + GET_Short := (Short(FCurrentFrame^[ FFrameCursor ]) shl 8) or + Short(FCurrentFrame^[FFrameCursor+1]); + inc( FFrameCursor, 2 ); end; (******************************************************************* @@ -889,11 +586,11 @@ end; * ******************************************************************) - function GET_UShort : UShort; + function TFreeTypeStream.GET_UShort : UShort; begin - GET_UShort := (UShort(current_frame^[ frame_cursor ]) shl 8) or - UShort(current_frame^[frame_cursor+1]); - inc( frame_cursor, 2 ); + GET_UShort := (UShort(FCurrentFrame^[ FFrameCursor ]) shl 8) or + UShort(FCurrentFrame^[FFrameCursor+1]); + inc( FFrameCursor, 2 ); end; (******************************************************************* @@ -913,13 +610,13 @@ end; * ******************************************************************) - function GET_Long : Long; + function TFreeTypeStream.GET_Long : Long; begin - GET_Long := (Long(current_frame^[ frame_cursor ]) shl 24) or - (Long(current_frame^[frame_cursor+1]) shl 16) or - (Long(current_frame^[frame_cursor+2]) shl 8 ) or - (Long(current_frame^[frame_cursor+3]) ); - inc( frame_cursor, 4 ); + GET_Long := (Long(FCurrentFrame^[ FFrameCursor ]) shl 24) or + (Long(FCurrentFrame^[FFrameCursor+1]) shl 16) or + (Long(FCurrentFrame^[FFrameCursor+2]) shl 8 ) or + (Long(FCurrentFrame^[FFrameCursor+3]) ); + inc( FFrameCursor, 4 ); end; (******************************************************************* @@ -939,13 +636,13 @@ end; * ******************************************************************) - function GET_ULong : ULong; + function TFreeTypeStream.GET_ULong : ULong; begin - GET_ULong := (ULong(current_frame^[ frame_cursor ]) shl 24) or - (ULong(current_frame^[frame_cursor+1]) shl 16) or - (ULong(current_frame^[frame_cursor+2]) shl 8 ) or - (ULong(current_frame^[frame_cursor+3]) ); - inc( frame_cursor, 4 ); + GET_ULong := (ULong(FCurrentFrame^[ FFrameCursor ]) shl 24) or + (ULong(FCurrentFrame^[FFrameCursor+1]) shl 16) or + (ULong(FCurrentFrame^[FFrameCursor+2]) shl 8 ) or + (ULong(FCurrentFrame^[FFrameCursor+3]) ); + inc( FFrameCursor, 4 ); end; (******************************************************************* @@ -965,18 +662,194 @@ end; * ******************************************************************) - function GET_Tag4 : ULong; + function TFreeTypeStream.GET_Tag4 : ULong; var C : array[0..3] of Byte; begin - move ( current_frame^[frame_cursor], c{%H-}, 4 ); - inc( frame_cursor, 4 ); + move ( FCurrentFrame^[FFrameCursor], c{%H-}, 4 ); + inc( FFrameCursor, 4 ); GET_Tag4 := ULong(C); end; - initialization + { TFreeTypeStream } - frame_cache := nil; + function TFreeTypeStream.GetFileSize: longint; + begin + if FStream = nil then + result := 0 + else + result := FStream.Size; + end; + +function TFreeTypeStream.GetPosition: longint; +begin + if Open then result := GetFilePos else result := FPosit; +end; + +procedure TFreeTypeStream.Init; +begin + FOpen:= false; + FStream := nil; + FBase:= 0; + FStoredSize:= -1; + FPosit:= 0; + + (* empty frame *) + FCurrentFrame := nil; + FFrameCursor := 0; + FFrameSize := 0; + + (* create frame cache *) + GetMem( FFrameCache, frame_cache_size ); +end; + + constructor TFreeTypeStream.Create(APathName: string); + begin + if APathName = '' then + raise exception.Create('Empty path name'); + Init; + FName:= APathName; + end; + + constructor TFreeTypeStream.Create(AStream: TStream; AStreamOwner: boolean); + begin + Init; + FStream:= AStream; + FOwnedStream := AStreamOwner; + end; + + destructor TFreeTypeStream.Destroy; +begin + Deactivate; + if FOwnedStream then FreeAndNil(FStream); + + if FCurrentFrame <> nil then ForgetFrame; + if FFrameCache <> nil then + FreeMem( FFrameCache, frame_cache_size ); + FFrameCache := nil; + + inherited Destroy; +end; + + function TFreeTypeStream.Activate: TError; + begin + result := Success; + if Open then exit; + + //in case stream provided by user + if (FName = '') and (FStream <> nil) then + begin + FOpen := True; + exit; + end; + + try + FStream := TFileStream.Create(FName, fmOpenRead); + FOpen := True; + FBase := 0; + if FStoredSize = -1 then FStoredSize := FStream.Size; + if FPosit <> 0 then FStream.Position:= FPosit; + except + on ex:exception do + begin + error := TT_Err_Could_Not_Open_File; + result := Failure; + exit; + end; + end; + end; + + function TFreeTypeStream.Deactivate: TError; + begin + result := Success; + if not Open then exit; + + if FName = '' then //in case stream provided by user + begin + FOpen := false; + exit; + end; + + FPosit := FStream.Position; + FreeAndNil(FStream); + FOpen := false; + end; + + function TFreeTypeStream.SeekFile(APos: Longint): TError; + begin + if FStream = nil then + begin + error := TT_Err_File_Error; + result := Failure; + exit; + end; + try + FStream.Position := APos; + except + on ex: exception do + begin + error := TT_Err_Invalid_File_Offset; + result := Failure; + exit; + end; + end; + result := Success; + end; + + function TFreeTypeStream.SkipFile(ADist: Longint): TError; + begin + result := SeekFile(Position+ADist); + end; + + function TFreeTypeStream.ReadFile(var ABuff; A Count: Int): TError; + begin + result := Failure; + if FStream = nil then + begin + error := TT_Err_Invalid_File_Read; + exit; + end; + try + if FStream.Read(ABuff,ACount) <> ACount then + begin + error := TT_Err_Invalid_File_Read; + exit; + end; + result := success; + except + on ex: Exception do + begin + error := TT_Err_Invalid_File_Read; + exit; + end; + end; + end; + + function TFreeTypeStream.ReadAtFile(APos: Long; var ABuff; ACount: Int): TError; + begin + result := Failure; + + if SeekFile( APos ) or + ReadFile( ABuff, ACount ) then exit; + + result := Success; + end; + +function TFreeTypeStream.GetSize: longint; +begin + if Open then + result := GetFileSize + else + result := FStoredSize; +end; + +function TFreeTypeStream.GetFilePos: longint; +begin + if FStream= nil then + result := 0 + else + result := FStream.Position; +end; end. diff --git a/components/lazutils/ttgload.pas b/components/lazutils/ttgload.pas index 0f91853c1b..028a8ac30c 100644 --- a/components/lazutils/ttgload.pas +++ b/components/lazutils/ttgload.pas @@ -222,8 +222,8 @@ const ******************************************************************) - function Load_Simple_Glyph( exec : PExec_Context; - {%H-}stream : TT_Stream; + function Load_Simple_Glyph( AStream : TFreeTypeStream; + exec : PExec_Context; n_contours : Int; left_contours : Int; left_points : Int; @@ -264,7 +264,7 @@ const (* Reading the contours endpoints *) - if TT_Access_Frame( (n_contours+1)*2 ) then + if AStream.AccessFrame( (n_contours+1)*2 ) then goto Fail_File; n_points := 0; @@ -272,7 +272,7 @@ const for k := 0 to n_contours-1 do begin {$IFDEF FREETYPE_DEBUG} Write( n_points,' '); {$ENDIF} - n_points := GET_Short; + n_points := AStream.GET_Short; exec^.pts.conEnds^[k] := n_points; inc( n_points ); end; @@ -286,9 +286,9 @@ const (* Loading instructions *) - n_ins := GET_Short; + n_ins := AStream.GET_Short; - TT_Forget_Frame; + AStream.ForgetFrame; { if not subg^.is_hinted then @@ -312,7 +312,7 @@ const with exec^ do begin - if TT_Read_File( glyphIns^, n_ins ) then + if AStream.ReadFile( glyphIns^, n_ins ) then goto Fail_File; glyphSize := n_ins; @@ -327,7 +327,7 @@ const (* read the flags *) - if TT_Check_And_Access_Frame( n_points*5 ) + if AStream.CheckAndAccessFrame( n_points*5 ) then goto Fail; k := 0; @@ -335,13 +335,13 @@ const while ( k < n_points ) do begin - c := GET_Byte; + c := AStream.GET_Byte; flag^[k] := c; inc(k); if c and 8 <> 0 then begin - cnt := GET_Byte; + cnt := AStream.GET_Byte; while ( cnt > 0 ) do begin @@ -361,10 +361,10 @@ const begin if flag^[k] and 2 <> 0 then - if flag^[k] and 16 <> 0 then inc( x, GET_Byte ) - else inc( x, -GET_Byte ) + if flag^[k] and 16 <> 0 then inc( x, AStream.GET_Byte ) + else inc( x, -AStream.GET_Byte ) 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; end; @@ -377,15 +377,15 @@ const begin if flag^[k] and 4 <> 0 then - if flag^[k] and 32 <> 0 then inc( y, GET_Byte ) - else inc( y, -GET_Byte ) + if flag^[k] and 32 <> 0 then inc( y, AStream.GET_Byte ) + else inc( y, -AStream.GET_Byte ) 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; end; - TT_Forget_Frame; + AStream.ForgetFrame; (* Now adds the two shadow points at n and n+1 *) (* 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; exec : PExec_Context; subg : PSubglyph_Record; @@ -509,9 +510,9 @@ const if subg^.is_hinted and (subg^.element_flag and WE_HAVE_INSTR <> 0) then begin - if TT_Access_Frame(2) then goto Fail_File; - n_ins := Get_UShort; - TT_Forget_Frame; + if AStream.AccessFrame(2) then goto Fail_File; + n_ins := AStream.Get_UShort; + AStream.ForgetFrame; (* load the instructions *) {$IFDEF FREETYPE_DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF} @@ -528,7 +529,7 @@ const if n_ins > 0 then with exec^ do begin - if TT_Read_File( glyphIns^, n_ins ) then + if AStream.ReadFile( glyphIns^, n_ins ) then goto Fail_File; glyphSize := n_ins; @@ -680,7 +681,7 @@ const xx, xy, yx, yy : TT_Fixed; exec : PExec_Context; - stream : TT_Stream; + ftstream : TFreeTypeStream; subglyph, subglyph2 : PSubGlyph_Record; @@ -779,7 +780,7 @@ const (* now access stream *) - if TT_Use_Stream( face^.stream, stream {%H-}) then + if TT_Use_Stream( face^.stream, ftstream {%H-}) then goto Fin; (* Main Loading Loop *) @@ -848,17 +849,17 @@ const (* read first glyph header *) - if TT_Seek_File( offset ) or - TT_Access_Frame( 5*sizeof(Short) ) then + if ftstream.SeekFile( offset ) or + ftstream.AccessFrame( 5*sizeof(Short) ) then goto Fail_File; - num_contours := GET_Short; - subglyph^.bbox.xMin := GET_Short; - subglyph^.bbox.yMin := GET_Short; - subglyph^.bbox.xMax := GET_Short; - subglyph^.bbox.yMax := GET_Short; + num_contours := ftstream.GET_Short; + subglyph^.bbox.xMin := ftstream.GET_Short; + subglyph^.bbox.yMin := ftstream.GET_Short; + subglyph^.bbox.xMax := ftstream.GET_Short; + subglyph^.bbox.yMax := ftstream.GET_Short; - TT_Forget_Frame; + ftstream.ForgetFrame; {$IFDEF FREETYPE_DEBUG} Writeln('Glyph ', i ); @@ -925,8 +926,8 @@ const new_flags := new_flags and not TT_Load_Debug; if Load_Simple_Glyph( + ftstream, exec, - stream, num_contours, left_contours, left_points, @@ -973,15 +974,15 @@ const (* now read composite header *) - if TT_Access_Frame( 4 ) then + if ftstream.AccessFrame( 4 ) then goto Fail_File; - new_flags := Get_UShort; + new_flags := ftstream.Get_UShort; subglyph^.element_flag := new_flags; - subglyph2^.index := Get_UShort; + subglyph2^.index := ftstream.Get_UShort; - TT_Forget_Frame; + ftstream.ForgetFrame; k := 2; @@ -997,18 +998,18 @@ const if new_flags and WE_HAVE_A_2X2 <> 0 then inc( k, 8 ); - if TT_Access_Frame( k ) then + if ftstream.AccessFrame( k ) then goto Fail_File; if new_flags and ARGS_ARE_WORDS <> 0 then begin - k := Get_Short; - l := Get_Short; + k := ftstream.Get_Short; + l := ftstream.Get_Short; end else begin - k := Get_Byte; - l := Get_Byte; + k := ftstream.Get_Byte; + l := ftstream.Get_Byte; end; subglyph^.arg1 := k; @@ -1027,24 +1028,24 @@ const if new_flags and WE_HAVE_A_SCALE <> 0 then begin - xx := Long(Get_Short) shl 2; + xx := Long(ftstream.Get_Short) shl 2; yy := xx; subglyph2^.is_scaled := true; end else if new_flags and WE_HAVE_AN_XY_SCALE <> 0 then begin - xx := Long(Get_Short) shl 2; - yy := Long(Get_Short) shl 2; + xx := Long(ftstream.Get_Short) shl 2; + yy := Long(ftstream.Get_Short) shl 2; subglyph2^.is_scaled := true; end else if new_flags and WE_HAVE_A_2X2 <> 0 then begin - xx := Long(Get_Short) shl 2; - xy := Long(Get_Short) shl 2; - yx := Long(Get_Short) shl 2; - yy := Long(Get_Short) shl 2; + xx := Long(ftstream.Get_Short) shl 2; + xy := Long(ftstream.Get_Short) shl 2; + yx := Long(ftstream.Get_Short) shl 2; + yy := Long(ftstream.Get_Short) shl 2; subglyph2^.is_scaled := true; end; @@ -1060,9 +1061,9 @@ const if abs(delta) <> 1 shl 16 then subglyph2^.is_hinted := false; - TT_Forget_Frame; + ftstream.ForgetFrame; - subglyph^.file_offset := TT_File_Pos; + subglyph^.file_offset := ftstream.Position; phase := Load_Glyph; end; @@ -1186,7 +1187,7 @@ const (* check for last component *) - if TT_Seek_File( subglyph^.file_offset ) then + if ftstream.SeekFile( subglyph^.file_offset ) then goto Fail_File; if subglyph^.element_flag and MORE_COMPONENTS <> 0 then @@ -1196,7 +1197,8 @@ const debug := ( load_top = 0 ) and ( load_flags and TT_Load_Debug <> 0 ); - if Load_Composite_End( num_points, + if Load_Composite_End( ftstream, + num_points, num_contours, exec, subglyph, @@ -1344,7 +1346,7 @@ const Load_TrueType_Glyph := Success; Fail: - TT_Done_Stream( stream ); + TT_Done_Stream( face^.stream ); Fin: diff --git a/components/lazutils/ttload.pas b/components/lazutils/ttload.pas index 558a0f085a..4ab1375212 100644 --- a/components/lazutils/ttload.pas +++ b/components/lazutils/ttload.pas @@ -26,27 +26,27 @@ Unit TTLoad; interface {$R-} -uses TTTypes, TTTables, TTCMap, TTObjs; +uses TTTypes, TTTables, TTCMap, TTObjs, TTFile; function LookUp_TrueType_Table( face : PFace; aTag : string ) : int; - function Load_TrueType_Directory( face : PFace; + function Load_TrueType_Directory( AStream: TFreeTypeStream; face : PFace; faceIndex : Int ) : TError; - function Load_TrueType_MaxProfile( face : PFace ) : TError; - function Load_TrueType_Header ( face : PFace ) : TError; - function Load_TrueType_Locations ( face : PFace ) : TError; - function Load_TrueType_CVT ( face : PFace ) : TError; - function Load_TrueType_CMap ( face : PFace ) : TError; - function Load_TrueType_Gasp ( face : PFace ) : TError; - function Load_TrueType_Names ( face : PFace ) : TError; - function Load_TrueType_Programs ( face : PFace ) : TError; - function Load_trueType_Postscript( face : PFace ) : TError; - function Load_TrueType_OS2 ( face : PFace ) : TError; - function Load_TrueType_HDMX ( face : PFace ) : TError; + function Load_TrueType_MaxProfile( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_Header ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_Locations ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_CVT ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_CMap ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_Gasp ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_Names ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_Programs ( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_trueType_Postscript( AStream: TFreeTypeStream; face : PFace ) : TError; + function Load_TrueType_OS2 ( AStream: TFreeTypeStream; 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; function Load_TrueType_Any( face : PFace; @@ -57,7 +57,7 @@ uses TTTypes, TTTables, TTCMap, TTObjs; implementation -uses TTError, TTMemory, TTFile; +uses TTError, TTMemory; (* 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 n : Int; const @@ -139,14 +139,14 @@ uses TTError, TTMemory, TTFile; with face^.ttcHeader do begin - if TT_Seek_File( 0 ) or - TT_Access_Frame( 12 ) then exit; + if AStream.SeekFile( 0 ) or + AStream.AccessFrame(12 ) then exit; - Tag := Get_ULong; - version := Get_Long; - dirCount := Get_Long; + Tag := AStream.Get_ULong; + version := AStream.Get_Long; + dirCount := AStream.Get_Long; - TT_Forget_Frame; + AStream.ForgetFrame; if Tag <> TTC_Tag then begin @@ -160,12 +160,12 @@ uses TTError, TTMemory, TTFile; end; 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 - tableDirectory^[n] := Get_ULong; + tableDirectory^[n] := AStream.Get_ULong; - TT_Forget_Frame; + AStream.ForgetFrame; end; 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; var n : Int; @@ -196,7 +196,7 @@ uses TTError, TTMemory, TTFile; {$IFDEF FREETYPE_DEBUG} Write('Directory '); {$ENDIF} - if Load_TrueType_Collection(face) then + if Load_TrueType_Collection(AStream, face) then begin if error <> TT_Err_File_Is_Not_Collection then exit; @@ -208,7 +208,7 @@ uses TTError, TTMemory, TTFile; error := TT_Err_Ok; (* Now skip to the beginning of the file *) - if TT_Seek_File(0) then + if AStream.SeekFile(0) then exit; end else @@ -222,23 +222,23 @@ uses TTError, TTMemory, TTFile; end; (* 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; end; - if TT_Access_Frame( 12 ) then + if AStream.AccessFrame( 12 ) then exit; - tableDir.version := GET_Long; - tableDir.numTables := GET_UShort; + tableDir.version := AStream.GET_Long; + tableDir.numTables := AStream.GET_UShort; - tableDir.searchRange := GET_UShort; - tableDir.entrySelector := GET_UShort; - tableDir.rangeShift := GET_UShort; + tableDir.searchRange := AStream.GET_UShort; + tableDir.entrySelector := AStream.GET_UShort; + tableDir.rangeShift := AStream.GET_UShort; {$IFDEF FREETYPE_DEBUG} Writeln('Tables number : ', tableDir.numTables ); {$ENDIF} - TT_Forget_Frame(); + AStream.ForgetFrame; (* Check that we have a 'sfnt' format there *) if (tableDir.version <> $10000 ) and (* MS fonts *) @@ -249,20 +249,25 @@ uses TTError, TTMemory, TTFile; exit; end; - face^.numTables := tableDir.numTables; - - 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 + with face^ do begin - face^.dirTables^[n].Tag := GET_ULong; - face^.dirTables^[n].Checksum := GET_ULong; - face^.dirTables^[n].Offset := GET_Long; - face^.dirTables^[n].Length := Get_Long; - end; - TT_Forget_Frame(); + numTables := tableDir.numTables; + + 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; + + AStream.ForgetFrame; + + end; {$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 table : int; begin @@ -299,10 +304,10 @@ uses TTError, TTMemory, TTFile; with face^ do begin - if TT_Seek_File( dirTables^[table].Offset ) or - TT_Access_Frame( 32 ) then exit; + if astream.SeekFile( dirTables^[table].Offset ) or + AStream.AccessFrame( 32 ) then exit; - with MaxProfile do + with AStream, MaxProfile do begin ULong(Version) := GET_ULong; @@ -325,7 +330,7 @@ uses TTError, TTMemory, TTFile; maxComponentDepth := GET_UShort; end; - TT_Forget_Frame; + AStream.ForgetFrame; (* XXX : an adjustement that is necessary to load certain */ /* 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 gRanges : PGaspRanges; table, i : Int; @@ -404,33 +409,33 @@ uses TTError, TTMemory, TTFile; exit; end; - if TT_Seek_File( face^.dirTables^[table].Offset ) or - TT_Access_Frame( 4 ) then exit; + if astream.SeekFile( face^.dirTables^[table].Offset ) or + AStream.AccessFrame( 4 ) then exit; - with face^.gasp do + with AStream, face^.gasp do begin version := Get_UShort; numRanges := Get_UShort; gaspRanges := nil; end; - TT_Forget_Frame; + AStream.ForgetFrame; gRanges:=nil; 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; face^.gasp.gaspRanges := gRanges; for i := 0 to face^.gasp.numRanges-1 do - with gRanges^[i] do + with AStream, gRanges^[i] do begin maxPPEM := Get_UShort; gaspFlag := Get_UShort; end; - TT_Forget_Frame; + AStream.ForgetFrame; Load_TrueType_Gasp := Success; 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 i : int; begin @@ -471,10 +476,10 @@ uses TTError, TTMemory, TTFile; with face^ do begin - if TT_Seek_File( dirTables^[i].offset ) or - TT_Access_Frame( 54 ) then exit; + if AStream.SeekFile( dirTables^[i].offset ) or + AStream.AccessFrame(54 ) then exit; - with FontHeader do + with AStream, FontHeader do begin ULong(Table_Version) := GET_ULong; @@ -505,7 +510,7 @@ uses TTError, TTMemory, TTFile; end; - TT_Forget_Frame; + AStream.ForgetFrame; 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; var table, n : int; @@ -599,20 +604,20 @@ uses TTError, TTMemory, TTFile; if Alloc( longs^, sizeof(TLongMetrics) * num_longs ) or Alloc( shorts^, sizeof(TShortMetrics)* num_shorts ) or - TT_Seek_File( face^.dirTables^[table].Offset ) or - TT_Access_Frame( face^.dirTables^[table].Length ) then exit; + AStream.SeekFile( face^.dirTables^[table].Offset ) or + AStream.AccessFrame( face^.dirTables^[table].Length ) then exit; for n := 0 to num_longs-1 do with longs^^[n] do begin - advance := GET_UShort; - bearing := GET_Short; + advance := AStream.GET_UShort; + bearing := AStream.GET_Short; end; (* do we have an inconsistent number of metric values ? *) if num_shorts > num_shorts_checked then begin 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 *) (* last valid value. Since this will occur for buggy CJK *) @@ -625,9 +630,9 @@ uses TTError, TTMemory, TTFile; end else 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} @@ -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; var table : int; @@ -691,11 +696,11 @@ uses TTError, TTMemory, TTFile; with face^ do begin - if TT_Seek_File( dirTables^[table].Offset ) or - TT_Access_Frame( 36 ) then + if AStream.SeekFile( dirTables^[table].Offset ) or + AStream.AccessFrame( 36 ) then exit; - with header^ do + with AStream, header^ do begin Long(Version) := GET_ULong; @@ -726,13 +731,13 @@ uses TTError, TTMemory, TTFile; end; - TT_Forget_Frame; + AStream.ForgetFrame; end; {$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; (******************************************************************* @@ -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 t, n : int; LongOffsets : int; @@ -772,7 +777,7 @@ uses TTError, TTMemory, TTFile; t := LookUp_Mandatory_Table( face, 'loca' ); 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 begin @@ -784,12 +789,12 @@ uses TTError, TTMemory, TTFile; {$ENDIF} 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 - glyphLocations^[n] := GET_Long; + glyphLocations^[n] := AStream.GET_Long; - TT_Forget_Frame; + AStream.ForgetFrame; end else @@ -801,12 +806,12 @@ uses TTError, TTMemory, TTFile; {$ENDIF} 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 - glyphLocations^[n] := Long(GET_UShort) * 2; + glyphLocations^[n] := Long(AStream.GET_UShort) * 2; - TT_Forget_Frame; + AStream.ForgetFrame; 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 table, i : Int; bytes : Long; @@ -845,17 +850,17 @@ uses TTError, TTMemory, TTFile; with face^.nameTable do begin (* Seek to the beginning of the table and check the frame access. *) - if TT_Seek_File( face^.dirTables^[table].Offset ) or - TT_Access_Frame( 6 ) then exit; + if AStream.SeekFile( face^.dirTables^[table].Offset ) or + AStream.AccessFrame(6 ) then exit; - format := GET_UShort; - numNameRecords := GET_UShort; - storageOffset := GET_UShort; + format := AStream.GET_UShort; + numNameRecords := AStream.GET_UShort; + storageOffset := AStream.GET_UShort; - TT_Forget_Frame; + AStream.ForgetFrame; if Alloc( names, numNameRecords*sizeof(TName_Record) ) or - TT_Access_Frame( numNameRecords*12 ) then + AStream.AccessFrame( numNameRecords*12 ) then begin numNameRecords := 0; exit; @@ -865,7 +870,7 @@ uses TTError, TTMemory, TTFile; (* to hold the strings themselves *) 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 platformID := GET_UShort; encodingID := GET_UShort; @@ -880,14 +885,14 @@ uses TTError, TTMemory, TTFile; bytes := Offset + Length; end; - TT_Forget_Frame; + AStream.ForgetFrame; storage := nil; if bytes > 0 then begin 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 begin 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 t, n : Int; begin @@ -943,14 +948,14 @@ uses TTError, TTMemory, TTFile; 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 - cvt^[n] := GET_Short; + cvt^[n] := AStream.GET_Short; - TT_Forget_Frame; + AStream.ForgetFrame; end; {$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 off, table_start : Longint; n, t : Int; @@ -998,15 +1003,15 @@ uses TTError, TTMemory, TTFile; table_start := dirTables^[t].offset; - if TT_Seek_File( dirTables^[t].Offset ) or - TT_Access_Frame( 4 ) then exit; + if AStream.SeekFile( dirTables^[t].Offset ) or + AStream.AccessFrame( 4 ) then exit; - cmap_dir.tableVersionNumber := GET_UShort; - cmap_dir.numCMaps := GET_UShort; + cmap_dir.tableVersionNumber := AStream.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 *) numCMaps := cmap_dir.numCMaps; @@ -1015,34 +1020,34 @@ uses TTError, TTMemory, TTFile; for n := 0 to numCMaps-1 do begin - if TT_Seek_File ( off ) or - TT_Access_Frame( 8 ) then exit; + if AStream.SeekFile ( off ) or + AStream.AccessFrame( 8 ) then exit; cmap := @cMaps^[n]; - entry.platformID := GET_UShort; - entry.platformEncodingID := GET_UShort; - entry.offset := GET_Long; + entry.platformID := AStream.GET_UShort; + entry.platformEncodingID := AStream.GET_UShort; + entry.offset := AStream.GET_Long; cmap^.loaded := False; cmap^.platformID := entry.platformID; 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 - TT_Access_Frame( 6 ) then exit; + if AStream.SeekFile ( table_start + entry.offset ) or + AStream.AccessFrame( 6 ) then exit; - cmap^.format := Get_UShort; - cmap^.length := Get_UShort; - cmap^.version := Get_UShort; + cmap^.format := AStream.Get_UShort; + cmap^.length := AStream.Get_UShort; + cmap^.version := AStream.Get_UShort; - TT_Forget_Frame; + AStream.ForgetFrame; cmap^.StreamPtr := @face^.stream; - cmap^.offset := TT_File_Pos; + cmap^.offset := AStream.Position; 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 t : Int; begin @@ -1139,7 +1144,7 @@ uses TTError, TTMemory, TTFile; fontPgmSize := dirTables^[t].Length; if Alloc( fontProgram, fontPgmSize ) or - TT_Read_At_File( dirTables^[t].offset, + AStream.ReadAtFile( dirTables^[t].offset, fontProgram^, fontPgmSize ) then exit; @@ -1170,7 +1175,7 @@ uses TTError, TTMemory, TTFile; cvtPgmSize := dirTables^[t].Length; if Alloc( cvtProgram, cvtPgmSize ) or - TT_Read_At_File( dirTables^[t].offset, + AStream.ReadAtFile( dirTables^[t].offset, cvtProgram^, 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 table : Int; i : Int; @@ -1210,10 +1215,10 @@ uses TTError, TTMemory, TTFile; exit; end; - if TT_Seek_File( face^.dirTables^[table].offset ) or - TT_Access_Frame( 78 ) then exit; + if AStream.SeekFile( face^.dirTables^[table].offset ) or + AStream.AccessFrame( 78 ) then exit; - with face^.os2 do + with AStream, face^.os2 do begin version := Get_UShort; xAvgCharWidth := Get_Short; @@ -1250,16 +1255,16 @@ uses TTError, TTMemory, TTFile; usWinAscent := Get_UShort; usWinDescent := Get_UShort; - TT_Forget_Frame; + AStream.ForgetFrame; if version >= $0001 then begin - if TT_Access_Frame(8) then exit; + if AStream.AccessFrame(8) then exit; - ulCodePageRange1 := Get_ULong; - ulCodePageRange2 := Get_ULong; + ulCodePageRange1 := AStream.Get_ULong; + ulCodePageRange2 := AStream.Get_ULong; - TT_Forget_Frame; + AStream.ForgetFrame; end else 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 table : Int; begin @@ -1297,10 +1302,10 @@ uses TTError, TTMemory, TTFile; table := LookUp_TrueType_Table( face, 'post' ); if table < 0 then exit; - if TT_Seek_File( face^.dirTables^[table].offset ) or - TT_Access_Frame(32) then exit; + if AStream.SeekFile( face^.dirTables^[table].offset ) or + AStream.AccessFrame(32) then exit; - with face^.postscript do + with AStream, face^.postscript do begin formatType := Get_ULong; italicAngle := Get_ULong; @@ -1313,7 +1318,7 @@ uses TTError, TTMemory, TTFile; maxMemType1 := Get_ULong; end; - TT_Forget_Frame; + AStream.ForgetFrame; {$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 table, n : Int; num_glyphs : Int; @@ -1362,14 +1367,14 @@ uses TTError, TTMemory, TTFile; exit; end; - if TT_Seek_File( face^.dirTables^[table].offset ) or - TT_Access_Frame( 8 ) then exit; + if AStream.SeekFile( face^.dirTables^[table].offset ) or + AStream.AccessFrame(8 ) then exit; - version := Get_UShort; - num_rec := Get_Short; - rec_size := Get_Long; + version := AStream.Get_UShort; + num_rec := AStream.Get_Short; + rec_size := AStream.Get_Long; - TT_Forget_Frame; + AStream.ForgetFrame; (* right now, we only recognize format 0 *) @@ -1390,22 +1395,22 @@ uses TTError, TTMemory, TTFile; (* read record *) - if TT_Access_Frame(2) then + if AStream.AccessFrame(2) then goto Fail; - rec^.ppem := Get_Byte; - rec^.max_width := Get_Byte; + rec^.ppem := AStream.Get_Byte; + rec^.max_width := AStream.Get_Byte; - TT_Forget_Frame; + AStream.ForgetFrame; if Alloc( rec^.widths, num_glyphs ) or - TT_Read_File( rec^.widths^, num_glyphs ) then + AStream.ReadFile( rec^.widths^, num_glyphs ) then goto Fail; (* skip padding bytes *) if rec_size > 0 then - if TT_Skip_File( rec_size ) then + if AStream.SkipFile( rec_size ) then goto Fail; end; @@ -1440,7 +1445,7 @@ uses TTError, TTMemory, TTFile; var buffer; var length : longint ) : TError; var - stream : TT_Stream; + ftstream : TFreeTypeStream; found, i : integer; begin if tag <> 0 then @@ -1483,8 +1488,8 @@ uses TTError, TTMemory, TTFile; exit; end; - TT_Use_Stream( face^.stream, stream {%H-}); - Load_TrueType_Any := TT_Read_At_File( offset, buffer, length ); + TT_Use_Stream( face^.stream, ftstream {%H-}); + Load_TrueType_Any := ftstream.ReadAtFile( offset, buffer, length ); TT_Done_Stream( face^.stream ); end; diff --git a/components/lazutils/ttobjs.pas b/components/lazutils/ttobjs.pas index dd3e23e293..5767d9804e 100644 --- a/components/lazutils/ttobjs.pas +++ b/components/lazutils/ttobjs.pas @@ -682,7 +682,7 @@ type PFont_Input = ^TFont_Input; TFont_Input = record - stream : TT_Stream; (* inpute stream *) + stream : TT_Stream; (* input stream *) fontIndex : Int; (* index of font in collection *) end; @@ -1834,8 +1834,8 @@ const var input : PFont_Input; face : PFace; - label - Fail; + ftstream: TFreeTypeStream; + label Fail; begin Face_Create := Failure; @@ -1843,34 +1843,38 @@ const input := PFont_Input(_input); face^.stream := input^.stream; + if TT_Use_Stream(face^.stream, ftstream) then exit; 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 *) - if Load_TrueType_Directory( face, input^.fontIndex ) then - exit; + if Load_TrueType_Directory( ftstream, face, input^.fontIndex ) then + goto Fail; - if Load_TrueType_Header ( face ) or - Load_TrueType_MaxProfile ( face ) or - Load_TrueType_Locations ( face ) or - Load_TrueType_CMap ( face ) or - Load_TrueType_CVT ( face ) or - Load_TrueType_Metrics_Header ( face, false ) or - Load_TrueType_Programs ( face ) or - Load_TrueType_Gasp ( face ) or - Load_TrueType_Names ( face ) or - Load_TrueType_OS2 ( face ) or - Load_TrueType_Hdmx ( face ) or - Load_TrueType_Postscript ( face ) or - Load_TrueType_Metrics_Header ( face, true ) then + if Load_TrueType_Header ( ftstream, face ) or + Load_TrueType_MaxProfile ( ftstream, face ) or + Load_TrueType_Locations ( ftstream, face ) or + Load_TrueType_CMap ( ftstream, face ) or + Load_TrueType_CVT ( ftstream, face ) or + Load_TrueType_Metrics_Header ( ftstream, face, false ) or + Load_TrueType_Programs ( ftstream, face ) or + Load_TrueType_Gasp ( ftstream, face ) or + Load_TrueType_Names ( ftstream, face ) or + Load_TrueType_OS2 ( ftstream, face ) or + Load_TrueType_Hdmx ( ftstream, face ) or + Load_TrueType_Postscript ( ftstream, face ) or + Load_TrueType_Metrics_Header ( ftstream, face, true ) then goto Fail; Face_Create := Success; + TT_Done_Stream(face^.stream); exit; Fail: + TT_Done_Stream(face^.stream); Face_Destroy( face ); + exit; end;