🚀 go-pugleaf

Composite Characters in PostScript
(C) Copyright Dipl.-Ing. Wilfried Soeker
    All Rights reserved

Extending the internal characterset with characters composed of standard
characters and/or any graphic seems to be difficult, especially if you
want to make use of the internal fonts.  The solution of this problem is
easy: use userfonts.

The basic idea behind the programs supplied with this text is the fact,
that there are not many things you can't do inside the "BuildChar"-
procedure of the userfonts, e.g.  it is possible to print characters
in another font!

What we want "BuildChar" to do is the following:
    1) select the basic font for the composite character
    2) print the basic character
    3) move the current point to whereever you want
    4) print a second character

With this program you can construct your own composite font with internal
fonts (and their quality!!) and use them with the standard encoding scheme.

Program 1 does the composition and reencoding. An example for the usage is
          included.

Program 2 is a program to help justifing the character positions. It prints
          the characters in 500 pt with a coordinate system in the background.
		  Note that the data used here is exact the same needed for program 1.

Some of the older PostScript versions may have problems with the "stringwidth"
operator. The effect is that the "show"s in BuildChar are not suppressed and
so they are printed.  There are several ways to solve this problem:

/stringwidth {gsave nulldevice stringwidth grestore} bind def
   or
/stringwidth {
    currentpoint 1e10 dup moveto stringwidth 4 2 roll moveto} bind def

The second solution is a bit "quick and dirty", but I think, it will be faster
than the first one. Both of them will work.

The processing speed is a bit slower than the original fonts, but the fact,
that the used basic and accent characters are cached, will give you acceptable
results. 

This article shows you just the tip of the iceberg. There are so many things
you can do with userfonts.

Some knowledge about programming in PostScript is necessary to understand the
following programs. I published a similar article in the german journal "PAGE",
issue 1/89.

If you have problems with the programs or have any suggestions please do not
hesitate to contact me.

                W. Soeker

Note:
    I am working as a consultant for the Linotype PostScript Support Group
    in Eschborn, West-Germany, but no part of this articles represents the
    opinion of Linotype.

PS: PostScript is a registered trademark of Adobe Systems Incorporated.

###########################################################################
#            Program 1                                                    #
###########################################################################

% Program for installation of fonts with userdefined accents.
% (C) Dipl.-Ing. Wilfried Soeker, February 1989
% Alpenroder Str. 14, D-6230 Frankfurt 80, West-Germany
% This program may be used or copied for non-commercial use
% only if this header with the copyright note is included.
% Commercial use of this program without written permission is prohibited!
%
/Neue-Akzente {         % Arguments: Basisfont New-Fontname Accenttable.
   10 dict dup begin               % This Dictionary is the new Font.
   /FontType 3 def                      % 3 = Userfont.
   /FontMatrix [0.01 0 0 0.01 0 0] def  % For internal use.
   /FontBBox [0 0 100 100] def          % Working area.
   /Basis_Font 5 -1 roll findfont def   % Store original font.
   /Encoding 256 array def         % Mark special character positions.
   0 1 255 {                       % All Positions 
      Encoding exch false put      % are initialised with "false".
      } for 

   exch aload length 2 idiv        % Get the amount of chars.
      { Encoding 3 1 roll put      % 
      } repeat                     %

   /BuildChar {                    % 
      exch begin                   % Open Font.
      Basis_Font 100 scalefont setfont % Aktivate basicfont.
      dup Encoding exch get          % Look into the table.
      dup false eq                 % Is this a special character?
         {   pop                   % NO!! It's a 'normal' one.
           ( ) dup 0 4 -1 roll put % Put chat in a string.
           dup stringwidth         % Get charwidth
           setcharwidth            % and use it.
           0 0 moveto              % 
           show                    % Print out this char!
           }
         {                          % Yes, this was a special char!
            exch pop aload pop      % Get the special char description.
            3 -1 roll               % Get the basic-char
            ( ) dup 0 4 -1 roll put  % and put it in a string.
            dup stringwidth         % Get the charwidth of the basic char
            setcharwidth            % and use it for the composite char.
            0 0 moveto              % Set the position
            show                    % and print it.
            0 0 moveto              % Set the position for the accent.
            exch                    % Get the accent procedure
            exec                    % and execute it.
            ( ) dup 0 4 -1 roll put   % Get the accent char 
            show                    % and print it.
            }
         ifelse
      end                           % That's all.
      } bind def
   end

   definefont pop                   % Registation of the new font.
   } def                            % End of "Neue-Akzente"

% Let's try a Czech font
% 
/Times-Roman                        % Name of the basicfont.
/Times-Tschech                      % Name of the new font.
[                                   % The description the special chars.
8#321                               % First the position in the encoding.
[                                   % The Array with the description of
                                    % a single composite char.
   8#143                            % Basicchar (c).
 {                                  % Procedure for position correction.
  6                                 % Correction in X-direction.
  0                                 %     "         Y-   "    .
   rmoveto                          % Move to this position.
   }                                % End of correction.
  8#317                             % Accent-Character.
                                    % (see PostScript referece manual p.254)
  ]                                 % End of this composite char.
% 
8#322 [ 8#156 {7 0 rmoveto } 8#317 ]             % n with \317
8#323 [ 8#172 {0 -2 rmoveto } 8#302 ]            % y with \302
8#324 [ 8#165 {6 0 rmoveto } 8#312 ]             % u with \312
8#325 [ 8#162 {0 0 rmoveto } 8#317 ]             % r with \317
8#326 [ 8#122 {10 32 rmoveto 1 0.5 scale } 8#317 ] % R with \317
8#327 [ 8#105 {13 18 rmoveto } 8#317 ]           % E with \317
8#330 [ 8#145 {6 -3 rmoveto } 8#302 ]            % e with \302
8#331 [ 8#105 {20 18 rmoveto } 8#302 ]           % E with \302
8#332 [ 8#144 {35 5 rmoveto } 8#047 ]            % d with \047
8#333 [ 8#164 { 6 5 rmoveto } 8#047 ]            % t with \047
] Neue-Akzente                      % Build a new font with composite chars.


/Times-Tschech findfont             % Find the new font
       12 scalefont setfont         % and activate it .
100 250 moveto
(The following characters are composed) show
100 200 moveto
(\322\323\324\325\326\327\330\331\332\332) show

showpage


###########################################################################
#            Program 2                                                    #
###########################################################################



% (c) Dipl.-Ing. Wilfried Soeker, February 1989
%
/xl 50 def   /yu 100 def            % lower left corner
/delta 5 def
/size 500 def
/showpair {                         % Arguments: Basicchar, procedur and Accent
                                    % (the same as needed by Neue-Akzente)
% Print the background first
     /Helvetica findfont 8 scalefont setfont
% The vertical lines
     xl yu moveto
     0 1 size delta idiv
          { dup 5 mod 0 eq
               { 0.7 setlinewidth currentpoint
                 3 -1 roll (   ) cvs dup
                 stringwidth pop 2 div neg -10 rmoveto show moveto
                 }
               { pop 0.1 setlinewidth }
               ifelse
            currentpoint 2 copy
            transform round exch round exch itransform moveto
            0 size rlineto stroke   
            moveto                 
            delta 0 rmoveto       
            } for

% The horizontal lines
     xl yu moveto
     0 1 size delta idiv
          { dup 5 mod 0 eq
               { 0.7 setlinewidth currentpoint
                 3 -1 roll (   ) cvs dup
                 stringwidth pop 3 add neg -3 rmoveto show
                 moveto
                 }
               { pop 0.1 setlinewidth }
               ifelse
            currentpoint 2 copy
            transform round exch round exch itransform moveto
            size 0 rlineto stroke   
            moveto                  
            0 delta rmoveto
            } for

% The composite character
     xl yu moveto
     /Times-Roman                            % Basic font
     findfont size scalefont setfont
     xl yu moveto
     3 -1 roll ( ) dup 0 4 -1 roll put show  % print the basic char.
     xl yu moveto
     delta dup scale                         % scaling inside the procedure
     currentpoint translate                  % for absolute positioning.
     exch exec                               % execute the procedure.
     1 delta div dup scale                   % reset the scaling.
     ( ) dup 0 4 -1 roll put show            % print accent char.
     showpage
     } def                                   % end of "showpair".



% now some example for the use of showpair
% 
% First a R with \317 and no correction.
(R) 0 get { } 8#317 showpair
% 
% The same with corrected position.
(R) 0 get { 10 15 rmoveto } 8#317 showpair
% 
% And the same pair again, but the \317 scaled down to half height.
(R) 0 get { 10 40 rmoveto 1 0.5 scale } 8#317 showpair
% 
% Now something special: an icelandic D with a horizontal line.
(D) 0 get { 2 34 moveto 30 0 rlineto 3.5 setlinewidth stroke
            0 0 moveto} ( ) 0 get showpair
###########################
#        End of Text      #
###########################