1 (******************************************************************* 2 * 3 * ttobjs.pas 2.0 4 * 5 * Objects definition unit. 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 (* *) 19 (* The four important objects managed by the library are : *) 20 (* *) 21 (* Face : the object for a given typeface *) 22 (* Instance : the object for a face's given pointsize/transform *) 23 (* Context : the object for a given glyph loading/hinting execution *) 24 (* Glyph : the object for a given glyph ( outline and metrics ) *) 25 (* *) 26 (* A Face object is described by a TFace record, and its *) 27 (* associated sub-tables. It is created through a call to the *) 28 (* 'TT_Open_Face' API. *) 29 (* *) 30 (* An Instance object is described by a TInstance record, and *) 31 (* sub-tables. It is created for a given face through a call to the *) 32 (* 'TT_Open_Instance' API. Several instances can share the same face *) 33 (* *) 34 (* The pointsize and/or transform of a given instance object can be *) 35 (* changed on the fly through a call to the 'TT_Reset_Instance' API. *) 36 (* *) 37 (* A Glyph object is used to describe a glyph to the client application *) 38 (* It is made of a TGlyph_Record header, with several sub-tables used *) 39 (* to store, for example, point coordinates or outline info.. *) 40 (* It can hold metrics information and other attributes, as well as *) 41 (* the glyph's outline. A client application can request any kind of *) 42 (* info to the library on a given glyph through the 'TT_Get_Glyph' *) 43 (* call. *) 44 (* *) 45 (* *) 46 (* A Context is described by a TExec_Context record, and sub-tables *) 47 (* Execution contexts are created on demand during the following *) 48 (* operations : *) 49 (* *) 50 (* - creating a new instance ( to read and execute the font program ) *) 51 (* - setting/resetting the pointsize ( to execute the CVT program ) *) 52 (* - during glyph loading ( when hinting is on ) *) 53 (* *) 54 (* They are used to run TrueType instructions and load/store *) 55 (* glyph data that are not part of the Glyph object ( as they're of *) 56 (* no meaning to a client application ). *) 57 (* *) 58 (* The library keeps track of all objects related to a given face : *) 59 (* *) 60 (* A face's instances are kept in two linked lists : one is the 'active' *) 61 (* list, which tracks the face's current opened instances, while the *) 62 (* other is the 'idle' list used to collect/recycle instance objects *) 63 (* when they become unuseful after a 'TT_Close_Instance' call. *) 64 (* *) 65 (* In the same way, a face's execution contexts are kept in two *) 66 (* similar lists. Note that, as contexts are created on demand, *) 67 (* the active and idle contexts lists should always contain few *) 68 (* elements. *) 69 (* *) 70 (* Look also for the following files : *) 71 (* *) 72 (* Face manager : TTFace.pas *) 73 (* Instance manager : TTInst.pas *) 74 (* Context manager : TTExec.pas *) 75 (* Glyph manager : TTGlyph.pas *) 76 (* *) 77 78 unit TTObjs; 79 80 interface 81 82 {$mode Delphi} 83 84 {$I TTCONFIG.INC} 85 {$R-} 86 87 uses LazFreeType, 88 TTTypes, 89 TTError, 90 TTCache, 91 TTTables, 92 TTCMap; 93 94 type 95 (* Graphics State *) 96 (* *) 97 (* The Graphics State (GS) is managed by the *) 98 (* instruction field, but does not come from *) 99 (* the font file. Thus, we can use 'int's *) 100 (* where needed. *) 101 (* *) 102 103 PGraphicsState = ^TGraphicsState; 104 TGraphicsState = record 105 rp0, 106 rp1, 107 rp2 : int; 108 109 dualVector, 110 projVector, 111 freeVector : TT_UnitVector; 112 113 loop : longint; 114 minimum_distance : TT_F26dot6; 115 round_state : int; 116 117 auto_flip : boolean; 118 control_value_cutin : TT_F26dot6; 119 single_width_cutin : TT_F26dot6; 120 single_width_value : TT_F26dot6; 121 delta_base : int; 122 delta_shift : int; 123 124 instruct_control : byte; 125 scan_control : Boolean; 126 scan_type : Int; 127 128 gep0, 129 gep1, 130 gep2 : int; 131 end; 132 133 134 const 135 Default_GraphicsState : TGraphicsState 136 = ( 137 rp0 : 0; 138 rp1 : 0; 139 rp2 : 0; 140 dualVector : ( x:$4000; y:0 ); 141 projVector : ( x:$4000; y:0 ); 142 freeVector : ( x:$4000; y:0 ); 143 loop : 1; 144 minimum_distance : 64; 145 round_state : 1; 146 auto_flip : True; 147 control_value_cutin : 4*17; 148 single_width_cutin : 0; 149 single_width_value : 0; 150 delta_Base : 9; 151 delta_Shift : 3; 152 instruct_control : 0; 153 scan_control : True; 154 scan_type : 0; 155 gep0 : 1; 156 gep1 : 1; 157 gep2 : 1 158 ); 159 160 (**********************************************************************) 161 (* *) 162 (* Execution Subtables : *) 163 (* *) 164 (**********************************************************************) 165 166 const 167 MaxCodeRanges = 3; 168 (* There can only be 3 active code ranges at once : *) 169 (* - the Font Program *) 170 (* - the CVT Program *) 171 (* - a glyph's instructions set *) 172 173 TT_CodeRange_Font = 1; 174 TT_CodeRange_Cvt = 2; 175 TT_CodeRange_Glyph = 3; 176 177 CvtFlag_None = 0; 178 CvtFlag_X = 1; 179 CvtFlag_Y = 2; 180 CvtFlag_Both = 3; 181 182 type 183 TCodeRange = record 184 Base : PByte; 185 Size : Int; 186 end; 187 PCodeRange = ^TCodeRange; 188 189 (* defines a code range *) 190 (* *) 191 (* code ranges can be resident to a glyph ( i.e. the Font Program) *) 192 (* while some others are volatile ( Glyph instructions ) *) 193 (* tracking the state and presence of code ranges allows function *) 194 (* and instruction definitions within a code range to be forgotten *) 195 (* when the range is discarded *) 196 197 TCodeRangeTable = array[1..MaxCodeRanges] of TCodeRange; 198 199 (* defines a function/instruction definition record *) 200 PDefRecord = ^TDefRecord; 201 TDefRecord = record 202 Range : Int; (* in which code range is it located ? *) 203 Start : Int; (* where does it start ? *) 204 Opc : Byte; (* function #, or instruction code *) 205 Active : boolean; (* is the entry active ? *) 206 end; 207 208 PDefArray = ^TDefArray; 209 TDefArray = array[0..99] of TDefRecord; 210 211 (* defines a call record, used to manage function calls *) 212 TCallRecord = record 213 Caller_Range : Int; 214 Caller_IP : Int; 215 Cur_Count : Int; 216 Cur_Restart : Int; 217 end; 218 219 (* defines a simple call stack *) 220 TCallStack = array[0..99] of TCallRecord; 221 PCallStack = ^TCallStack; 222 223 PGlyph_Zone = ^TGlyph_Zone; 224 TGlyph_Zone = record 225 n_points : Int; 226 n_contours : Int; 227 228 org : TT_Points; (* original (scaled) coords *) 229 cur : TT_Points; (* current coordinates *) 230 flags : TT_PTouchTable; 231 232 conEnds : PUShort; 233 end; 234 235 TRound_Function = function( distance, compensation : TT_F26dot6 ) 236 : TT_F26dot6 of object; 237 (* Rounding function, as used by the interpreter *) 238 239 TMove_Function = procedure( zone : PGlyph_Zone; 240 point : Int; 241 distance : TT_F26dot6 ) of object; 242 (* Point displacement along the freedom vector routine, as *) 243 (* used by the interpreter *) 244 245 TProject_Function = function( var P1, P2 : TT_Vector ) : TT_F26dot6 of object; 246 (* Distance projection along one of the proj. vectors, as used *) 247 (* by the interpreter *) 248 249 TFunc_Get_CVT = function ( index : Int ) : TT_F26Dot6 of object; 250 (* Reading a cvt value. Take care of non-square pixels when *) 251 (* needed *) 252 253 TFunc_Set_CVT = procedure( index : Int; value : TT_F26Dot6 ) of object; 254 (* Setting or Moving a cvt value. Take care of non-square *) 255 (* pixels when needed *) 256 257 258 (********************************************************************) 259 (* *) 260 (* Glyph Sub-Tables *) 261 (* *) 262 (********************************************************************) 263 264 PGlyph_Transform = ^TGlyph_Transform; 265 TGlyph_Transform = record 266 xx, xy : TT_Fixed; 267 yx, yy : TT_Fixed; 268 ox, oy : TT_F26Dot6; 269 end; 270 271 PSubglyph_Record = ^TSubglyph_Record; 272 TSubglyph_Record = record 273 index : Int; 274 is_scaled : boolean; 275 is_hinted : boolean; 276 preserve_pps : boolean; 277 278 bbox : TT_BBox; 279 zone : TGlyph_Zone; 280 281 arg1, arg2 : Int; 282 element_flag : Int; 283 transform : TGlyph_Transform; 284 file_offset : Long; 285 286 pp1, pp2 : TT_Vector; 287 288 advanceWidth : Int; 289 leftBearing : Int; 290 end; 291 292 TSubglyph_Stack = array[0..10] of TSubglyph_Record; 293 PSubglyph_Stack = ^TSubglyph_Stack; 294 295 (* A note regarding non-squared pixels : *) 296 (* *) 297 (* ( This text will probably go into some docs at some time, for *) 298 (* now, it is kept there to explain some definitions in the *) 299 (* TIns_Metrics record ). *) 300 (* *) 301 (* The CVT is a one-dimensional array containing values that *) 302 (* control certain important characteristics in a font, like *) 303 (* the height of all capitals, all lowercase letter, default *) 304 (* spacing or stem width/height. *) 305 (* *) 306 (* These values are found in FUnits in the font file, and must be *) 307 (* scaled to pixel coordinates before being used by the CVT and *) 308 (* glyph programs. Unfortunately, when using distinct x and y *) 309 (* resolutions ( or distinct x and y pointsizes ), there are two *) 310 (* possible scalings. *) 311 (* *) 312 (* A first try was to implement a 'lazy' scheme were all values *) 313 (* were scaled when first used. However, some values are always *) 314 (* used in the same direction, and some other are used in many *) 315 (* different circumstances and orientations. *) 316 (* *) 317 (* I have found a simpler way to do the same, and it even seems to *) 318 (* work in most of the cases : *) 319 (* *) 320 (* - all CVT values are scaled to the maximum ppem size *) 321 (* *) 322 (* - when performing a read or write in the CVT, a ratio factor *) 323 (* is used to perform adequate scaling. Example : *) 324 (* *) 325 (* x_ppem = 14 *) 326 (* y_ppem = 10 *) 327 (* *) 328 (* we chose ppem = x_ppem = 14 as the CVT scaling size. All cvt *) 329 (* entries are scaled to it. *) 330 (* *) 331 (* x_ratio = 1.0 *) 332 (* y_ratio = y_ppem/ppem ( < 1.0 ) *) 333 (* *) 334 (* we compute the current ratio like : *) 335 (* *) 336 (* - if projVector is horizontal, ratio = x_ratio = 1.0 *) 337 (* - if projVector is vertical, ratop = y_ratio *) 338 (* - else, ratio = sqrt( (proj.x*x_ratio)**2+(proj.y*y_ratio)**2 ) *) 339 (* *) 340 (* reading a cvt value returns ratio*cvt[index] *) 341 (* writing a cvt value in pixels cvt[index]/ratio *) 342 (* *) 343 (* the current ppem is simple ratio*ppem *) 344 (* *) 345 346 TIns_Metrics = record 347 pointsize : TT_F26Dot6; 348 x_resolution : Int; 349 y_resolution : Int; 350 x_ppem : Int; 351 y_ppem : Int; 352 353 x_scale1 : Long; 354 x_scale2 : Long; 355 y_scale1 : Long; 356 y_scale2 : Long; 357 358 (* for non-square pixels *) 359 x_ratio : Long; 360 y_ratio : Long; 361 362 scale1 : Long; 363 scale2 : Long; 364 ppem : Int; 365 ratio : Long; 366 367 (* compensations *) 368 compensations : array[0..3] of TT_F26Dot6; 369 370 (* flags *) 371 rotated : Boolean; 372 stretched : Boolean; 373 end; 374 375 (********************************************************************) 376 (* *) 377 (* FreeType Face Object *) 378 (* *) 379 (********************************************************************) 380 381 PFace = ^TFace; 382 PInstance = ^TInstance; 383 PExec_Context = ^TExec_Context; 384 385 TFace = record 386 387 stream : TT_Stream; 388 (* i/o stream *) 389 390 ttcHeader : TTTCHeader; 391 (* TrueType collection header, if any was found *) 392 393 maxProfile : TMaxProfile; 394 (* maximum profile table, as defined by the TT Spec *) 395 396 (* Note : *) 397 (* it seems that some maximum values cannot be *) 398 (* taken directly from this table, but rather by *) 399 (* combining some of its fields ( e.g. the max. *) 400 (* number of points seems to be given by *) 401 (* MAX( maxPoints, maxCompositePoints ) *) 402 (* *) 403 (* For this reason, we define later our own *) 404 (* max values that are used to load and allocate *) 405 (* further tables.. *) 406 407 fontHeader : TT_Header; 408 (* the font header as defined by the TT Spec *) 409 410 horizontalHeader : TT_Horizontal_Header; 411 (* the horizontal header, as defined in the spec *) 412 413 verticalInfo : Boolean; 414 (* set to true when vertical data is in the font *) 415 416 verticalHeader : TT_Vertical_Header; 417 (* vertical header table *) 418 419 os2 : TT_OS2; 420 (* 'OS/2' table *) 421 422 postscript : TT_Postscript; 423 (* 'Post' table *) 424 425 hdmx : THdmx; 426 (* 'hdmx' = horizontal device metrics table *) 427 428 nameTable : TName_Table; 429 (* 'name' = name table *) 430 431 numTables : Int; 432 dirTables : PTableDirEntries; 433 (* The directory of the TrueType tables found in *) 434 (* this face's stream *) 435 436 numCMaps : Int; 437 cMaps : PCMapTables; 438 (* the directory of character mappings tables found *) 439 (* for this face.. *) 440 441 numLocations : Int; 442 glyphLocations : PStorage; 443 (* the glyph locations table *) 444 445 (* the hmtx table is now within the horizontal header *) 446 447 fontPgmSize : Int; 448 fontProgram : PByte; 449 (* the font program, if any.. *) 450 451 cvtPgmSize : Int; 452 cvtProgram : PByte; 453 (* the cvt (or 'prep') program, if any.. *) 454 455 cvtSize : Int; 456 cvt : PShort; 457 (* the original, unscaled, control value table *) 458 459 gasp : TGasp; 460 461 (* the following values must be set by the *) 462 (* maximum profile loader.. *) 463 464 numGlyphs : Int; 465 (* the face's total number of glyphs *) 466 467 maxPoints : Int; 468 (* max glyph points number, simple and composite *) 469 470 maxContours : Int; 471 (* max glyph contours number, simple and composite *) 472 473 maxComponents : Int; 474 (* max components in a composite glyph *) 475 476 (* the following lists are used to track active *) 477 (* instance and context objects, as well as *) 478 (* to recycle them.. *) 479 480 (* see 'TTLists'.. *) 481 482 instances : TCache; 483 glyphs : TCache; 484 kernings : TObject; 485 (* various caches for this face's child objects *) 486 487 extension : Pointer; 488 (* a typeless pointer to the face object's extensions *) 489 490 genericP : Pointer; 491 (* generic pointer - see TT_Set/Get_Face_Pointer *) 492 end; 493 494 (********************************************************************) 495 (* *) 496 (* FreeType Instance Object *) 497 (* *) 498 (********************************************************************) 499 500 TInstance = record 501 502 owner : PFace; 503 504 valid : Boolean; 505 metrics : TIns_Metrics; 506 507 numFDefs : Int; (* number of function defs *) 508 maxFDefs : Int; 509 FDefs : PDefArray; (* table of FDefs entries *) 510 511 numIDefs : Int; (* number of instruction defs *) 512 maxIDefs : Int; 513 IDefs : PDefArray; (* table of IDefs entries *) 514 515 maxFunc : Int; (* maximum function number *) 516 maxIns : Int; (* maximum instruction number *) 517 518 codeRangeTable : TCodeRangeTable; 519 520 GS : TGraphicsState; 521 522 storeSize : Int; 523 storage : PStorage; 524 (* the storage area *) 525 526 cvtSize : Int; 527 cvt : PLong; 528 (* the scaled control value table *) 529 530 twilight : TGlyph_Zone; 531 (* the instance's twilight zone *) 532 533 (* debugging variables *) 534 535 debug : Boolean; 536 context : PExec_Context; 537 (* when using the debugger, we must keep the *) 538 (* execution context with the instance object *) 539 (* rather than asking it on demand *) 540 541 genericP: Pointer; 542 (* generic pointer - see TT_Set/Get_Instance_Pointer *) 543 end; 544 545 (********************************************************************) 546 (* *) 547 (* FreeType Execution Context Object *) 548 (* *) 549 (********************************************************************) 550 551 TExec_Context = record 552 553 face : PFace; 554 instance : PInstance; 555 error : Int; 556 interpreter: TObject; 557 558 stackSize : Int; (* size of instance stack *) 559 stack : PStorage; (* current instance stack *) 560 561 zp0, 562 zp1, 563 zp2, 564 twilight, 565 pts : TGlyph_Zone; 566 567 GS : TGraphicsState; 568 569 curRange : Int; (* current code range number *) 570 code : PByte; (* current code range *) 571 IP : Int; (* current instruction pointer *) 572 codeSize : Int; (* size of current range *) 573 574 step_ins : boolean; (* used by the interpreter *) 575 (* if true, go to the next *) 576 (* instruction.. *) 577 578 loadSize : Int; 579 loadStack : PSubglyph_Stack; 580 (* the load stack used to load composite glyphs *) 581 582 glyphIns : PByte; (* glyph instructions *) 583 glyphSize : Int; (* glyph ins. size *) 584 585 callSize : Int; 586 callStack : PCallStack; (* interpreter call stack *) 587 588 period, (* values used for the *) 589 phase, (* 'SuperRounding' *) 590 threshold : TT_F26dot6; 591 592 maxPoints : Int; 593 maxContours : Int; 594 595 (* the following are copies of the variables found *) 596 (* in an instance object *) 597 598 numFDefs : Int; (* number of function defs *) 599 maxFDefs : Int; 600 FDefs : PDefArray; (* table of FDefs entries *) 601 602 numIDefs : Int; (* number of instruction defs *) 603 maxIDefs : Int; 604 IDefs : PDefArray; (* table of IDefs entries *) 605 606 maxFunc : Int; (* maximum function number *) 607 maxIns : Int; (* maximum instruction number *) 608 609 codeRangeTable : TCodeRangeTable; 610 611 storeSize : Int; (* size of current storage *) 612 storage : PStorage; (* storage area *) 613 614 metrics : TIns_Metrics; 615 616 cur_ppem : Int; 617 scale1 : Long; 618 scale2 : Long; 619 cached_metrics : Boolean; 620 621 (* 622 numContours : Int; 623 endContours : PUShort; 624 *) 625 Instruction_Trap : Boolean; 626 (* used by the full-screen debugger. If set, the *) 627 (* interpreter will exit after executing one *) 628 (* opcode. Used to perform single-stepping.. *) 629 630 is_composite : Boolean; 631 (* this flag is true when the glyph is a composite *) 632 (* one. In this case, we measure original distances *) 633 (* in the loaded coordinates (font units), then *) 634 (* scale them appropriately. This get rids of *) 635 (* transformation artifacts (like symetries..) *) 636 637 cvtSize : Int; 638 cvt : PLong; 639 640 (* these variables are proper to the context *) 641 642 F_dot_P : Long; 643 (* the dot product of the free and projection *) 644 (* vector is used in frequent operations.. *) 645 646 func_round : TRound_Function; func_projectnull647 func_project : TProject_Function; 648 func_dualproj : TProject_Function; func_freeProjnull649 func_freeProj : TProject_Function; 650 func_move : TMove_Function; 651 func_read_cvtnull652 func_read_cvt : TFunc_Get_CVT; 653 func_write_cvt : TFunc_Set_CVT; 654 func_move_cvt : TFunc_Set_CVT; 655 (* single width ? *) 656 657 end; 658 659 (********************************************************************) 660 (* *) 661 (* FreeType Glyph Object *) 662 (* *) 663 (********************************************************************) 664 665 PGlyph = ^TGlyph; 666 TGlyph = record 667 face : PFace; 668 metrics : TT_Big_Glyph_Metrics; 669 outline : TT_Outline; 670 671 (* temporary - debugging purposes *) 672 computed_width : Int; 673 precalc_width : Int; 674 is_composite : Boolean; 675 end; 676 677 PFont_Input = ^TFont_Input; 678 TFont_Input = record 679 stream : TT_Stream; (* input stream *) 680 fontIndex : Int; (* index of font in collection *) 681 end; 682 683 (****************************************************************) 684 (* *) 685 (* Code Range Functions *) 686 (* *) 687 (****************************************************************) 688 Goto_CodeRangenull689 function Goto_CodeRange( exec : PExec_Context; 690 range : Int; 691 IP : Int ) : TError; 692 (* Go to a specified coderange *) 693 Get_CodeRangenull694 function Get_CodeRange( exec : PExec_Context; 695 range : Int ) : PCodeRange; 696 (* return a pointer to a given coderange record *) 697 (* used only by the debugger *) 698 Set_CodeRangenull699 function Set_CodeRange( exec : PExec_Context; 700 range : Int; 701 base : Pointer; 702 length : Int ) : TError; 703 (* Set a given code range properties *) 704 Clear_CodeRangenull705 function Clear_CodeRange( exec : PExec_Context; 706 range : Int ) : TError; 707 (* Clear a given code range *) 708 709 (****************************************************************) 710 (* *) 711 (* Management Functions *) 712 (* *) 713 (****************************************************************) 714 New_Contextnull715 function New_Context( instance : PInstance ) : PExec_Context; 716 (* Get a new execution context, either fresh or recycled, for *) 717 (* an instance of the face 'res' *) 718 (* *) 719 (* Notes : - called by 'New_Face_Context' *) 720 (* - assumes that the face mutex is acquired *) 721 722 procedure Done_Context( exec : PExec_Context ); 723 (* Releases an execution context. The context can be destroyed *) 724 (* or recycled, depending on implementation *) 725 (* *) 726 (* Notes : - called by 'Done_Face_Context' *) 727 (* - assumes that the face mutex is acquired *) 728 729 (****************************************************************) 730 (* *) 731 (* Instance Update Functions *) 732 (* *) 733 (****************************************************************) 734 735 procedure Context_Load( exec : PExec_Context; 736 ins : PInstance ); 737 (* update exec's data with the one found in 'ins' *) 738 (* typically before an execution *) 739 740 procedure Context_Save( exec : PExec_Context; 741 ins : PInstance ); 742 (* update ins's data with the one found in 'exec' *) 743 (* typically after an execution *) 744 Context_Runnull745 function Context_Run( exec : PExec_Context; 746 debug : Boolean ) : TError; 747 Instance_Initnull748 function Instance_Init( ins : PInstance ) : TError; 749 Instance_Resetnull750 function Instance_Reset( ins : PInstance; 751 debug : boolean ) : TError; 752 753 Scale_Xnull754 function Scale_X( var metrics : TIns_Metrics; x : TT_Pos ) : TT_Pos; 755 Scale_Ynull756 function Scale_Y( var metrics : TIns_Metrics; y : TT_Pos ) : TT_Pos; 757 TTObjs_Initnull758 function TTObjs_Init : TError; 759 (* Initialize object manager *) 760 761 procedure TTObjs_Done; 762 (* Finalize object manager *) 763 764 var 765 face_cache : TCache; 766 exec_cache : TCache; 767 768 implementation 769 770 uses TTMemory, TTFile, TTCalc, TTLoad, TTInterp; 771 772 function Face_Create( _face : Pointer; 773 _input : Pointer ) : TError; forward; 774 775 function Face_Destroy( _face : Pointer ) : TError; forward; 776 777 function Context_Create( _context : Pointer; 778 _face : Pointer ) : TError; forward; 779 780 function Context_Destroy( exec : Pointer ) : TError; forward; 781 782 function Instance_Create( _ins : Pointer; 783 _face : Pointer ) : TError; forward; 784 785 function Instance_Destroy( instance : Pointer ) : TError; forward; 786 787 function Glyph_Create( _glyph : Pointer; 788 _face : Pointer ) : TError; forward; 789 790 function Glyph_Destroy( _glyph : Pointer ) : TError; forward; 791 792 793 794 const 795 objs_face_class : TCache_Class 796 = (object_size: sizeof(TFace); 797 idle_limit : -1; 798 init : Face_Create; 799 done : Face_Destroy ); 800 801 objs_exec_class : TCache_Class 802 = (object_size: sizeof(TExec_Context); 803 idle_limit : 1; 804 init : Context_Create; 805 done : Context_Destroy ); 806 807 objs_instance_class : TCache_Class 808 = (object_size: sizeof(TInstance); 809 idle_limit : -1; 810 init : Instance_Create; 811 done : Instance_Destroy ); 812 813 objs_glyph_class : TCache_Class 814 = (object_size: sizeof(TGlyph); 815 idle_limit : -1; 816 init : Glyph_Create; 817 done : Glyph_Destroy ); 818 819 (******************************************************************* 820 * 821 * Function : New_Context 822 * 823 * Description : gets a new active execution context for a given 824 * resident/face object. 825 * 826 * Input : aResident 827 * 828 * Output : Returns new exec. context. Nil in case of failure 829 * 830 * Notes : Don't forget to modify 'Free_Context' if you change 831 * the fields of a TExec_Context 832 * 833 ******************************************************************) 834 New_Contextnull835 function New_Context( instance : PInstance ) : PExec_Context; 836 var 837 exec : PExec_Context; 838 begin 839 if instance = nil then 840 exec := nil 841 else 842 Cache_New( exec_cache, Pointer(exec), instance^.owner ); 843 844 New_Context := exec; 845 end; 846 847 (******************************************************************* 848 * 849 * Function : Done_Context 850 * 851 * Description : 852 * 853 * Input : aResident 854 * 855 * Output : Discards an active execution context when it 856 * becomes unuseful. It is putin its face's recycle 857 * list 858 * 859 ******************************************************************) 860 861 procedure Done_Context( exec : PExec_Context ); 862 begin 863 if exec <> nil then 864 Cache_Done( exec_cache, Pointer(exec) ); 865 end; 866 867 (******************************************************************* 868 * 869 * Function : New_Instance 870 * 871 * Description : gets a new active instance for a given 872 * face object. 873 * 874 * Input : face 875 * 876 * Output : Returns new instance. Nil in case of failure 877 * 878 ******************************************************************) 879 New_Instancenull880 function New_Instance( face : PFace ) : PInstance; 881 var 882 ins : PInstance; 883 begin 884 if face = nil then 885 ins := nil 886 else 887 Cache_New( face^.instances, Pointer(ins), face ); 888 889 New_Instance := ins; 890 end; 891 892 (******************************************************************* 893 * 894 * Function : Done_Instance 895 * 896 * Description : 897 * 898 * Input : instance 899 * 900 * Output : Discards an active instance when it 901 * becomes unuseful. It is put in its face's recycle 902 * list 903 * 904 ******************************************************************) 905 906 procedure Done_Instance( instance : PInstance ); 907 begin 908 if instance <> nil then 909 Cache_Done( instance^.owner^.instances, Pointer(instance) ); 910 end; 911 912 (****************************************************************) 913 (* *) 914 (* Code Range Functions *) 915 (* *) 916 (****************************************************************) 917 918 (******************************************************************* 919 * 920 * Function : Goto_CodeRange 921 * 922 * Description : Switch to a new code range (updates Code and IP). 923 * 924 * Input : exec target execution context 925 * range new execution code range 926 * IP new IP in new code range 927 * 928 * Output : SUCCESS on success. FAILURE on error (no code range). 929 * 930 *****************************************************************) 931 Goto_CodeRangenull932 function Goto_CodeRange( exec : PExec_Context; 933 range : Int; 934 IP : Int ) : TError; 935 begin 936 Goto_CodeRange := Failure; 937 938 if (range < 1) or (range > 3) then 939 begin 940 error := TT_Err_Bad_Argument; 941 exit; 942 end; 943 944 with exec^.codeRangeTable[range] do 945 begin 946 947 if base = nil then 948 begin 949 error := TT_Err_Invalid_CodeRange; 950 exit; 951 end; 952 953 (* NOTE : Because the last instruction of a program may be a CALL *) 954 (* which will return to the first byte *after* the code *) 955 (* range, we test for IP <= Size, instead of IP < Size. *) 956 957 if IP > size then 958 begin 959 error := TT_Err_Code_Overflow; 960 exit; 961 end; 962 963 exec^.code := base; 964 exec^.codeSize := size; 965 exec^.IP := IP; 966 exec^.currange := range; 967 end; 968 969 Goto_CodeRange := Success; 970 end; 971 972 (******************************************************************* 973 * 974 * Function : Get_CodeRange 975 * 976 * Description : Returns a pointer to a given code range. Should 977 * be used only by the debugger. Returns NULL if 978 * 'range' is out of current bounds. 979 * 980 * Input : exec target execution context 981 * range new execution code range 982 * 983 * Output : Pointer to the code range record. NULL on failure. 984 * 985 *****************************************************************) 986 Get_CodeRangenull987 function Get_CodeRange( exec : PExec_Context; 988 range : Int ) : PCodeRange; 989 begin 990 if (range < 1) or (range > 3) then 991 Get_CodeRange := nil 992 else 993 Get_CodeRange := @exec^.codeRangeTable[range]; 994 end; 995 996 (******************************************************************* 997 * 998 * Function : Set_CodeRange 999 * 1000 * Description : Sets a code range. 1001 * 1002 * Input : exec target execution context 1003 * range code range index 1004 * base new code base 1005 * length sange size in bytes 1006 * 1007 * Output : SUCCESS on success. FAILURE on error. 1008 * 1009 *****************************************************************) 1010 Set_CodeRangenull1011 function Set_CodeRange( exec : PExec_Context; 1012 range : Int; 1013 base : Pointer; 1014 length : Int ) : TError; 1015 begin 1016 Set_CodeRange := Failure; 1017 1018 if (range < 1) or (range > 3) then 1019 begin 1020 error := TT_Err_Invalid_CodeRange; 1021 exit; 1022 end; 1023 1024 exec^.codeRangeTable[range].base := base; 1025 exec^.codeRangeTable[range].size := length; 1026 1027 Set_CodeRange := Success; 1028 end; 1029 1030 (******************************************************************* 1031 * 1032 * Function : Clear_CodeRange 1033 * 1034 * Description : clears a code range. 1035 * 1036 * Input : exec target execution context 1037 * range code range index 1038 * 1039 * Output : SUCCESS on success. FAILURE on error. 1040 * 1041 * Notes : Does not set the Error variable. 1042 * 1043 *****************************************************************) 1044 Clear_CodeRangenull1045 function Clear_CodeRange( exec : PExec_Context; 1046 range : Int ) : TError; 1047 begin 1048 Clear_CodeRange := Failure; 1049 1050 if (range < 1) or (range > 3) then 1051 begin 1052 error := TT_Err_Invalid_CodeRange; 1053 exit; 1054 end; 1055 1056 exec^.codeRangeTable[range].base := nil; 1057 exec^.codeRangeTable[range].size := 0; 1058 1059 Clear_CodeRange := Success; 1060 end; 1061 1062 1063 (****************************************************************) 1064 (* *) 1065 (* Management Functions *) 1066 (* *) 1067 (****************************************************************) 1068 1069 (******************************************************************* 1070 * 1071 * Function : Context_Destroy 1072 * 1073 * Description : Frees an execution context 1074 * 1075 * Input : context : execution context 1076 * 1077 * Notes : Allocation is found in the 'New_Context' function 1078 * 1079 ******************************************************************) 1080 Context_Destroynull1081 function Context_Destroy( exec : Pointer ) : TError; 1082 begin 1083 Context_Destroy := Success; 1084 1085 if exec = nil then exit; 1086 1087 with PExec_Context(exec)^ do 1088 begin 1089 interpreter.Free; 1090 interpreter := nil; 1091 1092 (* Free contours array *) 1093 Free( pts.conEnds ); 1094 pts.n_contours := 0; 1095 1096 Free( pts.cur ); 1097 Free( pts.org ); 1098 1099 Free( pts.flags ); 1100 pts.n_points := 0; 1101 1102 (* Free stack *) 1103 Free( stack ); 1104 stackSize := 0; 1105 1106 (* Free call stack *) 1107 Free( callStack ); 1108 callSize := 0; 1109 1110 (* Free composite load stack *) 1111 Free( loadStack ); 1112 1113 (* free glyph code range *) 1114 Free( glyphIns ); 1115 glyphSize := 0; 1116 1117 instance := nil; 1118 face := nil; 1119 end; 1120 end; 1121 1122 1123 (******************************************************************* 1124 * 1125 * Function : Context_Create 1126 * 1127 * Description : Creates a new execution context 1128 * 1129 * Input : _context context record 1130 * _face face record 1131 * 1132 ******************************************************************) 1133 Context_Createnull1134 function Context_Create( _context : Pointer; 1135 _face : Pointer ) : TError; 1136 var 1137 exec : PExec_Context; 1138 label 1139 Fail_Memory; 1140 begin 1141 Context_Create := Failure; 1142 1143 exec := PExec_Context(_context); 1144 exec^.face := PFace(_face); 1145 1146 with exec^ do 1147 begin 1148 1149 interpreter := nil; 1150 1151 callSize := 32; 1152 loadSize := face^.maxComponents + 1; 1153 storeSize := face^.MaxProfile.maxStorage; 1154 stackSize := face^.MaxProfile.maxStackElements + 32; 1155 (* Allocate a little extra for broken fonts like Courbs.ttf *) 1156 (* and Timesbs.ttf *) 1157 1158 //n_points := face^.maxPoints + 2; 1159 1160 (* Reserve glyph code range *) 1161 if Alloc( glyphIns, face^.MaxProfile.maxSizeOfInstructions ) or 1162 1163 (* Reserve call stack *) 1164 Alloc( callStack, callSize*sizeof(TCallRecord) ) or 1165 1166 (* Reserve stack *) 1167 Alloc( stack, stackSize*sizeof(Long) ) then 1168 1169 (* we don't reserve the points and contours arrays anymore *) 1170 (* as this will be performed automatically by a Context_Load *) 1171 1172 (* the same is true for the load stack *) 1173 1174 goto Fail_Memory; 1175 1176 maxPoints := 0; 1177 maxContours := 0; 1178 1179 loadSize := 0; 1180 loadStack := nil; 1181 1182 pts.n_points := 0; 1183 pts.n_contours := 0; 1184 1185 instance := nil; 1186 end; 1187 1188 Context_Create := Success; 1189 exit; 1190 1191 Fail_Memory: 1192 Context_Destroy(_context); 1193 error := TT_Err_Out_Of_Memory; 1194 exit; 1195 end; 1196 1197 (******************************************************************* 1198 * 1199 * Function : Context_Run 1200 * 1201 * Description : Run a glyph's bytecode stream 1202 * 1203 * Input : exec context record 1204 * 1205 ******************************************************************) 1206 Context_Runnull1207 function Context_Run( exec : PExec_Context; 1208 debug : Boolean ) : TError; 1209 begin 1210 Context_Run := Failure; 1211 1212 if Goto_CodeRange( exec, TT_CodeRange_Glyph, 0 ) then 1213 exit; 1214 1215 with exec^ do 1216 begin 1217 zp0 := pts; 1218 zp1 := pts; 1219 zp2 := pts; 1220 GS.gep0 := 1; 1221 GS.gep1 := 1; 1222 GS.gep2 := 1; 1223 1224 GS.projVector.x := $4000; 1225 GS.projVector.y := $0000; 1226 GS.freeVector := GS.projVector; 1227 GS.dualVector := GS.projVector; 1228 GS.round_state := 1; 1229 GS.loop := 1; 1230 end; 1231 1232 if not debug and Run_Ins( @exec^ ) then 1233 begin 1234 error := exec^.error; 1235 exit; 1236 end; 1237 1238 Context_Run := Success; 1239 end; 1240 1241 (****************************************************************) 1242 (* *) 1243 (* Instance Update Functions *) 1244 (* *) 1245 (****************************************************************) 1246 1247 (******************************************************************* 1248 * 1249 * Function : Context_Load 1250 * 1251 * Description : loads instance data into a new execution context 1252 * 1253 *******************************************************************) 1254 1255 procedure Context_Load( exec : PExec_Context; 1256 ins : PInstance ); 1257 1258 procedure Update_Max( var size : Int; 1259 mult : Int; 1260 var buff; 1261 new_max : Int ); 1262 begin 1263 if size*mult < new_max then 1264 begin 1265 Free(buff); 1266 Alloc( buff, new_max*mult ); 1267 size := new_max; 1268 end; 1269 end; 1270 1271 1272 procedure Update_Points( max_points : Int; 1273 max_contours : Int; 1274 exec : PExec_Context ); 1275 begin 1276 if exec^.maxPoints < max_points then 1277 begin 1278 Free( exec^.pts.org ); 1279 Free( exec^.pts.cur ); 1280 Free( exec^.pts.flags ); 1281 1282 Alloc( exec^.pts.org, 2*sizeof(TT_F26dot6)*max_points ); 1283 Alloc( exec^.pts.cur, 2*sizeof(TT_F26dot6)*max_points ); 1284 Alloc( exec^.pts.flags, sizeof(Byte) *max_points ); 1285 1286 exec^.maxPoints := max_points; 1287 end; 1288 1289 if exec^.maxContours < max_contours then 1290 begin 1291 Free( exec^.pts.conEnds ); 1292 Alloc( exec^.pts.conEnds, sizeof(Short)*max_contours ); 1293 exec^.maxContours := max_contours; 1294 end; 1295 end; 1296 1297 1298 begin 1299 with exec^ do 1300 begin 1301 1302 instance := ins; 1303 face := ins^.owner; 1304 1305 numFDefs := ins^.numFDefs; 1306 numIDefs := ins^.numIDefs; 1307 maxFDefs := ins^.maxFDefs; 1308 maxIDefs := ins^.maxIDefs; 1309 FDefs := ins^.FDefs; 1310 IDefs := ins^.IDefs; 1311 maxFunc := ins^.maxFunc; 1312 maxIns := ins^.maxIns; 1313 1314 metrics := ins^.metrics; 1315 1316 codeRangeTable := ins^.codeRangeTable; 1317 1318 storeSize := ins^.storeSize; 1319 storage := ins^.storage; 1320 1321 twilight := ins^.twilight; 1322 1323 (* We reserve some extra space to deal with broken fonts *) 1324 (* like Arial BS, Courier BS, etc.. *) 1325 Update_Max( stackSize, 1326 sizeof(Long), 1327 stack, 1328 face^.maxProfile.maxStackElements+32 ); 1329 1330 Update_Max( loadSize, 1331 sizeof(TSubglyph_Record), 1332 loadStack, 1333 face^.maxComponents+1 ); 1334 1335 Update_Max( glyphSize, 1336 sizeof(Byte), 1337 glyphIns, 1338 face^.maxProfile.maxSizeOfInstructions ); 1339 1340 (* XXXX : Don't forget the phantom points !! *) 1341 Update_Points( face^.maxPoints+2, face^.maxContours, exec ); 1342 1343 pts.n_points := 0; 1344 pts.n_contours := 0; 1345 1346 instruction_trap := false; 1347 1348 (* Set default graphics state *) 1349 GS := ins^.GS; 1350 1351 cvtSize := ins^.cvtSize; 1352 cvt := ins^.cvt; 1353 end; 1354 end; 1355 1356 1357 procedure Context_Save( exec : PExec_Context; 1358 ins : PInstance ); 1359 begin 1360 with ins^ do 1361 begin 1362 error := exec^.error; 1363 1364 numFDefs := exec^.numFDefs; 1365 numIDefs := exec^.numIDefs; 1366 maxFunc := exec^.maxFunc; 1367 maxIns := exec^.maxIns; 1368 1369 codeRangeTable := exec^.codeRangeTable; 1370 1371 (* Set default graphics state *) 1372 1373 GS := exec^.GS; 1374 end; 1375 end; 1376 1377 (******************************************************************* 1378 * 1379 * Function : Instance_Destroy 1380 * 1381 * Description : The Instance Record destructor. 1382 * 1383 *****************************************************************) 1384 Instance_Destroynull1385 function Instance_Destroy( instance : Pointer ) : TError; 1386 var 1387 ins : PInstance; 1388 begin 1389 1390 Instance_Destroy := Success; 1391 1392 ins := PInstance(instance); 1393 if ins = nil then 1394 exit; 1395 1396 with ins^ do 1397 begin 1398 1399 if debug then 1400 begin 1401 context := nil; 1402 debug := false; 1403 end; 1404 1405 (* Free twilight zone *) 1406 Free( twilight.org ); 1407 Free( twilight.cur ); 1408 Free( twilight.flags ); 1409 twilight.n_points := 0; 1410 1411 Free( cvt ); 1412 cvtSize := 0; 1413 1414 Free( storage ); 1415 storeSize := 0; 1416 1417 Free( FDefs ); 1418 Free( IDefs ); 1419 numFDefs := 0; 1420 numIDefs := 0; 1421 maxFDefs := 0; 1422 maxIDefs := 0; 1423 1424 owner := nil; 1425 valid := false; 1426 1427 end; 1428 end; 1429 1430 (******************************************************************* 1431 * 1432 * Function : Instance_Create 1433 * 1434 * Description : The Instance constructor. 1435 * 1436 * This functions creates a new instance object for a given face 1437 * 1438 *****************************************************************) 1439 Instance_Createnull1440 function Instance_Create( _ins : Pointer; 1441 _face : Pointer ) : TError; 1442 label 1443 Fail_Memory; 1444 var 1445 ins : PInstance; 1446 face : PFace; 1447 1448 n_twilight : Int; 1449 begin 1450 Instance_Create := Failure; 1451 1452 {$IFDEF ASSERT} 1453 if (_face = nil) then 1454 Panic1('TTInst.Init_Instance : void argument' ); 1455 {$ENDIF} 1456 1457 face := PFace(_face); 1458 ins := PInstance(_ins); 1459 1460 ins^.owner := face; 1461 1462 with face^, ins^ do 1463 begin 1464 1465 (* Reserve function and instruction defs arrays *) 1466 maxFDefs := maxProfile.maxFunctionDefs; 1467 maxIDefs := maxProfile.maxInstructionDefs; 1468 storeSize := maxProfile.maxStorage; 1469 n_twilight := maxProfile.maxTwilightPoints; 1470 1471 if Alloc( FDefs, maxFDefs * sizeof(TDefRecord) ) or 1472 Alloc( IDefs, maxIDefs * sizeof(TDefRecord) ) or 1473 Alloc( storage, storeSize * sizeof(Long) ) or 1474 1475 Alloc( twilight.org, 2* n_twilight * sizeof(TT_F26Dot6) ) or 1476 Alloc( twilight.cur, 2* n_twilight * sizeof(TT_F26Dot6) ) or 1477 Alloc( twilight.flags, n_twilight ) 1478 1479 then goto Fail_Memory; 1480 1481 twilight.n_points := n_twilight; 1482 1483 metrics.x_resolution := 96; 1484 metrics.y_resolution := 96; 1485 metrics.pointSize := 10; 1486 metrics.x_scale2 := 1; 1487 metrics.y_scale2 := 1; 1488 metrics.scale2 := 1; 1489 1490 { Reserve Control Value Table } 1491 cvtSize := face^.cvtSize; 1492 1493 if Alloc( cvt, cvtSize * sizeof(Long) ) then 1494 goto Fail_Memory; 1495 1496 end; 1497 1498 Instance_Create := Success; 1499 exit; 1500 1501 Fail_Memory: 1502 Instance_Destroy(ins); 1503 (* free all partially allocated tables, including the instance record *) 1504 1505 error := TT_Err_Out_Of_Memory; 1506 exit; 1507 end; 1508 1509 1510 (******************************************************************* 1511 * 1512 * Function : Instance_Init 1513 * 1514 * Description : Initializes a fresh new instance 1515 * Executes the font program if any is found 1516 * 1517 * Input : ins the instance object to initialise 1518 * 1519 *****************************************************************) 1520 Instance_Initnull1521 function Instance_Init( ins : PInstance ) : TError; 1522 var 1523 exec : PExec_Context; 1524 face : PFace; 1525 label 1526 Fin; 1527 begin 1528 Instance_Init := Failure; 1529 1530 face := ins^.owner; 1531 1532 if ins^.debug then 1533 exec := ins^.context 1534 else 1535 exec := New_Context( ins ); 1536 (* debugging instances have their own context *) 1537 1538 if exec = nil then 1539 begin 1540 error := TT_Err_Could_Not_Find_Context; 1541 exit; 1542 end; 1543 1544 with ins^ do begin 1545 GS := Default_GraphicsState; 1546 numFDefs := 0; 1547 numIDefs := 0; 1548 maxFunc := -1; 1549 maxIns := -1; 1550 end; 1551 1552 Context_Load( exec, ins ); 1553 1554 with exec^ do 1555 begin 1556 period := 64; 1557 phase := 0; 1558 threshold := 0; 1559 1560 with metrics do 1561 begin 1562 x_ppem := 10; 1563 y_ppem := 10; 1564 pointSize := 10; 1565 x_scale1 := 0; 1566 x_scale2 := 1; 1567 y_scale1 := 0; 1568 y_scale2 := 1; 1569 1570 scale1 := 0; 1571 scale2 := 1; 1572 ratio := 1 shl 16; 1573 end; 1574 1575 instruction_trap := false; 1576 1577 cvtSize := ins^.cvtSize; 1578 cvt := ins^.cvt; 1579 1580 F_dot_P := $10000; 1581 end; 1582 1583 Set_CodeRange( exec, 1584 TT_CodeRange_Font, 1585 face^.fontProgram, 1586 face^.fontPgmSize ); 1587 (* Allow font program execution *) 1588 1589 Clear_CodeRange( exec, TT_CodeRange_Cvt ); 1590 Clear_CodeRange( exec, TT_CodeRange_Glyph ); 1591 (* disable CVT and glyph programs coderanges *) 1592 1593 if face^.fontPgmSize > 0 then 1594 begin 1595 if Goto_CodeRange( exec, TT_CodeRange_Font, 0 ) then 1596 goto Fin; 1597 1598 if Run_Ins( @exec^ ) then 1599 begin 1600 error := exec^.error; 1601 goto Fin; 1602 end; 1603 end; 1604 1605 Instance_Init := Success; 1606 1607 Fin: 1608 Context_Save( exec, ins ); 1609 1610 if not ins^.debug then 1611 Done_Context( exec ); 1612 1613 ins^.valid := False; 1614 end; 1615 1616 (******************************************************************* 1617 * 1618 * Function : Instance_Reset 1619 * 1620 * Description : Reset an instance to a new pointsize 1621 * Executes the prep/cvt program if any is found 1622 * 1623 * Input : ins the instance object to initialise 1624 * 1625 *****************************************************************) 1626 Instance_Resetnull1627 function Instance_Reset( ins : PInstance; 1628 debug : boolean ) : TError; 1629 var 1630 exec : PExec_Context; 1631 face : PFace; 1632 i : Int; 1633 label 1634 Fin; 1635 begin 1636 Instance_Reset := Failure; 1637 1638 if ins^.valid then 1639 begin 1640 Instance_Reset := Success; 1641 exit; 1642 end; 1643 1644 face := ins^.owner; 1645 1646 (* compute new transform *) 1647 1648 with ins^.metrics do 1649 begin 1650 1651 if x_ppem < 1 then x_ppem := 1; 1652 if y_ppem < 1 then y_ppem := 1; 1653 1654 if x_ppem >= y_ppem then 1655 begin 1656 scale1 := x_scale1; 1657 scale2 := x_scale2; 1658 ppem := x_ppem; 1659 x_ratio := 1 shl 16; 1660 y_ratio := MulDiv_Round( y_ppem, $10000, x_ppem ); 1661 end 1662 else 1663 begin 1664 scale1 := y_scale1; 1665 scale2 := y_scale2; 1666 ppem := y_ppem; 1667 x_ratio := MulDiv_Round( x_ppem, $10000, y_ppem ); 1668 y_ratio := 1 shl 16 1669 end; 1670 end; 1671 1672 (* scale the cvt values to the new ppem *) 1673 1674 for i := 0 to ins^.cvtSize-1 do 1675 ins^.cvt^[i] := MulDiv_Round( ins^.owner^.cvt^[i], 1676 ins^.metrics.scale1, 1677 ins^.metrics.scale2 ); 1678 1679 (* Note that we use the y resolution by default to scale the cvt *) 1680 1681 ins^.GS := Default_GraphicsState; 1682 1683 if ins^.debug then 1684 exec := ins^.context 1685 else 1686 exec := New_Context(ins); 1687 1688 if exec = nil then 1689 begin 1690 error := TT_Err_Could_Not_Find_Context; 1691 exit; 1692 end; 1693 1694 Context_Load( exec, ins ); 1695 1696 Set_CodeRange( exec, 1697 TT_CodeRange_CVT, 1698 face^.cvtProgram, 1699 face^.cvtPgmSize ); 1700 1701 Clear_CodeRange( exec, TT_CodeRange_Glyph ); 1702 1703 with exec^ do 1704 begin 1705 1706 for i := 0 to storeSize-1 do 1707 storage^[i] := 0; 1708 1709 instruction_trap := False; 1710 1711 (* all twilight points are originally zero *) 1712 for i := 0 to twilight.n_points-1 do 1713 begin 1714 twilight.org^[i].x := 0; 1715 twilight.org^[i].y := 0; 1716 twilight.cur^[i].x := 0; 1717 twilight.cur^[i].y := 0; 1718 end; 1719 end; 1720 1721 if face^.cvtPgmSize > 0 then 1722 if Goto_CodeRange( exec, TT_CodeRange_CVT, 0 ) or 1723 ( (not debug) and Run_Ins( @exec^ ) ) then 1724 goto Fin; 1725 1726 Instance_Reset := Success; 1727 1728 Fin: 1729 Context_Save( exec, ins ); 1730 1731 if not ins^.debug then 1732 Done_Context(exec); 1733 1734 if error = 0 then 1735 ins^.valid := True; 1736 end; 1737 1738 1739 (******************************************************************* 1740 * 1741 * Function : Face_Destroy 1742 * 1743 * Description : The face object destructor 1744 * 1745 *****************************************************************) 1746 Face_Destroynull1747 function Face_Destroy( _face : Pointer ) : TError; 1748 var 1749 face : PFace; 1750 n : Int; 1751 begin 1752 Face_Destroy := Success; 1753 1754 face := PFace(_face); 1755 if face = nil then exit; 1756 1757 Cache_Destroy( face^.instances ); 1758 Cache_Destroy( face^.glyphs ); 1759 face^.kernings.Free; 1760 face^.kernings := nil; 1761 1762 (* freeing the tables directory *) 1763 Free( face^.dirTables ); 1764 face^.numTables := 0; 1765 1766 (* freeing the locations table *) 1767 Free( face^.glyphLocations ); 1768 face^.numLocations := 0; 1769 1770 (* freeing the character mapping tables *) 1771 for n := 0 to face^.numCMaps-1 do 1772 CharMap_Free( face^.cMaps^[n] ); 1773 1774 Free( face^.cMaps ); 1775 face^.numCMaps := 0; 1776 1777 (* freeing the CVT *) 1778 Free( face^.cvt ); 1779 face^.cvtSize := 0; 1780 1781 (* freeing the horizontal header *) 1782 Free( face^.horizontalHeader.short_metrics ); 1783 Free( face^.horizontalHeader.long_metrics ); 1784 if face^.verticalInfo then 1785 begin 1786 Free( face^.verticalHeader.short_metrics ); 1787 Free( face^.verticalHeader.long_metrics ); 1788 face^.verticalInfo := False; 1789 end; 1790 1791 (* freeing the programs *) 1792 Free( face^.fontProgram ); 1793 Free( face^.cvtProgram ); 1794 face^.fontPgmSize := 0; 1795 face^.cvtPgmSize := 0; 1796 1797 (* freeing the gasp table - none yet *) 1798 Free( face^.gasp.gaspRanges ); 1799 1800 (* freeing the names table *) 1801 Free( face^.nameTable.names ); 1802 Free( face^.nameTable.storage ); 1803 face^.nameTable.numNameRecords := 0; 1804 face^.nameTable.format := 0; 1805 1806 (* freeing the hdmx table *) 1807 for n := 0 to face^.hdmx.num_records-1 do 1808 Free( face^.hdmx.records^[n].widths ); 1809 1810 Free( face^.hdmx.records ); 1811 face^.hdmx.num_records := 0; 1812 1813 TT_Close_Stream( face^.stream ); 1814 end; 1815 1816 (******************************************************************* 1817 * 1818 * Function : Face_Create 1819 * 1820 * Description : The face object constructor 1821 * 1822 *****************************************************************) 1823 Face_Createnull1824 function Face_Create( _face : Pointer; 1825 _input : Pointer ) : TError; 1826 var 1827 input : PFont_Input; 1828 face : PFace; 1829 ftstream: TFreeTypeStream; 1830 label Fail; 1831 begin 1832 Face_Create := Failure; 1833 1834 face := PFace(_face); 1835 input := PFont_Input(_input); 1836 1837 face^.stream := input^.stream; 1838 if TT_Use_Stream(face^.stream, ftstream) then exit; 1839 1840 if Cache_Create( objs_instance_class, face^.instances ) or 1841 Cache_Create( objs_glyph_class, face^.glyphs ) then goto Fail; 1842 1843 (* Load collection directory if present *) 1844 if Load_TrueType_Directory( ftstream, face, input^.fontIndex ) then 1845 goto Fail; 1846 1847 if Load_TrueType_Header ( ftstream, face ) or 1848 Load_TrueType_MaxProfile ( ftstream, face ) or 1849 Load_TrueType_Locations ( ftstream, face ) or 1850 Load_TrueType_CMap ( ftstream, face ) or 1851 Load_TrueType_CVT ( ftstream, face ) or 1852 Load_TrueType_Metrics_Header ( ftstream, face, false ) or 1853 Load_TrueType_Programs ( ftstream, face ) or 1854 Load_TrueType_Gasp ( ftstream, face ) or 1855 Load_TrueType_Names ( ftstream, face ) or 1856 Load_TrueType_OS2 ( ftstream, face ) or 1857 Load_TrueType_Hdmx ( ftstream, face ) or 1858 Load_TrueType_Postscript ( ftstream, face ) or 1859 Load_TrueType_Metrics_Header ( ftstream, face, true ) then 1860 goto Fail; 1861 1862 Face_Create := Success; 1863 TT_Done_Stream(face^.stream); 1864 exit; 1865 1866 Fail: 1867 TT_Done_Stream(face^.stream); 1868 Face_Destroy( face ); 1869 exit; 1870 end; 1871 1872 Glyph_Destroynull1873 function Glyph_Destroy( _glyph : Pointer ) : TError; 1874 var 1875 glyph : PGlyph; 1876 begin 1877 Glyph_Destroy := Success; 1878 1879 glyph := PGlyph(_glyph); 1880 if glyph = nil then 1881 exit; 1882 1883 glyph^.outline.owner := true; 1884 TT_Done_Outline( glyph^.outline ); 1885 end; 1886 1887 Glyph_Createnull1888 function Glyph_Create( _glyph : Pointer; 1889 _face : Pointer ) : TError; 1890 var 1891 glyph : PGlyph; 1892 begin 1893 glyph := PGlyph(_glyph); 1894 1895 glyph^.face := PFace(_face); 1896 error := TT_New_Outline( glyph^.face^.maxPoints+2, 1897 glyph^.face^.maxContours, 1898 glyph^.outline ); 1899 if error <> TT_Err_Ok then 1900 Glyph_Create := Failure 1901 else 1902 Glyph_Create := Success; 1903 end; 1904 1905 1906 Scale_Xnull1907 function Scale_X( var metrics : TIns_Metrics; x : TT_Pos ) : TT_Pos; 1908 begin 1909 Scale_X := MulDiv_Round( x, metrics.x_scale1, metrics.x_scale2 ); 1910 end; 1911 1912 1913 Scale_Ynull1914 function Scale_Y( var metrics : TIns_Metrics; y : TT_Pos ) : TT_Pos; 1915 begin 1916 Scale_Y := MulDiv_Round( y, metrics.y_scale1, metrics.y_scale2 ); 1917 end; 1918 1919 1920 TTObjs_Initnull1921 function TTObjs_Init : TError; 1922 begin 1923 TTObjs_Init := Failure; 1924 1925 Cache_Create( objs_face_class, face_cache ); 1926 Cache_Create( objs_exec_class, exec_cache ); 1927 1928 TTObjs_Init := success; 1929 end; 1930 1931 1932 1933 procedure TTObjs_Done; 1934 begin 1935 Cache_Destroy( face_cache ); 1936 Cache_Destroy( exec_cache ); 1937 end; 1938 1939 end. 1940 1941