Unit TTGLoad;

interface

{$I TTCONFIG.INC}

uses
  FreeType, TTError, TTTypes, TTObjs;

  function  Load_TrueType_Glyph( instance    : PInstance;
                                 glyph       : PGlyph;
                                 glyph_index : Int;
                                 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.     *)

 procedure Get_HMetrics( face     : PFace;
                         index    : Int;
                         check    : Boolean;
                         var  lsb : Int;
                         var  aw  : Int );

 function  Get_Advance_Widths( face : PFace;
                               ppem : Int    ) : PByte;

implementation

uses
  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;


 procedure Get_HMetrics( face     : PFace;
                         index    : Int;
                         check    : Boolean;
                         var  lsb : Int;
                         var  aw  : Int );
 var
   k : Int;
 begin
   k := face^.horizontalHeader.number_Of_HMetrics;

   if index < k then
     begin
       lsb := face^.LongHMetrics^[index].lsb;
       aw  := face^.LongHMetrics^[index].advance_Width;
     end
   else
     begin
       lsb := face^.ShortMetrics^[index-k];
       aw  := face^.LongHMetrics^[k-1].advance_Width;
     end;

   if check and (face^.postscript.isFixedPitch <> 0) then
     aw := face^.horizontalHeader.advance_Width_Max;
 end;



 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;



 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
   k, n_points, n_ins : Int;

   c, cnt : Byte;

   face : PFace;

   xs, ys : TT_PCoordinates;
   flag   : TT_PTouchTable;

   x, y, xmin, xmax, ymin, ymax : TT_F26dot6;

   pts  : PGlyph_Zone;

   leftSideBearing : Int;
   advanceWidth    : Int;
 label
   Fail, Fail_File, Fail_Exec;
 begin
   Load_Simple_Glyph := Failure;

   face := exec^.owner;

   (* 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 *)

   exec^.pts.n_points := 0;
   exec^.pts.org_x    := @subg^.org_x^[subg^.n_points];
   exec^.pts.org_y    := @subg^.org_y^[subg^.n_points];
   exec^.pts.cur_x    := @subg^.cur_x^[subg^.n_points];
   exec^.pts.cur_y    := @subg^.cur_y^[subg^.n_points];
   exec^.pts.touch    := @subg^.flag^ [subg^.n_points];

   exec^.pts.n_contours := 0;
   exec^.pts.contours   := @subg^.contours^[subg^.n_contours];

   (* 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.contours^[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.touch;

   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;
   xmin := 0;
   xmax := 0;
   xs   := exec^.pts.org_x;

   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 );

     xs^[k] := x;

     if x < xmin then xmin := x;
     if x > xmax then xmax := x;
   end;

   (* Read the Y *)

   y    := 0;
   ymin := 0;
   ymax := 0;
   ys   := exec^.pts.org_y;

   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 );

     ys^[k] := y;

     if y < ymin then ymin := y;
     if y > ymax then ymax := 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 *)

   Get_HMetrics( face, subg^.index, false, leftSideBearing, advanceWidth );

   subg^.leftSideBearing := leftSideBearing;
   subg^.advanceWidth    := advanceWidth;

   xs^[n_points] := subg^.xMin - leftSideBearing;
   ys^[n_points] := 0;
   (* pp1 = xMin - lsb *)

   xs^[n_points+1] := subg^.xMin - leftSideBearing + advanceWidth;
   ys^[n_points+1] := 0;
   (* pp2 = pp1 + aw *)

   for k := 0 to n_points-1 do
     exec^.pts.touch^[k] := exec^.pts.touch^[k] and TT_Flag_On_Curve;

   exec^.pts.touch^[n_points  ] := 0;
   exec^.pts.touch^[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 *)

       for k := 0 to n_points-1 do with pts^ do
       begin
         cur_x^[k] := org_x^[k];
         cur_y^[k] := org_y^[k];
       end

     end
   else
     begin

       (* first scale the glyph points *)

       for k := 0 to n_points-1 do with pts^ do
       begin
         x := MulDiv_Round( org_x^[k],
                            exec^.metrics.x_scale1,
                            exec^.metrics.y_scale2 );

         y := MulDiv_Round( org_y^[k],
                            exec^.metrics.y_scale1,
                            exec^.metrics.y_scale2 );
         org_x^[k] := x;
         org_y^[k] := y;
         cur_x^[k] := x;
         cur_y^[k] := y;

         touch^[k] := touch^[k] and 1;
       end;

       leftSideBearing := MulDiv_Round( leftSideBearing,
                                        exec^.metrics.x_scale1,
                                        exec^.metrics.x_scale2 );

       advanceWidth := MulDiv_Round( advanceWidth,
                                     exec^.metrics.x_scale1,
                                     exec^.metrics.x_scale2 );

       x := pts^.cur_x^[n_points-2];
       y := pts^.cur_x^[n_points-1];

       if x >= 0 then x := (x) and -64
                 else x := -((-x) and -64);

       y := ( y+32 ) and -64;

       pts^.cur_x^[n_points-2] := x;
       pts^.cur_x^[n_points-1] := y;

       subg^.leftSideBearing := leftSideBearing;
       subg^.advanceWidth    := advanceWidth;

       (* now consider hinting *)

       if subg^.is_hinted and (exec^.glyphSize > 0) then
         if Context_Run( exec, load_flags and TT_Load_Debug <> 0 ) then
           goto Fail_Exec;

       if exec^.owner^.postscript.isFixedPitch = 0 then
         subg^.advanceWidth := pts^.cur_x^[n_points-1] -
                               pts^.cur_x^[n_points-2]
       else
         subg^.advanceWidth := MulDiv_Round(
             exec^.owner^.horizontalHeader.advance_Width_Max,
             exec^.metrics.x_scale1,
             exec^.metrics.x_scale2 );

     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_Instructions( n_points   : Int;
                                        n_contours : Int;
                                        exec       : PExec_Context;
                                        subg       : PSubglyph_Record;
                                        debug      : Boolean ) : TError;
 var
   pts   : PGlyph_Zone;
   n_ins : Int;
   k     : Int;

   x, y, xmin, xmax, ymin, ymax : TT_F26dot6;
   widths : PByte;

 label
   Fail, Fail_File, Fail_Exec;
 begin
   Load_Composite_Instructions := Failure;

   if TT_Access_Frame(2) then
     goto Fail_File;

   n_ins := Get_UShort;

   TT_Forget_Frame;

   if n_ins > 0 then
   begin

     (* load the instructions *)

     {$IFDEF DEBUG}
     Writeln('Instructions size : ', n_ins);
     {$ENDIF}

     if n_ins > exec^.owner^.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_File;
     end;

     (* prepare the execution context *)

     exec^.pts.n_points := n_points + 2;
     exec^.pts.org_x    := subg^.org_x;
     exec^.pts.org_y    := subg^.org_y;
     exec^.pts.cur_x    := subg^.cur_x;
     exec^.pts.cur_y    := subg^.cur_y;
     exec^.pts.touch    := subg^.flag;

     exec^.pts.n_contours := n_contours;
     exec^.pts.contours   := subg^.contours;

     pts := @exec^.pts;

     (* add phantom points *)

     pts^.cur_x^[n_points] := (subg^.xMin - subg^.leftSideBearing);
     pts^.cur_y^[n_points] := 0;
     (* pp1 = xMin - lsb *)

     pts^.cur_x^[n_points+1] := (subg^.xMin - subg^.leftSideBearing +
                                 subg^.advanceWidth);
     pts^.cur_y^[n_points+1] := 0;
     (* pp2 = pp1 + aw *)

     for k := 0 to n_points+1 do
     begin
       pts^.org_x^[k] := pts^.cur_x^[k];
       pts^.org_y^[k] := pts^.cur_y^[k];
       pts^.touch^[k] := pts^.touch^[k] and TT_Flag_On_Curve;
     end;

     (* now consider hinting *)

     if subg^.is_hinted and (exec^.glyphSize > 0) then
       if Context_Run( exec, debug ) then
         goto Fail_Exec;

   end;

   Load_Composite_Instructions := 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    :  Load_TrueType_Glyph
 *
 *  Description :  Load a given glyph in an instance record
 *
 *  Input  :  aInstance   target instance table
 *            aIndex      glyph index
 *
 *  Output :  True on success. False on failure
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 *
 ******************************************************************)


 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;

     n_contours := 0;
     n_points   := 0;

     if original <> nil then
       begin
         n := original^.n_points;

         org_x := @original^.org_x^[n];
         org_y := @original^.org_y^[n];
         cur_x := @original^.cur_x^[n];
         cur_y := @original^.cur_y^[n];
         flag  := @original^.flag^[n];

         n := original^.n_contours;
         contours := @original^.contours^[n];
       end
     else
       begin
         org_x := exec^.pts.org_x;
         org_y := exec^.pts.org_y;
         cur_x := exec^.pts.cur_x;
         cur_y := exec^.pts.cur_y;
         flag  := exec^.pts.touch;

         contours := exec^.pts.contours;
       end;

     arg1 := 0;
     arg2 := 0;

     element_flag := 0;

     transform.xx := 1 shl 16;
     transform.xy := 0;
     transform.yx := 0;
     transform.yy := 1 shl 16;

     transform.ox := 0;
     transform.oy := 0;

     leftSideBearing := 0;
     advanceWidth    := 0;

   end;
 end;


 function  Load_TrueType_Glyph( instance    : PInstance;
                                glyph       : PGlyph;
                                glyph_index : Int;
                                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;

   x, y, nx, ny : TT_F26dot6;

   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_F26dot6;
   advanceWidth    : TT_F26dot6;

   error : TT_Error;

   delta : Long;

   widths : PByte;
 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(face);

   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^.high_precision := ( instance^.metrics.y_ppem < 24 );

   (* 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, k, l );

           if load_flags and TT_Load_Scale_Glyph <> 0 then
             begin
               k := MulDiv_Round( k,
                                  exec^.metrics.x_scale1,
                                  exec^.metrics.x_scale2 );

               l := MulDiv_Round( l,
                                  exec^.metrics.x_scale1,
                                  exec^.metrics.x_scale2 );
             end;

           subglyph^.leftSideBearing := k;
           subglyph^.advanceWidth    := l;

           (* 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^.xMin := 0;
               subglyph^.xMax := 0;
               subglyph^.yMin := 0;
               subglyph^.yMax := 0;

               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^.xMin := GET_Short;
               subglyph^.yMin := GET_Short;
               subglyph^.xMax := GET_Short;
               subglyph^.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;

               (* 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
           (* create a new element *)

           inc( load_top );

           if load_top > face^.maxProfile.maxComponentDepth 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
               l := Get_UShort;

               k := ShortInt( l shr 8 );
               l := ShortInt( l and $FF );
             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 (subglyph^.element_flag and USE_MY_METRICS <> 0) or
                (subglyph^.advanceWidth = 0) then
             begin
               subglyph^.leftSideBearing := subglyph2^.leftSideBearing;
               subglyph^.advanceWidth    := subglyph2^.advanceWidth;
             end;

             (* apply scale *)

             if subglyph2^.is_scaled then
             begin

               for k := 0 to num_points-1 do
               begin
                 x := subglyph2^.cur_x^[k];
                 y := subglyph2^.cur_y^[k];

                 nx := MulDiv_Round( x, subglyph^.transform.xx, 1 shl 16 ) +
                       MulDiv_Round( y, subglyph^.transform.yx, 1 shl 16 );

                 ny := MulDiv_Round( x, subglyph^.transform.xy, 1 shl 16 ) +
                       MulDiv_Round( y, subglyph^.transform.yy, 1 shl 16 );

                 subglyph2^.cur_x^[k] := nx;
                 subglyph2^.cur_y^[k] := ny;

                 x := subglyph2^.org_x^[k];
                 y := subglyph2^.org_y^[k];

                 nx := MulDiv_Round( x, subglyph^.transform.xx, 1 shl 16 ) +
                       MulDiv_Round( y, subglyph^.transform.yx, 1 shl 16 );

                 ny := MulDiv_Round( x, subglyph^.transform.xy, 1 shl 16 ) +
                       MulDiv_Round( y, subglyph^.transform.yy, 1 shl 16 );

                 subglyph2^.org_x^[k] := nx;
                 subglyph2^.org_y^[k] := ny;
               end;
             end;

             (* adjust counts *)

             for k := 0 to num_contours-1 do
               inc( subglyph2^.contours^[k], subglyph^.n_points );

             inc( subglyph^.n_points, num_points );
             inc( subglyph^.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^.n_points ) or
                  (l < 0) or (l >= subglyph2^.n_points) then
                 begin
                   error := TT_Err_Invalid_Composite;
                   goto Fail;
                 end;

               subglyph^.transform.ox := subglyph2^.org_x^[l] -
                                         subglyph^.org_x^[k];

               subglyph^.transform.oy := subglyph2^.org_y^[l] -
                                         subglyph^.org_y^[k];
             end;

             x := subglyph^.transform.ox;
             y := subglyph^.transform.oy;

             if load_flags and TT_Load_Scale_Glyph <> 0 then
             begin
               x := MulDiv_Round( x,
                                  exec^.metrics.x_Scale1,
                                  exec^.metrics.x_Scale2 );

               y := MulDiv_Round( y,
                                  exec^.metrics.y_Scale1,
                                  exec^.metrics.y_Scale2 );
             end;


            (* XXX : Undocumented or bug ? The font goudy.ttf uses a simple *)
            (*       symetry transform, and no corrective translation. We   *)
            (*       detect these cases and do the adjustements ourselves.. *)

               if subglyph^.element_flag and ARGS_ARE_XY_VALUES <> 0 then
               begin

                 if (subglyph^.transform.ox = 0) and
                    (subglyph^.transform.xx = -$10000) then
                  begin
                    xmax := subglyph2^.cur_x^[0];
                    xmin := xmax;
                    for k := 1 to num_points-1 do
                    begin
                      x := subglyph2^.cur_x^[k];
                      if xmax < x then xmax := x;
                      if xmin > x then xmin := x;
                    end;
                    x := -(xmin+xmax);
                  end;

                 if (subglyph^.transform.oy = 0) and
                    (subglyph^.transform.yy = -$10000) then
                   begin
                     ymax := subglyph2^.cur_y^[0];
                     ymin := ymax;
                     for k := 1 to num_points-1 do
                     begin
                       y := subglyph2^.cur_x^[k];
                       if ymax < y then ymax := y;
                       if ymin > y then ymin := y;
                     end;
                     y := -(ymin+ymax);
                   end;
               end;


             if (subglyph^.element_flag and ARGS_ARE_XY_VALUES <> 0 ) and
                (subglyph^.element_flag and ROUND_XY_TO_GRID <> 0) then
             begin

               if x >= 0 then x := (x+32) and -64
                         else x := -((32-x) and -64);

               if y >= 0 then y := (y+32) and -64
                         else y := -((32-y) and -64);
             end;

             for k := 0 to num_points-1 do
             begin
               inc( subglyph2^.org_x^[k], x );
               inc( subglyph2^.org_y^[k], y );
               inc( subglyph2^.cur_x^[k], x );
               inc( subglyph2^.cur_y^[k], y );
             end;

             num_points   := subglyph^.n_points;
             num_contours := subglyph^.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

                 if subglyph^.is_hinted and
                    (subglyph^.element_flag and WE_HAVE_INSTR <> 0) then
                 begin
                   debug := ( load_top = 0 ) and
                            ( load_flags and TT_Load_Debug <> 0 );

                   if Load_Composite_Instructions( num_points,
                                                   num_contours,
                                                   exec,
                                                   subglyph,
                                                   debug ) then
                     goto Fail;
                 end;

                 phase := Load_End;
               end;

           end
         else
           phase := Load_Exit;

     end;
   end;

   (* finally, copy the points arrays to the glyph object *)

   exec^.pts := base_pts;

   if num_points > 0 then
   begin
     xmin := exec^.pts.cur_x^[0];
     xmax := xmin;
     ymin := exec^.pts.cur_y^[0];
     ymax := ymin;

     for k := 1 to num_points-1 do
     begin
       x := exec^.pts.cur_x^[k];
       if x < xmin then xmin := x;
       if x > xmax then xmax := x;
       y := exec^.pts.cur_y^[k];
       if y < ymin then ymin := y;
       if y > ymax then ymax := y;
     end;
     subglyph^.xMin := xmin;
     subglyph^.xMax := xmax;
     subglyph^.yMin := ymin;
     subglyph^.yMax := ymax;
   end;

   inc( num_points, 2 );

   for k := 0 to num_points-1 do with glyph^, exec^.pts do
   begin
     x_coord^[k] := cur_x^[k];
     y_coord^[k] := cur_y^[k];
     glyph^.touch^[k] := exec^.pts.touch^[k];
   end;

   for k := 0 to num_contours-1 do
     glyph^.endContours^[k] := exec^.pts.contours^[k];

   glyph^.num_points   := num_points;
   glyph^.num_contours := num_contours;

   glyph^.leftSideBearing := subglyph^.leftSideBearing;
   glyph^.advanceWidth    := subglyph^.advanceWidth;

   (* 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^.owner,
                                   exec^.instance^.metrics.x_ppem );

     if widths <> nil then
       glyph^.advanceWidth := widths^[glyph_index]*64;
   end;

   glyph^.scan_type := exec^.GS.scan_type;

   glyph^.xMin := subglyph^.xMin;
   glyph^.yMin := subglyph^.yMin;
   glyph^.xMax := subglyph^.xMax;
   glyph^.yMax := subglyph^.yMax;

   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.
