Subversion Repositories planix.SVN

%    Copyright (C) 1992, 1993, 1994, 1995, 1999 Aladdin Enterprises.  All rights reserved.

% 

% This software is provided AS-IS with no warranty, either express or

% implied.

% 

% This software is distributed under license and may not be copied,

% modified or distributed except as expressly authorized under the terms

% of the license contained in the file LICENSE in this distribution.

% 

% For more information about licensing, please refer to

% http://www.ghostscript.com/licensing/. For information on

% commercial licensing, go to http://www.artifex.com/licensing/ or

% contact Artifex Software, Inc., 101 Lucas Valley Road #110,

% San Rafael, CA  94903, U.S.A., +1(415)492-9861.

% $Id: font2c.ps,v 1.6 2003/07/10 02:56:51 ray Exp $

% font2c.ps

% Write out a PostScript Type 0 or Type 1 font as C code

% that can be linked with the interpreter.

% This even works on protected fonts, if you use the -dWRITESYSTEMDICT

% switch in the command line.  The code is reentrant and location-

% independent and has no external references, so it can be put into

% a sharable library even on VMS.

/font2cdict 100 dict dup begin

% Define the maximum string length that all compilers will accept.

% This must be approximately

%	min(max line length, max string literal length) / 4 - 5.

/max_wcs 50 def

% Define a temporary file for writing out procedures.

/wtempname (_.tmp) def

% ------ Protection utilities ------ %

% Protection values are represented by a mask:

/a_noaccess 0 def

/a_executeonly 1 def

/a_readonly 3 def

/a_all 7 def

/prot_names

 [ (0) (a_execute) null (a_readonly) null null null (a_all)

 ] def

/prot_opers

 [ {noaccess} {executeonly} {} {readonly} {} {} {} {}

 ] def

% Get the protection of an object.

   /getpa

    { dup wcheck

       { pop a_all }

       {	% Check for executeonly or noaccess objects in protected.

         dup protected exch known

	  { protected exch get }

	  { pop a_readonly }

	 ifelse

       }

      ifelse

    } bind def

% Get the protection appropriate for (all the) values in a dictionary.

   /getva

    { a_noaccess exch

       { exch pop

         dup type dup /stringtype eq 1 index /arraytype eq or

	 exch /packedarraytype eq or

	  { getpa a_readonly and or }

	  { pop pop a_all exit }

	 ifelse

       }

      forall

    } bind def

% Keep track of executeonly and noaccess objects,

% but don't let the protection actually take effect.

.currentglobal

false .setglobal	% so protected can reference local objs

/protected		% do first so // will work

  systemdict wcheck { 1500 dict } { 1 dict } ifelse

def

systemdict wcheck not

 { (Warning: you will not be able to convert protected fonts.\n) print

   (If you need to convert a protected font, please\n) print

   (restart the program and specify the -dWRITESYSTEMDICT switch.\n) print

   flush

   (%end) .skipeof

 }

if

userdict begin

  /executeonly

   { dup //protected exch //a_executeonly put readonly

   } bind def

  /noaccess

   { dup //protected exch //a_noaccess put readonly

   } bind def

end

true .setglobal

systemdict begin

  /executeonly

   { userdict /executeonly get exec

   } bind odef

  /noaccess

   { userdict /noaccess get exec

   } bind odef

end

%end

.setglobal

% ------ Output utilities ------ %

% By convention, the output file is named cfile.

% Define some utilities for writing the output file.

   /wtstring 100 string def

   /wb {cfile exch write} bind def

   /ws {cfile exch writestring} bind def

   /wl {ws (\n) ws} bind def

   /wt {wtstring cvs ws} bind def

% Write a C string.  Some compilers have unreasonably small limits on

% the length of a string literal or the length of a line, so every place

% that uses wcs must either know that the string is short,

% or be prepared to use wcca instead.

   /wbx

    { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws

    } bind def

   /wcst

    [

      32 { /wbx load } repeat

      95 { /wb load } repeat

      129 { /wbx load } repeat

    ] def

   ("\\) { wcst exch { (\\) ws wb } put } forall

   /wcs

    { (") ws { dup wcst exch get exec } forall (") ws

    } bind def

   /can_wcs	% Test if can use wcs

    { length max_wcs le

    } bind def

   /wncs	% name -> C string

    { wtstring cvs wcs

    } bind def

% Write a C string as an array of character values.

% We only need this because of line and literal length limitations.

   /wca		% <string> <prefix> <suffix> wca -

    { 0 4 -2 roll exch

       {	% Stack: suffix n prefix char

	 exch ws

	 exch dup 19 ge { () wl pop 0 } if 1 add

	 exch dup 32 ge 1 index 126 le and

	  { 39 wb dup 39 eq 1 index 92 eq or { 92 wb } if wb 39 wb }

	  { wt }

	 ifelse (,)

       } forall

      pop pop ws

    } bind def

   /wcca	% <string> wcca -

    { ({\n) (}) wca

    } bind def

% Write object protection attributes.  Note that dictionaries and arrays are

% the only objects that can be writable.

   /wpa

    { dup xcheck { (a_executable|) ws } if

      dup type dup /dicttype eq exch /arraytype eq or

       { getpa }

       { getpa a_readonly and }

      ifelse prot_names exch get ws

    } bind def

   /wva

    { getva prot_names exch get ws

    } bind def

% ------ Object writing ------ %

   /wnstring 128 string def

% Convert an object to a string to be scanned at a later time.

   /cvos		% <obj> cvos <string>

    {		% We'd like to use == and write directly to a string,

		% but we can't do the former because of operators,

		% and we can't do the latter because we can't predict

		% how long the string would have to be....

	 wtempname (w) file dup 3 -1 roll wproc closefile

	 wtempname status pop pop pop exch pop string

	 wtempname (r) file dup 3 -1 roll readstring pop exch closefile

    } bind def

% Write a string/name or null as an element of a string/name/null array.

% Convert any other kind of value to a token to be read back in.

   /wsn

    { dup null eq

       { pop (\t255,255,) wl

       }

       { dup type /nametype eq { wnstring cvs } if

	 dup type /stringtype ne { cvos (255,) ws } if

	 dup length 256 idiv wt (,) ws

	 dup length 256 mod wt

	 (,) (,\n) wca

       }

      ifelse

    } bind def

% Write a packed string/name/null array.

   /wsna	% <name> <(string|name|null)*> wsna -

    { (\tstatic const unsigned char ) ws exch wt ([] = {) wl

      { wsn } forall

      (\t0\n};) wl

    } bind def

% Write a number or an array of numbers, as refs.

/isnumber

 { type dup /integertype eq exch /realtype eq or

 } bind def

/wnums

 { dup isnumber

    { (real_v\() ws wt (\),) ws }

    { { wnums } forall }

   ifelse

 } bind def

% Test whether a procedure or unusual array can be written (printed).

/iswx 4 dict dup begin

  /arraytype { { iswproc } isall } def

  /nametype { pop true } def

  /operatortype { pop true } def	% assume it has been bound in

  /packedarraytype /arraytype load def

end def

/iswnx 6 dict dup begin

  /arraytype { { iswproc } isall } def

  /integertype { pop true } def

  /nametype { pop true } def

  /realtype { pop true } def

  /stringtype { pop true } def

  /packedarraytype /arraytype load def

end def

/iswproc	% <obj> iswproc <bool>

 { dup xcheck { iswx } { iswnx } ifelse

   1 index type .knownget { exec } { pop false } ifelse

 } bind def

% Write a printable procedure (one for which iswproc returns true).

/wproca 3 dict dup begin

  /arraytype

   { 1 index ({) writestring

      { 1 index ( ) writestring 1 index exch wproc } forall

     (}) writestring

   } bind def

  /packedarraytype /arraytype load def

  /operatortype { .writecvs } bind def	% assume binding would work

end def

/wproc		% <file> <proc> wproc -

 { dup type wproca exch .knownget { exec } { write==only } ifelse

 } bind def

% Write a named object.  Return true if this was possible.

% Legal types are: boolean, integer, name, real, string,

% array of (integer, integer+real, name, null+string),

% and certain procedures and other arrays (see iswproc above).

% All other objects are either handled specially or ignored.

   /isall	% <array> <proc> isall <bool>

    { true 3 -1 roll

       { 2 index exec not { pop false exit } if }

      forall exch pop

    } bind def

   /wott 8 dict dup begin

      /arraytype

       { woatt

          { aload pop 2 index 2 index exec

	     { exch pop exec exit }

	     { pop pop }

	    ifelse

	  }

	 forall

       } bind def

      /booleantype

       { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws

         wt (\);) wl true

       } bind def

      /integertype

       { (\tmake_int\(&) ws exch wt (, ) ws

         wt (\);) wl true

       } bind def

      /nametype

       { (\tcode = (*pprocs->name_create)\(i_ctx_p, &) ws exch wt

         (, ) ws wnstring cvs wcs	% OK, names are short

	 (\);) wl

	 (\tif ( code < 0 ) return code;) wl

	 true

       } bind def

      /packedarraytype

	/arraytype load def

      /realtype

       { (\tmake_real\(&) ws exch wt (, (float)) ws

         wt (\);) wl true

       } bind def

      /stringtype

       { ({\tstatic const unsigned char s_[] = ) ws

         dup dup can_wcs { wcs } { wcca } ifelse

	 (;) wl

	 (\tmake_const_string\(&) ws exch wt

	 (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl

	 (}) wl true

       } bind def

   end def

% Write some other kind of object, if known.

   /wother

    { dup otherobjs exch known

       { otherobjs exch get (\t) ws exch wt ( = ) ws wt (;) wl true }

       { pop pop false }

      ifelse

    } bind def

% Top-level procedure.

   /wo		% name obj -> OK

    { dup type wott exch .knownget { exec } { wother } ifelse

    } bind def

% Write an array (called by wo).

   /wap		% <name> <array> wap -

    { dup xcheck not 1 index wcheck not and 1 index rcheck and

       { pop pop }

       { (\tr_set_attrs\(&) ws exch wt (, ) ws wpa (\);) wl }

      ifelse

    } bind def

   /wnuma {	% <name> <array> <element_C_type> <<type>_v> wnuma -

      ({\tstatic const ref_\() ws exch ws (\) a_[] = {) wl exch

		% Stack: name type_v array

      dup length 0 eq {

	(\t) ws 1 index ws (\(0\)) wl

      } {

	dup {

	  (\t) ws 2 index ws (\() ws wt (\),) wl

	} forall

      } ifelse exch pop

		% Stack: name array

      (\t};) wl

      dup wcheck {

	(\tcode = (*pprocs->scalar_array_create)\(i_ctx_p, &) ws exch wt

	(, (const ref *)a_, ) ws dup length wt

	(, ) ws wpa (\);) wl

	(\tif ( code < 0 ) return code;) 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)\(i_ctx_p, &) ws exch wt

	 (, \(const char *\)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)\(i_ctx_p, &) ws 1 index wt

	 (, \(const char *\)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 unsigned char s_[] = ) ws

         dup dup can_wcs { wcs } { wcca } ifelse

	 (;) wl

	 (\tcode = (*pprocs->ref_from_string)\(i_ctx_p, &) ws 2 index wt

	 (, \(const char *\)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\)\(i_ctx_p, &) ws wt

      (, &keys_, \(const char *\)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 unsigned char values_[] = {) wl

       { wsn } cdforall

      (\t0\n};) wl

      (\tcode = \(*pprocs->string_dict_create\)\(i_ctx_p, &) ws wt

      (, &keys_, (const char *)str_keys_, \(const char *\)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 unsigned char lengths_[] = {) wl

       { (\t) ws dup isnumber

	  { pop 0 }

	  { length 1 add }

	 ifelse wt (,) wl

       } cdforall

      (\t0\n};) wl

      (\tcode = \(*pprocs->num_dict_create\)\(i_ctx_p, &) 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

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

   (ccfont_proc\() ws fontprocname ws (\);) wl

   (int) wl

   fontprocname ws ((i_ctx_t *i_ctx_p, const cfont_procs *pprocs, ref *pfont)) wl

   (#else) wl

   (int) wl

   fontprocname ws ((i_ctx_p, pprocs, pfont) i_ctx_t *i_ctx_p; 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

   (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

		% Ensure that we get a clean copy of the font from the

		% file system.

      2 {	% do both local and global

	currentglobal not setglobal

	dup undefinefont

      } repeat

      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