← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/vnc4/gutsy

« back to all changes in this revision

Viewing changes to unix/xc/extras/FreeType/pascal/lib/ttgload.pas

  • Committer: Bazaar Package Importer
  • Author(s): Ola Lundqvist
  • Date: 2006-05-15 20:35:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060515203517-l4lre1ku942mn26k
Tags: 4.1.1+X4.3.0-10
* Correction of critical security issue. Thanks to Martin Kogler
  <e9925248@student.tuwien.ac.at> that informed me about the issue,
  and provided the patch.
  This flaw was originally found by Steve Wiseman of intelliadmin.com.
* Applied patch from Javier Kohen <jkohen@users.sourceforge.net> that
  inform the user that only 8 first characters of the password will
  actually be used when typing more than 8 characters, closes:
  #355619.

Show diffs side-by-side

added added

removed removed

Lines of Context:
unix/xc/extras/FreeType/pascal/lib/ttgload.pas
 
1
(*******************************************************************
 
2
 *
 
3
 *  ttgload.pas                                                  1.0
 
4
 *
 
5
 *    TrueType glyph loader
 
6
 *
 
7
 *  Copyright 1996, 1997 by
 
8
 *  David Turner, Robert Wilhelm, and Werner Lemberg.
 
9
 *
 
10
 *  This file is part of the FreeType project, and may only be used
 
11
 *  modified and distributed under the terms of the FreeType project
 
12
 *  license, LICENSE.TXT. By continuing to use, modify or distribute
 
13
 *  this file you indicate that you have read the license and
 
14
 *  understand and accept it fully.
 
15
 *
 
16
 ******************************************************************)
 
17
 
 
18
Unit TTGLoad;
 
19
 
 
20
interface
 
21
 
 
22
{$I TTCONFIG.INC}
 
23
 
 
24
uses
 
25
  FreeType, TTError, TTTypes, TTObjs;
 
26
 
 
27
  function  Load_TrueType_Glyph( instance    : PInstance;
 
28
                                 glyph       : PGlyph;
 
29
                                 glyph_index : Word;
 
30
                                 load_flags  : Int     ) : TError;
 
31
  (* loads a font glyph into a given glyph info. The instance and  *)
 
32
  (* glyph objects faces _must_ match. The load_flags indicates    *)
 
33
  (* what kind of values should be written to the glyph object     *)
 
34
  (* ( metrics, outline in EM coordinates, grid-fitted outline.. ) *)
 
35
  (*                                                               *)
 
36
  (* by default ( i.e. with load_flags = 0 ), this function only   *)
 
37
  (* returns the unscaled glyph metrics and points in EM units.    *)
 
38
  (*                                                               *)
 
39
  (* Use the following flags to query scaling and hinting ops.     *)
 
40
 
 
41
 (********************************************************)
 
42
 (* return horizontal or vertical metrics in font units  *)
 
43
 (* for a given glyph. The metrics are the left side     *)
 
44
 (* bearing [resp. top side bearing] and advance width   *)
 
45
 (* [resp. advance height].                              *)
 
46
 (*                                                      *)
 
47
 (* This function may move later to another component..  *)
 
48
 (*                                                      *)
 
49
 procedure TT_Get_Metrics( var header  : TT_Horizontal_Header;
 
50
                           index       : Int;
 
51
                           var bearing : TT_Pos;
 
52
                           var advance : TT_Pos );
 
53
 
 
54
 function  Get_Advance_Widths( face : PFace;
 
55
                               ppem : Int    ) : PByte;
 
56
 
 
57
implementation
 
58
 
 
59
uses
 
60
  TTTables,
 
61
  TTCalc,
 
62
  TTMemory,
 
63
  TTFile,
 
64
  TTInterp,
 
65
  TTLoad;
 
66
 
 
67
const
 
68
  ARGS_ARE_WORDS      = $01;
 
69
  ARGS_ARE_XY_VALUES  = $02;
 
70
  ROUND_XY_TO_GRID    = $04;
 
71
  WE_HAVE_A_SCALE     = $08;
 
72
  (* reserved           $10 *)
 
73
  MORE_COMPONENTS     = $20;
 
74
  WE_HAVE_AN_XY_SCALE = $40;
 
75
  WE_HAVE_A_2X2       = $80;
 
76
  WE_HAVE_INSTR       = $100;
 
77
  USE_MY_METRICS      = $200;
 
78
 
 
79
 
 
80
 (********************************************************)
 
81
 (* return horizontal or vertical metrics in font units  *)
 
82
 (* for a given glyph. The metrics are the left side     *)
 
83
 (* bearing [resp. top side bearing] and advance width   *)
 
84
 (* [resp. advance height].                              *)
 
85
 (*                                                      *)
 
86
 (* This function may move later to another component..  *)
 
87
 (*                                                      *)
 
88
 procedure TT_Get_Metrics( var header  : TT_Horizontal_Header;
 
89
                           index       : Int;
 
90
                           var bearing : TT_Pos;
 
91
                           var advance : TT_Pos );
 
92
 var
 
93
   k     : Int;
 
94
   longs : PTableLongMetrics;
 
95
 begin
 
96
   k := header.number_Of_HMetrics;
 
97
 
 
98
   if index < k then
 
99
     begin
 
100
       longs   := PTableLongMetrics(header.long_metrics);
 
101
       bearing := longs^[index].bearing;
 
102
       advance := longs^[index].advance;
 
103
     end
 
104
   else
 
105
     begin
 
106
       bearing := PTableShortMetrics(header.short_metrics)^[index-k];
 
107
       advance := PTableLongMetrics(header.long_metrics)^[k-1].advance;
 
108
     end;
 
109
 end;
 
110
 
 
111
 
 
112
 
 
113
 (********************************************************)
 
114
 (* return horizontal metrics in font units for a        *)
 
115
 (* given glyph. if "check" is true, take care of        *)
 
116
 (* mono-spaced fonts by returning the aw max.           *)
 
117
 (*                                                      *)
 
118
 procedure Get_HMetrics( face     : PFace;
 
119
                         index    : Int;
 
120
                         check    : Boolean;
 
121
                         var  lsb : Int;
 
122
                         var  aw  : Int );
 
123
 var
 
124
   left_bearing, advance : TT_Pos;
 
125
 begin
 
126
   TT_Get_Metrics( face^.horizontalHeader, index, left_bearing, advance );
 
127
 
 
128
   lsb := Int(left_bearing);
 
129
   aw  := Int(advance);
 
130
 
 
131
   if check and (face^.postscript.isFixedPitch <> 0) then
 
132
     aw := face^.horizontalHeader.advance_Width_Max;
 
133
 end;
 
134
 
 
135
 
 
136
 
 
137
 (********************************************************)
 
138
 (* return advance width table for a given pixel size    *)
 
139
 (* if it is found in the font's "hdmx" table (if any)   *)
 
140
 (*                                                      *)
 
141
 function Get_Advance_Widths( face  : PFace;
 
142
                              ppem  : Int    ) : PByte;
 
143
 var
 
144
   n : Integer;
 
145
 begin
 
146
   with face^.hdmx do
 
147
     for n := 0 to num_records-1 do
 
148
       if records^[n].ppem = ppem then
 
149
       begin
 
150
         Get_Advance_Widths := records^[n].widths;
 
151
         exit;
 
152
       end;
 
153
 
 
154
   Get_Advance_Widths := nil;
 
155
 end;
 
156
 
 
157
 (********************************************************)
 
158
 (* copy current glyph into original one                 *)
 
159
 (*                                                      *)
 
160
 procedure  cur_to_org( n   : int;
 
161
                        pts : PGlyph_Zone );
 
162
 var
 
163
   k : int;
 
164
 begin
 
165
   for k := 0 to n-1 do with pts^ do
 
166
     org^[k] := cur^[k];
 
167
 end;
 
168
 
 
169
 
 
170
 (********************************************************)
 
171
 (* copy original glyph into current one                 *)
 
172
 (*                                                      *)
 
173
 procedure  org_to_cur( n   : int;
 
174
                        pts : PGlyph_Zone );
 
175
 var
 
176
   k : int;
 
177
 begin
 
178
   for k := 0 to n-1 do with pts^ do
 
179
     cur^[k] := org^[k];
 
180
 end;
 
181
 
 
182
 (********************************************************)
 
183
 (* translate an array of coordinates                    *)
 
184
 (*                                                      *)
 
185
 procedure  translate_array( n      : int;
 
186
                             coords : TT_Points;
 
187
                             dx, dy : TT_Pos );
 
188
 var
 
189
   k : Int;
 
190
 begin
 
191
   if dx <> 0 then
 
192
     for k := 0 to n-1 do inc( coords^[k].x, dx );
 
193
   if dy <> 0 then
 
194
     for k := 0 to n-1 do inc( coords^[k].y, dy );
 
195
 end;
 
196
 
 
197
 (********************************************************)
 
198
 (* mount one zone on top of another one                 *)
 
199
 (*                                                      *)
 
200
 procedure  mount_zone( var source : TGlyph_Zone;
 
201
                        var target : TGlyph_Zone );
 
202
 var
 
203
   np, nc : Int;
 
204
 begin
 
205
   np := source.n_points;
 
206
   nc := source.n_contours;
 
207
 
 
208
   target.org   := @source.org^[np];
 
209
   target.cur   := @source.cur^[np];
 
210
   target.flags := @source.flags^[np];
 
211
 
 
212
   target.conEnds := @source.conEnds^[nc];
 
213
 
 
214
   target.n_points   := 0;
 
215
   target.n_contours := 0;
 
216
 end;
 
217
 
 
218
(*******************************************************************
 
219
 *
 
220
 *  Function    :  Load_Simple_Glyph
 
221
 *
 
222
 *
 
223
 ******************************************************************)
 
224
 
 
225
 
 
226
 function Load_Simple_Glyph( exec          : PExec_Context;
 
227
                             stream        : TT_Stream;
 
228
                             n_contours    : Int;
 
229
                             left_contours : Int;
 
230
                             left_points   : Int;
 
231
                             load_flags    : Int;
 
232
                             subg          : PSubGlyph_Record ) : TError;
 
233
 var
 
234
   n_points,
 
235
   n_ins, k : Int;
 
236
 
 
237
   c, cnt : Byte;
 
238
   face   : PFace;
 
239
   coords : TT_Points;
 
240
   flag   : TT_PTouchTable;
 
241
   x, y   : TT_F26dot6;
 
242
   pts    : PGlyph_Zone;
 
243
 
 
244
 label
 
245
   Fail, Fail_File, Fail_Exec;
 
246
 begin
 
247
   Load_Simple_Glyph := Failure;
 
248
 
 
249
   face := exec^.face;
 
250
 
 
251
   (* simple check *)
 
252
 
 
253
   if ( n_contours > left_contours ) then
 
254
     begin
 
255
       {$IFDEF DEBUG}
 
256
       Writeln( 'ERROR: Glyph index ',i,' has ',Gl.numberOfContours );
 
257
       Writeln( ' contours > left ', left_contours );
 
258
       {$ENDIF}
 
259
       error := TT_Err_Too_Many_Contours;
 
260
       goto Fail;
 
261
     end;
 
262
 
 
263
   (* preparing the execution context *)
 
264
   mount_zone( subg^.zone, exec^.pts );
 
265
 
 
266
   (* Reading the contours endpoints *)
 
267
 
 
268
   if TT_Access_Frame( (n_contours+1)*2 ) then
 
269
     goto Fail_File;
 
270
 
 
271
   n_points := 0;
 
272
 
 
273
   for k := 0 to n_contours-1 do
 
274
     begin
 
275
       {$IFDEF DEBUG} Write( n_points,' '); {$ENDIF}
 
276
       n_points              := GET_Short;
 
277
       exec^.pts.conEnds^[k] := n_points;
 
278
       inc( n_points );
 
279
     end;
 
280
 
 
281
   if n_points > left_points then
 
282
     begin
 
283
       {$IFDEF DEBUG} Writeln( 'ERROR: Too many points' ); {$ENDIF}
 
284
       error := TT_Err_Too_Many_Points;
 
285
       goto Fail;
 
286
     end;
 
287
 
 
288
   (* Loading instructions *)
 
289
 
 
290
   n_ins := GET_Short;
 
291
 
 
292
   TT_Forget_Frame;
 
293
 
 
294
{
 
295
   if not subg^.is_hinted then
 
296
 
 
297
     if TT_Skip_File( n_ins ) then
 
298
       goto Fail_File
 
299
     else
 
300
     (* skip the instructions *)
 
301
 
 
302
   else }
 
303
     begin
 
304
 
 
305
       {$IFDEF DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF}
 
306
 
 
307
       if n_ins > face^.maxProfile.maxSizeOfInstructions then
 
308
       begin
 
309
         {$IFDEF DEBUG} Writeln('Too many instructions'); {$ENDIF}
 
310
         error := TT_Err_Too_Many_Ins;
 
311
         goto Fail;
 
312
       end;
 
313
 
 
314
       with exec^ do
 
315
       begin
 
316
         if TT_Read_File( glyphIns^, n_ins ) then
 
317
           goto Fail_File;
 
318
 
 
319
         glyphSize := n_ins;
 
320
 
 
321
         if Set_CodeRange( exec,
 
322
                           TT_CodeRange_Glyph,
 
323
                           glyphIns,
 
324
                           glyphSize ) then
 
325
           goto Fail_Exec;
 
326
       end
 
327
     end;
 
328
 
 
329
   (* read the flags *)
 
330
 
 
331
   if TT_Check_And_Access_Frame( n_points*5 )
 
332
     then goto Fail;
 
333
 
 
334
   k    := 0;
 
335
   flag := exec^.pts.flags;
 
336
 
 
337
   while ( k < n_points ) do
 
338
    begin
 
339
     c        := GET_Byte;
 
340
     flag^[k] := c;
 
341
     inc(k);
 
342
 
 
343
     if c and 8 <> 0 then
 
344
       begin
 
345
         cnt := GET_Byte;
 
346
 
 
347
         while ( cnt > 0 ) do
 
348
           begin
 
349
             flag^[k] := c;
 
350
             inc( k );
 
351
             dec( cnt );
 
352
           end
 
353
       end
 
354
    end;
 
355
 
 
356
   (* Read the X *)
 
357
 
 
358
   x      := 0;
 
359
   coords := exec^.pts.org;
 
360
 
 
361
   for k := 0 to n_points-1 do
 
362
   begin
 
363
     if flag^[k] and 2 <> 0 then
 
364
 
 
365
        if flag^[k] and 16 <> 0 then inc( x,  GET_Byte )
 
366
                                else inc( x, -GET_Byte )
 
367
     else
 
368
        if flag^[k] and 16 = 0  then inc( x, GET_Short );
 
369
 
 
370
     coords^[k].x := x;
 
371
   end;
 
372
 
 
373
   (* Read the Y *)
 
374
 
 
375
   y := 0;
 
376
 
 
377
   for k := 0 to n_points-1 do
 
378
   begin
 
379
     if flag^[k] and 4 <> 0 then
 
380
 
 
381
       if flag^[k] and 32 <> 0 then inc( y,  GET_Byte )
 
382
                               else inc( y, -GET_Byte )
 
383
     else
 
384
       if flag^[k] and 32 = 0  then inc( y, GET_Short );
 
385
 
 
386
     coords^[k].y := y;
 
387
   end;
 
388
 
 
389
   TT_Forget_Frame;
 
390
 
 
391
   (* Now adds the two shadow points at n and n+1     *)
 
392
   (* We need the left side bearing and advance width *)
 
393
 
 
394
   (* pp1 = xMin - lsb == glyph origin *)
 
395
   coords^[n_points].x := subg^.bbox.XMin-subg^.leftBearing;
 
396
   coords^[n_points].y := 0;
 
397
 
 
398
   (* pp2 = pp1 + aw == glyph next position *)
 
399
   coords^[n_points+1].x := subg^.bbox.xMin-
 
400
                            subg^.leftBearing + subg^.advanceWidth;
 
401
   coords^[n_points+1].y := 0;
 
402
 
 
403
   for k := 0 to n_points-1 do
 
404
     exec^.pts.flags^[k] := exec^.pts.flags^[k] and TT_Flag_On_Curve;
 
405
 
 
406
   exec^.pts.flags^[n_points  ] := 0;
 
407
   exec^.pts.flags^[n_points+1] := 0;
 
408
 
 
409
   (* Note that we now return two more points, that are not *)
 
410
   (* part of the glyph outline                             *)
 
411
   inc( n_points, 2 );
 
412
 
 
413
   (* now eventually scale and hint the glyph *)
 
414
 
 
415
   pts := @exec^.pts;
 
416
   pts^.n_points := n_points;
 
417
 
 
418
   exec^.pts.n_contours := n_contours;
 
419
 
 
420
   if load_flags and TT_Load_Scale_Glyph = 0 then
 
421
     begin
 
422
       (* no scaling, just copy the org arrays into the cur ones *)
 
423
       org_to_cur( n_points, pts );
 
424
     end
 
425
   else
 
426
     begin
 
427
 
 
428
       (* first scale the glyph points *)
 
429
       for k := 0 to n_points-1 do with pts^ do
 
430
         org^[k].x := Scale_X( exec^.metrics, org^[k].x );
 
431
 
 
432
       for k := 0 to n_points-1 do with pts^ do
 
433
         org^[k].y := Scale_Y( exec^.metrics, org^[k].y );
 
434
 
 
435
       (* if hinting, round pp1, and shift the glyph accordingly *)
 
436
       if subg^.is_hinted then
 
437
       begin
 
438
         x := pts^.org^[n_points-2].x;
 
439
         x := ((x+32) and -64) - x;
 
440
         translate_array( n_points, pts^.org, x, 0 );
 
441
 
 
442
         org_to_cur( n_points, pts );
 
443
 
 
444
         (* set the advance width *)
 
445
         (*
 
446
         x := (Scale_X( exec^.metrics, subg^.advanceWidth )+32) and -64;
 
447
         with pts^ do
 
448
           cur_x^[n_points-1] := cur_x^[n_points-2]+x;
 
449
         *)
 
450
         with pts^ do
 
451
           cur^[n_points-1].x := (cur^[n_points-1].x+32) and -64;
 
452
 
 
453
         (* now consider hinting *)
 
454
         if (exec^.glyphSize > 0) then
 
455
         begin
 
456
             exec^.is_composite := False;
 
457
 
 
458
             if Context_Run( exec, load_flags and TT_Load_Debug <> 0 ) then
 
459
               goto Fail_Exec;
 
460
         end;
 
461
       end
 
462
       else
 
463
         org_to_cur( n_points, pts );
 
464
     end;
 
465
 
 
466
   (* save glyph origin and advance points *)
 
467
   if not subg^.preserve_pps then
 
468
   begin
 
469
     subg^.pp1 := pts^.cur^[n_points-2];
 
470
     subg^.pp2 := pts^.cur^[n_points-1];
 
471
   end;
 
472
 
 
473
   Load_Simple_Glyph := Success;
 
474
 
 
475
 Fail:
 
476
   exit;
 
477
 
 
478
 Fail_File:
 
479
   error := TT_Err_File_Error;
 
480
   exit;
 
481
 
 
482
 Fail_Exec:
 
483
   error := exec^.error;
 
484
   exit;
 
485
 end;
 
486
 
 
487
(*******************************************************************
 
488
 *
 
489
 *  Function    :  Load_Composite_End
 
490
 *
 
491
 *
 
492
 ******************************************************************)
 
493
 
 
494
 function  Load_Composite_End( n_points   : Int;
 
495
                               n_contours : Int;
 
496
                               exec       : PExec_Context;
 
497
                               subg       : PSubglyph_Record;
 
498
                               debug      : Boolean ) : TError;
 
499
 var
 
500
   pts     : PGlyph_Zone;
 
501
   n_ins   : Int;
 
502
   k       : Int;
 
503
   phant1,
 
504
   phant2,
 
505
   x, y    : TT_Pos;
 
506
   widths  : PByte;
 
507
 
 
508
 label
 
509
   Fail, Fail_File, Fail_Exec;
 
510
 begin
 
511
   Load_Composite_End := Failure;
 
512
 
 
513
   if subg^.is_hinted and
 
514
      (subg^.element_flag and WE_HAVE_INSTR <> 0) then
 
515
   begin
 
516
     if TT_Access_Frame(2) then goto Fail_File;
 
517
     n_ins := Get_UShort;
 
518
     TT_Forget_Frame;
 
519
 
 
520
     (* load the instructions *)
 
521
     {$IFDEF DEBUG} Writeln('Instructions size : ', n_ins); {$ENDIF}
 
522
 
 
523
     if n_ins > exec^.face^.maxProfile.maxSizeOfInstructions then
 
524
     begin
 
525
       {$IFDEF DEBUG} Writeln('Too many instructions'); {$ENDIF}
 
526
       error := TT_Err_Too_Many_Ins;
 
527
       goto Fail;
 
528
     end;
 
529
   end
 
530
   else
 
531
     n_ins := 0;
 
532
 
 
533
   if n_ins > 0 then with exec^ do
 
534
   begin
 
535
     if TT_Read_File( glyphIns^, n_ins ) then
 
536
       goto Fail_File;
 
537
 
 
538
     glyphSize := n_ins;
 
539
 
 
540
     if Set_CodeRange( exec,
 
541
                       TT_CodeRange_Glyph,
 
542
                       glyphIns,
 
543
                       glyphSize ) then goto Fail_File;
 
544
   end;
 
545
 
 
546
   (* prepare the execution context *)
 
547
   inc( n_points, 2 );
 
548
 
 
549
   exec^.pts     := subg^.zone;
 
550
   pts           := @exec^.pts;
 
551
   pts^.n_points := n_points;
 
552
 
 
553
   (* add phantom points *)
 
554
   with pts^ do
 
555
   begin
 
556
     cur^[n_points-2] := subg^.pp1;
 
557
     cur^[n_points-1] := subg^.pp2;
 
558
     flags^[n_points-2] := 0;
 
559
     flags^[n_points-1] := 0;
 
560
   end;
 
561
 
 
562
   (* if hinting, round the phantom points *)
 
563
   if subg^.is_hinted then
 
564
   begin
 
565
     y := ((subg^.pp1.x+32) and -64);
 
566
     pts^.cur^[n_points-2].y := y;
 
567
 
 
568
     x := ((subg^.pp2.x+32) and -64);
 
569
     pts^.cur^[n_points-1].x := x;
 
570
   end;
 
571
 
 
572
   for k := 0 to n_points-1 do
 
573
     pts^.flags^[k] := pts^.flags^[k] and TT_Flag_On_Curve;
 
574
 
 
575
   cur_to_org( n_points, pts );
 
576
 
 
577
   (* now consider hinting *)
 
578
   if subg^.is_hinted and (n_ins > 0) then
 
579
   begin
 
580
     exec^.is_composite := true;
 
581
 
 
582
     if Context_Run( exec, debug ) then
 
583
       goto Fail_Exec;
 
584
   end;
 
585
 
 
586
   (* save glyph origin and advance points *)
 
587
   subg^.pp1 := pts^.cur^[n_points-2];
 
588
   subg^.pp2 := pts^.cur^[n_points-1];
 
589
 
 
590
   Load_Composite_End := Success;
 
591
   error := TT_Err_Ok;
 
592
 
 
593
 Fail:
 
594
   exit;
 
595
 
 
596
 Fail_File:
 
597
   error := TT_Err_File_Error;
 
598
   goto Fail;
 
599
 
 
600
 Fail_Exec:
 
601
   error := exec^.error;
 
602
   goto Fail;
 
603
 
 
604
 end;
 
605
 
 
606
 
 
607
(*******************************************************************
 
608
 *
 
609
 *  Function    :  Init_Glyph_Component
 
610
 *
 
611
 *
 
612
 ******************************************************************)
 
613
 
 
614
 
 
615
 procedure Init_Glyph_Component( element   : PSubGlyph_Record;
 
616
                                 original  : PSubGlyph_Record;
 
617
                                 exec      : PExec_Context );
 
618
 var
 
619
   n: Int;
 
620
 begin
 
621
   with element^ do
 
622
   begin
 
623
     index     := -1;
 
624
     is_scaled := false;
 
625
     is_hinted := false;
 
626
 
 
627
     if original <> nil then
 
628
       mount_zone( original^.zone, zone )
 
629
     else
 
630
       zone := exec^.pts;
 
631
 
 
632
     zone.n_contours := 0;
 
633
     zone.n_points   := 0;
 
634
 
 
635
     arg1 := 0;
 
636
     arg2 := 0;
 
637
 
 
638
     element_flag := 0;
 
639
     preserve_pps := false;
 
640
 
 
641
     transform.xx := 1 shl 16;
 
642
     transform.xy := 0;
 
643
     transform.yx := 0;
 
644
     transform.yy := 1 shl 16;
 
645
 
 
646
     transform.ox := 0;
 
647
     transform.oy := 0;
 
648
 
 
649
     leftBearing  := 0;
 
650
     advanceWidth := 0;
 
651
   end;
 
652
 end;
 
653
 
 
654
 
 
655
 function  Load_TrueType_Glyph( instance    : PInstance;
 
656
                                glyph       : PGlyph;
 
657
                                glyph_index : Word;
 
658
                                load_flags  : Int     ) : TError;
 
659
 type
 
660
   TPhases = ( Load_Exit,
 
661
               Load_Glyph,
 
662
               Load_Simple,
 
663
               Load_Composite,
 
664
               Load_End );
 
665
   (* the composite loader is a simple automata wich states *)
 
666
   (* are defined by the TPhases enumeration                *)
 
667
 
 
668
 var
 
669
   face : PFace;
 
670
 
 
671
   num_points    : Int;
 
672
   num_contours  : Int;
 
673
   left_points   : Int;
 
674
   left_contours : Int;
 
675
 
 
676
   table,
 
677
   num_ins,
 
678
   index,
 
679
   load_top : Int;
 
680
 
 
681
   new_flags, k, l : Int;
 
682
 
 
683
   glyph_offset, offset : Long;
 
684
 
 
685
   c : Byte;
 
686
 
 
687
   vec, nvec : TT_Vector;
 
688
 
 
689
   xmin, xmax, ymin, ymax : TT_F26Dot6;
 
690
 
 
691
   xx, xy, yx, yy : TT_Fixed;
 
692
 
 
693
   exec   : PExec_Context;
 
694
   stream : TT_Stream;
 
695
 
 
696
   subglyph, subglyph2 : PSubGlyph_Record;
 
697
 
 
698
   base_pts : TGlyph_Zone;
 
699
 
 
700
   phase : TPhases;
 
701
 
 
702
   debug : Boolean;
 
703
 
 
704
   leftSideBearing : TT_Pos;
 
705
   advanceWidth    : TT_Pos;
 
706
 
 
707
   top_bearing     : TT_Pos;
 
708
   advance_height  : TT_Pos;
 
709
 
 
710
   error      : TT_Error;
 
711
   delta      : Long;
 
712
   widths     : PByte;
 
713
   horizontal : TT_Horizontal_Header;
 
714
 label
 
715
   Fin,
 
716
   Fail,
 
717
   Fail_File,
 
718
   Fail_Handle,
 
719
   Fail_Index;
 
720
 
 
721
 begin
 
722
 
 
723
   Load_TrueType_Glyph := Failure;
 
724
 
 
725
   (* check handle *)
 
726
 
 
727
   if (instance = nil) or (instance^.owner = nil) then
 
728
     begin
 
729
       error := TT_Err_Invalid_Face_Handle;
 
730
       exit;
 
731
     end;
 
732
 
 
733
   face := instance^.owner;
 
734
 
 
735
   table := LookUp_TrueType_Table( face, 'glyf');
 
736
   if table < 0 then
 
737
     begin
 
738
       {$IFDEF DEBUG}
 
739
       Trace1( 'TTApi.load_glyph : couldn''t find glyf table' );
 
740
       {$ENDIF}
 
741
       error := TT_Err_Table_Missing;
 
742
       exit;
 
743
     end;
 
744
 
 
745
   glyph_offset := face^.dirTables^[table].Offset;
 
746
 
 
747
   (* query new execution context *)
 
748
 
 
749
   if instance^.debug then
 
750
     exec := instance^.context (* if debugging, use the pre-alloced context *)
 
751
   else
 
752
     exec := New_Context(instance);
 
753
 
 
754
   if exec = nil then
 
755
     begin
 
756
       error := TT_Err_Out_Of_Memory;
 
757
       exit;
 
758
     end;
 
759
 
 
760
   Context_Load( exec, instance );
 
761
   if instance^.GS.instruct_control and 2 <> 0 then
 
762
     exec^.GS := Default_GraphicsState
 
763
   else
 
764
     exec^.GS := instance^.GS;
 
765
 
 
766
   glyph^.outline.high_precision := ( instance^.metrics.y_ppem < 24 );
 
767
 
 
768
   glyph^.is_composite := false;
 
769
 
 
770
   (* save its critical pointers that will be modified *)
 
771
   (* during load                                      *)
 
772
 
 
773
   base_pts := exec^.pts;
 
774
 
 
775
   (* init variables *)
 
776
 
 
777
   left_points   := face^.maxPoints;
 
778
   left_contours := face^.maxContours;
 
779
 
 
780
   num_points   := 0;
 
781
   num_contours := 0;
 
782
 
 
783
   load_top := 0;
 
784
   subglyph := @exec^.loadStack^[0];
 
785
 
 
786
   Init_Glyph_Component( subglyph, nil, exec );
 
787
 
 
788
   subglyph^.index     := glyph_index;
 
789
   subglyph^.is_hinted := load_flags and TT_Load_Hint_Glyph <> 0;
 
790
 
 
791
   if instance^.GS.instruct_control and 1 <> 0 then
 
792
     subglyph^.is_hinted := False;
 
793
 
 
794
   (* now access stream *)
 
795
 
 
796
   if TT_Use_Stream( face^.stream, stream ) then
 
797
     goto Fin;
 
798
 
 
799
   (* Main Loading Loop *)
 
800
 
 
801
   phase := Load_Glyph;
 
802
 
 
803
   while phase <> Load_Exit do
 
804
   begin
 
805
 
 
806
     subglyph := @exec^.loadStack^[load_top];
 
807
 
 
808
     case phase of
 
809
 
 
810
       (************************************************************)
 
811
       (*                                                          *)
 
812
       (* Load_Glyph state                                         *)
 
813
       (*                                                          *)
 
814
       (*   reading a glyph's generic header to determine          *)
 
815
       (*   wether it's simple or composite                        *)
 
816
       (*                                                          *)
 
817
       (* exit states : Load_Simple and Load_Composite             *)
 
818
       (*                                                          *)
 
819
 
 
820
       Load_Glyph:
 
821
         begin
 
822
           (* check glyph index and table *)
 
823
 
 
824
           index := subglyph^.index;
 
825
           if (index < 0) or (index >= face^.numGlyphs) then
 
826
           begin
 
827
             error := TT_Err_Invalid_Glyph_Index;
 
828
             goto Fail;
 
829
           end;
 
830
 
 
831
           (* load glyph metrics *)
 
832
           Get_HMetrics( face, index, true,
 
833
                         subglyph^.leftBearing,
 
834
                         subglyph^.advanceWidth );
 
835
 
 
836
           (* load glyph *)
 
837
           if (index+1 < face^.numLocations) and
 
838
              (face^.glyphLocations^[index] = face^.glyphLocations^[index+1]) then
 
839
             begin
 
840
 
 
841
               (* as noticed by Frederic Loyer, these are spaces, not *)
 
842
               (* the 'unknown' glyph                                 *)
 
843
               num_points   := 0;
 
844
               num_contours := 0;
 
845
 
 
846
               subglyph^.bbox.xMin := 0;
 
847
               subglyph^.bbox.xMax := 0;
 
848
               subglyph^.bbox.yMin := 0;
 
849
               subglyph^.bbox.yMax := 0;
 
850
 
 
851
               subglyph^.pp1.x := 0;
 
852
               subglyph^.pp2.x := subglyph^.advanceWidth;
 
853
               if load_flags and TT_LOAD_Scale_Glyph <> 0 then
 
854
                 subglyph^.pp2.x := Scale_X( exec^.metrics, subglyph^.pp2.x );
 
855
 
 
856
               exec^.glyphSize := 0;
 
857
               phase := Load_End;
 
858
             end
 
859
           else
 
860
             begin
 
861
               offset := glyph_offset + face^.glyphLocations^[index];
 
862
 
 
863
               (* read first glyph header *)
 
864
 
 
865
               if TT_Seek_File( offset ) or
 
866
                  TT_Access_Frame( 5*sizeof(Short) ) then
 
867
                 goto Fail_File;
 
868
 
 
869
               num_contours        := GET_Short;
 
870
               subglyph^.bbox.xMin := GET_Short;
 
871
               subglyph^.bbox.yMin := GET_Short;
 
872
               subglyph^.bbox.xMax := GET_Short;
 
873
               subglyph^.bbox.yMax := GET_Short;
 
874
 
 
875
               TT_Forget_Frame;
 
876
 
 
877
               {$IFDEF DEBUG}
 
878
               Writeln('Glyph ', i );
 
879
 
 
880
               Writeln(' # of Contours : ',num_contours );
 
881
               Writeln(' xMin : ',subglyph^.xMin:4,'  xMax : ',subglyph^.xMax);
 
882
               Writeln(' yMin : ',subglyph^.yMin:4,'  yMax : ',subglyph^.yMax);
 
883
               Writeln('-');
 
884
               {$ENDIF}
 
885
 
 
886
               if num_contours > left_contours then
 
887
               begin
 
888
                 {$IFDEF DEBUG}
 
889
                 Writeln( 'ERROR: Glyph index ', i, ' has ', num_contours );
 
890
                 Writeln(' contours > left ', left_contours );
 
891
                 {$ENDIF}
 
892
                 error := TT_Err_Too_Many_Contours;
 
893
                 goto Fail;
 
894
               end;
 
895
 
 
896
               with subglyph^ do
 
897
               begin
 
898
                 pp1.x := bbox.xMin - leftBearing;
 
899
                 pp1.y := 0;
 
900
                 pp2.x := pp1.x + advanceWidth;
 
901
                 pp2.y := 0;
 
902
 
 
903
                 if load_flags and TT_Load_Scale_Glyph <> 0 then
 
904
                 begin
 
905
                   pp1.x := Scale_X( exec^.metrics, pp1.x );
 
906
                   pp2.x := Scale_X( exec^.metrics, pp2.x );
 
907
                 end;
 
908
               end;
 
909
 
 
910
               (* is it a simple glyph ? *)
 
911
               if num_contours >= 0 then
 
912
                 phase := Load_Simple
 
913
               else
 
914
                 phase := Load_Composite;
 
915
 
 
916
             end
 
917
         end;
 
918
 
 
919
       (************************************************************)
 
920
       (*                                                          *)
 
921
       (* Load_Simple state                                        *)
 
922
       (*                                                          *)
 
923
       (*   reading a simple glyph (num_contours must be set to    *)
 
924
       (*   the glyph's number of contours..)                      *)
 
925
       (*                                                          *)
 
926
       (* exit states : Load_End                                   *)
 
927
       (*                                                          *)
 
928
 
 
929
       Load_Simple :
 
930
         begin
 
931
           new_flags := load_flags;
 
932
 
 
933
           if not subglyph^.is_hinted then
 
934
             new_flags := new_flags and not TT_Load_Hint_Glyph;
 
935
           (* disable hinting when scaling *)
 
936
 
 
937
           if new_flags and TT_Load_Debug <> 0 then
 
938
             if load_top > 0 then
 
939
               new_flags := new_flags and not TT_Load_Debug;
 
940
 
 
941
           if Load_Simple_Glyph(
 
942
                       exec,
 
943
                       stream,
 
944
                       num_contours,
 
945
                       left_contours,
 
946
                       left_points,
 
947
                       new_flags,
 
948
                       subglyph ) then
 
949
             goto Fail;
 
950
 
 
951
           num_points := exec^.pts.n_points-2;
 
952
 
 
953
           phase := Load_End;
 
954
         end;
 
955
 
 
956
       (************************************************************)
 
957
       (*                                                          *)
 
958
       (* Load_Composite state                                     *)
 
959
       (*                                                          *)
 
960
       (*   reading a composite glyph header a pushing a new       *)
 
961
       (*   load element on the stack..                            *)
 
962
       (*                                                          *)
 
963
       (* exit states : Load_Glyph                                 *)
 
964
       (*                                                          *)
 
965
 
 
966
       Load_Composite :
 
967
         begin
 
968
 
 
969
           glyph^.is_composite := true;
 
970
 
 
971
           (* create a new element *)
 
972
 
 
973
           inc( load_top );
 
974
 
 
975
           if load_top > face^.maxComponents then
 
976
           begin
 
977
             error := TT_Err_Invalid_Composite;
 
978
             goto Fail;
 
979
           end;
 
980
 
 
981
           subglyph2 := @exec^.loadStack^[load_top];
 
982
 
 
983
           Init_Glyph_Component( subglyph2, subglyph, nil );
 
984
 
 
985
           subglyph2^.index     := -1;
 
986
           subglyph2^.is_hinted := subglyph^.is_hinted;
 
987
 
 
988
           (* now read composite header *)
 
989
 
 
990
           if TT_Access_Frame( 4 ) then
 
991
             goto Fail_File;
 
992
 
 
993
           new_flags := Get_UShort;
 
994
 
 
995
           subglyph^.element_flag := new_flags;
 
996
           subglyph2^.index       := Get_UShort;
 
997
 
 
998
           TT_Forget_Frame;
 
999
 
 
1000
           k := 2;
 
1001
 
 
1002
           if new_flags and ARGS_ARE_WORDS <> 0 then
 
1003
             inc( k, 2 );
 
1004
 
 
1005
           if new_flags and WE_HAVE_A_SCALE <> 0 then
 
1006
             inc( k, 2 );
 
1007
 
 
1008
           if new_flags and WE_HAVE_AN_XY_SCALE <> 0 then
 
1009
             inc( k, 4 );
 
1010
 
 
1011
           if new_flags and WE_HAVE_A_2X2 <> 0 then
 
1012
             inc( k, 8 );
 
1013
 
 
1014
           if TT_Access_Frame( k ) then
 
1015
             goto Fail_File;
 
1016
 
 
1017
           if new_flags and ARGS_ARE_WORDS <> 0 then
 
1018
             begin
 
1019
               k := Get_Short;
 
1020
               l := Get_Short;
 
1021
             end
 
1022
           else
 
1023
             begin
 
1024
               k := Get_Byte;
 
1025
               l := Get_Byte;
 
1026
             end;
 
1027
 
 
1028
           subglyph^.arg1 := k;
 
1029
           subglyph^.arg2 := l;
 
1030
 
 
1031
           if new_flags and ARGS_ARE_XY_VALUES <> 0 then
 
1032
             begin
 
1033
               subglyph^.transform.ox := k;
 
1034
               subglyph^.transform.oy := l;
 
1035
             end;
 
1036
 
 
1037
           xx := 1 shl 16;
 
1038
           xy := 0;
 
1039
           yx := 0;
 
1040
           yy := 1 shl 16;
 
1041
 
 
1042
           if new_flags and WE_HAVE_A_SCALE <> 0 then
 
1043
             begin
 
1044
               xx := Long(Get_Short) shl 2;
 
1045
               yy := xx;
 
1046
 
 
1047
               subglyph2^.is_scaled := true;
 
1048
             end
 
1049
           else if new_flags and WE_HAVE_AN_XY_SCALE <> 0 then
 
1050
             begin
 
1051
               xx := Long(Get_Short) shl 2;
 
1052
               yy := Long(Get_Short) shl 2;
 
1053
 
 
1054
               subglyph2^.is_scaled := true;
 
1055
             end
 
1056
           else if new_flags and WE_HAVE_A_2X2 <> 0 then
 
1057
             begin
 
1058
               xx := Long(Get_Short) shl 2;
 
1059
               xy := Long(Get_Short) shl 2;
 
1060
               yx := Long(Get_Short) shl 2;
 
1061
               yy := Long(Get_Short) shl 2;
 
1062
 
 
1063
               subglyph2^.is_scaled := true;
 
1064
             end;
 
1065
 
 
1066
           subglyph^.transform.xx := xx;
 
1067
           subglyph^.transform.xy := xy;
 
1068
           subglyph^.transform.yx := yx;
 
1069
           subglyph^.transform.yy := yy;
 
1070
 
 
1071
           delta := MulDiv_Round( xx, yy, 1 shl 16 ) -
 
1072
                    MulDiv_Round( xy, yx, 1 shl 16 );
 
1073
 
 
1074
           if abs(delta) <> 1 shl 16 then
 
1075
             subglyph2^.is_hinted := false;
 
1076
 
 
1077
           TT_Forget_Frame;
 
1078
 
 
1079
           subglyph^.file_offset := TT_File_Pos;
 
1080
 
 
1081
           phase := Load_Glyph;
 
1082
         end;
 
1083
 
 
1084
       (************************************************************)
 
1085
       (*                                                          *)
 
1086
       (* Load_End state                                           *)
 
1087
       (*                                                          *)
 
1088
       (*   after loading a glyph, apply transform and offset      *)
 
1089
       (*   where necessary, pops element and continue or          *)
 
1090
       (*   stop process..                                         *)
 
1091
       (*                                                          *)
 
1092
       (* exit states : Load_Composite and Load_Exit               *)
 
1093
       (*                                                          *)
 
1094
 
 
1095
       Load_End :
 
1096
         if load_top > 0 then
 
1097
           begin
 
1098
 
 
1099
             subglyph2 := subglyph;
 
1100
 
 
1101
             dec( load_top );
 
1102
             subglyph := @exec^.loadStack^[load_top];
 
1103
 
 
1104
             (* check advance width and left side bearing *)
 
1105
 
 
1106
             if not subglyph^.preserve_pps and
 
1107
                (subglyph^.element_flag and USE_MY_METRICS <> 0) then
 
1108
             begin
 
1109
 
 
1110
               subglyph^.leftBearing  := subglyph2^.leftBearing;
 
1111
               subglyph^.advanceWidth := subglyph2^.advanceWidth;
 
1112
 
 
1113
               subglyph^.pp1 := subglyph2^.pp1;
 
1114
               subglyph^.pp2 := subglyph2^.pp2;
 
1115
 
 
1116
               subglyph^.preserve_pps := true;
 
1117
             end;
 
1118
 
 
1119
             (* apply scale/symmetry/rotation/wathever *)
 
1120
 
 
1121
             for k := 0 to num_points-1 do with subglyph^ do
 
1122
             begin
 
1123
               vec := subglyph2^.zone.cur^[k];
 
1124
 
 
1125
               nvec.x := MulDiv_Round( vec.x, transform.xx, 1 shl 16 ) +
 
1126
                         MulDiv_Round( vec.y, transform.yx, 1 shl 16 );
 
1127
 
 
1128
               nvec.y := MulDiv_Round( vec.x, transform.xy, 1 shl 16 ) +
 
1129
                         MulDiv_Round( vec.y, transform.yy, 1 shl 16 );
 
1130
 
 
1131
               subglyph2^.zone.cur^[k] := nvec;
 
1132
 
 
1133
               vec := subglyph2^.zone.org^[k];
 
1134
 
 
1135
               nvec.x := MulDiv_Round( vec.x, transform.xx, 1 shl 16 ) +
 
1136
                         MulDiv_Round( vec.y, transform.yx, 1 shl 16 );
 
1137
 
 
1138
               nvec.y := MulDiv_Round( vec.x, transform.xy, 1 shl 16 ) +
 
1139
                         MulDiv_Round( vec.y, transform.yy, 1 shl 16 );
 
1140
 
 
1141
               subglyph2^.zone.org^[k] := nvec;
 
1142
             end;
 
1143
 
 
1144
             (* adjust counts *)
 
1145
             for k := 0 to num_contours-1 do
 
1146
               inc( subglyph2^.zone.conEnds^[k], subglyph^.zone.n_points );
 
1147
 
 
1148
             inc( subglyph^.zone.n_points,   num_points );
 
1149
             inc( subglyph^.zone.n_contours, num_contours );
 
1150
 
 
1151
             dec( left_points, num_points );
 
1152
             dec( left_contours, num_contours );
 
1153
 
 
1154
             (* apply offset *)
 
1155
 
 
1156
             if subglyph^.element_flag and ARGS_ARE_XY_VALUES = 0 then
 
1157
               begin
 
1158
                 k := subglyph^.arg1;
 
1159
                 l := subglyph^.arg2;
 
1160
 
 
1161
                 if (k < 0) or (k >= subglyph^.zone.n_points ) or
 
1162
                    (l < 0) or (l >= num_points) then
 
1163
                   begin
 
1164
                     error := TT_Err_Invalid_Composite;
 
1165
                     goto Fail;
 
1166
                   end;
 
1167
 
 
1168
                 inc( l, subglyph^.zone.n_points );
 
1169
 
 
1170
                 vec.x := subglyph^.zone.cur^[k].x -
 
1171
                          subglyph^.zone.cur^[l].x;
 
1172
 
 
1173
                 vec.y := subglyph^.zone.cur^[k].y -
 
1174
                          subglyph^.zone.cur^[l].y;
 
1175
               end
 
1176
             else
 
1177
               begin
 
1178
                 vec.x := subglyph^.transform.ox;
 
1179
                 vec.y := subglyph^.transform.oy;
 
1180
 
 
1181
                 if load_flags and TT_Load_Scale_Glyph <> 0 then
 
1182
                 begin
 
1183
                   vec.x := Scale_X( exec^.metrics, vec.x );
 
1184
                   vec.y := Scale_Y( exec^.metrics, vec.y );
 
1185
 
 
1186
                   if subglyph^.element_flag and ROUND_XY_TO_GRID <> 0 then
 
1187
                   begin
 
1188
                     vec.x := (vec.x+32) and -64;
 
1189
                     vec.y := (vec.y+32) and -64;
 
1190
                   end;
 
1191
                 end
 
1192
               end;
 
1193
 
 
1194
             translate_array( num_points, subglyph2^.zone.cur, vec.x, vec.y );
 
1195
 
 
1196
             cur_to_org( num_points, @subglyph2^.zone );
 
1197
 
 
1198
             num_points   := subglyph^.zone.n_points;
 
1199
             num_contours := subglyph^.zone.n_contours;
 
1200
 
 
1201
             (* check for last component *)
 
1202
 
 
1203
             if TT_Seek_File( subglyph^.file_offset ) then
 
1204
               goto Fail_File;
 
1205
 
 
1206
             if subglyph^.element_flag and MORE_COMPONENTS <> 0 then
 
1207
               phase := Load_Composite
 
1208
             else
 
1209
               begin
 
1210
                 debug := ( load_top = 0 ) and
 
1211
                          ( load_flags and TT_Load_Debug <> 0 );
 
1212
 
 
1213
                 if Load_Composite_End( num_points,
 
1214
                                        num_contours,
 
1215
                                        exec,
 
1216
                                        subglyph,
 
1217
                                        debug ) then goto Fail;
 
1218
                 phase := Load_End;
 
1219
               end;
 
1220
 
 
1221
           end
 
1222
         else
 
1223
           phase := Load_Exit;
 
1224
 
 
1225
     end;
 
1226
   end;
 
1227
 
 
1228
   (* finally, copy the points arrays to the glyph object *)
 
1229
 
 
1230
   exec^.pts := base_pts;
 
1231
 
 
1232
   (* copy also the phantom points, the debugger needs them *)
 
1233
   inc( num_points, 2 );
 
1234
 
 
1235
   for k := 0 to num_points-1 do with glyph^.outline do
 
1236
   begin
 
1237
     points^[k] := exec^.pts.cur^[k];
 
1238
     flags ^[k] := exec^.pts.flags^[k];
 
1239
   end;
 
1240
 
 
1241
   for k := 0 to num_contours-1 do with glyph^.outline do
 
1242
     conEnds^[k] := exec^.pts.conEnds^[k];
 
1243
 
 
1244
   glyph^.outline.n_points    := num_points;
 
1245
   glyph^.outline.n_contours  := num_contours;
 
1246
   glyph^.outline.second_pass := true;
 
1247
 
 
1248
   TT_Get_Outline_BBox( glyph^.outline, glyph^.metrics.bbox );
 
1249
 
 
1250
   glyph^.metrics.horiBearingX := glyph^.metrics.bbox.xMin - subglyph^.pp1.x;
 
1251
   glyph^.metrics.horiBearingY := glyph^.metrics.bbox.yMax;
 
1252
   glyph^.metrics.horiAdvance  := subglyph^.pp2.x - subglyph^.pp1.x;
 
1253
 
 
1254
   glyph^.computed_width := glyph^.metrics.horiAdvance;
 
1255
   glyph^.precalc_width  := -1;
 
1256
 
 
1257
   (* Now take care of vertical metrics. In the case where there is    *)
 
1258
   (* no vertical information within the font (which is relatively     *)
 
1259
   (* common), make up some metrics "by hand"..                        *)
 
1260
   (*                                                                  *)
 
1261
 
 
1262
   begin
 
1263
     (* get the unscaled "tsb" and "ah"                            *)
 
1264
     (* don't assume that both the vertical header and metrics are *)
 
1265
     (* present in a font file...                                  *)
 
1266
     if face^.verticalInfo and
 
1267
        ( face^.verticalHeader.number_Of_VMetrics > 0 ) then
 
1268
       begin
 
1269
       (* apparently, the following line isn't accepted by the FreePascal *)
 
1270
       (* compiler. It complains because the typecast occurs on a 'var'   *)
 
1271
       (* parameter. Don't know if this is compiler bug or not, but I     *)
 
1272
       (* changed the code with some stupid copy trick..                  *)
 
1273
       (*                                                                 *)
 
1274
       (* TT_Get_Metrics( TT_Horizontal_Header(face^.verticalHeader),     *)
 
1275
       (*                 glyph_index,                                    *)
 
1276
       (*                 top_bearing,                                    *)
 
1277
       (*                 advance_height );                               *)
 
1278
       (*                                                                 *)
 
1279
          horizontal := TT_Horizontal_Header(face^.verticalHeader);
 
1280
          TT_Get_Metrics( horizontal,
 
1281
                          glyph_index,
 
1282
                          top_bearing,
 
1283
                          advance_height );
 
1284
       end
 
1285
     else
 
1286
       begin
 
1287
         (* Make up the distances from the horizontal header..       *)
 
1288
         (*                                                          *)
 
1289
         (* The typographic values are the only portable ones, which *)
 
1290
         (* is why we use them..                                     *)
 
1291
         (*                                                          *)
 
1292
         (* The sTypoDescender field is always negative, unlike the  *)
 
1293
         (* Windows Descender..                                      *)
 
1294
         (*                                                          *)
 
1295
         with face^.os2 do
 
1296
         begin
 
1297
           top_bearing    := sTypoLineGap div 2;
 
1298
           advance_height := sTypoAscender - sTypoDescender + sTypoLineGap;
 
1299
         end;
 
1300
 
 
1301
       end;
 
1302
 
 
1303
       (* now scale the metrics *)
 
1304
       if load_flags and TT_Load_Scale_Glyph <> 0 then
 
1305
       begin
 
1306
         top_bearing    := Scale_Y( exec^.metrics, top_bearing );
 
1307
         advance_height := Scale_Y( exec^.metrics, advance_height );
 
1308
       end;
 
1309
 
 
1310
       with glyph^.metrics do
 
1311
       begin
 
1312
         vertBearingX := ( bbox.xMin - bbox.xMax ) div 2;
 
1313
         vertBearingY := top_bearing;
 
1314
         vertAdvance  := advance_height;
 
1315
 
 
1316
         if load_flags and TT_Load_Hint_Glyph <> 0 then
 
1317
         begin
 
1318
           vertBearingX := vertBearingX and -64;
 
1319
           vertBearingY := (vertBearingY + 63) and -64;
 
1320
           vertAdvance  := (vertAdvance+32) and -64;
 
1321
         end;
 
1322
       end;
 
1323
 
 
1324
   end;
 
1325
 
 
1326
   (* use hdmx table to adjust advance width as necessary *)
 
1327
   if load_flags and TT_Load_Default = TT_Load_Default then
 
1328
   begin
 
1329
     widths := Get_Advance_Widths( exec^.face,
 
1330
                                   exec^.instance^.metrics.x_ppem );
 
1331
     if widths <> nil then
 
1332
     begin
 
1333
       glyph^.metrics.horiAdvance := widths^[glyph_index]*64;
 
1334
       glyph^.precalc_width       := glyph^.metrics.horiAdvance;
 
1335
     end;
 
1336
   end;
 
1337
 
 
1338
   (* in case of hinting, shift the glyph so that (0,0) corresponds *)
 
1339
   (* to the glyph origin.                                          *)
 
1340
   if subglyph^.is_hinted then
 
1341
   begin
 
1342
     glyph^.metrics.horiBearingX := (glyph^.metrics.bbox.xMin and -64) -
 
1343
                                     subglyph^.pp1.x;
 
1344
 
 
1345
     glyph^.metrics.horiAdvance  := (glyph^.metrics.horiAdvance+32) and -64;
 
1346
     glyph^.computed_width       := (glyph^.computed_width+32) and -64;
 
1347
 
 
1348
     translate_array( num_points,
 
1349
                      glyph^.outline.points,
 
1350
                      -subglyph^.pp1.x,
 
1351
                      0 );
 
1352
   end;
 
1353
 
 
1354
   glyph^.outline.dropout_mode := exec^.GS.scan_type;
 
1355
 
 
1356
   Load_TrueType_Glyph := Success;
 
1357
 
 
1358
 Fail:
 
1359
   TT_Done_Stream( stream );
 
1360
 
 
1361
 Fin:
 
1362
 
 
1363
   (* reset the execution context *)
 
1364
   exec^.pts := base_pts;
 
1365
 
 
1366
   if instance^.debug then
 
1367
     begin
 
1368
       exec^.pts.n_points   := num_points;
 
1369
       exec^.pts.n_contours := num_contours;
 
1370
     end
 
1371
   else
 
1372
     Done_Context( exec);
 
1373
 
 
1374
   exit;
 
1375
 
 
1376
 Fail_File:
 
1377
   error := TT_Err_File_Error;
 
1378
   goto Fail;
 
1379
 
 
1380
 Fail_Handle:
 
1381
   error := TT_Err_Invalid_Instance_Handle;
 
1382
   exit;
 
1383
 
 
1384
 Fail_Index:
 
1385
   error := TT_Err_Invalid_Glyph_Index;
 
1386
   exit;
 
1387
 
 
1388
 end;
 
1389
 
 
1390
 
 
1391
end.