font2c.ps

实现并行算法

	    (], ) ws wt (\);) wl
	  }
	 for pop
       }
       { ({\tstatic const ref_\() ws exch ws
	 (\) a_[] = {) wl exch
	 dup length 0 eq
	  { (\t) ws 1 index ws (\(0\)) wl
	  }
	  { dup
	     { (\t) ws 2 index ws (\() ws wt (\),) wl
	     } forall
	  }
	 ifelse exch pop
	 (\t};) wl
	 (\tmake_const_array\(&) ws exch wt
         (, avm_foreign|) ws dup wpa (, ) ws length wt
         (, (const ref *)a_\);) wl
       }
      ifelse
      (}) wl
    } bind def
   /woatt [
	% Integers
     { { { type /integertype eq } isall }
       { (long) (integer_v) wnuma true }
     }
	% Integers + reals
     { { { type dup /integertype eq exch /realtype eq or } isall }
       { (float) (real_v) wnuma true }
     }
	% Strings + nulls
     { { { type dup /nulltype eq exch /stringtype eq or } isall }
       { ({) ws dup (sa_) exch wsna
	 (\tcode = (*pprocs->string_array_create)\(&) ws exch wt
	 (, sa_, ) ws dup length wt (, ) ws wpa (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 (}) wl true
       }
     }
	% Names
     { { { type /nametype eq } isall }
       { ({) ws dup (na_) exch wsna
	 (\tcode = (*pprocs->name_array_create)\(&) ws 1 index wt
	 (, na_, ) ws dup length wt (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 wap (}) wl true
       }
     }
	% Procedure
     { { iswproc }
       { dup cvos
		% Stack: name proc string
	 ({\tstatic const char s_[] = ) ws
         dup dup can_wcs { wcs } { wcca } ifelse
	 (;) wl
	 (\tcode = (*pprocs->ref_from_string)\(&) ws 2 index wt
	 (, s_, ) ws length wt (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 wap (}) wl true
	 wtempname deletefile
       }
     }
	% Default
     { { pop true }
       { wother }
     }
   ] def

% Write a named dictionary.  We assume the ref is already declared.
   /wd		% <name> <dict> <extra> wd -
    { 3 1 roll
      ({) ws
      (\tref v_[) ws dup length wt (];) wl
      dup [ exch
       { counttomark 2 sub wtstring cvs
         (v_[) exch concatstrings (]) concatstrings exch wo not
          { (Skipping ) print ==only (....\n) print }
	 if
       } forall
      ]
		% Stack: array of keys (names)
      ({) ws dup (str_keys_) exch wsna
      (\tstatic const cfont_dict_keys keys_ =) wl
      (\t { 0, 0, ) ws length wt (, ) ws 3 -1 roll wt (, ) ws
      dup wpa (, ) ws dup wva ( };) wl pop
      (\tcode = \(*pprocs->ref_dict_create\)\(&) ws wt
      (, &keys_, str_keys_, v_\);) wl
      (\tif ( code < 0 ) return code;) wl
      (}) wl
      (}) wl
    } bind def

% Write character dictionary keys.
% We save a lot of space by abbreviating keys which appear in
% StandardEncoding or ISOLatin1Encoding.
% Writes code to declare and initialize enc_keys_, str_keys, and keys_.
/wcdkeys	% <dict> wcdkeys -
 {	% Write keys present in StandardEncoding or ISOLatin1Encoding,
	% pushing other keys on the o-stack.
   (static const charindex enc_keys_[] = {) wl
   dup [ exch 0 exch
    { pop decoding 1 index known
       { decoding exch get ({) ws dup -8 bitshift wt
	 (,) ws 255 and wt (}, ) ws
	 1 add dup 5 mod 0 eq { (\n) ws } if
       }
       { exch }
      ifelse
    }
   forall pop
   ]
   ({0,0}\n};) wl
	% Write other keys.
   (str_keys_) exch wsna
	% Write the declaration for keys_.
   (static const cfont_dict_keys keys_ = {) wl
   (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
   (\t) ws dup length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
   dup wpa (, ) ws wva () wl
   (};) wl
 } bind def

% Enumerate character dictionary values in the same order that
% the keys appear in enc_keys_ and str_keys_.
% <proc> is called with each value in turn.
/cdforall	% <dict> <proc> cdforall -
 { 2 copy
    { decoding 3 index known
       { 3 -1 roll pop exec }
       { pop pop pop }
      ifelse
    }
   /exec cvx 3 packedarray cvx
   /forall cvx
   5 -2 roll
    { decoding 3 index known
       { pop pop pop }
       { 3 -1 roll pop exec }
      ifelse
    }
   /exec cvx 3 packedarray cvx
   /forall cvx
   6 packedarray cvx exec
 } bind def

% ------ Writers for special objects ------ %

/writespecial 10 dict dup begin

   /FontInfo { 0 wd } def

   /Private { 0 wd } def

   /CharStrings
    { ({) wl
      dup wcdkeys
      (static const char values_[] = {) wl
       { wsn } cdforall
      (\t0\n};) wl
      (\tcode = \(*pprocs->string_dict_create\)\(&) ws wt
      (, &keys_, str_keys_, values_\);) wl
      (\tif ( code < 0 ) return code;) wl
      (}) wl
    } bind def

   /Metrics
    { ({) wl
      dup wcdkeys
      (static const ref_(float) values_[] = {) wl
      dup { (\t) ws wnums () wl } cdforall
      (\t0\n};) wl
      (static const char lengths_[] = {) wl
       { (\t) ws dup isnumber
	  { pop 0 }
	  { length 1 add }
	 ifelse wt (,) wl
       } cdforall
      (\t0\n};) wl
      (\tcode = \(*pprocs->num_dict_create\)\(&) ws wt
      (, &keys_, str_keys_, (const ref *)values_, lengths_\);) wl
      (\tif ( code < 0 ) return code;) wl
      (}) wl
    } bind def

   /Metrics2 /Metrics load def

   /FDepVector pop	% (converted to a list of font names)

end def

% ------ The main program ------ %

% Construct an inverse dictionary of encodings.
[ /StandardEncoding /ISOLatin1Encoding
  /SymbolEncoding /DingbatsEncoding
  /KanjiSubEncoding
]
dup length dict begin
 { mark exch dup { .findencoding exch def } stopped cleartomark
 } forall
currentdict end /encodingnames exch def

% Invert the StandardEncoding and ISOLatin1Encoding vectors.
512 dict begin
  0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
  0 1 255 { dup StandardEncoding exch get exch def } for
currentdict end /decoding exch def

/writefont		% cfilename procname -> [writes the current font]
 { (gsf_) exch concatstrings
     /fontprocname exch def
   /cfname exch def
   /cfile cfname (w) file def

% Remove unwanted keys from the font.
   currentfont dup length dict begin { def } forall
    { /FID /MIDVector /CurMID } { currentdict exch undef } forall
   /Font currentdict end def

% Replace the FDepVector with a list of font names.
   Font /FDepVector .knownget
    { [ exch { /FontName get } forall ]
      Font /FDepVector 3 -1 roll put
    }
   if

% Find all the special objects we know about.
% wo uses this to write out references to otherwise intractable objects.
   /otherobjs writespecial length dict dup begin
     writespecial
      { pop Font 1 index .knownget { exch def } { pop } ifelse
      }
     forall
   end def

% Define a dummy FontInfo, in case the font doesn't have one.
   /FontInfo 0 dict def

% Write out the boilerplate.
   Font begin
   (/****************************************************************) wl
   (   Portions of this file are subject to the following notice(s):) wl
   systemdict /copyright get wl
   FontInfo /Notice .knownget
    { (----------------------------------------------------------------) wl wl
    } if
   (****************************************************************/) wl
   () wl
   (/* ) ws cfname ws ( */) wl
   (/* This file was created by the ) ws product ws ( font2c utility. */) wl
   () wl
   (#undef DEBUG) wl
   (#include "ccfont.h") wl
   () wl

% Write the procedure prologue.
   (#ifdef __PROTOTYPES__) wl
   (int huge) wl
   fontprocname ws ((const cfont_procs *pprocs, ref *pfont)) wl
   (#else) wl
   (int huge) wl
   fontprocname ws ((pprocs, pfont) const cfont_procs *pprocs; ref *pfont;) wl
   (#endif) wl
   ({\tint code;) wl
   (\tref Font;) wl
   otherobjs
    { exch pop (\tref ) ws wt (;) wl }
   forall

% Write out the special objects.
   otherobjs
    { exch writespecial 2 index get exec
    }
   forall

% Write out the main font dictionary.
% If possible, substitute the encoding name for the encoding;
% PostScript code will fix this up.
    { /Encoding /PrefEnc }
    { Font 1 index .knownget
       { encodingnames exch .knownget { def } { pop } ifelse }
       { pop }
      ifelse
    }
   forall
   (Font) Font FontType 0 eq { 5 } { 1 } ifelse wd

% Finish the procedural initialization code.
   (\t*pfont = Font;) wl
   (\treturn 0;) wl
   (}) wl
   end				% Font

   cfile closefile

 } bind def

end def			% font2cdict

% Compute the procedure name from the font name.
% Replace all non-alphanumeric characters with '_'.
/makefontprocnamemap 256 string
   0 1 255 { 2 copy 95 put pop } for
   (0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz)
    { 2 copy dup put pop } forall
readonly def
/makefontprocname	% <fontname> makefontprocname <procnamestring>
 { dup length string cvs
   dup length 1 sub -1 0
    {		% Stack: string index
      2 copy 2 copy get //makefontprocnamemap exch get put pop
    }
   for 
 } def

/writefont { font2cdict begin writefont end } def

% If the program was invoked from the command line, run it now.
[ shellarguments
 { counttomark dup 2 eq exch 3 eq or
    { counttomark -1 roll cvn
      (Converting ) print dup =only ( font.\n) print flush
      dup FontDirectory exch known { dup FontDirectory exch undef } if
      findfont setfont
      (FontName is ) print currentfont /FontName get ==only (.\n) print flush
      counttomark 1 eq
       {	% Construct the procedure name from the file name.
         currentfont /FontName get makefontprocname
       }
      if
      writefont
      (Done.\n) print flush
    }
    { cleartomark
      (Usage: font2c fontname cfilename.c [shortname]\n) print
      ( e.g.: font2c Courier cour.c\n) print flush
      mark
    }
   ifelse
 }
if pop