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