home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / os2 / gspm25.zip / font2c.ps < prev    next >
Text File  |  1992-09-18  |  16KB  |  524 lines
  1. %    Copyright (C) 1992 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. % font2c.ps
  21. % Write out a Type 1 font as C code that can be linked with Ghostscript.
  22. % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
  23. % switch in the command line.  The code is reentrant and has no
  24. % external references, so it can be shared.
  25.  
  26. % Define the maximum string length that will get by the compiler.
  27. % This must be approximately
  28. %    min(max line length, max string literal length) / 4 - 5.
  29.  
  30. /max_wcs 50 def
  31.  
  32. % ------ Protection utilities ------ %
  33.  
  34. % Protection values are represented by a mask:
  35. /a_noaccess 0 def
  36. /a_executeonly 1 def
  37. /a_readonly 3 def
  38. /a_all 7 def
  39. /prot_names
  40.  [ (0) (a_execute) null (a_readonly) null null null (a_all)
  41.  ] def
  42. /prot_opers
  43.  [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
  44.  ] def
  45.  
  46. % Get the protection of an object.
  47.    /getpa
  48.     { dup wcheck
  49.        { pop a_all }
  50.        {    % Check for executeonly or noaccess objects in protected.
  51.          dup protected exch known
  52.       { protected exch get }
  53.       { pop a_readonly }
  54.      ifelse
  55.        }
  56.       ifelse
  57.     } bind def
  58.  
  59. % Get the protection appropriate for (all the) values in a dictionary.
  60.    /getva
  61.     { a_noaccess exch
  62.        { exch pop
  63.          dup type dup /stringtype eq exch /arraytype eq or
  64.       { getpa a_readonly and or }
  65.       { pop pop a_all exit }
  66.      ifelse
  67.        }
  68.       forall
  69.     } bind def
  70.  
  71. % Keep track of executeonly and noaccess objects,
  72. % but don't let the protection actually take effect.
  73. /protected        % do first so // will work
  74.   systemdict wcheck { 1500 dict } { 1 dict } ifelse
  75. def
  76. systemdict wcheck
  77.  { systemdict begin
  78.      /executeonly
  79.       { dup //protected exch a_executeonly put readonly
  80.       } bind odef
  81.      /noaccess
  82.       { dup //protected exch a_noaccess put readonly
  83.       } bind odef
  84.    end
  85.  }
  86.  { (Warning: you will not be able to convert protected fonts.\n) print
  87.    (If you need to convert a protected font,\n) print
  88.    (please restart Ghostscript with the -dWRITESYSTEMDICT switch.\n) print
  89.    flush
  90.  }
  91. ifelse
  92.  
  93. % ------ Output utilities ------ %
  94.  
  95. % By convention, the output file is named cfile.
  96.  
  97. % Define some utilities for writing the output file.
  98.    /wtstring 100 string def
  99.    /wb {cfile exch write} bind def
  100.    /ws {cfile exch writestring} bind def
  101.    /wl {ws (\n) ws} bind def
  102.    /wt {wtstring cvs ws} bind def
  103.  
  104. % Write a C string.  Some compilers have unreasonably small limits on
  105. % the length of a string literal or the length of a line, so every place
  106. % that uses wcs must either know that the string is short,
  107. % or be prepared to use wcca instead.
  108.    /wbx
  109.     { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
  110.     } bind def
  111.    /wcst
  112.     [
  113.       32 { /wbx load } repeat
  114.       95 { /wb load } repeat
  115.       129 { /wbx load } repeat
  116.     ] def
  117.    ("\\) { wcst exch { (\\) ws wb } put } forall
  118.    /wcs
  119.     { (") ws { dup wcst exch get exec } forall (") ws
  120.     } bind def
  121.    /can_wcs    % Test if can use wcs
  122.     { length max_wcs le
  123.     } bind def
  124.    /wncs    % name -> C string
  125.     { wtstring cvs wcs
  126.     } bind def
  127. % Write a C string as an array of character values.
  128. % We only need this because of line and literal length limitations.
  129.    /wca        % string prefix suffix ->
  130.     { 0 4 -2 roll exch
  131.        { exch ws
  132.          exch dup 19 ge { () wl pop 0 } if 1 add
  133.      exch wt (,)
  134.        } forall
  135.       pop pop ws
  136.     } bind def
  137.    /wcca
  138.     { ({\n) (}) wca
  139.     } bind def
  140.  
  141. % Write object protection attributes.  Note that dictionaries are
  142. % the only objects that can be writable.
  143.    /wpa
  144.     { dup xcheck { (a_executable+) ws } if
  145.       dup type /dicttype eq { getpa } { getpa a_readonly and } ifelse
  146.       prot_names exch get ws
  147.     } bind def
  148.    /wva
  149.     { getva prot_names exch get ws
  150.     } bind def
  151.  
  152. % ------ Object writing ------ %
  153.  
  154.    /wnstring 128 string def
  155.  
  156. % Write a string/name or null as an element of a string/name/null array. */
  157.    /wsn
  158.     { dup null eq
  159.        { pop (\t255,255,) wl
  160.        }
  161.        { dup type /nametype eq { wnstring cvs } if
  162.          dup length 256 idiv wt (,) ws
  163.      dup length 256 mod wt
  164.      (,) (,\n) wca
  165.        }
  166.       ifelse
  167.     } bind def
  168. % Write a packed string/name/null array.
  169.    /wsna    % name (string/name/null)* ->
  170.     { (\tstatic const char ) ws exch wt ([] = {) wl
  171.       { wsn } forall
  172.       (\t0\n};) wl
  173.     } bind def
  174.  
  175.  
  176. % Write a named object.  Return true if this was possible.
  177. % Legal types are: boolean, integer, name, real, string,
  178. % array of (integer, integer+real, null+string).
  179. % Dictionaries are handled specially.  Other types are ignored.
  180.    /isall    % array proc -> bool
  181.     { true 3 -1 roll
  182.        { 2 index exec not { pop false exit } if }
  183.       forall exch pop
  184.     } bind def
  185.    /wott 7 dict dup begin
  186.       /arraytype
  187.        { woatt
  188.           { aload pop 2 index 2 index isall
  189.          { exch pop exec exit }
  190.          { pop pop }
  191.         ifelse
  192.       }
  193.      forall
  194.        } bind def
  195.       /booleantype
  196.        { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
  197.          wt (\);) wl true
  198.        } bind def
  199.       /dicttype
  200.        { dup alldicts exch known
  201.           { alldicts exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
  202.       { pop pop false }
  203.      ifelse
  204.        } bind def
  205.       /integertype
  206.        { (\tmake_int\(&) ws exch wt (, ) ws
  207.          wt (\);) wl true
  208.        } bind def
  209.       /nametype
  210.        { (\tcode = (*pprocs->name_create)\(&) ws exch wt
  211.          (, ) ws wnstring cvs wcs    % OK, names are short
  212.      (\);) wl
  213.      (\tif ( code < 0 ) return code;) wl
  214.      true
  215.        } bind def
  216.       /realtype
  217.        { (\tmake_real\(&) ws exch wt (, ) ws
  218.          wt (\);) wl true
  219.        } bind def
  220.       /stringtype
  221.        { ({\tstatic const char s_[] = ) ws
  222.          dup dup can_wcs { wcs } { wcca } ifelse
  223.      (;) wl
  224.      (\tmake_string\(&) ws exch wt
  225.      (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
  226.      (}) wl true
  227.        } bind def
  228.    end def
  229.    /wo        % name obj -> OK
  230.     { dup type wott exch known
  231.        { dup type wott exch get exec }
  232.        { pop pop false }
  233.       ifelse
  234.     } bind def
  235.  
  236. % Write an array (called by wo).
  237.    /wnuma    % name array C_type type_v ->
  238.     { ({\tstatic const ref_\() ws exch ws
  239.       (\) a_[] = {) wl exch
  240.       dup length 0 eq
  241.        { (\t0) wl
  242.        }
  243.        { dup
  244.           { (\t) ws 2 index ws (\() ws wt (\),) wl
  245.       } forall
  246.        }
  247.       ifelse
  248.       (\t};) wl exch pop
  249.       (\tmake_array\(&) ws exch wt
  250.       (, ) ws dup wpa (, ) ws length wt
  251.       (, (ref *)a_\);) wl (}) wl
  252.     } bind def
  253.    /woatt [
  254.     % Integers
  255.      { { type /integertype eq }
  256.        { (long) (integer_v) wnuma true }
  257.      }
  258.     % Integers + reals
  259.      { { type dup /integertype eq exch /realtype eq or }
  260.        { (float) (real_v) wnuma true }
  261.      }
  262.     % Strings + nulls
  263.      { { type dup /nulltype eq exch /stringtype eq or }
  264.        { ({) ws dup (sa_) exch wsna
  265.      exch (\tcode = (*pprocs->string_array_create)\(&) ws wt
  266.      (, sa_, ) ws dup length wt (, ) ws wpa (\);) wl
  267.      (\tif ( code < 0 ) return code;) wl
  268.      (}) wl true
  269.        }
  270.      }
  271.     % Default
  272.      { { pop true }
  273.        { pop pop false }
  274.      }
  275.    ] def
  276.  
  277. % Write a named dictionary.  We assume the ref is already declared.
  278.    /wd        % name dict
  279.     { ({) ws
  280.       (\tref v_[) ws dup length wt (];) wl
  281.       dup [ exch
  282.        { counttomark 2 sub wtstring cvs
  283.          (v_[) exch concatstrings (]) concatstrings exch wo not
  284.           { pop }
  285.      if
  286.        } forall
  287.       ]
  288.       % stack: array of keys (names)
  289.       ({) ws dup (str_keys_) exch wsna
  290.       (\tstatic const cfont_dict_keys keys_ =) wl
  291.       (\t { 0, 0, ) ws length wt (, 1, ) ws
  292.       dup wpa (, ) ws dup wva ( };) wl
  293.       (\tcode = \(*pprocs->ref_dict_create\)\(&) ws 1 index wt
  294.       (, &keys_, str_keys_, &v_[0]\);) wl
  295.       (\tif (code < 0) return code;) wl
  296.       pop pop
  297.       (}) wl
  298.       (}) wl
  299.     } bind def
  300.  
  301. % Write a character dictionary.
  302. % We save a lot of space by abbreviating keys which appear in
  303. % StandardEncoding or ISOLatin1Encoding.
  304.    /wcd        % namestring createtype dict valuetype writevalueproc ->
  305.     {    % Keys present in StandardEncoding or ISOLatin1Encoding
  306.       2 index
  307.       (static const charindex enc_keys_[] = {) wl
  308.       [ exch 0 exch
  309.        { pop decoding 1 index known
  310.           { decoding exch get ({) ws dup -8 bitshift wt
  311.         (,) ws 255 and wt (}, ) ws
  312.         1 add dup 5 mod 0 eq { (\n) ws } if
  313.       }
  314.       { exch }
  315.      ifelse
  316.        }
  317.       forall pop
  318.       ]
  319.       ({0,0}\n};) wl
  320.     % Other keys
  321.       (str_keys_) exch wsna
  322.     % Values, with those corresponding to stdkeys first.
  323.       (static const ) ws 1 index ws
  324.       ( values_[] = {) wl
  325.       2 index
  326.        { decoding 2 index known
  327.           { exch pop 1 index exec }
  328.       { pop pop }
  329.      ifelse
  330.        }
  331.       forall
  332.       2 index
  333.        { decoding 2 index known
  334.           { pop pop }
  335.       { exch pop 1 index exec }
  336.      ifelse
  337.        }
  338.       forall
  339.       (\t0\n};) wl
  340.     % Actual creation code
  341.       (static const cfont_dict_keys keys_ = {) wl
  342.       (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
  343.       (\t) ws 2 index length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
  344.       pop pop
  345.       dup wpa (, ) ws wva () wl
  346.       (};) wl
  347.       (\tcode = \(*pprocs->) ws ws (_dict_create\)\(&) ws ws
  348.       (, &keys_, str_keys_, &values_[0]\);) wl
  349.       (\tif ( code < 0 ) return code;) wl
  350.     } bind def
  351.  
  352. % ------ The main program ------ %
  353.  
  354. % Construct an inverse dictionary of encodings.
  355. 3 dict begin
  356.  StandardEncoding (StandardEncoding) def
  357.  ISOLatin1Encoding (ISOLatin1Encoding) def
  358.  SymbolEncoding (SymbolEncoding) def
  359. currentdict end /encodingnames exch def
  360.  
  361. % Invert the StandardEncoding and ISOLatin1Encoding vector.
  362. 512 dict begin
  363.   0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
  364.   0 1 255 { dup StandardEncoding exch get exch def } for
  365. currentdict end /decoding exch def
  366.  
  367. /makefontprocname    % fontname -> procname
  368.  { wtstring cvs
  369.    dup length 1 sub -1 0
  370.     { dup wtstring exch get 45 eq { wtstring exch 95 put } { pop } ifelse
  371.     }
  372.    for 
  373.  } def
  374.  
  375. /writefont        % cfilename procname -> [writes the current font]
  376.  { (gsf_) exch concatstrings
  377.      /fontprocname exch def
  378.    /cfname exch def
  379.    /cfile cfname (w) file def
  380.    /Font currentfont def
  381.    Font /CharStrings get length dict
  382.    /charmap exch def
  383.  
  384. % Define all the dictionaries we know about.
  385. % wo uses this when writing out dictionaries.
  386.    /alldicts 10 dict def
  387.    alldicts begin
  388.      Font /Font def
  389.       { /FontInfo /CharStrings /Private }
  390.       { dup Font exch get exch def }
  391.      forall
  392.      encodingnames Font /Encoding get known not
  393.       { % Make a fake entry for Encoding, for later
  394.         Font /Encoding get /Encoding def
  395.       }
  396.      if
  397.      Font /Metrics known { Font /Metrics get /Metrics def } if
  398.    end
  399.  
  400. % Write out the boilerplate.
  401.    Font begin
  402.    (/* Copyright (C) 1992 Aladdin Enterprises.  All rights reserved.) wl
  403.    (   Distributed by Free Software Foundation, Inc.) wl
  404.    () wl
  405.    (This file is part of Ghostscript.) wl
  406.    () wl
  407.    (Ghostscript is distributed in the hope that it will be useful, but) wl
  408.    (WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility) wl
  409.    (to anyone for the consequences of using it or for whether it serves any) wl
  410.    (particular purpose or works at all, unless he says so in writing.) wl
  411.    (Refer to the Ghostscript General Public License for full details.) wl
  412.    () wl
  413.    (Everyone is granted permission to copy, modify and redistribute) wl
  414.    (Ghostscript, but only under the conditions described in the Ghostscript) wl
  415.    (General Public License.  A copy of this license is supposed to have been) wl
  416.    (given to you along with Ghostscript so you can know your rights and) wl
  417.    (responsibilities.  It should be in a file named COPYING.  Among other) wl
  418.    (things, the copyright notice and this notice must be preserved on all) wl
  419.    (copies.  */) wl
  420.    () wl
  421.    (/* ) ws cfname ws ( */) wl
  422.    (/* This file was created by the Ghostscript font2c utility. */) wl
  423.    () wl
  424.    FontInfo /Notice known
  425.     { (/* Portions of this file are subject to the following notice: */) wl
  426.       (/****************************************************************) wl
  427.       FontInfo /Notice get wl
  428.       ( ****************************************************************/) wl
  429.       () wl
  430.     } if
  431.    (#include "std.h") wl
  432.    (#include "iref.h") wl
  433.    (#include "store.h") wl
  434.    (#include "ccfont.h") wl
  435.    () wl
  436.  
  437. % Write the procedure prologue.
  438.    (#ifdef __PROTOTYPES__) wl
  439.    (int huge) wl
  440.    fontprocname ws ((const cfont_procs *pprocs, ref *pfont)) wl
  441.    (#else) wl
  442.    (int huge) wl
  443.    fontprocname ws ((pprocs, pfont) const cfont_procs *pprocs; ref *pfont;) wl
  444.    (#endif) wl
  445.    ({\tint code;) wl
  446.    alldicts
  447.     { exch pop (\tref ) ws wt (;) wl }
  448.    forall
  449.  
  450. % Write out the FontInfo.
  451.    (FontInfo) FontInfo wd
  452.  
  453. % Write out the CharStrings.
  454.    ({) wl
  455.    (CharStrings) (string) CharStrings (char) { wsn } wcd
  456.    (}) wl
  457.  
  458. % Write out the Metrics.
  459.    Font /Metrics known
  460.     { ({) wl
  461.       (Metrics) (num) Metrics (float) { (\t) ws wtstring cvs ws (,) wl } wcd
  462.       (}) wl
  463.     }
  464.    if
  465.  
  466. % Write out the Private dictionary.
  467.    (Private) Private wd
  468.  
  469. % Write out the Encoding vector, if it isn't standard.
  470.    encodingnames Encoding known not
  471.     { ({) wl
  472.       (str_elts_) Encoding wsna
  473.       (\tcode = \(*pprocs->name_array_create\)\(&Encoding, str_elts_, ) ws
  474.       Encoding length wt (\);) wl
  475.       (\tif (code < 0) return code;) wl
  476.       (}) wl
  477.     }
  478.    if
  479.  
  480. % Write out the main font dictionary.
  481. % If possible, substitute the encoding name for the encoding;
  482. % PostScript code will fix this up.
  483.    Font dup length dict copy
  484.    encodingnames Encoding known
  485.     { dup /Encoding encodingnames Encoding get put
  486.     }
  487.     { % Force it to be treated like a known dictionary
  488.       dup /Encoding 1 dict put
  489.     }
  490.    ifelse
  491.    (Font) exch wd
  492.  
  493. % Finish the procedural initialization code.
  494.    (\t*pfont = Font;) wl
  495.    (\treturn 0;) wl
  496.    (}) wl
  497.    end
  498.  
  499.    cfile closefile
  500.  
  501.  } bind def
  502.  
  503. % If the program was invoked from the command line, run it now.
  504. [ shellarguments
  505.  { counttomark dup 2 eq exch 3 eq or
  506.     { counttomark -1 roll cvn
  507.       dup FontDirectory exch known { dup FontDirectory exch undef } if
  508.       findfont setfont
  509.       counttomark 1 eq
  510.        {    % Construct the procedure name from the file name.
  511.          currentfont /FontName get makefontprocname
  512.        }
  513.       if
  514.       writefont
  515.     }
  516.     { cleartomark
  517.       (Usage: font2c fontname cfilename.c [shortname]\n) print
  518.       ( e.g.: font2c Courier cour.c\n) print flush
  519.       mark
  520.     }
  521.    ifelse
  522.  }
  523. if pop
  524.