(******************************************************************* * * ttgload.pas 1.0 * * TrueType glyph loader * * 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. * ******************************************************************) Unit TTGLoad; interface {$I TTCONFIG.INC} uses FreeType, TTError, TTTypes, TTObjs; function Load_TrueType_Glyph( instance : PInstance; glyph : PGlyph; glyph_index : Word; load_flags : Int ) : TError; (* loads a font glyph into a given glyph info. The instance and *) (* glyph objects faces _must_ match. The load_flags indicates *) (* what kind of values should be written to the glyph object *) (* ( metrics, outline in EM coordinates, grid-fitted outline.. ) *) (* *) (* by default ( i.e. with load_flags = 0 ), this function only *) (* returns the unscaled glyph metrics and points in EM units. *) (* *) (* Use the following flags to query scaling and hinting ops. *) (********************************************************) (* return horizontal or vertical metrics in font units *) (* for a given glyph. The metrics are the left side *) (* bearing [resp. top side bearing] and advance width *) (* [resp. advance height]. *) (* *) (* This function may move later to another component.. *) (* *) procedure TT_Get_Metrics( var header : TT_Horizontal_Header; index : Int; var bearing : TT_Pos; var advance : TT_Pos ); function Get_Advance_Widths( face : PFace; ppem : Int ) : PByte; implementation uses TTTables, TTCalc, TTMemory, TTFile, TTInterp, TTLoad; const ARGS_ARE_WORDS = $01; ARGS_ARE_XY_VALUES = $02; ROUND_XY_TO_GRID = $04; WE_HAVE_A_SCALE = $08; (* reserved $10 *) MORE_COMPONENTS = $20; WE_HAVE_AN_XY_SCALE = $40; WE_HAVE_A_2X2 = $80; WE_HAVE_INSTR = $100; USE_MY_METRICS = $200; (********************************************************) (* return horizontal or vertical metrics in font units *) (* for a given glyph. The metrics are the left side *) (* bearing [resp. top side bearing] and advance width *) (* [resp. advance height]. *) (* *) (* This function may move later to another component.. *) (* *) procedure TT_Get_Metrics( var header : TT_Horizontal_Header; index : Int; var bearing : TT_Pos; var advance : TT_Pos ); var k : Int; longs : PTableLongMetrics; begin k := header.number_Of_HMetrics; if index < k then begin longs := PTableLongMetrics(header.long_metrics); bearing := longs^[index].bearing; advance := longs^[index].advance; end else begin bearing := PTableShortMetrics(header.short_metrics)^[index-k]; advance := PTableLongMetrics(header.long_metrics)^[k-1].advance; end; end; (********************************************************) (* return horizontal metrics in font units for a *) (* given glyph. if "check" is true, take care of *) (* mono-spaced fonts by returning the aw max. *) (* *) procedure Get_HMetrics( face : PFace; index : Int; check : Boolean; var lsb : Int; var aw : Int ); var left_bearing, advance : TT_Pos; begin TT_Get_Metrics( face^.horizontalHeader, index, left_bearing, advance ); lsb := Int(left_bearing); aw := Int(advance); if check and (face^.postscript.isFixedPitch <> 0) then aw := face^.horizontalHeader.advance_Width_Max; end; (********************************************************) (* return advance width table for a given pixel size *) (* if it is found in the font's "hdmx" table (if any) *) (* *) function Get_Advance_Widths( face : PFace; ppem : Int ) : PByte; var n : Integer; begin with face^.hdmx do for n := 0 to num_records-1 do if records^[n].ppem = ppem then begin Get_Advance_Widths := records^[n].widths; exit; end; Get_Advance_Widths := nil; end; (********************************************************) (* copy current glyph into original one *) (* *) procedure cur_to_org( n : int; pts : PGlyph_Zone ); var k : int; begin for k := 0 to n-1 do with pts^ do org^[k] := cur^[k]; end; (********************************************************) (* copy original glyph into current one *) (* *) procedure org_to_cur( n : int; pts : PGlyph_Zone ); var k : int; begin for k := 0 to n-1 do with pts^ do cur^[k] := org^[k]; end; (********************************************************) (* translate an array of coordinates *) (* *) procedure translate_array( n : int; coords : TT_Points; dx, dy : TT_Pos ); var k : Int; begin if dx <> 0 then for k := 0 to n-1 do inc( coords^[k].x, dx ); if dy <> 0 then for k := 0 to n-1 do inc( coords^[k].y, dy ); end; (********************************************************) (* mount one zone on top of another one *) (* *) procedure mount_zone( var source : TGlyph_Zone; var target : TGlyph_Zone ); var np, nc : Int; begin np := source.n_points; nc := source.n_contours; target.org := @source.org^[np]; target.cur := @source.cur^[np]; target.flags := @source.flags^[np]; target.conEnds := @source.conEnds^[nc]; target.n_points := 0; target.n_contours := 0; end; (******************************************************************* * * Function : Load_Simple_Glyph * * ******************************************************************) function Load_Simple_Glyph( exec : PExec_Context; stream : TT_Stream; n_contours : Int; left_contours : Int; left_points : Int; load_flags : Int; subg : PSubGlyph_Record ) : TError; var n_points, n_ins, k : Int; c, cnt : Byte; face : PFace; coords : TT_Points; flag : TT_PTouchTable; x, y : TT_F26dot6; pts : PGlyph_Zone; label Fail, Fail_File, Fail_Exec; begin Load_Simple_Glyph := Failure; face := exec^.face; (* simple check *) if ( n_contours > left_contours ) then begin {$IFDEF DEBUG} Writeln( 'ERROR: Glyph index ',i,' has ',Gl.numberOfContours ); Writeln( ' contours > left ', left_contours ); {$ENDIF} error := TT_Err_Too_Many_Contours; goto Fail; end; (* preparing the execution context *) mount_zone( subg^.zone, exec^.pts ); (* Reading the contours endpoints *) if TT_Access_Frame( (n_contours+1)*2 ) then goto Fail_File; n_points := 0; for k := 0 to n_contours-1 do begin {$IFDEF DEBUG} Write( n_points,' '); {$ENDIF} n_points := GET_Short; exec^.pts.conEnds^[k] := n_points; inc( n_points ); end; if n_points > left_points then begin {$IFDEF DEBUG} Writeln( 'ERROR: Too many points' ); {$ENDIF} error := TT_Err_Too_Many_Points; goto Fail; end; (* Loading instructions *) n_ins := GET_Short; TT_Forget_Frame; { if not subg^.is_hinted then if TT_Skip_File( n_ins ) then goto Fail_File else (* skip the instructions *) else } begin {$IFDEF DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF} if n_ins > face^.maxProfile.maxSizeOfInstructions then begin {$IFDEF DEBUG} Writeln('Too many instructions'); {$ENDIF} error := TT_Err_Too_Many_Ins; goto Fail; end; with exec^ do begin if TT_Read_File( glyphIns^, n_ins ) then goto Fail_File; glyphSize := n_ins; if Set_CodeRange( exec, TT_CodeRange_Glyph, glyphIns, glyphSize ) then goto Fail_Exec; end end; (* read the flags *) if TT_Check_And_Access_Frame( n_points*5 ) then goto Fail; k := 0; flag := exec^.pts.flags; while ( k < n_points ) do begin c := GET_Byte; flag^[k] := c; inc(k); if c and 8 <> 0 then begin cnt := GET_Byte; while ( cnt > 0 ) do begin flag^[k] := c; inc( k ); dec( cnt ); end end end; (* Read the X *) x := 0; coords := exec^.pts.org; for k := 0 to n_points-1 do begin if flag^[k] and 2 <> 0 then if flag^[k] and 16 <> 0 then inc( x, GET_Byte ) else inc( x, -GET_Byte ) else if flag^[k] and 16 = 0 then inc( x, GET_Short ); coords^[k].x := x; end; (* Read the Y *) y := 0; for k := 0 to n_points-1 do begin if flag^[k] and 4 <> 0 then if flag^[k] and 32 <> 0 then inc( y, GET_Byte ) else inc( y, -GET_Byte ) else if flag^[k] and 32 = 0 then inc( y, GET_Short ); coords^[k].y := y; end; TT_Forget_Frame; (* Now adds the two shadow points at n and n+1 *) (* We need the left side bearing and advance width *) (* pp1 = xMin - lsb == glyph origin *) coords^[n_points].x := subg^.bbox.XMin-subg^.leftBearing; coords^[n_points].y := 0; (* pp2 = pp1 + aw == glyph next position *) coords^[n_points+1].x := subg^.bbox.xMin- subg^.leftBearing + subg^.advanceWidth; coords^[n_points+1].y := 0; for k := 0 to n_points-1 do exec^.pts.flags^[k] := exec^.pts.flags^[k] and TT_Flag_On_Curve; exec^.pts.flags^[n_points ] := 0; exec^.pts.flags^[n_points+1] := 0; (* Note that we now return two more points, that are not *) (* part of the glyph outline *) inc( n_points, 2 ); (* now eventually scale and hint the glyph *) pts := @exec^.pts; pts^.n_points := n_points; exec^.pts.n_contours := n_contours; if load_flags and TT_Load_Scale_Glyph = 0 then begin (* no scaling, just copy the org arrays into the cur ones *) org_to_cur( n_points, pts ); end else begin (* first scale the glyph points *) for k := 0 to n_points-1 do with pts^ do org^[k].x := Scale_X( exec^.metrics, org^[k].x ); for k := 0 to n_points-1 do with pts^ do org^[k].y := Scale_Y( exec^.metrics, org^[k].y ); (* if hinting, round pp1, and shift the glyph accordingly *) if subg^.is_hinted then begin x := pts^.org^[n_points-2].x; x := ((x+32) and -64) - x; translate_array( n_points, pts^.org, x, 0 ); org_to_cur( n_points, pts ); (* set the advance width *) (* x := (Scale_X( exec^.metrics, subg^.advanceWidth )+32) and -64; with pts^ do cur_x^[n_points-1] := cur_x^[n_points-2]+x; *) with pts^ do cur^[n_points-1].x := (cur^[n_points-1].x+32) and -64; (* now consider hinting *) if (exec^.glyphSize > 0) then begin exec^.is_composite := False; if Context_Run( exec, load_flags and TT_Load_Debug <> 0 ) then goto Fail_Exec; end; end else org_to_cur( n_points, pts ); end; (* save glyph origin and advance points *) if not subg^.preserve_pps then begin subg^.pp1 := pts^.cur^[n_points-2]; subg^.pp2 := pts^.cur^[n_points-1]; end; Load_Simple_Glyph := Success; Fail: exit; Fail_File: error := TT_Err_File_Error; exit; Fail_Exec: error := exec^.error; exit; end; (******************************************************************* * * Function : Load_Composite_End * * ******************************************************************) function Load_Composite_End( n_points : Int; n_contours : Int; exec : PExec_Context; subg : PSubglyph_Record; debug : Boolean ) : TError; var pts : PGlyph_Zone; n_ins : Int; k : Int; phant1, phant2, x, y : TT_Pos; widths : PByte; label Fail, Fail_File, Fail_Exec; begin Load_Composite_End := Failure; 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; (* load the instructions *) {$IFDEF DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF} if n_ins > exec^.face^.maxProfile.maxSizeOfInstructions then begin {$IFDEF DEBUG} Writeln('Too many instructions'); {$ENDIF} error := TT_Err_Too_Many_Ins; goto Fail; end; end else n_ins := 0; if n_ins > 0 then with exec^ do begin if TT_Read_File( glyphIns^, n_ins ) then goto Fail_File; glyphSize := n_ins; if Set_CodeRange( exec, TT_CodeRange_Glyph, glyphIns, glyphSize ) then goto Fail_File; end; (* prepare the execution context *) inc( n_points, 2 ); exec^.pts := subg^.zone; pts := @exec^.pts; pts^.n_points := n_points; (* add phantom points *) with pts^ do begin cur^[n_points-2] := subg^.pp1; cur^[n_points-1] := subg^.pp2; flags^[n_points-2] := 0; flags^[n_points-1] := 0; end; (* if hinting, round the phantom points *) if subg^.is_hinted then begin y := ((subg^.pp1.x+32) and -64); pts^.cur^[n_points-2].y := y; x := ((subg^.pp2.x+32) and -64); pts^.cur^[n_points-1].x := x; end; for k := 0 to n_points-1 do pts^.flags^[k] := pts^.flags^[k] and TT_Flag_On_Curve; cur_to_org( n_points, pts ); (* now consider hinting *) if subg^.is_hinted and (n_ins > 0) then begin exec^.is_composite := true; if Context_Run( exec, debug ) then goto Fail_Exec; end; (* save glyph origin and advance points *) subg^.pp1 := pts^.cur^[n_points-2]; subg^.pp2 := pts^.cur^[n_points-1]; Load_Composite_End := Success; error := TT_Err_Ok; Fail: exit; Fail_File: error := TT_Err_File_Error; goto Fail; Fail_Exec: error := exec^.error; goto Fail; end; (******************************************************************* * * Function : Init_Glyph_Component * * ******************************************************************) procedure Init_Glyph_Component( element : PSubGlyph_Record; original : PSubGlyph_Record; exec : PExec_Context ); var n: Int; begin with element^ do begin index := -1; is_scaled := false; is_hinted := false; if original <> nil then mount_zone( original^.zone, zone ) else zone := exec^.pts; zone.n_contours := 0; zone.n_points := 0; arg1 := 0; arg2 := 0; element_flag := 0; preserve_pps := false; transform.xx := 1 shl 16; transform.xy := 0; transform.yx := 0; transform.yy := 1 shl 16; transform.ox := 0; transform.oy := 0; leftBearing := 0; advanceWidth := 0; end; end; function Load_TrueType_Glyph( instance : PInstance; glyph : PGlyph; glyph_index : Word; load_flags : Int ) : TError; type TPhases = ( Load_Exit, Load_Glyph, Load_Simple, Load_Composite, Load_End ); (* the composite loader is a simple automata wich states *) (* are defined by the TPhases enumeration *) var face : PFace; num_points : Int; num_contours : Int; left_points : Int; left_contours : Int; table, num_ins, index, load_top : Int; new_flags, k, l : Int; glyph_offset, offset : Long; c : Byte; vec, nvec : TT_Vector; xmin, xmax, ymin, ymax : TT_F26Dot6; xx, xy, yx, yy : TT_Fixed; exec : PExec_Context; stream : TT_Stream; subglyph, subglyph2 : PSubGlyph_Record; base_pts : TGlyph_Zone; phase : TPhases; debug : Boolean; leftSideBearing : TT_Pos; advanceWidth : TT_Pos; top_bearing : TT_Pos; advance_height : TT_Pos; error : TT_Error; delta : Long; widths : PByte; horizontal : TT_Horizontal_Header; label Fin, Fail, Fail_File, Fail_Handle, Fail_Index; begin Load_TrueType_Glyph := Failure; (* check handle *) if (instance = nil) or (instance^.owner = nil) then begin error := TT_Err_Invalid_Face_Handle; exit; end; face := instance^.owner; table := LookUp_TrueType_Table( face, 'glyf'); if table < 0 then begin {$IFDEF DEBUG} Trace1( 'TTApi.load_glyph : couldn''t find glyf table' ); {$ENDIF} error := TT_Err_Table_Missing; exit; end; glyph_offset := face^.dirTables^[table].Offset; (* query new execution context *) if instance^.debug then exec := instance^.context (* if debugging, use the pre-alloced context *) else exec := New_Context(instance); if exec = nil then begin error := TT_Err_Out_Of_Memory; exit; end; Context_Load( exec, instance ); if instance^.GS.instruct_control and 2 <> 0 then exec^.GS := Default_GraphicsState else exec^.GS := instance^.GS; glyph^.outline.high_precision := ( instance^.metrics.y_ppem < 24 ); glyph^.is_composite := false; (* save its critical pointers that will be modified *) (* during load *) base_pts := exec^.pts; (* init variables *) left_points := face^.maxPoints; left_contours := face^.maxContours; num_points := 0; num_contours := 0; load_top := 0; subglyph := @exec^.loadStack^[0]; Init_Glyph_Component( subglyph, nil, exec ); subglyph^.index := glyph_index; subglyph^.is_hinted := load_flags and TT_Load_Hint_Glyph <> 0; if instance^.GS.instruct_control and 1 <> 0 then subglyph^.is_hinted := False; (* now access stream *) if TT_Use_Stream( face^.stream, stream ) then goto Fin; (* Main Loading Loop *) phase := Load_Glyph; while phase <> Load_Exit do begin subglyph := @exec^.loadStack^[load_top]; case phase of (************************************************************) (* *) (* Load_Glyph state *) (* *) (* reading a glyph's generic header to determine *) (* wether it's simple or composite *) (* *) (* exit states : Load_Simple and Load_Composite *) (* *) Load_Glyph: begin (* check glyph index and table *) index := subglyph^.index; if (index < 0) or (index >= face^.numGlyphs) then begin error := TT_Err_Invalid_Glyph_Index; goto Fail; end; (* load glyph metrics *) Get_HMetrics( face, index, true, subglyph^.leftBearing, subglyph^.advanceWidth ); (* load glyph *) if (index+1 < face^.numLocations) and (face^.glyphLocations^[index] = face^.glyphLocations^[index+1]) then begin (* as noticed by Frederic Loyer, these are spaces, not *) (* the 'unknown' glyph *) num_points := 0; num_contours := 0; subglyph^.bbox.xMin := 0; subglyph^.bbox.xMax := 0; subglyph^.bbox.yMin := 0; subglyph^.bbox.yMax := 0; subglyph^.pp1.x := 0; subglyph^.pp2.x := subglyph^.advanceWidth; if load_flags and TT_LOAD_Scale_Glyph <> 0 then subglyph^.pp2.x := Scale_X( exec^.metrics, subglyph^.pp2.x ); exec^.glyphSize := 0; phase := Load_End; end else begin offset := glyph_offset + face^.glyphLocations^[index]; (* read first glyph header *) if TT_Seek_File( offset ) or TT_Access_Frame( 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; TT_Forget_Frame; {$IFDEF DEBUG} Writeln('Glyph ', i ); Writeln(' # of Contours : ',num_contours ); Writeln(' xMin : ',subglyph^.xMin:4,' xMax : ',subglyph^.xMax); Writeln(' yMin : ',subglyph^.yMin:4,' yMax : ',subglyph^.yMax); Writeln('-'); {$ENDIF} if num_contours > left_contours then begin {$IFDEF DEBUG} Writeln( 'ERROR: Glyph index ', i, ' has ', num_contours ); Writeln(' contours > left ', left_contours ); {$ENDIF} error := TT_Err_Too_Many_Contours; goto Fail; end; with subglyph^ do begin pp1.x := bbox.xMin - leftBearing; pp1.y := 0; pp2.x := pp1.x + advanceWidth; pp2.y := 0; if load_flags and TT_Load_Scale_Glyph <> 0 then begin pp1.x := Scale_X( exec^.metrics, pp1.x ); pp2.x := Scale_X( exec^.metrics, pp2.x ); end; end; (* is it a simple glyph ? *) if num_contours >= 0 then phase := Load_Simple else phase := Load_Composite; end end; (************************************************************) (* *) (* Load_Simple state *) (* *) (* reading a simple glyph (num_contours must be set to *) (* the glyph's number of contours..) *) (* *) (* exit states : Load_End *) (* *) Load_Simple : begin new_flags := load_flags; if not subglyph^.is_hinted then new_flags := new_flags and not TT_Load_Hint_Glyph; (* disable hinting when scaling *) if new_flags and TT_Load_Debug <> 0 then if load_top > 0 then new_flags := new_flags and not TT_Load_Debug; if Load_Simple_Glyph( exec, stream, num_contours, left_contours, left_points, new_flags, subglyph ) then goto Fail; num_points := exec^.pts.n_points-2; phase := Load_End; end; (************************************************************) (* *) (* Load_Composite state *) (* *) (* reading a composite glyph header a pushing a new *) (* load element on the stack.. *) (* *) (* exit states : Load_Glyph *) (* *) Load_Composite : begin glyph^.is_composite := true; (* create a new element *) inc( load_top ); if load_top > face^.maxComponents then begin error := TT_Err_Invalid_Composite; goto Fail; end; subglyph2 := @exec^.loadStack^[load_top]; Init_Glyph_Component( subglyph2, subglyph, nil ); subglyph2^.index := -1; subglyph2^.is_hinted := subglyph^.is_hinted; (* now read composite header *) if TT_Access_Frame( 4 ) then goto Fail_File; new_flags := Get_UShort; subglyph^.element_flag := new_flags; subglyph2^.index := Get_UShort; TT_Forget_Frame; k := 2; if new_flags and ARGS_ARE_WORDS <> 0 then inc( k, 2 ); if new_flags and WE_HAVE_A_SCALE <> 0 then inc( k, 2 ); if new_flags and WE_HAVE_AN_XY_SCALE <> 0 then inc( k, 4 ); if new_flags and WE_HAVE_A_2X2 <> 0 then inc( k, 8 ); if TT_Access_Frame( k ) then goto Fail_File; if new_flags and ARGS_ARE_WORDS <> 0 then begin k := Get_Short; l := Get_Short; end else begin k := Get_Byte; l := Get_Byte; end; subglyph^.arg1 := k; subglyph^.arg2 := l; if new_flags and ARGS_ARE_XY_VALUES <> 0 then begin subglyph^.transform.ox := k; subglyph^.transform.oy := l; end; xx := 1 shl 16; xy := 0; yx := 0; yy := 1 shl 16; if new_flags and WE_HAVE_A_SCALE <> 0 then begin xx := Long(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; 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; subglyph2^.is_scaled := true; end; subglyph^.transform.xx := xx; subglyph^.transform.xy := xy; subglyph^.transform.yx := yx; subglyph^.transform.yy := yy; delta := MulDiv_Round( xx, yy, 1 shl 16 ) - MulDiv_Round( xy, yx, 1 shl 16 ); if abs(delta) <> 1 shl 16 then subglyph2^.is_hinted := false; TT_Forget_Frame; subglyph^.file_offset := TT_File_Pos; phase := Load_Glyph; end; (************************************************************) (* *) (* Load_End state *) (* *) (* after loading a glyph, apply transform and offset *) (* where necessary, pops element and continue or *) (* stop process.. *) (* *) (* exit states : Load_Composite and Load_Exit *) (* *) Load_End : if load_top > 0 then begin subglyph2 := subglyph; dec( load_top ); subglyph := @exec^.loadStack^[load_top]; (* check advance width and left side bearing *) if not subglyph^.preserve_pps and (subglyph^.element_flag and USE_MY_METRICS <> 0) then begin subglyph^.leftBearing := subglyph2^.leftBearing; subglyph^.advanceWidth := subglyph2^.advanceWidth; subglyph^.pp1 := subglyph2^.pp1; subglyph^.pp2 := subglyph2^.pp2; subglyph^.preserve_pps := true; end; (* apply scale/symmetry/rotation/wathever *) for k := 0 to num_points-1 do with subglyph^ do begin vec := subglyph2^.zone.cur^[k]; nvec.x := MulDiv_Round( vec.x, transform.xx, 1 shl 16 ) + MulDiv_Round( vec.y, transform.yx, 1 shl 16 ); nvec.y := MulDiv_Round( vec.x, transform.xy, 1 shl 16 ) + MulDiv_Round( vec.y, transform.yy, 1 shl 16 ); subglyph2^.zone.cur^[k] := nvec; vec := subglyph2^.zone.org^[k]; nvec.x := MulDiv_Round( vec.x, transform.xx, 1 shl 16 ) + MulDiv_Round( vec.y, transform.yx, 1 shl 16 ); nvec.y := MulDiv_Round( vec.x, transform.xy, 1 shl 16 ) + MulDiv_Round( vec.y, transform.yy, 1 shl 16 ); subglyph2^.zone.org^[k] := nvec; end; (* adjust counts *) for k := 0 to num_contours-1 do inc( subglyph2^.zone.conEnds^[k], subglyph^.zone.n_points ); inc( subglyph^.zone.n_points, num_points ); inc( subglyph^.zone.n_contours, num_contours ); dec( left_points, num_points ); dec( left_contours, num_contours ); (* apply offset *) if subglyph^.element_flag and ARGS_ARE_XY_VALUES = 0 then begin k := subglyph^.arg1; l := subglyph^.arg2; if (k < 0) or (k >= subglyph^.zone.n_points ) or (l < 0) or (l >= num_points) then begin error := TT_Err_Invalid_Composite; goto Fail; end; inc( l, subglyph^.zone.n_points ); vec.x := subglyph^.zone.cur^[k].x - subglyph^.zone.cur^[l].x; vec.y := subglyph^.zone.cur^[k].y - subglyph^.zone.cur^[l].y; end else begin vec.x := subglyph^.transform.ox; vec.y := subglyph^.transform.oy; if load_flags and TT_Load_Scale_Glyph <> 0 then begin vec.x := Scale_X( exec^.metrics, vec.x ); vec.y := Scale_Y( exec^.metrics, vec.y ); if subglyph^.element_flag and ROUND_XY_TO_GRID <> 0 then begin vec.x := (vec.x+32) and -64; vec.y := (vec.y+32) and -64; end; end end; translate_array( num_points, subglyph2^.zone.cur, vec.x, vec.y ); cur_to_org( num_points, @subglyph2^.zone ); num_points := subglyph^.zone.n_points; num_contours := subglyph^.zone.n_contours; (* check for last component *) if TT_Seek_File( subglyph^.file_offset ) then goto Fail_File; if subglyph^.element_flag and MORE_COMPONENTS <> 0 then phase := Load_Composite else begin debug := ( load_top = 0 ) and ( load_flags and TT_Load_Debug <> 0 ); if Load_Composite_End( num_points, num_contours, exec, subglyph, debug ) then goto Fail; phase := Load_End; end; end else phase := Load_Exit; end; end; (* finally, copy the points arrays to the glyph object *) exec^.pts := base_pts; (* copy also the phantom points, the debugger needs them *) inc( num_points, 2 ); for k := 0 to num_points-1 do with glyph^.outline do begin points^[k] := exec^.pts.cur^[k]; flags ^[k] := exec^.pts.flags^[k]; end; for k := 0 to num_contours-1 do with glyph^.outline do conEnds^[k] := exec^.pts.conEnds^[k]; glyph^.outline.n_points := num_points; glyph^.outline.n_contours := num_contours; glyph^.outline.second_pass := true; TT_Get_Outline_BBox( glyph^.outline, glyph^.metrics.bbox ); glyph^.metrics.horiBearingX := glyph^.metrics.bbox.xMin - subglyph^.pp1.x; glyph^.metrics.horiBearingY := glyph^.metrics.bbox.yMax; glyph^.metrics.horiAdvance := subglyph^.pp2.x - subglyph^.pp1.x; glyph^.computed_width := glyph^.metrics.horiAdvance; glyph^.precalc_width := -1; (* Now take care of vertical metrics. In the case where there is *) (* no vertical information within the font (which is relatively *) (* common), make up some metrics "by hand".. *) (* *) begin (* get the unscaled "tsb" and "ah" *) (* don't assume that both the vertical header and metrics are *) (* present in a font file... *) if face^.verticalInfo and ( face^.verticalHeader.number_Of_VMetrics > 0 ) then begin (* apparently, the following line isn't accepted by the FreePascal *) (* compiler. It complains because the typecast occurs on a 'var' *) (* parameter. Don't know if this is compiler bug or not, but I *) (* changed the code with some stupid copy trick.. *) (* *) (* TT_Get_Metrics( TT_Horizontal_Header(face^.verticalHeader), *) (* glyph_index, *) (* top_bearing, *) (* advance_height ); *) (* *) horizontal := TT_Horizontal_Header(face^.verticalHeader); TT_Get_Metrics( horizontal, glyph_index, top_bearing, advance_height ); end else begin (* Make up the distances from the horizontal header.. *) (* *) (* The typographic values are the only portable ones, which *) (* is why we use them.. *) (* *) (* The sTypoDescender field is always negative, unlike the *) (* Windows Descender.. *) (* *) with face^.os2 do begin top_bearing := sTypoLineGap div 2; advance_height := sTypoAscender - sTypoDescender + sTypoLineGap; end; end; (* now scale the metrics *) if load_flags and TT_Load_Scale_Glyph <> 0 then begin top_bearing := Scale_Y( exec^.metrics, top_bearing ); advance_height := Scale_Y( exec^.metrics, advance_height ); end; with glyph^.metrics do begin vertBearingX := ( bbox.xMin - bbox.xMax ) div 2; vertBearingY := top_bearing; vertAdvance := advance_height; if load_flags and TT_Load_Hint_Glyph <> 0 then begin vertBearingX := vertBearingX and -64; vertBearingY := (vertBearingY + 63) and -64; vertAdvance := (vertAdvance+32) and -64; end; end; end; (* use hdmx table to adjust advance width as necessary *) if load_flags and TT_Load_Default = TT_Load_Default then begin widths := Get_Advance_Widths( exec^.face, exec^.instance^.metrics.x_ppem ); if widths <> nil then begin glyph^.metrics.horiAdvance := widths^[glyph_index]*64; glyph^.precalc_width := glyph^.metrics.horiAdvance; end; end; (* in case of hinting, shift the glyph so that (0,0) corresponds *) (* to the glyph origin. *) if subglyph^.is_hinted then begin glyph^.metrics.horiBearingX := (glyph^.metrics.bbox.xMin and -64) - subglyph^.pp1.x; glyph^.metrics.horiAdvance := (glyph^.metrics.horiAdvance+32) and -64; glyph^.computed_width := (glyph^.computed_width+32) and -64; translate_array( num_points, glyph^.outline.points, -subglyph^.pp1.x, 0 ); end; glyph^.outline.dropout_mode := exec^.GS.scan_type; Load_TrueType_Glyph := Success; Fail: TT_Done_Stream( stream ); Fin: (* reset the execution context *) exec^.pts := base_pts; if instance^.debug then begin exec^.pts.n_points := num_points; exec^.pts.n_contours := num_contours; end else Done_Context( exec); exit; Fail_File: error := TT_Err_File_Error; goto Fail; Fail_Handle: error := TT_Err_Invalid_Instance_Handle; exit; Fail_Index: error := TT_Err_Invalid_Glyph_Index; exit; end; end.