(******************************************************************* * * ttobjs.pas 2.0 * * Objects definition unit. * * Copyright 1996, 1997 by * David Turner, Robert Wilhelm, and Werner Lemberg. * * This file is part of the FreeType project, and may only be used * modified and distributed under the terms of the FreeType project * license, LICENSE.TXT. By continuing to use, modify or distribute * this file you indicate that you have read the license and * understand and accept it fully. * ******************************************************************) (* *) (* The four important objects managed by the library are : *) (* *) (* Face : the object for a given typeface *) (* Instance : the object for a face's given pointsize/transform *) (* Context : the object for a given glyph loading/hinting execution *) (* Glyph : the object for a given glyph ( outline and metrics ) *) (* *) (* A Face object is described by a TFace record, and its *) (* associated sub-tables. It is created through a call to the *) (* 'TT_Open_Face' API. *) (* *) (* An Instance object is described by a TInstance record, and *) (* sub-tables. It is created for a given face through a call to the *) (* 'TT_Open_Instance' API. Several instances can share the same face *) (* *) (* The pointsize and/or transform of a given instance object can be *) (* changed on the fly through a call to the 'TT_Reset_Instance' API. *) (* *) (* A Glyph object is used to describe a glyph to the client application *) (* It is made of a TGlyph_Record header, with several sub-tables used *) (* to store, for example, point coordinates or outline info.. *) (* It can hold metrics information and other attributes, as well as *) (* the glyph's outline. A client application can request any kind of *) (* info to the library on a given glyph through the 'TT_Get_Glyph' *) (* call. *) (* *) (* *) (* A Context is described by a TExec_Context record, and sub-tables *) (* Execution contexts are created on demand during the following *) (* operations : *) (* *) (* - creating a new instance ( to read and execute the font program ) *) (* - setting/resetting the pointsize ( to execute the CVT program ) *) (* - during glyph loading ( when hinting is on ) *) (* *) (* They are used to run TrueType instructions and load/store *) (* glyph data that are not part of the Glyph object ( as they're of *) (* no meaning to a client application ). *) (* *) (* The library keeps track of all objects related to a given face : *) (* *) (* A face's instances are kept in two linked lists : one is the 'active' *) (* list, which tracks the face's current opened instances, while the *) (* other is the 'idle' list used to collect/recycle instance objects *) (* when they become unuseful after a 'TT_Close_Instance' call. *) (* *) (* In the same way, a face's execution contexts are kept in two *) (* similar lists. Note that, as contexts are created on demand, *) (* the active and idle contexts lists should always contain few *) (* elements. *) (* *) (* Look also for the following files : *) (* *) (* Face manager : TTFace.pas *) (* Instance manager : TTInst.pas *) (* Context manager : TTExec.pas *) (* Glyph manager : TTGlyph.pas *) (* *) unit TTObjs; interface {$I TTCONFIG.INC} uses FreeType, TTTypes, TTError, TTCache, TTTables, TTCMap; type (* Graphics State *) (* *) (* The Graphics State (GS) is managed by the *) (* instruction field, but does not come from *) (* the font file. Thus, we can use 'int's *) (* where needed. *) (* *) PGraphicsState = ^TGraphicsState; TGraphicsState = record rp0, rp1, rp2 : int; dualVector, projVector, freeVector : TT_UnitVector; loop : longint; minimum_distance : TT_F26dot6; round_state : int; auto_flip : boolean; control_value_cutin : TT_F26dot6; single_width_cutin : TT_F26dot6; single_width_value : TT_F26dot6; delta_base : int; delta_shift : int; instruct_control : byte; scan_control : Boolean; scan_type : Int; gep0, gep1, gep2 : int; end; const Default_GraphicsState : TGraphicsState = ( rp0 : 0; rp1 : 0; rp2 : 0; dualVector : ( x:$4000; y:0 ); projVector : ( x:$4000; y:0 ); freeVector : ( x:$4000; y:0 ); loop : 1; minimum_distance : 64; round_state : 1; auto_flip : True; control_value_cutin : 4*17; single_width_cutin : 0; single_width_value : 0; delta_Base : 9; delta_Shift : 3; instruct_control : 0; scan_control : True; scan_type : 0; gep0 : 1; gep1 : 1; gep2 : 1 ); (**********************************************************************) (* *) (* Execution Subtables : *) (* *) (**********************************************************************) const MaxCodeRanges = 3; (* There can only be 3 active code ranges at once : *) (* - the Font Program *) (* - the CVT Program *) (* - a glyph's instructions set *) TT_CodeRange_Font = 1; TT_CodeRange_Cvt = 2; TT_CodeRange_Glyph = 3; CvtFlag_None = 0; CvtFlag_X = 1; CvtFlag_Y = 2; CvtFlag_Both = 3; type TCodeRange = record Base : PByte; Size : Int; end; PCodeRange = ^TCodeRange; (* defines a code range *) (* *) (* code ranges can be resident to a glyph ( i.e. the Font Program) *) (* while some others are volatile ( Glyph instructions ) *) (* tracking the state and presence of code ranges allows function *) (* and instruction definitions within a code range to be forgotten *) (* when the range is discarded *) TCodeRangeTable = array[1..MaxCodeRanges] of TCodeRange; (* defines a function/instruction definition record *) PDefRecord = ^TDefRecord; TDefRecord = record Range : Int; (* in which code range is it located ? *) Start : Int; (* where does it start ? *) Opc : Byte; (* function #, or instruction code *) Active : boolean; (* is the entry active ? *) end; PDefArray = ^TDefArray; TDefArray = array[0..99] of TDefRecord; (* defines a call record, used to manage function calls *) TCallRecord = record Caller_Range : Int; Caller_IP : Int; Cur_Count : Int; Cur_Restart : Int; end; (* defines a simple call stack *) TCallStack = array[0..99] of TCallRecord; PCallStack = ^TCallStack; PGlyph_Zone = ^TGlyph_Zone; TGlyph_Zone = record n_points : Int; n_contours : Int; org : TT_Points; (* original (scaled) coords *) cur : TT_Points; (* current coordinates *) flags : TT_PTouchTable; conEnds : PUShort; end; TRound_Function = function( distance, compensation : TT_F26dot6 ) : TT_F26dot6; (* Rounding function, as used by the interpreter *) TMove_Function = procedure( zone : PGlyph_Zone; point : Int; distance : TT_F26dot6 ); (* Point displacement along the freedom vector routine, as *) (* used by the interpreter *) TProject_Function = function( var P1, P2 : TT_Vector ) : TT_F26dot6; (* Distance projection along one of the proj. vectors, as used *) (* by the interpreter *) TFunc_Get_CVT = function ( index : Int ) : TT_F26Dot6; (* Reading a cvt value. Take care of non-square pixels when *) (* needed *) TFunc_Set_CVT = procedure( index : Int; value : TT_F26Dot6 ); (* Setting or Moving a cvt value. Take care of non-square *) (* pixels when needed *) (********************************************************************) (* *) (* Glyph Sub-Tables *) (* *) (********************************************************************) PGlyph_Transform = ^TGlyph_Transform; TGlyph_Transform = record xx, xy : TT_Fixed; yx, yy : TT_Fixed; ox, oy : TT_F26Dot6; end; PSubglyph_Record = ^TSubglyph_Record; TSubglyph_Record = record index : Int; is_scaled : boolean; is_hinted : boolean; preserve_pps : boolean; bbox : TT_BBox; zone : TGlyph_Zone; arg1, arg2 : Int; element_flag : Int; transform : TGlyph_Transform; file_offset : Long; pp1, pp2 : TT_Vector; advanceWidth : Int; leftBearing : Int; end; TSubglyph_Stack = array[0..10] of TSubglyph_Record; PSubglyph_Stack = ^TSubglyph_Stack; (* A note regarding non-squared pixels : *) (* *) (* ( This text will probably go into some docs at some time, for *) (* now, it is kept there to explain some definitions in the *) (* TIns_Metrics record ). *) (* *) (* The CVT is a one-dimensional array containing values that *) (* control certain important characteristics in a font, like *) (* the height of all capitals, all lowercase letter, default *) (* spacing or stem width/height. *) (* *) (* These values are found in FUnits in the font file, and must be *) (* scaled to pixel coordinates before being used by the CVT and *) (* glyph programs. Unfortunately, when using distinct x and y *) (* resolutions ( or distinct x and y pointsizes ), there are two *) (* possible scalings. *) (* *) (* A first try was to implement a 'lazy' scheme were all values *) (* were scaled when first used. However, some values are always *) (* used in the same direction, and some other are used in many *) (* different circumstances and orientations. *) (* *) (* I have found a simpler way to do the same, and it even seems to *) (* work in most of the cases : *) (* *) (* - all CVT values are scaled to the maximum ppem size *) (* *) (* - when performing a read or write in the CVT, a ratio factor *) (* is used to perform adequate scaling. Example : *) (* *) (* x_ppem = 14 *) (* y_ppem = 10 *) (* *) (* we chose ppem = x_ppem = 14 as the CVT scaling size. All cvt *) (* entries are scaled to it. *) (* *) (* x_ratio = 1.0 *) (* y_ratio = y_ppem/ppem ( < 1.0 ) *) (* *) (* we compute the current ratio like : *) (* *) (* - if projVector is horizontal, ratio = x_ratio = 1.0 *) (* - if projVector is vertical, ratop = y_ratio *) (* - else, ratio = sqrt( (proj.x*x_ratio)ý+(proj.y*y_ratio)ý ) *) (* *) (* reading a cvt value returns ratio*cvt[index] *) (* writing a cvt value in pixels cvt[index]/ratio *) (* *) (* the current ppem is simple ratio*ppem *) (* *) TIns_Metrics = record pointsize : TT_F26Dot6; x_resolution : Int; y_resolution : Int; x_ppem : Int; y_ppem : Int; x_scale1 : Long; x_scale2 : Long; y_scale1 : Long; y_scale2 : Long; (* for non-square pixels *) x_ratio : Long; y_ratio : Long; scale1 : Long; scale2 : Long; ppem : Int; ratio : Long; (* compensations *) compensations : array[0..3] of TT_F26Dot6; (* flags *) rotated : Boolean; stretched : Boolean; end; (********************************************************************) (* *) (* FreeType Face Object *) (* *) (********************************************************************) PFace = ^TFace; PInstance = ^TInstance; PExec_Context = ^TExec_Context; TFace = record stream : TT_Stream; (* i/o stream *) ttcHeader : TTTCHeader; (* TrueType collection header, if any was found *) maxProfile : TMaxProfile; (* maximum profile table, as defined by the TT Spec *) (* Note : *) (* it seems that some maximum values cannot be *) (* taken directly from this table, but rather by *) (* combining some of its fields ( e.g. the max. *) (* number of points seems to be given by *) (* MAX( maxPoints, maxCompositePoints ) *) (* *) (* For this reason, we define later our own *) (* max values that are used to load and allocate *) (* further tables.. *) fontHeader : TT_Header; (* the font header as defined by the TT Spec *) horizontalHeader : TT_Horizontal_Header; (* the horizontal header, as defined in the spec *) verticalInfo : Boolean; (* set to true when vertical data is in the font *) verticalHeader : TT_Vertical_Header; (* vertical header table *) os2 : TT_OS2; (* 'OS/2' table *) postscript : TT_Postscript; (* 'Post' table *) hdmx : THdmx; (* 'hdmx' = horizontal device metrics table *) nameTable : TName_Table; (* 'name' = name table *) numTables : Int; dirTables : PTableDirEntries; (* The directory of the TrueType tables found in *) (* this face's stream *) numCMaps : Int; cMaps : PCMapTables; (* the directory of character mappings tables found *) (* for this face.. *) numLocations : Int; glyphLocations : PStorage; (* the glyph locations table *) (* the hmtx table is now within the horizontal header *) fontPgmSize : Int; fontProgram : PByte; (* the font program, if any.. *) cvtPgmSize : Int; cvtProgram : PByte; (* the cvt (or 'prep') program, if any.. *) cvtSize : Int; cvt : PShort; (* the original, unscaled, control value table *) gasp : TGasp; (* the following values must be set by the *) (* maximum profile loader.. *) numGlyphs : Int; (* the face's total number of glyphs *) maxPoints : Int; (* max glyph points number, simple and composite *) maxContours : Int; (* max glyph contours number, simple and composite *) maxComponents : Int; (* max components in a composite glyph *) (* the following lists are used to track active *) (* instance and context objects, as well as *) (* to recycle them.. *) (* see 'TTLists'.. *) instances : TCache; glyphs : TCache; (* various caches for this face's child objects *) extension : Pointer; (* a typeless pointer to the face object's extensions *) generic : Pointer; (* generic pointer - see TT_Set/Get_Face_Pointer *) end; (********************************************************************) (* *) (* FreeType Instance Object *) (* *) (********************************************************************) TInstance = record owner : PFace; valid : Boolean; metrics : TIns_Metrics; numFDefs : Int; (* number of function defs *) maxFDefs : Int; FDefs : PDefArray; (* table of FDefs entries *) numIDefs : Int; (* number of instruction defs *) maxIDefs : Int; IDefs : PDefArray; (* table of IDefs entries *) maxFunc : Int; (* maximum function number *) maxIns : Int; (* maximum instruction number *) codeRangeTable : TCodeRangeTable; GS : TGraphicsState; storeSize : Int; storage : PStorage; (* the storage area *) cvtSize : Int; cvt : PLong; (* the scaled control value table *) twilight : TGlyph_Zone; (* the instance's twilight zone *) (* debugging variables *) debug : Boolean; context : PExec_Context; (* when using the debugger, we must keep the *) (* execution context with the instance object *) (* rather than asking it on demand *) generic : Pointer; (* generic pointer - see TT_Set/Get_Instance_Pointer *) end; (********************************************************************) (* *) (* FreeType Execution Context Object *) (* *) (********************************************************************) TExec_Context = record face : PFace; instance : PInstance; error : Int; stackSize : Int; (* size of instance stack *) top : Int; (* top of instance stack *) stack : PStorage; (* current instance stack *) args : Int; (* number of arguments in opcode *) new_top : Int; (* new stack top after opc. exec *) zp0, zp1, zp2, twilight, pts : TGlyph_Zone; GS : TGraphicsState; curRange : Int; (* current code range number *) code : PByte; (* current code range *) IP : Int; (* current instruction pointer *) codeSize : Int; (* size of current range *) opcode : Byte; (* current opcode *) length : Int; (* length of current opcode *) step_ins : boolean; (* used by the interpreter *) (* if true, go to the next *) (* instruction.. *) loadSize : Int; loadStack : PSubglyph_Stack; (* the load stack used to load composite glyphs *) glyphIns : PByte; (* glyph instructions *) glyphSize : Int; (* glyph ins. size *) callTop : Int; callSize : Int; callStack : PCallStack; (* interpreter call stack *) period, (* values used for the *) phase, (* 'SuperRounding' *) threshold : TT_F26dot6; maxPoints : Int; maxContours : Int; (* the following are copies of the variables found *) (* in an instance object *) numFDefs : Int; (* number of function defs *) maxFDefs : Int; FDefs : PDefArray; (* table of FDefs entries *) numIDefs : Int; (* number of instruction defs *) maxIDefs : Int; IDefs : PDefArray; (* table of IDefs entries *) maxFunc : Int; (* maximum function number *) maxIns : Int; (* maximum instruction number *) codeRangeTable : TCodeRangeTable; storeSize : Int; (* size of current storage *) storage : PStorage; (* storage area *) metrics : TIns_Metrics; cur_ppem : Int; scale1 : Long; scale2 : Long; cached_metrics : Boolean; (* numContours : Int; endContours : PUShort; *) Instruction_Trap : Boolean; (* used by the full-screen debugger. If set, the *) (* interpreter will exit after executing one *) (* opcode. Used to perform single-stepping.. *) is_composite : Boolean; (* this flag is true when the glyph is a composite *) (* one. In this case, we measure original distances *) (* in the loaded coordinates (font units), then *) (* scale them appropriately. This get rids of *) (* transformation artifacts (like symetries..) *) cvtSize : Int; cvt : PLong; (* these variables are proper to the context *) F_dot_P : Long; (* the dot product of the free and projection *) (* vector is used in frequent operations.. *) func_round : TRound_Function; func_project : TProject_Function; func_dualproj : TProject_Function; func_freeProj : TProject_Function; func_move : TMove_Function; func_read_cvt : TFunc_Get_CVT; func_write_cvt : TFunc_Set_CVT; func_move_cvt : TFunc_Set_CVT; (* single width ? *) end; (********************************************************************) (* *) (* FreeType Glyph Object *) (* *) (********************************************************************) PGlyph = ^TGlyph; TGlyph = record face : PFace; metrics : TT_Big_Glyph_Metrics; outline : TT_Outline; (* temporary - debugging purposes *) computed_width : Int; precalc_width : Int; is_composite : Boolean; end; PFont_Input = ^TFont_Input; TFont_Input = record stream : TT_Stream; (* inpute stream *) fontIndex : Int; (* index of font in collection *) end; (****************************************************************) (* *) (* Code Range Functions *) (* *) (****************************************************************) function Goto_CodeRange( exec : PExec_Context; range : Int; IP : Int ) : TError; (* Go to a specified coderange *) function Get_CodeRange( exec : PExec_Context; range : Int ) : PCodeRange; (* return a pointer to a given coderange record *) (* used only by the debugger *) function Set_CodeRange( exec : PExec_Context; range : Int; base : Pointer; length : Int ) : TError; (* Set a given code range properties *) function Clear_CodeRange( exec : PExec_Context; range : Int ) : TError; (* Clear a given code range *) (****************************************************************) (* *) (* Management Functions *) (* *) (****************************************************************) function New_Context( instance : PInstance ) : PExec_Context; (* Get a new execution context, either fresh or recycled, for *) (* an instance of the face 'res' *) (* *) (* Notes : - called by 'New_Face_Context' *) (* - assumes that the face mutex is acquired *) procedure Done_Context( exec : PExec_Context ); (* Releases an execution context. The context can be destroyed *) (* or recycled, depending on implementation *) (* *) (* Notes : - called by 'Done_Face_Context' *) (* - assumes that the face mutex is acquired *) (****************************************************************) (* *) (* Instance Update Functions *) (* *) (****************************************************************) procedure Context_Load( exec : PExec_Context; ins : PInstance ); (* update exec's data with the one found in 'ins' *) (* typically before an execution *) procedure Context_Save( exec : PExec_Context; ins : PInstance ); (* update ins's data with the one found in 'exec' *) (* typically after an execution *) function Context_Run( exec : PExec_Context; debug : Boolean ) : TError; function Instance_Init( ins : PInstance ) : TError; function Instance_Reset( ins : PInstance; debug : boolean ) : TError; function Scale_X( var metrics : TIns_Metrics; x : TT_Pos ) : TT_Pos; function Scale_Y( var metrics : TIns_Metrics; y : TT_Pos ) : TT_Pos; function TTObjs_Init : TError; (* Initialize object manager *) procedure TTObjs_Done; (* Finalize object manager *) var face_cache : TCache; exec_cache : TCache; implementation uses TTMemory, TTFile, TTCalc, TTLoad, TTInterp; function Face_Create( _face : Pointer; _input : Pointer ) : TError; far; forward; function Face_Destroy( _face : Pointer ) : TError; far; forward; function Context_Create( _context : Pointer; _face : Pointer ) : TError; far; forward; function Context_Destroy( exec : Pointer ) : TError; far; forward; function Instance_Create( _ins : Pointer; _face : Pointer ) : TError; far; forward; function Instance_Destroy( instance : Pointer ) : TError; far; forward; function Glyph_Create( _glyph : Pointer; _face : Pointer ) : TError; far; forward; function Glyph_Destroy( _glyph : Pointer ) : TError; far; forward; const objs_face_class : TCache_Class = (object_size: sizeof(TFace); idle_limit : -1; init : Face_Create; done : Face_Destroy ); objs_exec_class : TCache_Class = (object_size: sizeof(TExec_Context); idle_limit : 1; init : Context_Create; done : Context_Destroy ); objs_instance_class : TCache_Class = (object_size: sizeof(TInstance); idle_limit : -1; init : Instance_Create; done : Instance_Destroy ); objs_glyph_class : TCache_Class = (object_size: sizeof(TGlyph); idle_limit : -1; init : Glyph_Create; done : Glyph_Destroy ); (******************************************************************* * * Function : New_Context * * Description : gets a new active execution context for a given * resident/face object. * * Input : aResident * * Output : Returns new exec. context. Nil in case of failure * * Notes : Don't forget to modify 'Free_Context' if you change * the fields of a TExec_Context * ******************************************************************) function New_Context( instance : PInstance ) : PExec_Context; var exec : PExec_Context; begin if instance = nil then exec := nil else Cache_New( exec_cache, Pointer(exec), instance^.owner ); New_Context := exec; end; (******************************************************************* * * Function : Done_Context * * Description : * * Input : aResident * * Output : Discards an active execution context when it * becomes unuseful. It is putin its face's recycle * list * ******************************************************************) procedure Done_Context( exec : PExec_Context ); begin if exec <> nil then Cache_Done( exec_cache, Pointer(exec) ); end; (******************************************************************* * * Function : New_Instance * * Description : gets a new active instance for a given * face object. * * Input : face * * Output : Returns new instance. Nil in case of failure * ******************************************************************) function New_Instance( face : PFace ) : PInstance; var ins : PInstance; begin if face = nil then ins := nil else Cache_New( face^.instances, Pointer(ins), face ); New_Instance := ins; end; (******************************************************************* * * Function : Done_Instance * * Description : * * Input : instance * * Output : Discards an active instance when it * becomes unuseful. It is put in its face's recycle * list * ******************************************************************) procedure Done_Instance( instance : PInstance ); begin if instance <> nil then Cache_Done( instance^.owner^.instances, Pointer(instance) ); end; (****************************************************************) (* *) (* Code Range Functions *) (* *) (****************************************************************) (******************************************************************* * * Function : Goto_CodeRange * * Description : Switch to a new code range (updates Code and IP). * * Input : exec target execution context * range new execution code range * IP new IP in new code range * * Output : SUCCESS on success. FAILURE on error (no code range). * *****************************************************************) function Goto_CodeRange( exec : PExec_Context; range : Int; IP : Int ) : TError; begin Goto_CodeRange := Failure; if (range < 1) or (range > 3) then begin error := TT_Err_Bad_Argument; exit; end; with exec^.codeRangeTable[range] do begin if base = nil then begin error := TT_Err_Invalid_CodeRange; exit; end; (* NOTE : Because the last instruction of a program may be a CALL *) (* which will return to the first byte *after* the code *) (* range, we test for IP <= Size, instead of IP < Size. *) if IP > size then begin error := TT_Err_Code_Overflow; exit; end; exec^.code := base; exec^.codeSize := size; exec^.IP := IP; exec^.currange := range; end; Goto_CodeRange := Success; end; (******************************************************************* * * Function : Get_CodeRange * * Description : Returns a pointer to a given code range. Should * be used only by the debugger. Returns NULL if * 'range' is out of current bounds. * * Input : exec target execution context * range new execution code range * * Output : Pointer to the code range record. NULL on failure. * *****************************************************************) function Get_CodeRange( exec : PExec_Context; range : Int ) : PCodeRange; begin if (range < 1) or (range > 3) then Get_CodeRange := nil else Get_CodeRange := @exec^.codeRangeTable[range]; end; (******************************************************************* * * Function : Set_CodeRange * * Description : Sets a code range. * * Input : exec target execution context * range code range index * base new code base * length sange size in bytes * * Output : SUCCESS on success. FAILURE on error. * *****************************************************************) function Set_CodeRange( exec : PExec_Context; range : Int; base : Pointer; length : Int ) : TError; begin Set_CodeRange := Failure; if (range < 1) or (range > 3) then begin error := TT_Err_Invalid_CodeRange; exit; end; exec^.codeRangeTable[range].base := base; exec^.codeRangeTable[range].size := length; Set_CodeRange := Success; end; (******************************************************************* * * Function : Clear_CodeRange * * Description : clears a code range. * * Input : exec target execution context * range code range index * * Output : SUCCESS on success. FAILURE on error. * * Notes : Does not set the Error variable. * *****************************************************************) function Clear_CodeRange( exec : PExec_Context; range : Int ) : TError; begin Clear_CodeRange := Failure; if (range < 1) or (range > 3) then begin error := TT_Err_Invalid_CodeRange; exit; end; exec^.codeRangeTable[range].base := nil; exec^.codeRangeTable[range].size := 0; Clear_CodeRange := Success; end; (****************************************************************) (* *) (* Management Functions *) (* *) (****************************************************************) (******************************************************************* * * Function : Context_Destroy * * Description : Frees an execution context * * Input : context : execution context * * Notes : Allocation is found in the 'New_Context' function * ******************************************************************) function Context_Destroy( exec : Pointer ) : TError; begin Context_Destroy := Success; if exec = nil then exit; with PExec_Context(exec)^ do begin (* Free contours array *) Free( pts.conEnds ); pts.n_contours := 0; Free( pts.cur ); Free( pts.org ); Free( pts.flags ); pts.n_points := 0; (* Free stack *) Free( stack ); stackSize := 0; (* Free call stack *) Free( callStack ); callSize := 0; callTop := 0; (* Free composite load stack *) Free( loadStack ); (* free glyph code range *) Free( glyphIns ); glyphSize := 0; instance := nil; face := nil; end; end; (******************************************************************* * * Function : Context_Create * * Description : Creates a new execution context * * Input : _context context record * _face face record * ******************************************************************) function Context_Create( _context : Pointer; _face : Pointer ) : TError; var n_points : Int; n_twilight : Int; exec : PExec_Context; label Fail_Memory; begin Context_Create := Failure; exec := PExec_Context(_context); exec^.face := PFace(_face); with exec^ do begin callSize := 32; loadSize := face^.maxComponents + 1; storeSize := face^.MaxProfile.maxStorage; stackSize := face^.MaxProfile.maxStackElements + 32; (* Allocate a little extra for broken fonts like Courbs.ttf *) (* and Timesbs.ttf *) n_points := face^.maxPoints + 2; (* Reserve glyph code range *) if Alloc( glyphIns, face^.MaxProfile.maxSizeOfInstructions ) or (* Reserve call stack *) Alloc( callStack, callSize*sizeof(TCallRecord) ) or (* Reserve stack *) Alloc( stack, stackSize*sizeof(Long) ) then (* we don't reserve the points and contours arrays anymore *) (* as this will be performed automatically by a Context_Load *) (* the same is true for the load stack *) goto Fail_Memory; maxPoints := 0; maxContours := 0; loadSize := 0; loadStack := nil; pts.n_points := 0; pts.n_contours := 0; instance := nil; end; Context_Create := Success; exit; Fail_Memory: Context_Destroy(_context); error := TT_Err_Out_Of_Memory; exit; end; (******************************************************************* * * Function : Context_Run * * Description : Run a glyph's bytecode stream * * Input : exec context record * ******************************************************************) function Context_Run( exec : PExec_Context; debug : Boolean ) : TError; begin Context_Run := Failure; if Goto_CodeRange( exec, TT_CodeRange_Glyph, 0 ) then exit; with exec^ do begin top := 0; callTop := 0; zp0 := pts; zp1 := pts; zp2 := pts; GS.gep0 := 1; GS.gep1 := 1; GS.gep2 := 1; GS.projVector.x := $4000; GS.projVector.y := $0000; GS.freeVector := GS.projVector; GS.dualVector := GS.projVector; GS.round_state := 1; GS.loop := 1; end; if not debug and Run_Ins( @exec^ ) then begin error := exec^.error; exit; end; Context_Run := Success; end; (****************************************************************) (* *) (* Instance Update Functions *) (* *) (****************************************************************) (******************************************************************* * * Function : Context_Load * * Description : loads instance data into a new execution context * *******************************************************************) procedure Context_Load( exec : PExec_Context; ins : PInstance ); procedure Update_Max( var size : Int; mult : Int; var buff; new_max : Int ); begin if size*mult < new_max then begin Free(buff); Alloc( buff, new_max*mult ); size := new_max; end; end; procedure Update_Points( max_points : Int; max_contours : Int; exec : PExec_Context ); begin if exec^.maxPoints < max_points then begin Free( exec^.pts.org ); Free( exec^.pts.cur ); Free( exec^.pts.flags ); Alloc( exec^.pts.org, 2*sizeof(TT_F26dot6)*max_points ); Alloc( exec^.pts.cur, 2*sizeof(TT_F26dot6)*max_points ); Alloc( exec^.pts.flags, sizeof(Byte) *max_points ); exec^.maxPoints := max_points; end; if exec^.maxContours < max_contours then begin Free( exec^.pts.conEnds ); Alloc( exec^.pts.conEnds, sizeof(Short)*max_contours ); exec^.maxContours := max_contours; end; end; begin with exec^ do begin instance := ins; face := ins^.owner; numFDefs := ins^.numFDefs; numIDefs := ins^.numIDefs; maxFDefs := ins^.maxFDefs; maxIDefs := ins^.maxIDefs; FDefs := ins^.FDefs; IDefs := ins^.IDefs; maxFunc := ins^.maxFunc; maxIns := ins^.maxIns; metrics := ins^.metrics; codeRangeTable := ins^.codeRangeTable; storeSize := ins^.storeSize; storage := ins^.storage; twilight := ins^.twilight; (* We reserve some extra space to deal with broken fonts *) (* like Arial BS, Courier BS, etc.. *) Update_Max( stackSize, sizeof(Long), stack, face^.maxProfile.maxStackElements+32 ); Update_Max( loadSize, sizeof(TSubglyph_Record), loadStack, face^.maxComponents+1 ); Update_Max( glyphSize, sizeof(Byte), glyphIns, face^.maxProfile.maxSizeOfInstructions ); (* XXXX : Don't forget the phantom points !! *) Update_Points( face^.maxPoints+2, face^.maxContours, exec ); pts.n_points := 0; pts.n_contours := 0; instruction_trap := false; (* Set default graphics state *) GS := ins^.GS; cvtSize := ins^.cvtSize; cvt := ins^.cvt; end; end; procedure Context_Save( exec : PExec_Context; ins : PInstance ); begin with ins^ do begin error := exec^.error; numFDefs := exec^.numFDefs; numIDefs := exec^.numIDefs; maxFunc := exec^.maxFunc; maxIns := exec^.maxIns; codeRangeTable := exec^.codeRangeTable; (* Set default graphics state *) GS := exec^.GS; end; end; (******************************************************************* * * Function : Instance_Destroy * * Description : The Instance Record destructor. * *****************************************************************) function Instance_Destroy( instance : Pointer ) : TError; var ins : PInstance; begin Instance_Destroy := Success; ins := PInstance(instance); if ins = nil then exit; with ins^ do begin if debug then begin context := nil; debug := false; end; (* Free twilight zone *) Free( twilight.org ); Free( twilight.cur ); Free( twilight.flags ); twilight.n_points := 0; Free( cvt ); cvtSize := 0; Free( storage ); storeSize := 0; Free( FDefs ); Free( IDefs ); numFDefs := 0; numIDefs := 0; maxFDefs := 0; maxIDefs := 0; owner := nil; valid := false; end; end; (******************************************************************* * * Function : Instance_Create * * Description : The Instance constructor. * * This functions creates a new instance object for a given face * *****************************************************************) function Instance_Create( _ins : Pointer; _face : Pointer ) : TError; label Fail_Memory; var l : Longint; ins : PInstance; face : PFace; n_twilight : Int; begin Instance_Create := Failure; {$IFDEF ASSERT} if (_face = nil) then Panic1('TTInst.Init_Instance : void argument' ); {$ENDIF} face := PFace(_face); ins := PInstance(_ins); ins^.owner := face; with face^, ins^ do begin (* Reserve function and instruction defs arrays *) maxFDefs := maxProfile.maxFunctionDefs; maxIDefs := maxProfile.maxInstructionDefs; storeSize := maxProfile.maxStorage; n_twilight := maxProfile.maxTwilightPoints; if Alloc( FDefs, maxFDefs * sizeof(TDefRecord) ) or Alloc( IDefs, maxIDefs * sizeof(TDefRecord) ) or Alloc( storage, storeSize * sizeof(Long) ) or Alloc( twilight.org, 2* n_twilight * sizeof(TT_F26Dot6) ) or Alloc( twilight.cur, 2* n_twilight * sizeof(TT_F26Dot6) ) or Alloc( twilight.flags, n_twilight ) then goto Fail_Memory; twilight.n_points := n_twilight; metrics.x_resolution := 96; metrics.y_resolution := 96; metrics.pointSize := 10; metrics.x_scale2 := 1; metrics.y_scale2 := 1; metrics.scale2 := 1; { Reserve Control Value Table } cvtSize := face^.cvtSize; if Alloc( cvt, cvtSize * sizeof(Long) ) then goto Fail_Memory; end; Instance_Create := Success; exit; Fail_Memory: Instance_Destroy(ins); (* free all partially allocated tables, including the instance record *) error := TT_Err_Out_Of_Memory; exit; end; (******************************************************************* * * Function : Instance_Init * * Description : Initializes a fresh new instance * Executes the font program if any is found * * Input : ins the instance object to initialise * *****************************************************************) function Instance_Init( ins : PInstance ) : TError; var exec : PExec_Context; face : PFace; label Fin; begin Instance_Init := Failure; face := ins^.owner; if ins^.debug then exec := ins^.context else exec := New_Context( ins ); (* debugging instances have their own context *) if exec = nil then begin error := TT_Err_Could_Not_Find_Context; exit; end; with ins^ do begin GS := Default_GraphicsState; numFDefs := 0; numIDefs := 0; maxFunc := -1; maxIns := -1; end; Context_Load( exec, ins ); with exec^ do begin callTop := 0; top := 0; period := 64; phase := 0; threshold := 0; with metrics do begin x_ppem := 10; y_ppem := 10; pointSize := 10; x_scale1 := 0; x_scale2 := 1; y_scale1 := 0; y_scale2 := 1; scale1 := 0; scale2 := 1; ratio := 1 shl 16; end; instruction_trap := false; cvtSize := ins^.cvtSize; cvt := ins^.cvt; F_dot_P := $10000; end; Set_CodeRange( exec, TT_CodeRange_Font, face^.fontProgram, face^.fontPgmSize ); (* Allow font program execution *) Clear_CodeRange( exec, TT_CodeRange_Cvt ); Clear_CodeRange( exec, TT_CodeRange_Glyph ); (* disable CVT and glyph programs coderanges *) if face^.fontPgmSize > 0 then begin if Goto_CodeRange( exec, TT_CodeRange_Font, 0 ) then goto Fin; if Run_Ins( @exec^ ) then begin error := exec^.error; goto Fin; end; end; Instance_Init := Success; Fin: Context_Save( exec, ins ); if not ins^.debug then Done_Context( exec ); ins^.valid := False; end; (******************************************************************* * * Function : Instance_Reset * * Description : Reset an instance to a new pointsize * Executes the prep/cvt program if any is found * * Input : ins the instance object to initialise * *****************************************************************) function Instance_Reset( ins : PInstance; debug : boolean ) : TError; var exec : PExec_Context; face : PFace; i : Int; label Fin; begin Instance_Reset := Failure; if ins^.valid then begin Instance_Reset := Success; exit; end; face := ins^.owner; (* compute new transform *) with ins^.metrics do begin if x_ppem < 1 then x_ppem := 1; if y_ppem < 1 then y_ppem := 1; if x_ppem >= y_ppem then begin scale1 := x_scale1; scale2 := x_scale2; ppem := x_ppem; x_ratio := 1 shl 16; y_ratio := MulDiv_Round( y_ppem, $10000, x_ppem ); end else begin scale1 := y_scale1; scale2 := y_scale2; ppem := y_ppem; x_ratio := MulDiv_Round( x_ppem, $10000, y_ppem ); y_ratio := 1 shl 16 end; end; (* scale the cvt values to the new ppem *) for i := 0 to ins^.cvtSize-1 do ins^.cvt^[i] := MulDiv_Round( ins^.owner^.cvt^[i], ins^.metrics.scale1, ins^.metrics.scale2 ); (* Note that we use the y resolution by default to scale the cvt *) ins^.GS := Default_GraphicsState; if ins^.debug then exec := ins^.context else exec := New_Context(ins); if exec = nil then begin error := TT_Err_Could_Not_Find_Context; exit; end; Context_Load( exec, ins ); Set_CodeRange( exec, TT_CodeRange_CVT, face^.cvtProgram, face^.cvtPgmSize ); Clear_CodeRange( exec, TT_CodeRange_Glyph ); with exec^ do begin for i := 0 to storeSize-1 do storage^[i] := 0; instruction_trap := False; top := 0; callTop := 0; (* all twilight points are originally zero *) for i := 0 to twilight.n_points-1 do begin twilight.org^[i].x := 0; twilight.org^[i].y := 0; twilight.cur^[i].x := 0; twilight.cur^[i].y := 0; end; end; if face^.cvtPgmSize > 0 then if Goto_CodeRange( exec, TT_CodeRange_CVT, 0 ) or ( (not debug) and Run_Ins( @exec^ ) ) then goto Fin; ins^.GS := exec^.GS; Instance_Reset := Success; Fin: Context_Save( exec, ins ); if not ins^.debug then Done_Context(exec); if error = 0 then ins^.valid := True; end; (******************************************************************* * * Function : Face_Destroy * * Description : The face object destructor * *****************************************************************) function Face_Destroy( _face : Pointer ) : TError; var face : PFace; n : Int; begin Face_Destroy := Success; face := PFace(_face); if face = nil then exit; Cache_Destroy( face^.instances ); Cache_Destroy( face^.glyphs ); (* freeing the tables directory *) Free( face^.dirTables ); face^.numTables := 0; (* freeing the locations table *) Free( face^.glyphLocations ); face^.numLocations := 0; (* freeing the character mapping tables *) for n := 0 to face^.numCMaps-1 do CharMap_Free( face^.cMaps^[n] ); Free( face^.cMaps ); face^.numCMaps := 0; (* freeing the CVT *) Free( face^.cvt ); face^.cvtSize := 0; (* freeing the horizontal header *) Free( face^.horizontalHeader.short_metrics ); Free( face^.horizontalHeader.long_metrics ); if face^.verticalInfo then begin Free( face^.verticalHeader.short_metrics ); Free( face^.verticalHeader.long_metrics ); face^.verticalInfo := False; end; (* freeing the programs *) Free( face^.fontProgram ); Free( face^.cvtProgram ); face^.fontPgmSize := 0; face^.cvtPgmSize := 0; (* freeing the gasp table - none yet *) Free( face^.gasp.gaspRanges ); (* freeing the names table *) Free( face^.nameTable.names ); Free( face^.nameTable.storage ); face^.nameTable.numNameRecords := 0; face^.nameTable.format := 0; (* freeing the hdmx table *) for n := 0 to face^.hdmx.num_records-1 do Free( face^.hdmx.records^[n].widths ); Free( face^.hdmx.records ); face^.hdmx.num_records := 0; TT_Close_Stream( face^.stream ); end; (******************************************************************* * * Function : Face_Create * * Description : The face object constructor * *****************************************************************) function Face_Create( _face : Pointer; _input : Pointer ) : TError; var input : PFont_Input; face : PFace; label Fail; begin Face_Create := Failure; face := PFace(_face); input := PFont_Input(_input); face^.stream := input^.stream; if Cache_Create( objs_instance_class, face^.instances ) or Cache_Create( objs_glyph_class, face^.glyphs ) then exit; (* Load collection directory if present *) if Load_TrueType_Directory( face, input^.fontIndex ) then exit; 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 goto Fail; Face_Create := Success; exit; Fail: Face_Destroy( face ); end; function Glyph_Destroy( _glyph : Pointer ) : TError; var glyph : PGlyph; begin Glyph_Destroy := Success; glyph := PGlyph(_glyph); if glyph = nil then exit; glyph^.outline.owner := true; TT_Done_Outline( glyph^.outline ); end; function Glyph_Create( _glyph : Pointer; _face : Pointer ) : TError; var glyph : PGlyph; begin glyph := PGlyph(_glyph); glyph^.face := PFace(_face); error := TT_New_Outline( glyph^.face^.maxPoints+2, glyph^.face^.maxContours, glyph^.outline ); if error <> TT_Err_Ok then Glyph_Create := Failure else Glyph_Create := Success; end; function Scale_X( var metrics : TIns_Metrics; x : TT_Pos ) : TT_Pos; begin Scale_X := MulDiv_Round( x, metrics.x_scale1, metrics.x_scale2 ); end; function Scale_Y( var metrics : TIns_Metrics; y : TT_Pos ) : TT_Pos; begin Scale_Y := MulDiv_Round( y, metrics.y_scale1, metrics.y_scale2 ); end; function TTObjs_Init : TError; begin TTObjs_Init := Failure; Cache_Create( objs_face_class, face_cache ); Cache_Create( objs_exec_class, exec_cache ); TTObjs_Init := success; end; procedure TTObjs_Done; begin Cache_Destroy( face_cache ); Cache_Destroy( exec_cache ); end; end.