PC World Komputer 1996 February/PCWK0296.iso/sharewar/dos/inne/gs300ini/wrfont.ps

Text File | 1994-08-02 | 15.6 KB | 542 lines

%    Copyright (C) 1991, 1993, 1994 Aladdin Enterprises.  All rights reserved.
%
% This file is part of Aladdin Ghostscript.
%
% Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
% or distributor accepts any responsibility for the consequences of using it,
% or for whether it serves any particular purpose or works at all, unless he
% or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
% License (the "License") for full details.
%
% Every copy of Aladdin Ghostscript must include a copy of the License,
% normally in a plain ASCII text file named PUBLIC.  The License grants you
% the right to copy, modify and redistribute Aladdin Ghostscript, but only
% under certain conditions described in the License.  Among other things, the
% License requires that the copyright notice and this notice be preserved on
% all copies.

% wrfont.ps
% Write out a Type 1 font in readable, reloadable form.
% Note that this does NOT work on protected fonts, such as Adobe fonts
% (unless you have loaded unprot.ps first, in which case you may be
% violating the Adobe license).

/wrfont_dict 100 dict def
wrfont_dict begin

% ------ Options ------ %

% Define whether to write out the CharStrings in binary or in hex.
% Binary takes less space on the file, but isn't guaranteed portable.
   /binary_CharStrings false def

% Define whether to use binary token encodings when possible.
% Binary tokens are smaller and load faster, but are a Level 2 feature.
   /binary_tokens false def

% Define whether to encrypt the CharStrings on the file.  (CharStrings
% are always encrypted in memory.)  Unencrypted CharStrings load about
% 20% slower, but make the files compress much better for transport.
   /encrypt_CharStrings true def

% Define whether the font must provide standard PostScript language
% equivalents for any facilities it uses that are provided in Ghostscript
% but are not part of the standard PostScript language.
   /standard_only true def

% Define the value of lenIV to use in writing out the font.
% use_lenIV = 0 produces the smallest output, but this may not be
% compatible with old Adobe interpreters.  use_lenIV = -1 means
% use the value of lenIV from the font.
   /use_lenIV -1 def

% Define whether to produce the smallest possible output, relying
% as much as possible on Ghostscript-specific support code.
% Taking full advantage of this requires the following settings:
% binary_CharStrings = true, binary_tokens = true, standard_only = false.
   /smallest_output false def

% ---------------- Runtime support ---------------- %

currentdict end

% If smallest_output was selected when the font was written,
% the following code must be available when the font is being loaded.

/.check_existing_font    % <fontname> <uid> .check_existing_font {}
            % <fontname> <uid> .check_existing_font restore -save-
 { {} 3 1 roll
   exch FontDirectory exch .knownget
    { dup /UniqueID .knownget
       { 2 index eq exch /FontType get 1 eq and }
       { pop false }
      ifelse exch pop
       { pop save /restore load }
      if
    }
    { pop
    }
   ifelse
 } bind def

/.knownEncodings [
   ISOLatin1Encoding
   StandardEncoding
   SymbolEncoding
] readonly def

/.read_CharStrings    % <count> <encrypt> .read_CharStrings <dict>
 { exch dup dict dup 3 -1 roll
    { currentfile token pop dup type /integertype eq
       { dup -8 bitshift .knownEncodings exch get exch 255 and get } if
      currentfile token pop dup type /nametype eq
       { 2 index exch get
       }
       {    % Stack: encrypt dict dict key value
     4 index { 4330 exch dup .type1encrypt exch pop } if
     readonly
       }
      ifelse put dup
    }
   repeat pop exch pop
 } bind def

begin

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

% By convention, the output file is named psfile.

% Define some utilities for writing the output file.
   /wtstring 800 string def
   /wb {psfile exch write} bind def
   /wnb {/wb load repeat} bind def
   /w1 {psfile exch write} bind def
   /ws {psfile exch writestring} bind def
   /wl {ws (\n) ws} bind def
   /wt {wtstring cvs ws ( ) ws} bind def
   /wd        % Write a dictionary.
    { dup length wt (dict dup begin) wl { we } forall
      (end) ws
    } bind def
   /wld        % Write a large dictionary more efficiently.
           % Ignore the readonly attributes.
    { dup length wt (dict dup begin) wl
      0 exch
       { exch wo wo () wl
     1 add dup 200 eq
      { wo ({def} repeat) wl 0 }
     if
       }
      forall
      dup 0 ne
       { wo ({def} repeat) wl }
       { pop }
      ifelse
      (end) ws
    } bind def
   /we        % Write a dictionary entry.
    { exch wo wo /def cvx wo (\n) ws
    } bind def
   /wcs        % Write a CharString (or Subrs entry)
    { dup type /stringtype eq
       { 4330 exch changelenIV 0 ge
          {    % Add some leading garbage bytes.
        wtstring changelenIV 2 index length getinterval
        .type1decrypt exch pop
        wtstring exch 0 exch length changelenIV add getinterval
      }
      {    % Drop some leading garbage bytes.
        wtstring .type1decrypt exch pop
        changelenIV neg 1 index length 1 index sub getinterval
      }
     ifelse
         binary_tokens encrypt_CharStrings and
      { % Suppress recognizing the readonly status of the string.
        4330 exch dup .type1encrypt exch pop wo
      }
      { encrypt_CharStrings
         { 4330 exch dup .type1encrypt exch pop
         } if
        smallest_output
         { wo
         }
         { readonly dup length wo
           binary_tokens not { ( ) ws } if
           readproc ws wx
         }
        ifelse
      }
     ifelse
       }
       { wo        % PostScript procedure
       }
      ifelse
    } bind def

% Construct the inversion of the system name table.
   /SystemNames where
    { pop /snit 256 dict def
      0 1 255
       { dup SystemNames exch get
         dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
       }
      for
    }
    { /snit 1 dict def
    }
   ifelse

% Write an object, using binary tokens if requested and possible.
   /woa        % write in ascii
    { psfile exch write==only
    } bind def

            % Lookup table for ASCII output.

   /intbytes    % int nbytes -> byte*
    { { dup 255 and exch -8 bitshift } repeat pop
    } bind def
   /wotta 10 dict dup begin
      { /booleantype /integertype /nulltype }
      { { ( ) ws woa } def }
     forall
        % Iterate over arrays so we can print operators.
     /arraytype
      { dup xcheck {(}) ({)} {(]) ([)} ifelse ws exch dup wol exch ws wop
      } bind def
     /dicttype
      { ( ) ws wd } def
     /nametype
      { dup xcheck { ( ) ws } if woa
      } bind def
        % Map back operators to their names,
        % so we can write procedures.
     /operatortype
      { wtstring cvs cvn cvx wo
      } bind def
        % Convert reals to integers if possible.
     /realtype
      { dup cvi 1 index eq { cvi wo } { ( ) ws woa } ifelse
      } bind def
        % == truncates strings longer than 200 characters!
     /stringtype
      { (\() ws dup
     { dup dup 32 lt exch 127 ge or
        { (\\) ws dup -6 bitshift 48 add w1
          dup -3 bitshift 7 and 48 add w1
          7 and 48 add
        }
        { dup dup -2 and 40 eq exch 92 eq or {(\\) ws} if
        }
       ifelse w1
     }
    forall
    (\)) ws wop
      } bind def
     /packedarraytype
      { ([) ws dup { wo } forall
    encodingnames 1 index known
        % This is an encoding, but not one of the standard ones.
        % Use the built-in encoding only if it is available.
     { encodingnames exch get wo
       ({findencoding}stopped{pop) ws
       (}{counttomark 1 add 1 roll cleartomark}ifelse)
     }
     { pop ()
     }
    ifelse
    (/packedarray where{pop counttomark packedarray exch pop}{]readonly}ifelse) ws
    wl
      }
     def
   end def

            % Lookup table for binary output.

   /wottb 8 dict dup begin
   wotta currentdict copy pop
     /integertype
      { dup dup 127 le exch -128 ge and
         { 136 wb 255 and wb }
     { dup dup 32767 le exch -32768 ge and
        { 134 wb 2 intbytes wb wb }
        { 132 wb 4 intbytes wb wb wb wb }
       ifelse
     }
    ifelse
      } bind def
     /nametype
      { dup snit exch known
         { dup xcheck { 146 } { 145 } ifelse wb
       snit exch get wb
     }
     { wotta /nametype get exec
     }
    ifelse
      } bind def
     /stringtype
      { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
    ws wop
      } bind def
   end def

   /wop        % Write object protection
     { wcheck not { /readonly cvx wo } if
     } bind def
   /wo        % Write an object.
     { dup type binary_tokens { wottb } { wotta } ifelse
       exch get exec
     } bind def
   /wol        % Write a list of objects.
     { { wo } forall
     } bind def

% Write a hex string for Subrs or CharStrings.
   /wx        % string ->
    { binary_CharStrings
       { ws
       }
       { % Some systems choke on very long lines, so
     % we break up the hexstring into chunks of 50 characters.
      { dup length 25 le {exit} if
        dup 0 25 getinterval psfile exch writehexstring (\n) ws
        dup length 25 sub 25 exch getinterval
      } loop
     psfile exch writehexstring
       } ifelse
    } bind def

% ------ CharString encryption utilities ------ %

/enc_dict 20 dict def
1 dict begin
/bind { } def        % make sure we can print out the procedures
enc_dict begin

(type1enc.ps) run
enc_dict /.type1decrypt undef        % we don't need this

end end

enc_dict { 1 index where { pop pop pop } { def } ifelse } forall

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

% Define the dictionary of actions for special entries in the dictionaries.
% We lump the font and the Private dictionary together, because
% the set of keys doesn't overlap.
[/CharStrings /Encoding /FID /FontInfo /Metrics /Private /Subrs]
dup length dict begin
 { null cvx def } forall
currentdict end /specialkeys exch def

% Define the procedures for the Private dictionary.
% These must be defined without `bind',
% for the sake of the DISKFONTS feature.
4 dict begin
 /-! {string currentfile exch readhexstring pop} def
 /-| {string currentfile exch readstring pop} def
 /|- {readonly def} def
 /| {readonly put} def
currentdict end /encrypted_procs exch def
4 dict begin
 /-! {string currentfile exch readhexstring pop
   4330 exch dup .type1encrypt exch pop} def
 /-| {string currentfile exch readstring pop
   4330 exch dup .type1encrypt exch pop} def
 /|- {readonly def} def
 /| {readonly put} def
currentdict end /unencrypted_procs exch def

% Construct an inverse dictionary of encodings.
4 dict begin
 StandardEncoding /StandardEncoding def
 ISOLatin1Encoding /ISOLatin1Encoding def
 SymbolEncoding /SymbolEncoding def
 DingbatsEncoding /DingbatsEncoding def
currentdict end /encodingnames exch def

% Invert the standard encodings.
.knownEncodings length 256 mul dict begin
  0 .knownEncodings
   {  { currentdict 1 index known { pop } { 1 index def } ifelse
    1 add
      }
     forall
   }
  forall pop
currentdict end /inverseencodings exch def

/writefont        % <psfile> writefont - (writes the current font)
 { /psfile exch def
   /Font currentfont def
   /readproc binary_CharStrings { (-| ) } { (-! ) } ifelse def
   /privateprocs
     encrypt_CharStrings binary_tokens not and
      { encrypted_procs } { unencrypted_procs } ifelse
     def
   /changelenIV use_lenIV 0 lt
    { 0 }
    { use_lenIV Font /Private get /lenIV .knownget not { 4 } if sub }
   ifelse def
   (%!FontType1-1.0: ) ws currentfont /FontName get wt (000.000) wl
   (systemdict begin) wl

% Turn on binary tokens if relevant.
   binary_tokens { (currentobjectformat 1 setobjectformat) wl } if

% If the file has a UniqueID, write out a check against loading it twice.
   Font /UniqueID known
    { smallest_output
       { Font /FontName get wo
     Font /UniqueID get wo
     ( .check_existing_font) wl
       }
       { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
     ( {) ws wo ( findfont dup /UniqueID known) wl
     (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
     (    { pop false } ifelse) wl
     (    { pop save /restore load } if) wl
     ( } if) wl
       }
      ifelse
    }
   if

% If we are writing unencrypted CharStrings for a standard environment,
% write out the encryption procedures.
   privateprocs unencrypted_procs eq standard_only and
    { (systemdict /.type1encrypt known) wl
      ( { save /restore load } { { } } ifelse) wl
      (userdict begin) wl
      enc_dict { we } forall
      (end exec) wl
    }
   if

% Write out the creation of the font dictionary and FontInfo.
   Font length 1 add wt (dict begin) wl        % +1 for FontFile
   Font begin
   (/FontInfo ) ws FontInfo wd ( readonly def) wl

% Write out the other fixed entries in the font dictionary.
   Font
    { 1 index specialkeys exch known
       { pop pop } { we } ifelse
    } forall
   /Encoding
   encodingnames Encoding known
   Encoding StandardEncoding eq
   Encoding ISOLatin1Encoding eq or and
    { encodingnames Encoding get cvx }
    { Encoding }
   ifelse we

% Write out the Metrics, if any.
   Font /Metrics known
    { (/Metrics ) ws Metrics wld ( readonly def) wl
    }
   if

% Close the font dictionary.
   (currentdict end) wl

% The rest of the file could be in eexec form, but we don't see any point
% in doing this, because we aren't attempting to conceal it from anyone.

% Create and initialize the Private dictionary.
   Private
   smallest_output
    { begin
    }
    {  dup length privateprocs length add dict copy begin
       privateprocs { readonly def } forall
    }
   ifelse
   {dup /Private} wol currentdict length 1 add wo {dict dup begin} wol () wl
   currentdict
    { 1 index specialkeys exch known
       { pop pop }
       { 1 index /lenIV eq use_lenIV 0 ge and { pop use_lenIV } if we }
      ifelse
    } forall

% Write the Subrs entries, if any.
   currentdict /Subrs known
    { (/Subrs[) wl
      Subrs
       { dup null ne
      { wcs }
      { pop /null cvx wo }
     ifelse
       } forall
      {] dup {readonly pop} forall readonly def} wol () wl
    }
   if

% Write the CharStrings entries.
% Detect identical (eq) entries, which bdftops produces.
   {2 index /CharStrings} wol
   CharStrings length wo
   smallest_output
    { encrypt_CharStrings not wo ( .read_CharStrings) wl
      CharStrings length dict
      CharStrings
       { exch inverseencodings 1 index .knownget not { dup } if wo
        % Stack: vdict value key
     3 copy pop .knownget { wo pop pop } { 3 copy put pop wcs } ifelse
       } forall
    }
    { {dict dup begin} wol () wl
      CharStrings length dict
      CharStrings
       { 2 index 1 index known
      { exch wo 1 index exch get wo ( load def) wl
      }
      { 2 index 1 index 3 index put
        exch wo wcs ( |-) wl
      }
     ifelse
       } forall
      {end} wol
    }
   ifelse
   pop

% Wrap up the private part of the font.
   end            % Private
   end            % Font
    { end        % Private
      readonly put    % CharStrings in font
      readonly put    % Private in font

% Terminate the output.
      dup /FontName get exch definefont pop
    }
   wol
   Font /UniqueID known { /exec cvx wo } if
   binary_tokens { /setobjectformat cvx wo } if
   /end cvx wo        % systemdict
   () wl

 } bind def

% ------ Other utilities ------ %

% Prune garbage characters and OtherSubrs out of the current font,
% if the relevant dictionaries are writable.
/prunefont
 { currentfont /CharStrings get wcheck
    { currentfont /CharStrings get dup [ exch
       { pop dup (S????00?) .stringmatch not { pop } if
       } forall
      ] { 2 copy undef pop } forall pop
    }
   if
 } bind def

end            % wrfont_dict

/writefont { wrfont_dict begin writefont end } def