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