sys/lib/ghostscript/wrfont.ps

   1 %    Copyright (C) 1991, 1995, 1996, 2002 Aladdin Enterprises.  All rights reserved.
   2 %
   3 % This software is provided AS-IS with no warranty, either express or
   4 % implied.
   5 %
   6 % This software is distributed under license and may not be copied,
   7 % modified or distributed except as expressly authorized under the terms
   8 % of the license contained in the file LICENSE in this distribution.
   9 %
  10 % For more information about licensing, please refer to
  11 % http://www.ghostscript.com/licensing/. For information on
  12 % commercial licensing, go to http://www.artifex.com/licensing/ or
  13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15
  16 % $Id: wrfont.ps,v 1.5 2002/04/19 06:52:25 lpd Exp $
  17 % wrfont.ps
  18 % Write out a Type 1 font in readable, reloadable form.
  19 % Note that this does NOT work on protected fonts, such as Adobe fonts
  20 % (unless you have loaded unprot.ps first, in which case you may be
  21 % violating the Adobe license).
  22
  23 % ****** NOTE: This file must be kept consistent with gs_pfile.ps.
  24
  25 /wrfont_dict 100 dict def
  26 wrfont_dict begin
  27
  28 % ------ Options ------ %
  29
  30 % Define whether to use eexec encryption for the font.
  31 % eexec encryption is only useful for compatibility with Adobe Type Manager
  32 % and other programs; it only slows Ghostscript down.
  33    /eexec_encrypt false def
  34
  35 % Define whether to write out the CharStrings in binary or in hex.
  36 % Binary takes less space on the file, but isn't guaranteed portable.
  37    /binary_CharStrings false def
  38
  39 % Define whether to use binary token encodings when possible.
  40 % Binary tokens are smaller and load faster, but are a Level 2 feature.
  41    /binary_tokens false def
  42
  43 % Define whether to encrypt the CharStrings on the file.  (CharStrings
  44 % are always encrypted in memory.)  Unencrypted CharStrings load about
  45 % 20% slower, but make the files compress much better for transport.
  46    /encrypt_CharStrings true def
  47
  48 % Define whether the font must provide standard PostScript language
  49 % equivalents for any facilities it uses that are provided in Ghostscript
  50 % but are not part of the standard PostScript language.
  51    /standard_only true def
  52
  53 % Define the value of lenIV to use in writing out the font.
  54 % use_lenIV = 0 produces the smallest output, but this may not be
  55 % compatible with old Adobe interpreters.  use_lenIV = -1 means
  56 % use the value of lenIV from the font.
  57    /use_lenIV -1 def
  58
  59 % Define whether to produce the smallest possible output, relying
  60 % as much as possible on Ghostscript-specific support code.
  61 % Taking full advantage of this requires the following settings:
  62 % binary_CharStrings = true, binary_tokens = true, standard_only = false.
  63    /smallest_output false def
  64
  65 % Define whether to write out all currently known Encodings by name,
  66 % or only StandardEncoding and ISOLatin1Encoding.
  67    /name_all_Encodings false def
  68
  69 % ---------------- Runtime support ---------------- %
  70
  71 /.packedfilefilter where
  72  { pop }
  73  { (gs_pfile.ps) runlibfile }
  74 ifelse
  75
  76 % ------ Output utilities ------ %
  77
  78 % By convention, the output file is named psfile.
  79
  80 % Define some utilities for writing the output file.
  81    /wtstring 2000 string def
  82    /wb {psfile exch write} bind def
  83    /wnb {/wb load repeat} bind def
  84    /w1 {psfile exch write} bind def
  85    /ws {psfile exch writestring} bind def
  86    /wl {ws (\n) ws} bind def
  87    /wt {wtstring cvs ws ( ) ws} bind def
  88    /wd          % Write a dictionary.
  89     { dup length wo {dict dup begin} wol { we } forall
  90       {end} wol
  91     } bind def
  92    /wld         % Write a large dictionary more efficiently.
  93                 % Ignore the readonly attributes.
  94     { dup length wo {dict dup begin} wol
  95       0 exch
  96        { exch wo wo () wl
  97          1 add dup 200 eq
  98           { wo ({def} repeat) wl 0 }
  99          if
 100        }
 101       forall
 102       dup 0 ne
 103        { wo ({def} repeat) wl }
 104        { pop }
 105       ifelse
 106       (end) ws
 107     } bind def
 108    /we          % Write a dictionary entry.
 109     { exch wo wo /def cvx wo (\n) ws
 110     } bind def
 111    /wcs         % Write a CharString (or Subrs entry)
 112     { dup type /stringtype eq
 113        { 4330 exch changelenIV 0 ge
 114           {     % Add some leading garbage bytes.
 115             wtstring changelenIV 2 index length getinterval
 116             .type1decrypt exch pop
 117             wtstring exch 0 exch length changelenIV add getinterval
 118           }
 119           {     % Drop some leading garbage bytes.
 120             wtstring .type1decrypt exch pop
 121             changelenIV neg 1 index length 1 index sub getinterval
 122           }
 123          ifelse
 124          binary_tokens encrypt_CharStrings and
 125           { % Suppress recognizing the readonly status of the string.
 126             4330 exch dup .type1encrypt exch pop wo
 127           }
 128           { encrypt_CharStrings
 129              { 4330 exch dup .type1encrypt exch pop
 130              } if
 131             smallest_output
 132              { wo
 133              }
 134              { readonly dup length wo
 135                binary_tokens not { ( ) ws } if
 136                readproc ws wx
 137              }
 138             ifelse
 139           }
 140          ifelse
 141        }
 142        { wo             % PostScript procedure
 143        }
 144       ifelse
 145     } bind def
 146
 147 % Construct the inversion of the system name table.
 148   (\210\001) token pop exch pop 1 eq {  % i.e., do we have binary tokens?
 149     /snit 256 dict def
 150     0 1 255 {
 151       (\221 ) dup 1 3 index put
 152       { token } stopped {
 153         pop pop
 154       } {
 155                 % Stack: char () token true
 156         pop exch pop exch snit 3 1 roll put
 157       } ifelse
 158     } for
 159   } {
 160     /snit 1 dict def
 161   } ifelse
 162
 163 % Write an object, using binary tokens if requested and possible.
 164    /woa         % write in ascii
 165     { psfile exch write==only
 166     } bind def
 167
 168                         % Lookup table for ASCII output.
 169
 170    /intbytes    % int nbytes -> byte*
 171     { { dup 255 and exch -8 bitshift } repeat pop
 172     } bind def
 173    /wotta 10 dict dup begin
 174       { /booleantype /integertype }
 175       { { ( ) ws woa } def }
 176      forall
 177                 % Iterate over arrays so we can print operators.
 178      /arraytype
 179       { dup xcheck {(}) ({)} {(]) ([)} ifelse ws exch dup wol exch ws wop
 180       } bind def
 181      /dicttype
 182       { ( ) ws wd } def
 183      /nametype
 184       { dup xcheck { ( ) ws } if woa
 185       } bind def
 186                 % Map back operators to their names,
 187                 % so we can write procedures.
 188      /nulltype
 189       { pop ( null) ws
 190       } bind def
 191      /operatortype
 192       { wtstring cvs cvn cvx wo
 193       } bind def
 194                 % Convert reals to integers if possible.
 195      /realtype
 196       { dup cvi 1 index eq { cvi wo } { ( ) ws woa } ifelse
 197       } bind def
 198                 % == truncates strings longer than 200 characters!
 199      /stringtype
 200       { (\() ws dup
 201          { dup dup 32 lt exch 127 ge or
 202             { (\\) ws dup -6 bitshift 48 add w1
 203               dup -3 bitshift 7 and 48 add w1
 204               7 and 48 add
 205             }
 206             { dup dup -2 and 40 eq exch 92 eq or {(\\) ws} if
 207             }
 208            ifelse w1
 209          }
 210         forall
 211         (\)) ws wop
 212       } bind def
 213      /packedarraytype
 214       { ([) ws dup { wo } forall
 215         encodingnames 1 index known
 216                 % This is an encoding, but not one of the standard ones.
 217                 % Use the built-in encoding only if it is available.
 218          { encodingnames exch get wo
 219            ({findencoding}stopped{pop) ws
 220            (}{counttomark 1 add 1 roll cleartomark}ifelse)
 221          }
 222          { pop ()
 223          }
 224         ifelse
 225         (/packedarray where{pop counttomark packedarray exch pop}{]readonly}ifelse) ws
 226         wl
 227       }
 228      def
 229    end def
 230
 231                         % Lookup table for binary output.
 232
 233    /wottb 8 dict dup begin
 234    wotta currentdict copy pop
 235      /integertype
 236       { dup dup 127 le exch -128 ge and
 237          { 136 wb 255 and wb }
 238          { dup dup 32767 le exch -32768 ge and
 239             { 134 wb 2 intbytes wb wb }
 240             { 132 wb 4 intbytes wb wb wb wb }
 241            ifelse
 242          }
 243         ifelse
 244       } bind def
 245      /nametype
 246       { dup snit exch known
 247          { dup xcheck { 146 } { 145 } ifelse wb
 248            snit exch get wb
 249          }
 250          { wotta /nametype get exec
 251          }
 252         ifelse
 253       } bind def
 254      /stringtype
 255       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
 256         ws wop
 257       } bind def
 258    end def
 259
 260    /wop         % Write object protection
 261      { wcheck not { /readonly cvx wo } if
 262      } bind def
 263    /wo          % Write an object.
 264      { dup type binary_tokens { wottb } { wotta } ifelse
 265        exch get exec
 266      } bind def
 267    /wol         % Write a list of objects.
 268      { { wo } forall
 269      } bind def
 270
 271 % Write a hex string for Subrs or CharStrings.
 272    /wx          % string ->
 273     { binary_CharStrings
 274        { ws
 275        }
 276        { % Some systems choke on very long lines, so
 277          % we break up the hexstring into chunks of 50 characters.
 278           { dup length 25 le {exit} if
 279             dup 0 25 getinterval psfile exch writehexstring (\n) ws
 280             dup length 25 sub 25 exch getinterval
 281           } loop
 282          psfile exch writehexstring
 283        } ifelse
 284     } bind def
 285
 286 % ------ CharString encryption utilities ------ %
 287
 288 /enc_dict 20 dict def
 289 1 dict begin
 290 /bind { } def           % make sure we can print out the procedures
 291 enc_dict begin
 292
 293 (type1enc.ps) runlibfile
 294 enc_dict /.type1decrypt undef           % we don't need this
 295
 296 end end
 297
 298 enc_dict { 1 index where { pop pop pop } { def } ifelse } forall
 299
 300 % ------ Other utilities ------ %
 301
 302 % Test whether two values are equal (for default dictionary entries).
 303    /valueeq             % <obj1> <obj2> valueeq <bool>
 304     { 2 copy eq
 305        { pop pop true }
 306        {        % Special hack for comparing FontMatrix values
 307          dup type /arraytype eq 2 index type /arraytype eq and
 308           { dup length 2 index length eq
 309              { true 0 1 3 index length 1 sub
 310                 {       % Stack: arr1 arr2 true index
 311                   3 index 1 index get 3 index 3 -1 roll get eq not
 312                    { pop false exit }
 313                   if
 314                 }
 315                for 3 1 roll pop pop
 316              }
 317              { pop pop false
 318              }
 319             ifelse
 320           }
 321           { pop pop false
 322           }
 323          ifelse
 324        }
 325       ifelse
 326     } bind def
 327
 328 % ------ The main program ------ %
 329
 330 % Define the dictionary of keys to skip because they are treated specially.
 331 /.fontskipkeys mark
 332   /CharStrings dup
 333   /Encoding dup
 334   /FDepVector dup
 335   /FID dup
 336   /FontInfo dup
 337   /Metrics dup
 338   /Metrics2 dup
 339   /Private dup
 340 .dicttomark def
 341 /.minfontskipkeys mark
 342   .fontskipkeys { } forall
 343   /FontName dup
 344   /UniqueID dup
 345 .dicttomark def
 346 /.privateskipkeys mark
 347   /ND dup
 348   /NP dup
 349   /RD dup
 350   /Subrs dup
 351 .dicttomark def
 352 /.minprivateskipkeys mark
 353   .privateskipkeys { } forall
 354   /MinFeature dup
 355   /Password dup
 356   /UniqueID dup
 357 .dicttomark def
 358
 359 % Define the procedures for the Private dictionary.
 360 % These must be defined without `bind',
 361 % for the sake of the DISKFONTS feature.
 362 4 dict begin
 363  /-! {string currentfile exch readhexstring pop} def
 364  /-| {string currentfile exch readstring pop} def
 365  /|- {readonly def} def
 366  /| {readonly put} def
 367 currentdict end /encrypted_procs exch def
 368 4 dict begin
 369  /-! {string currentfile exch readhexstring pop
 370    4330 exch dup .type1encrypt exch pop} def
 371  /-| {string currentfile exch readstring pop
 372    4330 exch dup .type1encrypt exch pop} def
 373  /|- {readonly def} def
 374  /| {readonly put} def
 375 currentdict end /unencrypted_procs exch def
 376
 377 % Construct an inverse dictionary of encodings.
 378 /encodingnames mark
 379  StandardEncoding /StandardEncoding
 380  ISOLatin1Encoding /ISOLatin1Encoding
 381  SymbolEncoding /SymbolEncoding
 382  DingbatsEncoding /DingbatsEncoding
 383  /resourceforall where
 384   { pop (*) { cvn dup findencoding exch } 100 string /Encoding resourceforall }
 385  if
 386 .dicttomark def
 387
 388 % Invert the standard encodings.
 389 .knownEncodings length 256 mul dict begin
 390   0 .knownEncodings
 391    {  { currentdict 1 index known { pop } { 1 index def } ifelse
 392         1 add
 393       }
 394      forall
 395    }
 396   forall pop
 397 currentdict end /inverseencodings exch def
 398
 399 /writefont              % <psfile> writefont - (writes the current font)
 400  { /psfile exch def
 401    /Font currentfont def
 402    /FontInfo Font /FontInfo .knownget not { 0 dict } if def
 403    /FontType Font /FontType get def
 404    /hasPrivate Font /Private known def
 405    /Private hasPrivate { Font /Private get } { 0 dict } ifelse def
 406    /readproc binary_CharStrings { (-| ) } { (-! ) } ifelse def
 407    /privateprocs
 408      encrypt_CharStrings binary_tokens not and
 409       { encrypted_procs } { unencrypted_procs } ifelse
 410      def
 411    /addlenIV false def
 412    /changelenIV use_lenIV 0 lt
 413     { 0 }
 414     { use_lenIV Private /lenIV .knownget not
 415        { 4 /addlenIV use_lenIV 4 ne def } if sub }
 416    ifelse def
 417    /minimize
 418      smallest_output
 419      FontType 1 eq and
 420      Font /UniqueID known and
 421    def
 422    (%!FontType) ws FontType wtstring cvs ws (-1.0: ) ws
 423      currentfont /FontName get wt
 424      FontInfo /version .knownget not { (001.001) } if wl
 425    FontInfo /CreationDate .knownget { (%%Creation Date: ) ws wl } if
 426    FontInfo /VMusage .knownget
 427     { (%%VMusage: ) ws dup wt wtstring cvs wl }
 428    if
 429    (systemdict begin) wl
 430
 431 % If we're going to use eexec, create the filters now.
 432    /realpsfile psfile def
 433    eexec_encrypt
 434     { /eexecfilter psfile binary_CharStrings not
 435        { pop /bxstring 35 string def
 436           { pop dup length 0 ne
 437              { realpsfile exch writehexstring realpsfile (\n) writestring }
 438              { pop }
 439             ifelse bxstring
 440           }
 441          /NullEncode filter dup /hexfilter exch def
 442        }
 443       if 55665 /eexecEncode filter def
 444     }
 445    if
 446
 447 % Turn on binary tokens if relevant.
 448    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
 449
 450 % If the file has a UniqueID, write out a check against loading it twice.
 451    minimize
 452     { Font /FontName get wo
 453       Font /UniqueID get wo
 454       Private length addlenIV { 1 add } if wo
 455       Font length 1 add wo              % +1 for FontFile
 456       ( .checkexistingfont) wl
 457     }
 458     { Font /UniqueID known
 459        { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
 460          ( {) ws wo ( findfont dup /UniqueID known) wl
 461          (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
 462          (    { pop false } ifelse) wl
 463          (    { pop save /restore load } if) wl
 464          ( } if) wl
 465        }
 466       if
 467     }
 468    ifelse
 469
 470 % If we are writing unencrypted CharStrings for a standard environment,
 471 % write out the encryption procedures.
 472    privateprocs unencrypted_procs eq standard_only and
 473     { (systemdict /.type1encrypt known) wl
 474       ( { save /restore load } { { } } ifelse) wl
 475       (userdict begin) wl
 476       enc_dict { we } forall
 477       (end exec) wl
 478     }
 479    if
 480
 481 % Write out the creation of the font dictionary and FontInfo.
 482    minimize not
 483     { Font length 1 add wo {dict begin} wol             % +1 for FontFile
 484     }
 485    if
 486    (/FontInfo ) ws FontInfo wd {readonly def} wol
 487
 488 % Write out the other fixed entries in the font dictionary.
 489    Font begin
 490    Font
 491     { minimize
 492        { .minfontskipkeys 2 index known
 493           { pop pop
 494           }
 495           { //.compactfontdefault 2 index .knownget
 496              { 1 index valueeq { pop pop } { we } ifelse }
 497              { we }
 498             ifelse
 499           }
 500          ifelse
 501        }
 502        { .fontskipkeys 2 index known { pop pop } { we } ifelse
 503        }
 504       ifelse
 505     } forall
 506    /Encoding
 507    encodingnames Encoding known
 508    name_all_Encodings
 509    Encoding StandardEncoding eq or
 510    Encoding ISOLatin1Encoding eq or and
 511     { encodingnames Encoding get cvx }
 512     { Encoding }
 513    ifelse
 514    dup /StandardEncoding cvx eq minimize and
 515     { pop pop }
 516     { we }
 517    ifelse
 518
 519 % Write the FDepVector, if any.
 520    Font /FDepVector .knownget
 521     { {/FDepVector [} wol
 522        { /FontName get wo {findfont} wol () wl } forall
 523       {] readonly def} wol
 524     }
 525    if
 526
 527 % Write out the Metrics, if any.
 528    Font /Metrics .knownget
 529     { (/Metrics ) ws wld {readonly def} wol
 530     }
 531    if
 532    Font /Metrics2 .knownget
 533     { (/Metrics2 ) ws wld {readonly def} wol
 534     }
 535    if
 536
 537 % Start the eexec-encrypted section, if applicable.
 538   eexec_encrypt
 539    { {currentdict currentfile eexec} wol () wl
 540      /psfile eexecfilter store
 541      (\000\000\000\000) ws {begin} wol
 542    }
 543   if
 544
 545 % Create and initialize the Private dictionary, if any.
 546    hasPrivate
 547 {
 548    Private
 549    minimize
 550     { begin {Private dup begin}
 551     }
 552     {  dup length privateprocs length add dict copy begin
 553        privateprocs { readonly def } forall
 554        /Private wo
 555        currentdict length 1 add wo {dict dup begin}
 556     }
 557    ifelse wol () wl
 558    currentdict
 559     { 1 index minimize { .minprivateskipkeys } { .privateskipkeys } ifelse
 560       exch known
 561        { pop pop }
 562        { 1 index /lenIV eq use_lenIV 0 ge and { pop use_lenIV } if we }
 563       ifelse
 564     } forall
 565    addlenIV { /lenIV use_lenIV we } if
 566 }
 567 if
 568
 569 % Write the Subrs entries, if any.
 570    currentdict /Subrs known
 571     { (/Subrs[) wl
 572       Subrs
 573        { dup null ne
 574           { wcs minimize not { () wl } if }
 575           { pop /null cvx wo }
 576          ifelse
 577        } forall
 578       {] dup {readonly pop} forall readonly def} wol () wl
 579     }
 580    if
 581
 582 % Wrap up the Private dictionary.
 583    hasPrivate
 584     { end                       % Private
 585       minimize
 586        { {end readonly pop} }   % Private
 587        { {end readonly def} }   % Private in font
 588       ifelse wol
 589     }
 590    if
 591
 592 % Write the CharStrings entries.
 593 % Detect identical (eq) entries, which bdftops produces.
 594    currentdict /CharStrings known
 595 {
 596    /CharStrings wo CharStrings length wo
 597    minimize
 598     { encrypt_CharStrings not wo ( .readCharStrings) wl
 599       CharStrings length dict
 600       CharStrings
 601        { exch inverseencodings 1 index .knownget not { dup } if wo
 602                 % Stack: vdict value key
 603          3 copy pop .knownget { wo pop pop } { 3 copy put pop wcs } ifelse
 604        } forall
 605     }
 606     { {dict dup Private begin begin} wol () wl
 607       CharStrings length dict
 608       CharStrings
 609        { 2 index 1 index known
 610           { exch wo 1 index exch get wo {load def} wol () wl
 611           }
 612           { 2 index 1 index 3 index put
 613             exch wo wcs ( |-) wl
 614           }
 615          ifelse
 616        } forall
 617       {end end} wol
 618     }
 619    ifelse
 620    pop
 621     { readonly def }    % CharStrings in font
 622    wol
 623 }
 624 if
 625
 626 % Terminate the output.
 627    end                  % Font
 628    eexec_encrypt
 629     { {end mark currentfile closefile} wol () wl
 630       eexecfilter dup flushfile closefile       % psfile is eexecfilter
 631       binary_CharStrings not { hexfilter dup flushfile closefile } if
 632       /psfile realpsfile store
 633       8
 634        { (0000000000000000000000000000000000000000000000000000000000000000)
 635          wl
 636        }
 637       repeat {cleartomark} wol
 638     }
 639    if
 640     { FontName currentdict end definefont pop
 641     }
 642    wol
 643    Font /UniqueID known { /exec cvx wo } if
 644    binary_tokens { /setobjectformat cvx wo } if
 645    ( end) wl            % systemdict
 646
 647  } bind def
 648
 649 % ------ Other utilities ------ %
 650
 651 % Prune garbage characters and OtherSubrs out of the current font,
 652 % if the relevant dictionaries are writable.
 653 /prunefont
 654  { currentfont /CharStrings get wcheck
 655     { currentfont /CharStrings get dup [ exch
 656        { pop dup (S????00?) .stringmatch not { pop } if
 657        } forall
 658       ] { 2 copy undef pop } forall pop
 659     }
 660    if
 661  } bind def
 662
 663 end                     % wrfont_dict
 664
 665 /writefont { wrfont_dict begin writefont end } def