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