home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / os2 / gspm25.zip / wrfont.ps < prev   
Text File  |  1992-06-04  |  9KB  |  289 lines
  1. %    Copyright (C) 1991 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % wrfont.ps
  21. % Write out a Type 1 font in readable, reloadable form.
  22. % Note that this does NOT work on protected fonts, such as Adobe fonts
  23. % (unless you have loaded unprot.ps first, in which case you may be
  24. % violating the Adobe license).
  25.  
  26. % ------ Options ------ %
  27.  
  28. % Define whether to write out the CharStrings in binary or in hex.
  29. % Binary takes less space on the file, but isn't guaranteed portable.
  30.    /binary false def
  31.  
  32. % Define whether to use binary token encodings for the CharStrings.
  33. % Binary tokens are smaller and load faster, but are a Level 2 feature.
  34.    /binary_tokens false def
  35.  
  36. % ------ Output utilities ------ %
  37.  
  38. % By convention, the output file is named psfile.
  39.  
  40. % Define some utilities for writing the output file.
  41.    /wtstring 100 string def
  42.    /wb {psfile exch write} bind def
  43.    /wnb {/wb load repeat} bind def
  44.    /ws {psfile exch writestring} bind def
  45.    /wl {ws (\n) ws} bind def
  46.    /wt {wtstring cvs ws ( ) ws} bind def
  47.    /wd        % Write a dictionary.
  48.     { dup length wt (dict dup begin) wl { we } forall
  49.       (end) ws
  50.     } bind def
  51.    /wld        % Write a large dictionary more efficiently.
  52.            % Ignore the readonly attributes.
  53.     { dup length wt (dict dup begin) wl
  54.       0 exch
  55.        { exch wo wo
  56.      1 add dup 200 eq
  57.       { wo ({def} repeat) wl 0 }
  58.      if
  59.        }
  60.       forall
  61.       dup 0 ne
  62.        { wo ({def} repeat) wl }
  63.        { pop }
  64.       ifelse
  65.       (end) ws
  66.     } bind def
  67.    /we        % Write a dictionary entry.
  68.     { exch wo wo /def cvx wo (\n) ws
  69.     } bind def
  70.  
  71. % Construct the inversion of the system name table.
  72.    /SystemNames where
  73.     { pop /snit 256 dict def
  74.       0 1 255
  75.        { dup SystemNames exch get
  76.          dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
  77.        }
  78.       for
  79.     }
  80.     { /snit 1 dict def
  81.     }
  82.    ifelse
  83.  
  84. % Write an object, using binary tokens if requested and possible.
  85.    /woa        % write in ascii
  86.     { psfile exch write==only
  87.     } bind def
  88.     % Lookup table for ASCII output.
  89.    /intbytes    % int nbytes -> byte*
  90.     { exch { dup 255 and exch -8 bitshift } repeat pop
  91.     } bind def
  92.    /wotta 8 dict dup begin
  93.     { /booleantype /integertype /nulltype /realtype }
  94.     { { ( ) ws woa } def }
  95.    forall
  96.      /nametype
  97.       { dup xcheck { ( ) ws } if woa
  98.       } bind def
  99.     { /arraytype /packedarraytype /stringtype }
  100.     { { dup woa wop } def }
  101.    forall
  102.    end def
  103.     % Lookup table for binary output.
  104.    /wottb 8 dict dup begin
  105.    wotta currentdict copy pop
  106.      /integertype
  107.       { dup dup 127 le exch -128 ge and
  108.          { 136 wb 255 and wb
  109.      }
  110.      { ( ) ws woa
  111.      }
  112.     ifelse
  113.       } bind def
  114.      /nametype
  115.       { dup snit exch known
  116.          { dup xcheck { 146 } { 145 } ifelse wb
  117.        snit exch get wb
  118.      }
  119.      { wotta /nametype get exec
  120.      }
  121.     ifelse
  122.       } bind def
  123.      /stringtype
  124.       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
  125.         ws wop
  126.       } bind def
  127.    end def
  128.    /wop        % Write object protection
  129.      { wcheck not { /readonly cvx wo } if
  130.      } bind def
  131.    /wo        % Write an object.
  132.      { dup type binary_tokens { wottb } { wotta } ifelse
  133.        exch get exec
  134.      } bind def
  135.  
  136. % Write a hex string for Subrs or CharStrings.
  137.    /wx        % string ->
  138.     { binary
  139.        { ws
  140.        }
  141.        { % Some systems choke on very long lines, so
  142.      % we break up the hexstring into chunks of 50 characters.
  143.       { dup length 25 le {exit} if
  144.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  145.         dup length 25 sub 25 exch getinterval
  146.       } loop
  147.      psfile exch writehexstring
  148.        } ifelse
  149.     } bind def
  150.  
  151. % ------ The main program ------ %
  152.  
  153. % Define the dictionary of actions for special entries in the dictionaries.
  154. % We lump the font and the Private dictionary together, because
  155. % the set of keys doesn't overlap.
  156. [/CharStrings /Encoding /FID /FontInfo /Metrics /Private /Subrs]
  157. dup length dict begin
  158.  { null cvx def } forall
  159. currentdict end /specialkeys exch def
  160.  
  161. % Define the procedures for the Private dictionary.
  162. % These must be defined without being bound.
  163. 4 dict begin
  164.  /-! {string currentfile exch readhexstring pop} def
  165.  /-| {string currentfile exch readstring pop} def
  166.  /|- {readonly def} def
  167.  /| {readonly put} def
  168. currentdict end /privateprocs exch def
  169.  
  170. % Construct an inverse dictionary of encodings.
  171. 3 dict begin
  172.  StandardEncoding /StandardEncoding def
  173.  ISOLatin1Encoding /ISOLatin1Encoding def
  174.  SymbolEncoding /SymbolEncoding def
  175. currentdict end /encodingnames exch def
  176.  
  177. /writefont        % psfile -> [writes the current font]
  178.  { /psfile exch def
  179.    /Font currentfont def
  180.    /readproc binary { (-| ) } { (-! ) } ifelse def
  181.    (%!FontType1-1.0: ) ws currentfont /FontName get wt (000.000) wl
  182.  
  183. % Turn on binary tokens if relevant.
  184.    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
  185.  
  186. % If the file has a UniqueID, write out a check against loading it twice.
  187.    Font /UniqueID known
  188.     { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
  189.       ( {) ws wo ( findfont dup /UniqueID known) wl
  190.       (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
  191.       (    { pop false } ifelse) wl
  192.       (    { pop save /restore load } if) wl
  193.       ( } if) wl
  194.     }
  195.    if
  196.  
  197. % Write out the creation of the font dictionary and FontInfo.
  198.    Font length 1 add wt (dict begin) wl        % +1 for FontFile
  199.    Font begin
  200.    (/FontInfo ) ws FontInfo wd ( readonly def) wl
  201.  
  202. % Write out the other fixed entries in the font dictionary.
  203.    Font
  204.     { 1 index specialkeys exch known
  205.        { pop pop } { we } ifelse
  206.     } forall
  207.    /Encoding
  208.    encodingnames Encoding known
  209.     { encodingnames Encoding get cvx }
  210.     { Encoding }
  211.    ifelse we
  212.  
  213. % Write out the Metrics, if any.
  214.    Font /Metrics known
  215.     { (/Metrics ) ws Metrics wld ( readonly def) wl
  216.     }
  217.    if
  218.  
  219. % Close the font dictionary.
  220.    (currentdict end) wl
  221.  
  222. % The rest of the file could be in eexec form, but we don't see any point
  223. % in doing this, because we aren't attempting to conceal it from anyone.
  224.  
  225. % Create and initialize the Private dictionary.
  226.    Private dup length privateprocs length add dict copy begin
  227.    privateprocs { readonly def } forall
  228.    (dup /Private ) ws currentdict length 1 add wt (dict dup begin) wl
  229.    currentdict
  230.     { 1 index specialkeys exch known
  231.        { pop pop } { we } ifelse
  232.     } forall
  233.  
  234. % Write the Subrs entries, if any.
  235.    currentdict /Subrs known
  236.     { (/Subrs ) ws Subrs length wt (array) wl
  237.       0 1 Subrs length 1 sub
  238.        { dup Subrs exch get dup null ne
  239.       { /dup cvx wo exch wo dup length wo ( ) ws readproc ws wx ( |) wl }
  240.       { pop pop }
  241.      ifelse
  242.        } for
  243.       (readonly def) wl
  244.     }
  245.    if
  246.  
  247. % Write the CharStrings entries.
  248.    (2 index /CharStrings ) ws
  249.    CharStrings length wt (dict dup begin) wl
  250.    CharStrings
  251.     { exch wo
  252.       binary_tokens
  253.        { % Suppress recognizing the readonly status of the string.
  254.          dup length string copy wo
  255.        }
  256.        { dup length wo ( ) ws readproc ws wx
  257.        }
  258.       ifelse ( |-) wl
  259.     } forall
  260.  
  261. % Wrap up the private part of the font.
  262.    (end) wl        % CharStrings
  263.    (end) wl        % Private
  264.    end            % Private
  265.    (readonly put) wl    % CharStrings in font
  266.    (readonly put) wl    % Private in font
  267.    end            % Font
  268.  
  269. % Terminate the output.
  270.    (dup /FontName get exch definefont pop) wl
  271.    Font /UniqueID known { (exec) wl } if
  272.    binary_tokens { (setobjectformat) wl } if
  273.  
  274.  } bind def
  275.  
  276. % ------ Other utilities ------ %
  277.  
  278. % Prune garbage characters and OtherSubrs out of the current font,
  279. % if the relevant dictionaries are writable.
  280. /prunefont
  281.  { currentfont /CharStrings get wcheck
  282.     { currentfont /CharStrings get dup [ exch
  283.        { pop dup (S????00?) stringmatch not { pop } if
  284.        } forall
  285.       ] { 2 copy undef pop } forall pop
  286.     }
  287.    if
  288.  } bind def
  289.