1 (******************************************************************* 2 * 3 * TTLoad.Pas 1.0 4 * 5 * TrueType Tables loaders 6 * 7 * Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg 8 * 9 * This file is part of the FreeType project, and may only be used 10 * modified and distributed under the terms of the FreeType project 11 * license, LICENSE.TXT. By continuing to use, modify or distribute 12 * this file you indicate that you have read the license and 13 * understand and accept it fully. 14 * 15 * 16 * Difference between 1.0 and 1.1 : HUGE !! 17 * 18 * - Changed the load model to get in touch with TTFile 1.1 19 * - Now loads one whole resident table in one call 20 * - defined resident and instance records/data 21 * 22 ******************************************************************) 23 24 Unit TTLoad; 25 26 interface 27 28 {$R-} 29 uses TTTypes, TTTables, TTCMap, TTObjs, TTFile; 30 LookUp_TrueType_Tablenull31 function LookUp_TrueType_Table( face : PFace; 32 aTag : string ) : int; 33 Load_TrueType_Directorynull34 function Load_TrueType_Directory( AStream: TFreeTypeStream; face : PFace; 35 faceIndex : Int ) : TError; 36 Load_TrueType_MaxProfilenull37 function Load_TrueType_MaxProfile( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_Headernull38 function Load_TrueType_Header ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_Locationsnull39 function Load_TrueType_Locations ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_CVTnull40 function Load_TrueType_CVT ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_CMapnull41 function Load_TrueType_CMap ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_Gaspnull42 function Load_TrueType_Gasp ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_Namesnull43 function Load_TrueType_Names ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_Programsnull44 function Load_TrueType_Programs ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_trueType_Postscriptnull45 function Load_trueType_Postscript( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_OS2null46 function Load_TrueType_OS2 ( AStream: TFreeTypeStream; face : PFace ) : TError; Load_TrueType_HDMXnull47 function Load_TrueType_HDMX ( AStream: TFreeTypeStream; face : PFace ) : TError; 48 Load_TrueType_Metrics_Headernull49 function Load_TrueType_Metrics_Header( AStream: TFreeTypeStream; face : PFace; 50 vertical : Boolean ) : TError; 51 Load_TrueType_Anynull52 function Load_TrueType_Any( face : PFace; 53 tag : longint; 54 offset : longint; 55 var buffer; 56 var length : longint ) : TError; 57 58 implementation 59 60 uses TTError, TTMemory; 61 62 (* Composite glyph decoding flags *) 63 64 (******************************************************************* 65 * 66 * Function : LookUp_TrueType_Table 67 * 68 * Description : Looks for a TrueType table by name 69 * 70 * Input : face resident table to look for 71 * aTag searched tag 72 * 73 * Output : index of table if found, -1 otherwise. 74 * 75 ******************************************************************) 76 LookUp_TrueType_Tablenull77 function LookUp_TrueType_Table( face : PFace; 78 aTag : string ) : int; 79 var 80 ltag : Long; 81 i : int; 82 begin 83 ltag := (Long(ord(aTag[1])) shl 24) + (Long(ord(aTag[2])) shl 16) + 84 (Long(ord(aTag[3])) shl 8 ) + Long(ord(aTag[4])); 85 86 for i := 0 to face^.numTables-1 do 87 begin 88 89 if face^.dirTables^[i].Tag = lTag then 90 begin 91 LookUp_TrueType_Table := i; 92 exit; 93 end 94 end; 95 96 (* couldn't find the table *) 97 LookUp_TrueType_Table := -1; 98 end; 99 100 LookUp_Mandatory_Tablenull101 function LookUp_Mandatory_Table( face : PFace; 102 aTag : string ) : int; 103 var 104 table : int; 105 begin 106 table := LookUp_TrueType_Table( face, aTag ); 107 if table < 0 then 108 error := TT_Err_Table_Missing; 109 110 LookUp_Mandatory_Table := table; 111 end; 112 113 (******************************************************************* 114 * 115 * Function : Load_TrueType_Collection 116 * 117 * Description : 118 * 119 * Input : face 120 * 121 * Output : True on success. False on failure 122 * 123 * Notes : A table directory doesn't own subttables. There is no 124 * constructor or destructor for it. 125 * 126 ******************************************************************) 127 Load_TrueType_Collectionnull128 function Load_TrueType_Collection( AStream: TFreeTypeStream; face : PFace ) : TError; 129 var 130 n : Int; 131 const 132 TTC_Tag = ( ord('t') shl 24 ) + 133 ( ord('t') shl 16 ) + 134 ( ord('c') shl 8 ) + 135 ( ord(' ') ); 136 begin 137 Load_TrueType_Collection := Failure; 138 139 with face^.ttcHeader do 140 begin 141 142 if AStream.SeekFile( 0 ) or 143 AStream.AccessFrame(12 ) then exit; 144 145 Tag := AStream.Get_ULong; 146 version := AStream.Get_Long; 147 dirCount := AStream.Get_Long; 148 149 AStream.ForgetFrame; 150 151 if Tag <> TTC_Tag then 152 begin 153 Tag := 0; 154 version := 0; 155 dirCount := 0; 156 tableDirectory := nil; 157 158 error := TT_Err_File_Is_Not_Collection; 159 exit; 160 end; 161 162 if Alloc( tableDirectory, dirCount * sizeof(ULong) ) or 163 AStream.AccessFrame( dirCount*4 ) then exit; 164 165 for n := 0 to dirCount-1 do 166 tableDirectory^[n] := AStream.Get_ULong; 167 168 AStream.ForgetFrame; 169 end; 170 171 Load_TrueType_Collection := Success; 172 end; 173 174 (******************************************************************* 175 * 176 * Function : Load_TrueType_Directory 177 * 178 * Description : 179 * 180 * Input : face 181 * 182 * Output : True on success. False on failure 183 * 184 * Notes : A table directory doesn't own subttables. There is no 185 * constructor or destructor for it. 186 * 187 ******************************************************************) 188 Load_TrueType_Directorynull189 function Load_TrueType_Directory( AStream: TFreeTypeStream; face : PFace; 190 faceIndex : Int ) : TError; 191 var 192 n : Int; 193 tableDir : TTableDir; 194 begin 195 Load_TrueType_Directory := Failure; 196 197 {$IFDEF FREETYPE_DEBUG} Write('Directory '); {$ENDIF} 198 199 if Load_TrueType_Collection(AStream, face) then 200 begin 201 if error <> TT_Err_File_Is_Not_Collection then 202 exit; 203 204 (* The file isn't a collection, exit if index isn't 0 *) 205 if faceIndex <> 0 then 206 exit; 207 208 error := TT_Err_Ok; 209 210 (* Now skip to the beginning of the file *) 211 if AStream.SeekFile(0) then 212 exit; 213 end 214 else 215 begin 216 (* file is a collection. Check the index *) 217 if ( faceIndex < 0 ) or 218 ( ulong(faceIndex) >= face^.ttcHeader.dirCount ) then 219 begin 220 error := TT_Err_Bad_Argument; 221 exit; 222 end; 223 224 (* select a TT Font within the ttc file *) 225 if AStream.SeekFile( face^.ttcHeader.tableDirectory^[faceIndex] ) then 226 exit; 227 end; 228 229 if AStream.AccessFrame( 12 ) then 230 exit; 231 232 tableDir.version := AStream.GET_Long; 233 tableDir.numTables := AStream.GET_UShort; 234 235 tableDir.searchRange := AStream.GET_UShort; 236 tableDir.entrySelector := AStream.GET_UShort; 237 tableDir.rangeShift := AStream.GET_UShort; 238 239 {$IFDEF FREETYPE_DEBUG} Writeln('Tables number : ', tableDir.numTables ); {$ENDIF} 240 241 AStream.ForgetFrame; 242 243 (* Check that we have a 'sfnt' format there *) 244 if (tableDir.version <> $10000 ) and (* MS fonts *) 245 (tableDir.version <> $74727565) then (* Mac fonts *) 246 begin 247 {$IFDEF FREETYPE_DEBUG} Writeln('Invalid font format'); {$ENDIF} 248 error := TT_Err_Invalid_File_Format; 249 exit; 250 end; 251 252 with face^ do 253 begin 254 255 numTables := tableDir.numTables; 256 257 if Alloc( dirTables, numTables * sizeof( TTableDirEntry ) ) or 258 AStream.AccessFrame( 16 * numTables ) then exit; 259 260 for n := 0 to numTables-1 do with dirTables^[n] do 261 begin 262 Tag := AStream.GET_ULong; 263 Checksum := AStream.GET_ULong; 264 Offset := AStream.GET_Long; 265 Length := AStream.Get_Long; 266 end; 267 268 AStream.ForgetFrame; 269 270 end; 271 272 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 273 274 Load_TrueType_Directory := Success; 275 end; 276 277 (******************************************************************* 278 * 279 * Function : Load_TrueType_MaxProfile 280 * 281 * Description : 282 * 283 * Input : face 284 * 285 * Output : True on success. False on failure 286 * 287 * Notes : A maximum profile is a static table that owns no 288 * subttable. It has then no constructor nor destructor 289 * 290 ******************************************************************) 291 Load_TrueType_MaxProfilenull292 function Load_TrueType_MaxProfile( AStream: TFreeTypeStream; face : PFace ) : TError; 293 var 294 table : int; 295 begin 296 297 Load_TrueType_MaxProfile := Failure; 298 299 {$IFDEF FREETYPE_DEBUG} Write('MaxProfile '); {$ENDIF} 300 301 table := LookUp_Mandatory_Table( face, 'maxp'); 302 if table < 0 then exit; 303 304 with face^ do 305 begin 306 307 if astream.SeekFile( dirTables^[table].Offset ) or 308 AStream.AccessFrame( 32 ) then exit; 309 310 with AStream, MaxProfile do 311 begin 312 313 ULong(Version) := GET_ULong; 314 315 numGlyphs := GET_UShort; 316 maxPoints := GET_UShort; 317 maxContours := GET_UShort; 318 319 maxCompositePoints := GET_UShort; 320 maxCompositeContours := GET_UShort; 321 maxZones := GET_UShort; 322 maxTwilightPoints := GET_UShort; 323 maxStorage := GET_UShort; 324 maxFunctionDefs := GET_UShort; 325 maxINstructionDefs := GET_UShort; 326 maxStackElements := GET_UShort; 327 328 maxSizeOfInstructions := GET_UShort; 329 maxComponentElements := GET_UShort; 330 maxComponentDepth := GET_UShort; 331 end; 332 333 AStream.ForgetFrame; 334 335 (* XXX : an adjustement that is necessary to load certain */ 336 /* broken fonts like "Keystrokes MT" :-( */ 337 /* */ 338 /* We allocate 64 function entries by default when */ 339 /* the maxFunctionDefs field is null. *) 340 341 (* otherwise, we increment this field by one, in order *) 342 (* to load some old Apple fonts.. *) 343 344 if maxProfile.maxFunctionDefs = 0 then 345 maxProfile.maxFunctionDefs := 64; 346 347 numGlyphs := MaxProfile.numGlyphs; 348 (* compute number of glyphs *) 349 350 maxPoints := MaxProfile.maxCompositePoints; 351 if (maxPoints < MaxProfile.maxPoints) then 352 maxPoints := MaxProfile.maxPoints; 353 (* compute max number of points *) 354 355 maxContours := MaxProfile.maxCompositeContours; 356 if maxContours < MaxProfile.maxContours then 357 maxContours := MaxProfile.maxContours; 358 (* compute max number of contours *) 359 360 maxComponents := MaxProfile.maxComponentElements + 361 MaxProfile.maxComponentDepth; 362 (* compute max number of components for glyph loading *) 363 364 (* XXX: some fonts have maxComponents set to 0; we will *) 365 (* then use 16 of them by default *) 366 if maxComponents = 0 then maxComponents := 16; 367 368 (* We also increase maxPoints and maxContours in order to support *) 369 (* some broken fonts *) 370 inc( maxPoints, 8 ); 371 inc( maxContours, 4 ); 372 end; 373 374 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 375 376 Load_TrueType_MaxProfile := Success; 377 end; 378 379 (******************************************************************* 380 * 381 * Function : Load_TrueType_Gasp 382 * 383 * Description : 384 * 385 * Input : face 386 * 387 ******************************************************************) 388 Load_TrueType_Gaspnull389 function Load_TrueType_Gasp( AStream: TFreeTypeStream; face : PFace ) : TError; 390 var 391 gRanges : PGaspRanges; 392 table, i : Int; 393 label 394 Fail; 395 begin 396 Load_TrueType_Gasp := Failure; 397 398 with face^.gasp do 399 begin 400 version := 0; 401 numRanges := 0; 402 gaspRanges := nil; 403 end; 404 405 table := Lookup_TrueType_Table( face, 'gasp' ); 406 if ( table < 0 ) then 407 begin 408 Load_TrueType_Gasp := Success; 409 exit; 410 end; 411 412 if astream.SeekFile( face^.dirTables^[table].Offset ) or 413 AStream.AccessFrame( 4 ) then exit; 414 415 with AStream, face^.gasp do 416 begin 417 version := Get_UShort; 418 numRanges := Get_UShort; 419 gaspRanges := nil; 420 end; 421 422 AStream.ForgetFrame; 423 424 gRanges:=nil; 425 if Alloc( gRanges, face^.gasp.numRanges * sizeof(TGaspRange) ) or 426 AStream.AccessFrame( face^.gasp.numRanges * 4 ) then 427 goto Fail; 428 429 face^.gasp.gaspRanges := gRanges; 430 431 for i := 0 to face^.gasp.numRanges-1 do 432 with AStream, gRanges^[i] do 433 begin 434 maxPPEM := Get_UShort; 435 gaspFlag := Get_UShort; 436 end; 437 438 AStream.ForgetFrame; 439 440 Load_TrueType_Gasp := Success; 441 exit; 442 443 Fail: 444 Free( gRanges ); 445 face^.gasp.numRanges := 0; 446 end; 447 448 449 (******************************************************************* 450 * 451 * Function : Load_TrueType_Header 452 * 453 * Description : Load the TrueType header table in the resident 454 * table 455 * 456 * Input : face current leading segment. 457 * 458 * Output : True on success. False on failure 459 * 460 * Notes : A font header is a static table that owns no 461 * subttable. It has then no constructor nor destructor 462 * 463 ******************************************************************) 464 Load_TrueType_Headernull465 function Load_TrueType_Header( AStream: TFreeTypeStream; face : PFace ) : TError; 466 var 467 i : int; 468 begin 469 Load_TrueType_Header := Failure; 470 471 {$IFDEF FREETYPE_DEBUG} Write('Header '); {$ENDIF} 472 473 i := LookUp_Mandatory_Table(face, 'head'); 474 if i <= 0 then exit; 475 476 with face^ do 477 begin 478 479 if AStream.SeekFile( dirTables^[i].offset ) or 480 AStream.AccessFrame(54 ) then exit; 481 482 with AStream, FontHeader do 483 begin 484 485 ULong(Table_Version) := GET_ULong; 486 ULong(Font_Revision) := GET_ULong; 487 488 Checksum_Adjust := GET_Long; 489 Magic_Number := GET_Long; 490 491 Flags := GET_UShort; 492 Units_Per_EM := GET_UShort; 493 494 Created [0] := GET_Long; Created [1] := GET_Long; 495 Modified[0] := GET_Long; Modified[1] := GET_Long; 496 497 xMin := GET_Short; 498 yMin := GET_SHort; 499 xMax := GET_SHort; 500 yMax := GET_Short; 501 502 Mac_Style := GET_UShort; 503 Lowest_Rec_PPEM := GET_UShort; 504 505 Font_Direction := GET_Short; 506 Index_To_Loc_Format := GET_Short; 507 Glyph_Data_Format := GET_Short; 508 509 {$IFDEF FREETYPE_DEBUG} Writeln('Units per EM : ',Units_Per_EM ); {$ENDIF} 510 511 end; 512 513 AStream.ForgetFrame; 514 515 end; 516 517 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 518 519 Load_TrueType_Header := Success; 520 end; 521 522 (******************************************************************* 523 * 524 * Function : Load_TrueType_Metrics 525 * 526 * Description : Load TrueType metrics either from the "hmtx" or 527 * "vmtx" table. 528 * 529 * Input : face current resident leading segment 530 * vertical boolean. When set, try to load the vertical 531 * header. 532 * 533 * Output : True on success. False on failure 534 * 535 ******************************************************************) 536 Load_TrueType_Metricsnull537 function Load_TrueType_Metrics( AStream: TFreeTypeStream; face : PFace; 538 vertical : Boolean ) : TError; 539 var 540 table, n : int; 541 num_longs : int; 542 num_shorts : int; 543 num_shorts_checked : int; 544 temp : Short; 545 546 header : ^TT_Horizontal_Header; 547 548 shorts : ^PTableShortMetrics; 549 longs : ^PTableLongMetrics; 550 551 begin 552 Load_TrueType_Metrics := Failure; 553 554 {$IFDEF FREETYPE_DEBUG} 555 if vertical then 556 Write('vmtx ') 557 else 558 Write('hmtx '); 559 {$ENDIF} 560 561 if vertical then 562 begin 563 564 table := LookUp_TrueType_Table( face, 'vmtx' ); 565 if table < 0 then 566 begin 567 (* This is an optional table. Return silently if it *) 568 (* wasn't found. Note : some fonts have a vertical *) 569 (* header, but no 'vmtx'. E.g. : mingliu.ttf *) 570 571 face^.verticalHeader.number_Of_VMetrics := 0; 572 Load_TrueType_Metrics := Success; 573 exit; 574 end; 575 576 header := @TT_Horizontal_Header(face^.verticalHeader); 577 end 578 else 579 begin 580 table := LookUp_Mandatory_Table( face, 'hmtx' ); 581 if table < 0 then 582 exit; 583 584 header := @face^.horizontalHeader; 585 end; 586 587 588 shorts := @PTableShortMetrics(header^.short_metrics); 589 longs := @PTableLongMetrics (header^.long_metrics ); 590 591 num_longs := header^.number_Of_HMetrics; 592 num_shorts := face^.numGlyphs - num_longs; 593 594 num_shorts_checked := (face^.dirTables^[table].Length - num_longs*4) div 2; 595 596 if num_shorts < 0 then 597 begin 598 {$IFDEF FREETYPE_DEBUG} Writeln('!! More metrics than glyphs !\n'); {$ENDIF} 599 if vertical then error := TT_Err_Invalid_Vert_Metrics 600 else error := TT_Err_Invalid_Horiz_Metrics; 601 exit; 602 end; 603 604 if Alloc( longs^, sizeof(TLongMetrics) * num_longs ) or 605 Alloc( shorts^, sizeof(TShortMetrics)* num_shorts ) or 606 607 AStream.SeekFile( face^.dirTables^[table].Offset ) or 608 AStream.AccessFrame( face^.dirTables^[table].Length ) then exit; 609 610 for n := 0 to num_longs-1 do with longs^^[n] do 611 begin 612 advance := AStream.GET_UShort; 613 bearing := AStream.GET_Short; 614 end; 615 616 (* do we have an inconsistent number of metric values ? *) 617 if num_shorts > num_shorts_checked then 618 begin 619 for n := 0 to num_shorts_checked-1 do 620 shorts^^[n] := AStream.GET_Short; 621 622 (* we fill up the missing left side bearings with the *) 623 (* last valid value. Since this will occur for buggy CJK *) 624 (* fonts usually, nothing serious will happen. *) 625 626 temp := shorts^^[num_shorts_checked-1]; 627 628 for n := num_shorts_checked to num_shorts-1 do 629 shorts^^[n] := temp; 630 end 631 else 632 for n := 0 to num_shorts-1 do 633 shorts^^[n] := AStream.GET_Short; 634 635 AStream.ForgetFrame; 636 637 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 638 639 Load_TrueType_Metrics := Success; 640 end; 641 642 643 (******************************************************************* 644 * 645 * Function : Load_TrueType_Metrics_Header 646 * 647 * Description : 648 * 649 * Input : face current resident leading segment 650 * vertical boolean. When set, try to load the vertical 651 * header. 652 * 653 * Output : True on success. False on failure 654 * 655 ******************************************************************) 656 Load_TrueType_Metrics_Headernull657 function Load_TrueType_Metrics_Header( AStream: TFreeTypeStream; face : PFace; 658 vertical : Boolean ) : TError; 659 var 660 table : int; 661 header : ^TT_Horizontal_Header; 662 begin 663 Load_TrueType_Metrics_Header := Failure; 664 665 {$IFDEF FREETYPE_DEBUG} 666 if vertical then 667 Write('Vertical Header ') 668 else 669 Write('Horizontal Header '); 670 {$ENDIF} 671 672 if vertical then 673 begin 674 face^.verticalInfo := False; 675 676 (* the vertical header is an optional table.. so return *) 677 (* silently if we don't find it *) 678 table := LookUp_TrueType_Table( face, 'vhea' ); 679 if (table < 0) then 680 begin 681 Load_TrueType_Metrics_Header := Success; 682 exit; 683 end; 684 685 face^.verticalInfo := True; 686 header := @TT_Horizontal_Header(face^.verticalHeader); 687 end 688 else 689 begin 690 table := LookUp_Mandatory_Table( face, 'hhea'); 691 if ( table < 0 ) then 692 exit; 693 header := @face^.horizontalHeader; 694 end; 695 696 with face^ do 697 begin 698 699 if AStream.SeekFile( dirTables^[table].Offset ) or 700 AStream.AccessFrame( 36 ) then 701 exit; 702 703 with AStream, header^ do 704 begin 705 706 Long(Version) := GET_ULong; 707 Ascender := GET_Short; 708 Descender := GET_Short; 709 Line_Gap := GET_Short; 710 711 advance_Width_Max := GET_UShort; 712 713 min_Left_Side_Bearing := GET_Short; 714 min_Right_Side_Bearing := GET_Short; 715 xMax_Extent := GET_Short; 716 caret_Slope_Rise := GET_Short; 717 caret_Slope_Run := GET_Short; 718 719 Reserved[0] := GET_Short; (* this is cared offset for vertical *) 720 721 Reserved[1] := GET_Short; 722 Reserved[2] := GET_Short; 723 Reserved[3] := GET_Short; 724 Reserved[4] := GET_Short; 725 726 metric_Data_Format := GET_Short; 727 number_Of_HMetrics := GET_UShort; 728 729 short_metrics := nil; 730 long_metrics := nil; 731 732 end; 733 734 AStream.ForgetFrame; 735 736 end; 737 738 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 739 740 Load_TrueType_Metrics_Header := Load_TrueType_Metrics( AStream, face, vertical ); 741 end; 742 743 (******************************************************************* 744 * 745 * Function : Load_TrueType_Locations 746 * 747 * Description : Loads the location table in resident table 748 * 749 * Input : face Current Resident Leading Segment 750 * 751 * Output : True on success. False on failure 752 * 753 * NOTES : 754 * 755 * The Font Header *must* be loaded in the leading segment 756 * before calling this function. 757 * 758 * This table is destroyed directly by the resident destructor. 759 * 760 ******************************************************************) 761 Load_TrueType_Locationsnull762 function Load_TrueType_Locations( AStream: TFreeTypeStream; face : PFace ): TError; 763 var 764 t, n : int; 765 LongOffsets : int; 766 begin 767 768 Load_TrueType_Locations := Failure; 769 770 {$IFDEF FREETYPE_DEBUG} Write('Locations '); {$ENDIF} 771 772 with face^ do 773 begin 774 775 LongOffsets := fontHeader.Index_To_Loc_Format; 776 777 t := LookUp_Mandatory_Table( face, 'loca' ); 778 if t < 0 then exit; 779 780 if AStream.SeekFile( dirTables^[T].Offset ) then exit; 781 782 if LongOffsets <> 0 then 783 begin 784 785 numLocations := dirTables^[T].Length shr 2; 786 787 {$IFDEF FREETYPE_DEBUG} 788 Writeln('Glyph locations # ( 32 bits offsets ) : ', numLocations ); 789 {$ENDIF} 790 791 if Alloc( glyphLocations, sizeof(Long)*numLocations ) or 792 AStream.AccessFrame( numLocations*4 ) then exit; 793 794 for n := 0 to numLocations-1 do 795 glyphLocations^[n] := AStream.GET_Long; 796 797 AStream.ForgetFrame; 798 799 end 800 else 801 begin 802 numLocations := dirTables^[T].Length shr 1; 803 804 {$IFDEF FREETYPE_DEBUG} 805 Writeln('Glyph locations # ( 16 bits offsets ) : ', numLocations ); 806 {$ENDIF} 807 808 if Alloc( glyphLocations, sizeof(Long)*numLocations ) or 809 AStream.AccessFrame( numLocations*2 ) then exit; 810 811 for n := 0 to numLocations-1 do 812 glyphLocations^[n] := Long(AStream.GET_UShort) * 2; 813 814 AStream.ForgetFrame; 815 end; 816 817 end; 818 819 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 820 821 Load_TrueType_Locations := Success; 822 end; 823 824 825 (******************************************************************* 826 * 827 * Function : Load_TrueType_Names 828 * 829 * Description : Loads the name table into the face table 830 * 831 * Input : face 832 * 833 * Output : True on success. False on failure 834 * 835 * Notes : This attribute table is destroyed by the resident 836 * destructor. 837 * 838 ******************************************************************) 839 Load_TrueType_Namesnull840 function Load_TrueType_Names( AStream: TFreeTypeStream; face : PFace ) : TError; 841 var 842 table, i : Int; 843 bytes : Long; 844 begin 845 Load_TrueType_Names := Failure; 846 847 table := Lookup_Mandatory_Table( face, 'name' ); 848 if table < 0 then exit; 849 850 with face^.nameTable do 851 begin 852 (* Seek to the beginning of the table and check the frame access. *) 853 if AStream.SeekFile( face^.dirTables^[table].Offset ) or 854 AStream.AccessFrame(6 ) then exit; 855 856 format := AStream.GET_UShort; 857 numNameRecords := AStream.GET_UShort; 858 storageOffset := AStream.GET_UShort; 859 860 AStream.ForgetFrame; 861 862 if Alloc( names, numNameRecords*sizeof(TName_Record) ) or 863 AStream.AccessFrame( numNameRecords*12 ) then 864 begin 865 numNameRecords := 0; 866 exit; 867 end; 868 869 (* Load the name records and determine how much storage is needed *) 870 (* to hold the strings themselves *) 871 872 bytes := 0; 873 for i := 0 to numNameRecords-1 do with AStream, names^[i] do 874 begin 875 platformID := GET_UShort; 876 encodingID := GET_UShort; 877 languageID := GET_UShort; 878 nameID := GET_UShort; 879 length := GET_UShort; 880 offset := GET_UShort; 881 882 (* this test takes care of 'holes' in the names tabls, as *) 883 (* reported by Erwin *) 884 if long(Offset + Length) > bytes then 885 bytes := Offset + Length; 886 end; 887 888 AStream.ForgetFrame; 889 890 storage := nil; 891 if bytes > 0 then 892 begin 893 if Alloc( storage, bytes ) then exit; 894 895 if AStream.ReadAtFile( face^.dirTables^[table].Offset + storageOffset, 896 storage^, bytes ) then 897 begin 898 Free(storage); 899 exit; 900 end; 901 end; 902 903 end; 904 905 Load_TrueType_Names := Success; 906 exit; 907 end; 908 909 (******************************************************************* 910 * 911 * Function : Load_TrueType_CVT 912 * 913 * Description : 914 * 915 * Input : face 916 * 917 * Output : True on success. False on failure 918 * 919 * Notes : This attribute table is destroyed by the resident 920 * destructor. 921 * 922 ******************************************************************) 923 Load_TrueType_CVTnull924 function Load_TrueType_CVT( AStream: TFreeTypeStream; face : PFace ): TError; 925 var 926 t, n : Int; 927 begin 928 Load_TrueType_CVT := Failure; 929 930 {$IFDEF FREETYPE_DEBUG} Write('CVT '); {$ENDIF} 931 932 (* the CVT table is optional *) 933 934 t := LookUp_TrueType_Table( face, 'cvt '); 935 if t < 0 then 936 begin 937 face^.cvt := nil; 938 face^.cvtSize := 0; 939 Load_TrueType_CVT := Success; 940 {$IFDEF FREETYPE_DEBUG} writeln('none'); {$ENDIF} 941 exit; 942 end; 943 944 with face^ do 945 begin 946 947 cvtSize := dirTables^[t].Length div 2; 948 949 if Alloc( cvt, sizeof(Short)*cvtSize ) or 950 951 AStream.SeekFile( dirTables^[t].Offset ) or 952 953 AStream.AccessFrame(2*cvtSize ) then exit; 954 955 for n := 0 to cvtSize-1 do 956 cvt^[n] := AStream.GET_Short; 957 958 AStream.ForgetFrame; 959 end; 960 961 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 962 Load_TrueType_CVT := Success; 963 end; 964 965 966 (******************************************************************* 967 * 968 * Function : Load_TrueType_CMap 969 * 970 * Description : 971 * 972 * Input : face 973 * 974 * Output : True on success. False on failure 975 * 976 * Notes : The Cmap table directory is destroyed by the resident 977 * destructor. The Cmap subtables must be destroyed by 978 * Free_CMap_Table. 979 * 980 ******************************************************************) 981 Load_TrueType_CMapnull982 function Load_TrueType_CMap( AStream: TFreeTypeStream; face : PFace ) : TError; 983 var 984 off, table_start : Longint; 985 n, t : Int; 986 987 cmap_dir : TCMapDir; 988 entry : TCMapDirEntry; 989 cmap : PCMapTable; 990 label 991 Fail; 992 begin 993 994 Load_TrueType_CMap := Failure; 995 996 {$IFDEF FREETYPE_DEBUG} Write('CMaps '); {$ENDIF} 997 998 t := LookUp_Mandatory_Table( face,'cmap' ); 999 if t < 0 then exit; 1000 1001 with face^ do 1002 begin 1003 1004 table_start := dirTables^[t].offset; 1005 1006 if AStream.SeekFile( dirTables^[t].Offset ) or 1007 AStream.AccessFrame( 4 ) then exit; 1008 1009 cmap_dir.tableVersionNumber := AStream.GET_UShort; 1010 cmap_dir.numCMaps := AStream.GET_UShort; 1011 1012 AStream.ForgetFrame; 1013 1014 off := AStream.Position; 1015 1016 (* save space in face data for cmap tables *) 1017 numCMaps := cmap_dir.numCMaps; 1018 if Alloc( cMaps, numCMaps * sizeof(TCMapTable) ) then exit; 1019 1020 for n := 0 to numCMaps-1 do 1021 begin 1022 1023 if AStream.SeekFile ( off ) or 1024 AStream.AccessFrame( 8 ) then exit; 1025 1026 cmap := @cMaps^[n]; 1027 1028 entry.platformID := AStream.GET_UShort; 1029 entry.platformEncodingID := AStream.GET_UShort; 1030 entry.offset := AStream.GET_Long; 1031 1032 cmap^.loaded := False; 1033 cmap^.platformID := entry.platformID; 1034 cmap^.platformEncodingID := entry.platformEncodingID; 1035 1036 AStream.ForgetFrame; 1037 1038 off := AStream.Position; 1039 1040 if AStream.SeekFile ( table_start + entry.offset ) or 1041 AStream.AccessFrame( 6 ) then exit; 1042 1043 cmap^.format := AStream.Get_UShort; 1044 cmap^.length := AStream.Get_UShort; 1045 cmap^.version := AStream.Get_UShort; 1046 1047 AStream.ForgetFrame; 1048 1049 cmap^.StreamPtr := @face^.stream; 1050 cmap^.offset := AStream.Position; 1051 1052 end; (* for n *) 1053 1054 end; (* with face^ *) 1055 1056 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 1057 1058 Load_TrueType_CMap := Success; 1059 exit; 1060 1061 Fail: 1062 Free( face^.cMaps ); 1063 Load_TrueType_CMap := Failure; 1064 end; 1065 1066 1067 (* 1068 procedure Free_CMap_Table( var cmap : TCMapTable ); 1069 begin 1070 if cmap.cmap0 <> nil then 1071 with cmap do 1072 case format of 1073 1074 0 : begin 1075 Free( cmap0^.glyphIdArray ); 1076 Free( cmap0 ); 1077 end; 1078 1079 2 : begin 1080 Free( cmap2^.glyphIdArray ); 1081 Free( cmap2^.subHeaders ); 1082 Free( cmap2 ); 1083 end; 1084 1085 4 : begin 1086 Free( cmap4^.glyphIdArray ); 1087 Free( cmap4^.segments ); 1088 Free( cmap4 ); 1089 end; 1090 1091 6 : begin 1092 Free( cmap6^.glyphIdArray ); 1093 Free( cmap6 ); 1094 end; 1095 end; 1096 1097 cmap.format := 0; 1098 cmap.length := 0; 1099 cmap.version := 0; 1100 end; 1101 *) 1102 1103 (******************************************************************* 1104 * 1105 * Function : Load_TrueType_Programs 1106 * 1107 * Description : Load the Font and CVT programs in the resident 1108 * table 1109 * 1110 * Input : face 1111 * 1112 * Output : True on success. False on failure 1113 * 1114 ******************************************************************) 1115 Load_TrueType_Programsnull1116 function Load_TrueType_Programs( AStream: TFreeTypeStream; face : PFace ) : TError; 1117 var 1118 t : Int; 1119 begin 1120 1121 Load_TrueType_Programs := Failure; 1122 1123 {$IFDEF FREETYPE_DEBUG} Write('Font program '); {$ENDIF} 1124 1125 (* The font program is optional *) 1126 1127 t := Lookup_TrueType_Table( face, 'fpgm' ); 1128 1129 if t < 0 then 1130 1131 with face^ do 1132 begin 1133 fontProgram := nil; 1134 fontPgmSize := 0; 1135 1136 {$IFDEF FREETYPE_DEBUG} Writeln('none in file'); {$ENDIF} 1137 end 1138 1139 else 1140 1141 with face^ do 1142 begin 1143 1144 fontPgmSize := dirTables^[t].Length; 1145 1146 if Alloc( fontProgram, fontPgmSize ) or 1147 AStream.ReadAtFile( dirTables^[t].offset, 1148 fontProgram^, 1149 fontPgmSize ) then exit; 1150 1151 {$IFDEF FREETYPE_DEBUG} Writeln('loaded, ',fontPgmSize,' bytes'); {$ENDIF} 1152 end; 1153 1154 {$IFDEF FREETYPE_DEBUG} Write('CVT program '); {$ENDIF} 1155 1156 t := LookUp_trueType_Table( face, 'prep' ); 1157 1158 (* The CVT table is optional *) 1159 1160 if t < 0 then 1161 1162 with face^ do 1163 begin 1164 cvtProgram := nil; 1165 cvtPgmSize := 0; 1166 1167 {$IFDEF FREETYPE_DEBUG} Writeln('none in file'); {$ENDIF} 1168 end 1169 1170 else 1171 1172 with face^ do 1173 begin 1174 1175 cvtPgmSize := dirTables^[t].Length; 1176 1177 if Alloc( cvtProgram, cvtPgmSize ) or 1178 AStream.ReadAtFile( dirTables^[t].offset, 1179 cvtProgram^, 1180 cvtPgmSize ) then exit; 1181 1182 {$IFDEF FREETYPE_DEBUG} Writeln('loaded, ',cvtPgmSize,' bytes'); {$ENDIF} 1183 end; 1184 1185 Load_TrueType_Programs := Success; 1186 end; 1187 1188 (******************************************************************* 1189 * 1190 * Function : Load_TrueType_OS2 1191 * 1192 * Description : Load the OS2 Table 1193 * 1194 * Input : face 1195 * 1196 * Output : True on success. False on failure 1197 * 1198 ******************************************************************) 1199 Load_TrueType_OS2null1200 function Load_TrueType_OS2( AStream: TFreeTypeStream; face : PFace ) : TError; 1201 var 1202 table : Int; 1203 i : Int; 1204 begin 1205 Load_TrueType_OS2 := Failure; 1206 1207 {$IFDEF FREETYPE_DEBUG} Write('OS/2 table '); {$ENDIF} 1208 1209 (* We now support Apple fonts who do not have an OS/2 table *) 1210 table := LookUp_Mandatory_Table( face, 'OS/2' ); 1211 if table < 0 then begin 1212 face^.os2.version := $FFFF; 1213 Load_TrueType_OS2 := Success; 1214 error := TT_Err_Ok; (* clear error *) 1215 exit; 1216 end; 1217 1218 if AStream.SeekFile( face^.dirTables^[table].offset ) or 1219 AStream.AccessFrame( 78 ) then exit; 1220 1221 with AStream, face^.os2 do 1222 begin 1223 version := Get_UShort; 1224 xAvgCharWidth := Get_Short; 1225 usWeightClass := Get_UShort; 1226 usWidthClass := Get_UShort; 1227 fsType := Get_Short; 1228 ySubscriptXSize := Get_Short; 1229 ySubscriptYSize := Get_Short; 1230 ySubscriptXOffset := Get_Short; 1231 ySubscriptYOffset := Get_Short; 1232 ySuperscriptXSize := Get_Short; 1233 ySuperscriptYSize := Get_Short; 1234 ySuperscriptXOffset := Get_Short; 1235 ySuperscriptYOffset := Get_Short; 1236 yStrikeoutSize := Get_Short; 1237 yStrikeoutPosition := Get_Short; 1238 sFamilyClass := Get_Short; 1239 1240 for i := 0 to 9 do panose[i] := Get_Byte; 1241 1242 ulUnicodeRange1 := Get_ULong; 1243 ulUnicodeRange2 := Get_ULong; 1244 ulUnicodeRange3 := Get_ULong; 1245 ulUnicodeRange4 := Get_ULong; 1246 1247 for i := 0 to 3 do achVendID[i] := Get_Byte; 1248 1249 fsSelection := Get_UShort; 1250 usFirstCharIndex := Get_UShort; 1251 usLastCharIndex := Get_UShort; 1252 sTypoAscender := Get_Short; 1253 sTypoDescender := Get_Short; 1254 sTypoLineGap := Get_Short; 1255 usWinAscent := Get_UShort; 1256 usWinDescent := Get_UShort; 1257 1258 AStream.ForgetFrame; 1259 1260 if version >= $0001 then 1261 begin 1262 if AStream.AccessFrame(8) then exit; 1263 1264 ulCodePageRange1 := AStream.Get_ULong; 1265 ulCodePageRange2 := AStream.Get_ULong; 1266 1267 AStream.ForgetFrame; 1268 end 1269 else 1270 begin 1271 ulCodePageRange1 := 0; 1272 ulCodePageRange2 := 0; 1273 end; 1274 1275 if version >= $0002 then 1276 begin 1277 if AStream.AccessFrame(10) then exit; 1278 1279 sxHeight := AStream.Get_Short; 1280 sCapHeight := AStream.Get_Short; 1281 usDefaultChar := AStream.Get_UShort; 1282 usBreakChar := AStream.Get_UShort; 1283 usMaxContext := AStream.Get_UShort; 1284 1285 AStream.ForgetFrame; 1286 end; 1287 end; 1288 1289 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 1290 1291 Load_TrueType_OS2 := Success; 1292 end; 1293 1294 (******************************************************************* 1295 * 1296 * Function : Load_TrueType_Postscript 1297 * 1298 * Description : Load the 'post' table 1299 * 1300 * Input : face 1301 * 1302 * Output : True on success. False on failure 1303 * 1304 ******************************************************************) 1305 Load_TrueType_Postscriptnull1306 function Load_TrueType_Postscript( AStream: TFreeTypeStream; face : PFace ) : TError; 1307 var 1308 table : Int; 1309 begin 1310 Load_TrueType_Postscript := Failure; 1311 1312 {$IFDEF FREETYPE_DEBUG} Write('post table '); {$ENDIF} 1313 1314 table := LookUp_TrueType_Table( face, 'post' ); 1315 if table < 0 then exit; 1316 1317 if AStream.SeekFile( face^.dirTables^[table].offset ) or 1318 AStream.AccessFrame(32) then exit; 1319 1320 with AStream, face^.postscript do 1321 begin 1322 formatType := Get_ULong; 1323 italicAngle := Get_ULong; 1324 underlinePosition := Get_Short; 1325 underlineThickness := Get_Short; 1326 isFixedPitch := Get_ULong; 1327 minMemType42 := Get_ULong; 1328 maxMemType42 := Get_ULong; 1329 minMemType1 := Get_ULong; 1330 maxMemType1 := Get_ULong; 1331 end; 1332 1333 AStream.ForgetFrame; 1334 1335 {$IFDEF FREETYPE_DEBUG} Writeln('loaded'); {$ENDIF} 1336 1337 Load_trueType_Postscript := Success; 1338 end; 1339 1340 (******************************************************************* 1341 * 1342 * Function : Load_TrueType_HDMX 1343 * 1344 * Description : Load the 'hdmx' tables 1345 * 1346 * Input : face 1347 * 1348 * Output : True on success. False on failure 1349 * 1350 ******************************************************************) 1351 Load_TrueType_Hdmxnull1352 function Load_TrueType_Hdmx( AStream: TFreeTypeStream; face : PFace ) : TError; 1353 var 1354 table, n : Int; 1355 num_glyphs : Int; 1356 1357 version : UShort; 1358 num_rec : Short; 1359 rec_size : Long; 1360 rec : PHdmx_Record; 1361 label 1362 Fail; 1363 begin 1364 Load_TrueType_Hdmx := Failure; 1365 1366 with face^.hdmx do 1367 begin 1368 version := 0; 1369 num_records := 0; 1370 records := nil; 1371 end; 1372 1373 (* This table is optional *) 1374 1375 table := LookUp_TrueType_Table( face, 'hdmx' ); 1376 if table < 0 then 1377 begin 1378 Load_TrueType_Hdmx := Success; 1379 exit; 1380 end; 1381 1382 if AStream.SeekFile( face^.dirTables^[table].offset ) or 1383 AStream.AccessFrame(8 ) then exit; 1384 1385 version := AStream.Get_UShort; 1386 num_rec := AStream.Get_Short; 1387 rec_size := AStream.Get_Long; 1388 1389 AStream.ForgetFrame; 1390 1391 (* right now, we only recognize format 0 *) 1392 1393 if version <> 0 then 1394 exit; 1395 1396 if Alloc( face^.hdmx.records, sizeof(THdmx_Record)*num_rec ) then 1397 exit; 1398 1399 face^.hdmx.num_records := num_rec; 1400 num_glyphs := face^.NumGlyphs; 1401 1402 rec_size := rec_size - num_glyphs - 2; 1403 1404 for n := 0 to num_rec-1 do 1405 begin 1406 rec := @face^.hdmx.records^[n]; 1407 1408 (* read record *) 1409 1410 if AStream.AccessFrame(2) then 1411 goto Fail; 1412 1413 rec^.ppem := AStream.Get_Byte; 1414 rec^.max_width := AStream.Get_Byte; 1415 1416 AStream.ForgetFrame; 1417 1418 if Alloc( rec^.widths, num_glyphs ) or 1419 AStream.ReadFile( rec^.widths^, num_glyphs ) then 1420 goto Fail; 1421 1422 (* skip padding bytes *) 1423 1424 if rec_size > 0 then 1425 if AStream.SkipFile( rec_size ) then 1426 goto Fail; 1427 end; 1428 1429 Load_TrueType_HDMX := Success; 1430 exit; 1431 1432 Fail: 1433 for n := 0 to num_rec-1 do 1434 Free( face^.hdmx.records^[n].widths ); 1435 1436 Free( face^.hdmx.records ); 1437 face^.hdmx.num_records := 0; 1438 end; 1439 1440 1441 (******************************************************************* 1442 * 1443 * Function : Load_TrueType_Any 1444 * 1445 * Description : Load any TrueType table in user memory 1446 * 1447 * Input : face the font file's face object 1448 * tag the table 1449 * 1450 * Output : True on success. False on failure 1451 * 1452 ******************************************************************) 1453 Load_TrueType_Anynull1454 function Load_TrueType_Any( face : PFace; 1455 tag : longint; 1456 offset : longint; 1457 var buffer; 1458 var length : longint ) : TError; 1459 var 1460 ftstream : TFreeTypeStream; 1461 found, i : integer; 1462 begin 1463 if tag <> 0 then 1464 begin 1465 found := -1; 1466 i := 0; 1467 while i < face^.numTables do 1468 if Longint(face^.dirTables^[i].tag) = tag then 1469 begin 1470 found := i; 1471 i := face^.numTables; 1472 end 1473 else 1474 inc(i); 1475 1476 if found < 0 then 1477 begin 1478 error := TT_Err_Table_Missing; 1479 Load_TrueType_Any := Failure; 1480 exit; 1481 end; 1482 1483 inc( offset, face^.dirTables^[found].offset ); 1484 1485 (* if length = 0, the user requested the table's size *) 1486 if length = 0 then 1487 begin 1488 length := face^.dirTables^[found].length; 1489 Load_TrueType_Any := Success; 1490 exit; 1491 end; 1492 end 1493 else 1494 (* if length = 0 and tag = 0, the user requested the font file's size *) 1495 if length = 0 then 1496 begin 1497 (* return length of font file *) 1498 length := TT_Stream_Size( face^.stream ); 1499 Load_TrueType_Any := Success; 1500 exit; 1501 end; 1502 1503 TT_Use_Stream( face^.stream, ftstream {%H-}); 1504 Load_TrueType_Any := ftstream.ReadAtFile( offset, buffer, length ); 1505 TT_Done_Stream( face^.stream ); 1506 end; 1507 1508 end. 1509 1510