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