sys/lib/ghostscript/font2c.ps

   1 %    Copyright (C) 1992, 1993, 1994, 1995, 1999 Aladdin Enterprises.  All rights reserved.
   2 %
   3 % This software is provided AS-IS with no warranty, either express or
   4 % implied.
   5 %
   6 % This software is distributed under license and may not be copied,
   7 % modified or distributed except as expressly authorized under the terms
   8 % of the license contained in the file LICENSE in this distribution.
   9 %
  10 % For more information about licensing, please refer to
  11 % http://www.ghostscript.com/licensing/. For information on
  12 % commercial licensing, go to http://www.artifex.com/licensing/ or
  13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15
  16 % $Id: font2c.ps,v 1.6 2003/07/10 02:56:51 ray Exp $
  17 % font2c.ps
  18 % Write out a PostScript Type 0 or Type 1 font as C code
  19 % that can be linked with the interpreter.
  20 % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
  21 % switch in the command line.  The code is reentrant and location-
  22 % independent and has no external references, so it can be put into
  23 % a sharable library even on VMS.
  24
  25 /font2cdict 100 dict dup begin
  26
  27 % Define the maximum string length that all compilers will accept.
  28 % This must be approximately
  29 %       min(max line length, max string literal length) / 4 - 5.
  30
  31 /max_wcs 50 def
  32
  33 % Define a temporary file for writing out procedures.
  34 /wtempname (_.tmp) def
  35
  36 % ------ Protection utilities ------ %
  37
  38 % Protection values are represented by a mask:
  39 /a_noaccess 0 def
  40 /a_executeonly 1 def
  41 /a_readonly 3 def
  42 /a_all 7 def
  43 /prot_names
  44  [ (0) (a_execute) null (a_readonly) null null null (a_all)
  45  ] def
  46 /prot_opers
  47  [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
  48  ] def
  49
  50 % Get the protection of an object.
  51    /getpa
  52     { dup wcheck
  53        { pop a_all }
  54        {        % Check for executeonly or noaccess objects in protected.
  55          dup protected exch known
  56           { protected exch get }
  57           { pop a_readonly }
  58          ifelse
  59        }
  60       ifelse
  61     } bind def
  62
  63 % Get the protection appropriate for (all the) values in a dictionary.
  64    /getva
  65     { a_noaccess exch
  66        { exch pop
  67          dup type dup /stringtype eq 1 index /arraytype eq or
  68          exch /packedarraytype eq or
  69           { getpa a_readonly and or }
  70           { pop pop a_all exit }
  71          ifelse
  72        }
  73       forall
  74     } bind def
  75
  76 % Keep track of executeonly and noaccess objects,
  77 % but don't let the protection actually take effect.
  78 .currentglobal
  79 false .setglobal        % so protected can reference local objs
  80 /protected              % do first so // will work
  81   systemdict wcheck { 1500 dict } { 1 dict } ifelse
  82 def
  83 systemdict wcheck not
  84  { (Warning: you will not be able to convert protected fonts.\n) print
  85    (If you need to convert a protected font, please\n) print
  86    (restart the program and specify the -dWRITESYSTEMDICT switch.\n) print
  87    flush
  88    (%end) .skipeof
  89  }
  90 if
  91 userdict begin
  92   /executeonly
  93    { dup //protected exch //a_executeonly put readonly
  94    } bind def
  95   /noaccess
  96    { dup //protected exch //a_noaccess put readonly
  97    } bind def
  98 end
  99 true .setglobal
 100 systemdict begin
 101   /executeonly
 102    { userdict /executeonly get exec
 103    } bind odef
 104   /noaccess
 105    { userdict /noaccess get exec
 106    } bind odef
 107 end
 108 %end
 109 .setglobal
 110
 111 % ------ Output utilities ------ %
 112
 113 % By convention, the output file is named cfile.
 114
 115 % Define some utilities for writing the output file.
 116    /wtstring 100 string def
 117    /wb {cfile exch write} bind def
 118    /ws {cfile exch writestring} bind def
 119    /wl {ws (\n) ws} bind def
 120    /wt {wtstring cvs ws} bind def
 121
 122 % Write a C string.  Some compilers have unreasonably small limits on
 123 % the length of a string literal or the length of a line, so every place
 124 % that uses wcs must either know that the string is short,
 125 % or be prepared to use wcca instead.
 126    /wbx
 127     { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
 128     } bind def
 129    /wcst
 130     [
 131       32 { /wbx load } repeat
 132       95 { /wb load } repeat
 133       129 { /wbx load } repeat
 134     ] def
 135    ("\\) { wcst exch { (\\) ws wb } put } forall
 136    /wcs
 137     { (") ws { dup wcst exch get exec } forall (") ws
 138     } bind def
 139    /can_wcs     % Test if can use wcs
 140     { length max_wcs le
 141     } bind def
 142    /wncs        % name -> C string
 143     { wtstring cvs wcs
 144     } bind def
 145 % Write a C string as an array of character values.
 146 % We only need this because of line and literal length limitations.
 147    /wca         % <string> <prefix> <suffix> wca -
 148     { 0 4 -2 roll exch
 149        {        % Stack: suffix n prefix char
 150          exch ws
 151          exch dup 19 ge { () wl pop 0 } if 1 add
 152          exch dup 32 ge 1 index 126 le and
 153           { 39 wb dup 39 eq 1 index 92 eq or { 92 wb } if wb 39 wb }
 154           { wt }
 155          ifelse (,)
 156        } forall
 157       pop pop ws
 158     } bind def
 159    /wcca        % <string> wcca -
 160     { ({\n) (}) wca
 161     } bind def
 162
 163 % Write object protection attributes.  Note that dictionaries and arrays are
 164 % the only objects that can be writable.
 165    /wpa
 166     { dup xcheck { (a_executable|) ws } if
 167       dup type dup /dicttype eq exch /arraytype eq or
 168        { getpa }
 169        { getpa a_readonly and }
 170       ifelse prot_names exch get ws
 171     } bind def
 172    /wva
 173     { getva prot_names exch get ws
 174     } bind def
 175
 176 % ------ Object writing ------ %
 177
 178    /wnstring 128 string def
 179
 180 % Convert an object to a string to be scanned at a later time.
 181    /cvos                % <obj> cvos <string>
 182     {           % We'd like to use == and write directly to a string,
 183                 % but we can't do the former because of operators,
 184                 % and we can't do the latter because we can't predict
 185                 % how long the string would have to be....
 186          wtempname (w) file dup 3 -1 roll wproc closefile
 187          wtempname status pop pop pop exch pop string
 188          wtempname (r) file dup 3 -1 roll readstring pop exch closefile
 189     } bind def
 190
 191 % Write a string/name or null as an element of a string/name/null array.
 192 % Convert any other kind of value to a token to be read back in.
 193    /wsn
 194     { dup null eq
 195        { pop (\t255,255,) wl
 196        }
 197        { dup type /nametype eq { wnstring cvs } if
 198          dup type /stringtype ne { cvos (255,) ws } if
 199          dup length 256 idiv wt (,) ws
 200          dup length 256 mod wt
 201          (,) (,\n) wca
 202        }
 203       ifelse
 204     } bind def
 205 % Write a packed string/name/null array.
 206    /wsna        % <name> <(string|name|null)*> wsna -
 207     { (\tstatic const unsigned char ) ws exch wt ([] = {) wl
 208       { wsn } forall
 209       (\t0\n};) wl
 210     } bind def
 211
 212 % Write a number or an array of numbers, as refs.
 213 /isnumber
 214  { type dup /integertype eq exch /realtype eq or
 215  } bind def
 216 /wnums
 217  { dup isnumber
 218     { (real_v\() ws wt (\),) ws }
 219     { { wnums } forall }
 220    ifelse
 221  } bind def
 222
 223 % Test whether a procedure or unusual array can be written (printed).
 224 /iswx 4 dict dup begin
 225   /arraytype { { iswproc } isall } def
 226   /nametype { pop true } def
 227   /operatortype { pop true } def        % assume it has been bound in
 228   /packedarraytype /arraytype load def
 229 end def
 230 /iswnx 6 dict dup begin
 231   /arraytype { { iswproc } isall } def
 232   /integertype { pop true } def
 233   /nametype { pop true } def
 234   /realtype { pop true } def
 235   /stringtype { pop true } def
 236   /packedarraytype /arraytype load def
 237 end def
 238 /iswproc        % <obj> iswproc <bool>
 239  { dup xcheck { iswx } { iswnx } ifelse
 240    1 index type .knownget { exec } { pop false } ifelse
 241  } bind def
 242
 243 % Write a printable procedure (one for which iswproc returns true).
 244 /wproca 3 dict dup begin
 245   /arraytype
 246    { 1 index ({) writestring
 247       { 1 index ( ) writestring 1 index exch wproc } forall
 248      (}) writestring
 249    } bind def
 250   /packedarraytype /arraytype load def
 251   /operatortype { .writecvs } bind def  % assume binding would work
 252 end def
 253 /wproc          % <file> <proc> wproc -
 254  { dup type wproca exch .knownget { exec } { write==only } ifelse
 255  } bind def
 256
 257 % Write a named object.  Return true if this was possible.
 258 % Legal types are: boolean, integer, name, real, string,
 259 % array of (integer, integer+real, name, null+string),
 260 % and certain procedures and other arrays (see iswproc above).
 261 % All other objects are either handled specially or ignored.
 262    /isall       % <array> <proc> isall <bool>
 263     { true 3 -1 roll
 264        { 2 index exec not { pop false exit } if }
 265       forall exch pop
 266     } bind def
 267    /wott 8 dict dup begin
 268       /arraytype
 269        { woatt
 270           { aload pop 2 index 2 index exec
 271              { exch pop exec exit }
 272              { pop pop }
 273             ifelse
 274           }
 275          forall
 276        } bind def
 277       /booleantype
 278        { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
 279          wt (\);) wl true
 280        } bind def
 281       /integertype
 282        { (\tmake_int\(&) ws exch wt (, ) ws
 283          wt (\);) wl true
 284        } bind def
 285       /nametype
 286        { (\tcode = (*pprocs->name_create)\(i_ctx_p, &) ws exch wt
 287          (, ) ws wnstring cvs wcs       % OK, names are short
 288          (\);) wl
 289          (\tif ( code < 0 ) return code;) wl
 290          true
 291        } bind def
 292       /packedarraytype
 293         /arraytype load def
 294       /realtype
 295        { (\tmake_real\(&) ws exch wt (, (float)) ws
 296          wt (\);) wl true
 297        } bind def
 298       /stringtype
 299        { ({\tstatic const unsigned char s_[] = ) ws
 300          dup dup can_wcs { wcs } { wcca } ifelse
 301          (;) wl
 302          (\tmake_const_string\(&) ws exch wt
 303          (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
 304          (}) wl true
 305        } bind def
 306    end def
 307 % Write some other kind of object, if known.
 308    /wother
 309     { dup otherobjs exch known
 310        { otherobjs exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
 311        { pop pop false }
 312       ifelse
 313     } bind def
 314 % Top-level procedure.
 315    /wo          % name obj -> OK
 316     { dup type wott exch .knownget { exec } { wother } ifelse
 317     } bind def
 318
 319 % Write an array (called by wo).
 320    /wap         % <name> <array> wap -
 321     { dup xcheck not 1 index wcheck not and 1 index rcheck and
 322        { pop pop }
 323        { (\tr_set_attrs\(&) ws exch wt (, ) ws wpa (\);) wl }
 324       ifelse
 325     } bind def
 326    /wnuma {     % <name> <array> <element_C_type> <<type>_v> wnuma -
 327       ({\tstatic const ref_\() ws exch ws (\) a_[] = {) wl exch
 328                 % Stack: name type_v array
 329       dup length 0 eq {
 330         (\t) ws 1 index ws (\(0\)) wl
 331       } {
 332         dup {
 333           (\t) ws 2 index ws (\() ws wt (\),) wl
 334         } forall
 335       } ifelse exch pop
 336                 % Stack: name array
 337       (\t};) wl
 338       dup wcheck {
 339         (\tcode = (*pprocs->scalar_array_create)\(i_ctx_p, &) ws exch wt
 340         (, (const ref *)a_, ) ws dup length wt
 341         (, ) ws wpa (\);) wl
 342         (\tif ( code < 0 ) return code;) wl
 343       } {
 344         (\tmake_const_array\(&) ws exch wt
 345         (, avm_foreign|) ws dup wpa (, ) ws length wt
 346         (, (const ref *)a_\);) wl
 347       } ifelse
 348       (}) wl
 349     } bind def
 350    /woatt [
 351         % Integers
 352      { { { type /integertype eq } isall }
 353        { (long) (integer_v) wnuma true }
 354      }
 355         % Integers + reals
 356      { { { type dup /integertype eq exch /realtype eq or } isall }
 357        { (float) (real_v) wnuma true }
 358      }
 359         % Strings + nulls
 360      { { { type dup /nulltype eq exch /stringtype eq or } isall }
 361        { ({) ws dup (sa_) exch wsna
 362          (\tcode = (*pprocs->string_array_create)\(i_ctx_p, &) ws exch wt
 363          (, \(const char *\)sa_, ) ws dup length wt (, ) ws wpa (\);) wl
 364          (\tif ( code < 0 ) return code;) wl
 365          (}) wl true
 366        }
 367      }
 368         % Names
 369      { { { type /nametype eq } isall }
 370        { ({) ws dup (na_) exch wsna
 371          (\tcode = (*pprocs->name_array_create)\(i_ctx_p, &) ws 1 index wt
 372          (, \(const char *\)na_, ) ws dup length wt (\);) wl
 373          (\tif ( code < 0 ) return code;) wl
 374          wap (}) wl true
 375        }
 376      }
 377         % Procedure
 378      { { iswproc }
 379        { dup cvos
 380                 % Stack: name proc string
 381          ({\tstatic const unsigned char s_[] = ) ws
 382          dup dup can_wcs { wcs } { wcca } ifelse
 383          (;) wl
 384          (\tcode = (*pprocs->ref_from_string)\(i_ctx_p, &) ws 2 index wt
 385          (, \(const char *\)s_, ) ws length wt (\);) wl
 386          (\tif ( code < 0 ) return code;) wl
 387          wap (}) wl true
 388          wtempname deletefile
 389        }
 390      }
 391         % Default
 392      { { pop true }
 393        { wother }
 394      }
 395    ] def
 396
 397 % Write a named dictionary.  We assume the ref is already declared.
 398    /wd          % <name> <dict> <extra> wd -
 399     { 3 1 roll
 400       ({) ws
 401       (\tref v_[) ws dup length wt (];) wl
 402       dup [ exch
 403        { counttomark 2 sub wtstring cvs
 404          (v_[) exch concatstrings (]) concatstrings exch wo not
 405           { (Skipping ) print ==only (....\n) print }
 406          if
 407        } forall
 408       ]
 409                 % Stack: array of keys (names)
 410       ({) ws dup (str_keys_) exch wsna
 411       (\tstatic const cfont_dict_keys keys_ =) wl
 412       (\t { 0, 0, ) ws length wt (, ) ws 3 -1 roll wt (, ) ws
 413       dup wpa (, ) ws dup wva ( };) wl pop
 414       (\tcode = \(*pprocs->ref_dict_create\)\(i_ctx_p, &) ws wt
 415       (, &keys_, \(const char *\)str_keys_, v_\);) wl
 416       (\tif ( code < 0 ) return code;) wl
 417       (}) wl
 418       (}) wl
 419     } bind def
 420
 421 % Write character dictionary keys.
 422 % We save a lot of space by abbreviating keys which appear in
 423 % StandardEncoding or ISOLatin1Encoding.
 424 % Writes code to declare and initialize enc_keys_, str_keys, and keys_.
 425 /wcdkeys        % <dict> wcdkeys -
 426  {      % Write keys present in StandardEncoding or ISOLatin1Encoding,
 427         % pushing other keys on the o-stack.
 428    (static const charindex enc_keys_[] = {) wl
 429    dup [ exch 0 exch
 430     { pop decoding 1 index known
 431        { decoding exch get ({) ws dup -8 bitshift wt
 432          (,) ws 255 and wt (}, ) ws
 433          1 add dup 5 mod 0 eq { (\n) ws } if
 434        }
 435        { exch }
 436       ifelse
 437     }
 438    forall pop
 439    ]
 440    ({0,0}\n};) wl
 441         % Write other keys.
 442    (str_keys_) exch wsna
 443         % Write the declaration for keys_.
 444    (static const cfont_dict_keys keys_ = {) wl
 445    (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
 446    (\t) ws dup length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
 447    dup wpa (, ) ws wva () wl
 448    (};) wl
 449  } bind def
 450
 451 % Enumerate character dictionary values in the same order that
 452 % the keys appear in enc_keys_ and str_keys_.
 453 % <proc> is called with each value in turn.
 454 /cdforall       % <dict> <proc> cdforall -
 455  { 2 copy
 456     { decoding 3 index known
 457        { 3 -1 roll pop exec }
 458        { pop pop pop }
 459       ifelse
 460     }
 461    /exec cvx 3 packedarray cvx
 462    /forall cvx
 463    5 -2 roll
 464     { decoding 3 index known
 465        { pop pop pop }
 466        { 3 -1 roll pop exec }
 467       ifelse
 468     }
 469    /exec cvx 3 packedarray cvx
 470    /forall cvx
 471    6 packedarray cvx exec
 472  } bind def
 473
 474 % ------ Writers for special objects ------ %
 475
 476 /writespecial 10 dict dup begin
 477
 478    /FontInfo { 0 wd } def
 479
 480    /Private { 0 wd } def
 481
 482    /CharStrings
 483     { ({) wl
 484       dup wcdkeys
 485       (static const unsigned char values_[] = {) wl
 486        { wsn } cdforall
 487       (\t0\n};) wl
 488       (\tcode = \(*pprocs->string_dict_create\)\(i_ctx_p, &) ws wt
 489       (, &keys_, (const char *)str_keys_, \(const char *\)values_\);) wl
 490       (\tif ( code < 0 ) return code;) wl
 491       (}) wl
 492     } bind def
 493
 494    /Metrics
 495     { ({) wl
 496       dup wcdkeys
 497       (static const ref_(float) values_[] = {) wl
 498       dup { (\t) ws wnums () wl } cdforall
 499       (\t0\n};) wl
 500       (static const unsigned char lengths_[] = {) wl
 501        { (\t) ws dup isnumber
 502           { pop 0 }
 503           { length 1 add }
 504          ifelse wt (,) wl
 505        } cdforall
 506       (\t0\n};) wl
 507       (\tcode = \(*pprocs->num_dict_create\)\(i_ctx_p, &) ws wt
 508       (, &keys_, str_keys_, (const ref *)values_, lengths_\);) wl
 509       (\tif ( code < 0 ) return code;) wl
 510       (}) wl
 511     } bind def
 512
 513    /Metrics2 /Metrics load def
 514
 515    /FDepVector pop      % (converted to a list of font names)
 516
 517 end def
 518
 519 % ------ The main program ------ %
 520
 521 % Construct an inverse dictionary of encodings.
 522 [ /StandardEncoding /ISOLatin1Encoding
 523   /SymbolEncoding /DingbatsEncoding
 524   /KanjiSubEncoding
 525 ]
 526 dup length dict begin
 527  { mark exch dup { .findencoding exch def } stopped cleartomark
 528  } forall
 529 currentdict end /encodingnames exch def
 530
 531 % Invert the StandardEncoding and ISOLatin1Encoding vectors.
 532 512 dict begin
 533   0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
 534   0 1 255 { dup StandardEncoding exch get exch def } for
 535 currentdict end /decoding exch def
 536
 537 /writefont              % cfilename procname -> [writes the current font]
 538  { (gsf_) exch concatstrings
 539      /fontprocname exch def
 540    /cfname exch def
 541    /cfile cfname (w) file def
 542
 543 % Remove unwanted keys from the font.
 544    currentfont dup length dict begin { def } forall
 545     { /FID /MIDVector /CurMID } { currentdict exch undef } forall
 546    /Font currentdict end def
 547
 548 % Replace the FDepVector with a list of font names.
 549    Font /FDepVector .knownget
 550     { [ exch { /FontName get } forall ]
 551       Font /FDepVector 3 -1 roll put
 552     }
 553    if
 554
 555 % Find all the special objects we know about.
 556 % wo uses this to write out references to otherwise intractable objects.
 557    /otherobjs writespecial length dict dup begin
 558      writespecial
 559       { pop Font 1 index .knownget { exch def } { pop } ifelse
 560       }
 561      forall
 562    end def
 563
 564 % Define a dummy FontInfo, in case the font doesn't have one.
 565    /FontInfo 0 dict def
 566
 567 % Write out the boilerplate.
 568    Font begin
 569    (/****************************************************************) wl
 570    (   Portions of this file are subject to the following notice(s):) wl
 571    systemdict /copyright get wl
 572    FontInfo /Notice .knownget
 573     { (----------------------------------------------------------------) wl wl
 574     } if
 575    (****************************************************************/) wl
 576    () wl
 577    (/* ) ws cfname ws ( */) wl
 578    (/* This file was created by the ) ws product ws ( font2c utility. */) wl
 579    () wl
 580    (#undef DEBUG) wl
 581    (#include "ccfont.h") wl
 582    () wl
 583
 584 % Write the procedure prologue.
 585    (#ifdef __PROTOTYPES__) wl
 586    (ccfont_proc\() ws fontprocname ws (\);) wl
 587    (int) wl
 588    fontprocname ws ((i_ctx_t *i_ctx_p, const cfont_procs *pprocs, ref *pfont)) wl
 589    (#else) wl
 590    (int) wl
 591    fontprocname ws ((i_ctx_p, pprocs, pfont) i_ctx_t *i_ctx_p; const cfont_procs *pprocs; ref *pfont;) wl
 592    (#endif) wl
 593    ({\tint code;) wl
 594    (\tref Font;) wl
 595    otherobjs
 596     { exch pop (\tref ) ws wt (;) wl }
 597    forall
 598
 599 % Write out the special objects.
 600    otherobjs
 601     { exch writespecial 2 index get exec
 602     }
 603    forall
 604
 605 % Write out the main font dictionary.
 606 % If possible, substitute the encoding name for the encoding;
 607 % PostScript code will fix this up.
 608     { /Encoding /PrefEnc }
 609     { Font 1 index .knownget
 610        { encodingnames exch .knownget { def } { pop } ifelse }
 611        { pop }
 612       ifelse
 613     }
 614    forall
 615    (Font) Font FontType 0 eq { 5 } { 1 } ifelse wd
 616
 617 % Finish the procedural initialization code.
 618    (\t*pfont = Font;) wl
 619    (\treturn 0;) wl
 620    (}) wl
 621    end                          % Font
 622
 623    cfile closefile
 624
 625  } bind def
 626
 627 end def                 % font2cdict
 628
 629 % Compute the procedure name from the font name.
 630 % Replace all non-alphanumeric characters with '_'.
 631 /makefontprocnamemap 256 string
 632    0 1 255 { 2 copy 95 put pop } for
 633    (0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz)
 634     { 2 copy dup put pop } forall
 635 readonly def
 636 /makefontprocname       % <fontname> makefontprocname <procnamestring>
 637  { dup length string cvs
 638    dup length 1 sub -1 0
 639     {           % Stack: string index
 640       2 copy 2 copy get //makefontprocnamemap exch get put pop
 641     }
 642    for
 643  } def
 644
 645 /writefont { font2cdict begin writefont end } def
 646
 647 % If the program was invoked from the command line, run it now.
 648 [ shellarguments
 649  { counttomark dup 2 eq exch 3 eq or
 650     { counttomark -1 roll cvn
 651       (Converting ) print dup =only ( font.\n) print flush
 652                 % Ensure that we get a clean copy of the font from the
 653                 % file system.
 654       2 {       % do both local and global
 655         currentglobal not setglobal
 656         dup undefinefont
 657       } repeat
 658       findfont setfont
 659       (FontName is ) print currentfont /FontName get ==only (.\n) print flush
 660       counttomark 1 eq
 661        {        % Construct the procedure name from the file name.
 662          currentfont /FontName get makefontprocname
 663        }
 664       if
 665       writefont
 666       (Done.\n) print flush
 667     }
 668     { cleartomark
 669       (Usage: font2c fontname cfilename.c [shortname]\n) print
 670       ( e.g.: font2c Courier cour.c\n) print flush
 671       mark
 672     }
 673    ifelse
 674  }
 675 if pop