% ==> <PDriver$Dir>.<PDriver$PSprologue2>
#1%% Main prologue (Level 1) for the PostScript printer driver module.
#2%% Main prologue (Level 2) for the PostScript printer driver module.
%% Version 4.02 first used with version 4.36 of the module
% * Level 2 stuff (sprites,JPEGs)
% * Support for JPEGs - /S8
% * Support for Medusa TrueColour sprites - /S32
% * Bugfix to PAR to make flipped source-clipped sprites work.  SAHunt 12-Sep-93
% Version 2.24 first used with version 3.33 of the module
% * Much better version of PAR.  SAHunt 23-Oct-92
% Version 2.23 first used with version 3.33 of the module
% * re-instated IT command.  SAHunt 21-Sep-92
% Version 2.22 first used with version 3.31 of the module
% * Fixed incorrect scale of parameters to PAR.  SAHunt 17-Aug-92
% Version 2.21 first used with version 3.30 of the module
% Version 2.20 first used with version 3.28 of the module
% * Support for runtime creation of accented characters
% Version 2.19 first used with version 3.25 of the module
% * Support for fonts with no y kern offsets.
% Version 2.18 first used with version 3.25 of the module
% * Support for transformed sprites added.  SHunt 11-Nov-91
% Version 2.17 first used with version 3.24 of the module
% * Support for kerning added.  SHunt 30-Oct-91
% Version 2.16 first used with version 3.16 of the module
% * Fonts no longer held in a special directory, normal fonts
%  are now got using the findfont operator, and the ArcFont is
%  explicitly held in PDict.  BCockburn 12-Aug-91.
% Version 2.15, first used with version 3.15 of the module.
% * /CJ changed to only set the mitre limit if the join style is
%   mitred. BCockburn.
% * New procedure /BD reduces size of prologue. BCockburn.
% * New procedure /SDM added to take a Draw style matrix from
%  a sprite plot call, this seems to be different to the /DM
%  procedure used elsewhere, the latter has the shape arguments
%  divided by 256.  BCockburn.
% * Justified text printing changed to cope with the new interface
%  at the device dependent / device independent level.  BCockburn.
% Version 2.10, first used with version 3.13 of the module.

/PDdict 200 dict def                            % the dictionary to contain these
                                                % definitions.
PDdict begin
  /BD { bind def } bind def                     % makes the output shorter
  /LD { load def } BD                           % makes the output shorter

  /LW /setlinewidth LD                          % some useful abbreviations
  /St /stroke LD
  /T /translate LD
  /S /save LD
  /R /restore LD
  /GS /gsave LD
  /GR /grestore LD
  /CP /clippath LD
  /Cl /closepath LD
  /M /moveto LD
  /RM /rmoveto LD
  /L /lineto LD
  /B /curveto LD                                % B for Bezier...
  /I /index LD

  /SW /stringwidth LD
  /GCF /currentfont LD
  /GCM /currentmatrix LD
  /SCM /setmatrix LD
  /CCM /concatmatrix LD

  /ED {exch def} BD
 
  /Copies {/#copies ED showpage} BD
                                                % sets up number of copies.

  /MP {400. div} BD                             % converts millipoints to OS units.

  /Fb {65536. div} BD                           % converts 16-place fixed binary
                                                %  numbers to real numbers.

  /WM1 matrix def
  /WM2 matrix def
  /IM1 matrix def                               % invert matrix for transformed justified text

  /UM {                                         % converts a matrix as given to
    Fb 4 1 roll                                 %  PDriver_DrawPage to proper
    Fb 4 1 roll                                 %  PostScript form and concatenates
    Fb 4 1 roll                                 %  it with the current matrix.
    Fb 4 1 roll
    0. 0. WM1 astore concat
  } BD

  /Bx {                                         % takes x1,y1,x2,y2 on the stack and
    4 copy                                      %  makes a path which is the axis-
    5 1 roll                                    %  aligned box with opposite corners
    4 2 roll                                    %  (x1,y1) and (x2,y2)
    5 -1 roll
    M L L L Cl
  } BD

  /Cp {Bx clip newpath} BD                      % converts a clipping box into a
                                                %  clipping path and intersects it
                                                %  into the current clipping path

  /PS {                                         % start of page routine.
                                                % expect paper limits on stack in
                                                % OS Units (left bottom right top)
    72. 180. div dup scale                      % - sets OS unit co-ordinates
    newpath                                     % - ensures no current path
    Cp                                          % set graphics margins
    [] 0. setdash                               % - ensures no dash pattern
  } BD

  /MC {0. 0. Cp} BD                             % converts a clipping box into a
                                                %  clipping path and makes it the
                                                %  current clipping path.

  /G {255. div setgray} BD                      % set a grey based on a number in
                                                % the range 0-255 on the stack.

  /C {                                          % set a colour based on numbers in
    255. div 3 1 roll                           % the range 0-255 on the stack.
    255. div 3 1 roll                           % - expects red, green, blue on the
    255. div 3 1 roll                           %  stack.
    setrgbcolor
  } BD

  /Eps 0.1 MP def                               % a very small amount that is used to
                                                % avoid various problems to do with
                                                % zero length lines vanishing.

  /VSt {                                        % do a stroke with the standard
    2 setlinecap                                % options for VDU calls.
    0 setlinejoin                               % - this includes adding a very short
    2.000001 setmiterlimit                      %  line segment to the end to make
    2. LW                                       %  zero length paths produce a small
    0. Eps rlineto                              %  axis-aligned square.
    St
  } BD

  /VFl {Cl GS fill GR VSt} BD                   % do a fill with the standard options
                                                % for VDU calls.
                                                % - this includes a 'VSt' to get
                                                %  correct boundary conditions.

  /Li {M L VSt} BD                              % handles the VDU solid line calls.
                                                % - expects newX, newY, oldX, oldY
                                                %  on the stack.

  /Pt {M VSt} BD                                % handles the VDU point plot call.
                                                % - expects newX, newY on the stack.

  /Tr {M L L VFl} BD                            % handles the VDU triangle plot call.
                                                % - expects newX, newY, oldX, oldY,
                                                %  olderX, olderY on the stack.

  /Rc {Bx VFl} BD                               % handles the VDU axis-aligned
                                                % rectangle call
                                                % - expects newX, newY, oldX, oldY
                                                %  on the stack.

  /Pr {                                         % handles the VDU parallelogram call.
    6 copy                                      % - expects newX, newY, oldX, oldY,
    M L L                                       %  olderX, olderY on the stack.
    5 -1 roll                                   % - calculates the fourth point.
    4 -1 roll
    sub add
    4 1 roll
    exch sub add
    exch L
    VFl
  } BD

  /Ln {                                         % determines the length of the vector
    dup mul exch dup mul add sqrt               % on the stack.
  } BD

  /Cir {0. 360. arc} BD                         % makes the current path a circle of
                                                % radius r, centre (x,y).
                                                % - expects x, y, r on the stack.

  /VC {Ln Cir} BD                               % makes the current path a VDU
                                                % circle.
                                                % - expects oldX, oldY, newX-oldX,
                                                %  newY-oldY on the stack.

  /CS {VC VSt} BD                               % handles the VDU circle stroke call.
                                                % - expects oldX, oldY, newX-oldX,
                                                %  newY-oldY on the stack.

  /CF {VC VFl} BD                               % handles the VDU circle fill call.
                                                % - expects oldX, oldY, newX-oldX,
                                                %  newY-oldY on the stack.

  /VA {                                         % adds a VDU circular arc to the
    2 copy Ln                                   % current path.
    5 1 roll                                    % - expects olderX, olderY,
    exch atan                                   %  newX-olderX, newY-olderY,
    3 1 roll                                    %  oldX-olderX, oldY-olderY on
    exch atan                                   %  the stack.
    arc
  } BD

  /Ac {VA VSt} BD                               % handles the VDU circular arc call.
                                                % - expects olderX, olderY,
                                                %  newX-olderX, newY-olderY,
                                                %  oldX-olderX, oldY-olderY on
                                                %  the stack.

  /Cd {VA VFl} BD                               % handles the VDU chord segment fill.
                                                % - expects olderX, olderY,
                                                %  newX-olderX, newY-olderY,
                                                %  oldX-olderX, oldY-olderY on
                                                %  the stack.

  /Sc {                                         % handles the VDU pie sector fill.
    5 I 5 I M VA VFl                            % - expects olderX, olderY,
  } BD                                          %  newX-olderX, newY-olderY,
                                                %  oldX-olderX, oldY-olderY on
                                                %  the stack.

  /VE {                                         % makes the current path a VDU
    0. 5 1 roll                                 % ellipse.
    WM1 astore                                  % - expects xwidth, xtop, ytop,
    WM2 GCM exch                                %  xcentre, ycentre on the stack
    concat                                      % Stack changes: xw xt yt xc yc
    0. 0. 1. Cir                                %  -> xw 0 xt yt xc yc
    SCM                                         %  -> [ xw 0 xt yt xc yc ]
  } BD

  /ES {VE VSt} BD                               % handles the VDU ellipse stroke
                                                % call.
                                                % - expects xwidth, xtop, ytop,
                                                %  xcentre, ycentre on the stack

  /EF {VE VFl} BD                               % handles the VDU ellipse fill call.
                                                % - expects xwidth, xtop, ytop,
                                                %  xcentre, ycentre on the stack


  /Max {2 copy lt {exch} if pop}                % find the maximum of two numbers
    BD


  /DM {                                         % sets up a Draw-style matrix
    256. div 6 1 roll                           % - expects the Draw matrix (in the
    256. div 6 1 roll                           %  standard order) on the stack
    Fb 256. div 6 1 roll
    Fb 256. div 6 1 roll
    Fb 256. div 6 1 roll
    Fb 256. div 6 1 roll
    WM1 astore concat
  } BD

% This version of SDM makes an itransform matrix in IM1 for the
% use of the justification routines, which need to make the spaceadd(x,y)
% offsets in the original coordinate system.

  /SDM {                                        % sets up a Draw-style matrix
    256. div 6 1 roll                           % - expects the Draw matrix (in the
    256. div 6 1 roll                           %  standard order) on the stack
    Fb 6 1 roll                                 % as used by the sprite plotter
    Fb 6 1 roll
    Fb 6 1 roll
    Fb 6 1 roll
    6 copy
    WM1 astore concat
    pop pop 0 0 IM1 astore pop
  } BD

% For transformed justified text, transform x1 y1 via the inverse of IM1

/IT {
  IM1 itransform
} BD


  /CJ {                                         % sets line caps and joins.
                                                % - expects join style, cap style,
                                                %  2^16 * mitre limit on the stack
    2 I 0 eq {                                  % get the join style, is it miter'd?
    Fb setmiterlimit                            % adjust units and do it
    }{ pop } ifelse                             % only set miter limit if join is miter'd
    setlinecap                                  % units are OK
    setlinejoin                                 % units are OK
  } BD

  /WS 4096 string def                           % a pre-allocated string to hold 64
                                                % rows of up to 64 bytes of sprite
                                                % data. Also used in text printing.
                                                % Pre-allocated to avoid VM wastage.


  /SMat matrix def                              % a pre-allocated matrix for use with
                                                % the 'imagemask' operator in 'S1' or
                                                % the 'image' operator in 'SN'.

  /SS {                                         % Do scaling for a sprite.
    div 3 1 roll div exch scale                 % - expects X multiplier, X divisor,
  } BD                                          %  Y multiplier, Y divisor on stack.

  /SM {                                         % set up matrix from sprite user
    1. exch div 0. 0. 1. 0. 0.                  % space (which will have been set up
    SMat astore pop                             % to bits by lines) to sprite space
  } BD                                          % (pixels by lines).
                                                % - expects bits/pixel on the stack.


  /RC {
    WS 0 3 I put dup 1 gt {
      WS 1 3 I put dup 2 gt {
        WS 2 3 I put WS 3 3 I put dup 4 gt {
          WS 4 WS 0 4 getinterval putinterval dup 8 gt {
            WS 8 WS 0 8 getinterval putinterval dup 16 gt {
              WS 16 WS 0 16 getinterval putinterval dup 32 gt {
                WS 32 WS 0 32 getinterval putinterval dup 64 gt {
                  WS 64 WS 0 64 getinterval putinterval dup 128 gt {
                    WS 128 WS 0 128 getinterval putinterval dup 256 gt {
                      WS 256 WS 0 256 getinterval putinterval dup 512 gt {
                        WS 512 WS 0 512 getinterval putinterval dup 1024 gt {
                          WS 1024 WS 0 1024 getinterval putinterval dup 2048 gt {
                            WS 2048 WS 0 2048 getinterval putinterval
                          } if
                        } if
                      } if
                    } if
                  } if
                } if
              } if
            } if
          } if
        } if
      } if
    } if pop pop
  } BD 

% handle RLE,hex coded image data (Level 1)
#1  /SR { currentfile
#1    token pop dup 0 gt {
#1      WS 0 3 -1 roll getinterval currentfile exch readhexstring pop
#1    } {
#1      neg currentfile token pop 1 I RC WS 0 3 -1 roll getinterval
#1    } ifelse
#1  } BD

% handle RLE,ASCII85 coded image data (Level 2)
#2  /RLEFilt {
#2    currentfile /ASCII85Decode filter /RunLengthDecode filter
#2  } BD

% S1 is operator for 1 bit image data (sprites)
%
#1  /S1 { true SMat /SR load
#1    imagemask
#1  } BD
%
#2  /S1 { true SMat RLEFilt
#2    imagemask
#2  } BD


  255 2048 RC                                   % set up the string FFs to be 2048
  /FFs WS 0 2048                                % characters of &FF
  getinterval 2048 string
  copy def


  /SF {
    /WS2 FFs 0 4 I
    7 add 8 idiv 4 I mul
    getinterval def
    true SMat { WS2 }
    imagemask
  } BD


% S8 is operator for 8 bit image data (sprites)
%
#1  /SN {
#1    8 SMat /SR load image
#1  } BD
%
#2  /SN {
#2    8 SMat RLEFilt image
#2  } BD


% operators for 16/32 bpp colour sprites (no RLE coding)
%
#1  /Rem 0 def
#1  /D32 {
#1    currentfile
#1    Rem WS length lt { WS 0 Rem getinterval } { WS } ifelse readhexstring pop
#1    /Rem Rem WS length sub def
#1  } BD
#1  /S32 {
#1    2 copy  mul 3 mul /Rem exch def
#1    8 SMat /D32 load false 3 colorimage
#1  } BD
%
#2  /D32 { 
#2    currentfile /ASCII85Decode filter
#2  } BD
#2  /S32 {
#2    2 copy  mul 3 mul/Rem exch def
#2    8 SMat D32 false 3 colorimage
#2  } BD


% operators for JPEGs (JM for matrix, J32 for colour, J8 for grey)
% JM takes <image height> on stack, needed for Level 2 only
%
#1  /JM { pop 1 SM } BD
#1  /J8 {
#1    2 copy mul /Rem exch def
#1    8 SMat /D32 load image 
#1  } BD
#1  /J32 { S32 } BD
%
% Level 2 JM is required to invert y (RISC OS stuff bottom-up, DCTDecode top-down)
#2  /JM {
#2    1. 0. 0. -1. 0. 6 -1 roll cvr SMat astore pop
#2  } BD
#2  /JPFilt {
#2    currentfile /ASCII85Decode filter 1 dict /DCTDecode filter
#2  } BD
#2  /J8 {
#2    8 SMat JPFilt image
#2  } BD
#2  /J32 {
#2    8 SMat JPFilt false 3 colorimage
#2  } BD


  /TS {                                         % rescale to text co-ordinate system
    1. exch div exch 1. exch div exch           % - expects X scale factor, Y scale
    scale                                       %  on the stack.
  } BD

  /Fn {                                         % set a font for a text string.
    0.016 div exch                              % - expects font name, 16 * X font
    0.016 div exch                              %  size, 16 * Y font size on the
    dup /fheight ED                             %  stack. Font size in millipoints
    0. 0. 3 -1 roll 0. 0. WM1 astore            % Stack ==> /Name [shape]
%  fonts 3 -1 roll get
    exch findfont
    exch makefont setfont                       % scale it and make it current
  } BD

  /Ul {                                         % do underlining for a text string.
    GS                                          % - expects X movement, Y movement
      2 copy Ln                                 %  on the stack.
      ulpos ulthick 2. div sub                  % - expects 'ulpos' to hold the
      256. div fheight mul                      %  underline position in 256ths of
      exch div dup                              %  the font height.
      2 I neg mul exch                          % - expects 'ulthick' to hold the
      3 I mul RM                                %  underline thickness in 256ths of
      2 copy rlineto                            %  the font height.
      ulthick 256. div fheight mul LW           % - expects 'fheight' to hold the
      0 setlinecap St                           %  font height in millipoints.
    GR
  } BD

  /AC {                                         % calculate the amount by which to
    3 -1 roll exch                              % adjust character widths to allow
    sub 3 I length div 4 1 roll                 % for the difference between the font
    sub 1 I length div 3 1 roll                 % manager metrics and the PostScript
  } BD                                          % metrics.
                                                % - expects string, font manager X
                                                %  size, font manager Y size,
                                                %  PostScript X size, PostScript Y
                                                %  size on the stack.
                                                % - leaves X adjustment, Y
                                                %  adjustment, string on the stack.

  /Tx {                                         % print a non-justified text string.
    M                                           % - expects the correct colour and
    2 I SW                                      %  font to be set up already.
    AC                                          % - expects string, X movement, Y
    ashow                                       %  movement, X position, Y position
  } BD                                          %  on the stack.

  /JTx {                                        % Print a justified text string.
                                                % Expects; string, SpaceAddX,
                                                % SpaceAddY, "32", CharAddX, CharAddY,
                                                % BBoxX, BBoxY, StartX, StartY
    M 7 I dup 4 1 roll
    SW AC pop                                   % - expects string, X movement, Y
    exch 4 -1 roll add                          % sum the ax components
    3 1 roll add                                % sum the ay components
    6 -1 roll awidthshow
  } BD


  /UTx {                                        % print an underlined non-justified
    /ulthick ED                                 % text string.
    /ulpos ED                                   % - expects the correct colour and
    M                                           %  font to be set up already.
    Ul                                          % - expects string, X movement, Y
    2 I SW                                      %  movement, X position, Y position,
    AC                                          %  underline position, underline
    ashow                                       %  thickness on the stack.
  } BD

  /UJTx {                                       % Print an underlined and justified
                                                % text string.
                                                % Expects; string, SpaceAddX,
                                                % SpaceAddY, "32", CharAddX, CharAddY,
                                                % BBoxX, BBoxY, WidthX, WidthY,
                                                % underline position, underline thickness,
                                                % StartX, StartY
    M
    /ulthick ED /ulpos ED
    Ul pop pop

%   GS                                          % Preserve position, line width and cap
%     dup 256. div fheight mul LW             % set thickness of underline
%                                               % from value in 256ths of font height
%     2. div sub 256. div fheight mul         % position is in 256ths of font height
%     3 1 roll 2 copy Ln div dup
%     2 I neg mul exch 
%     3 I mul RM rlineto
%     0 setlinecap St
%   GR

    7 I dup 4 1 roll
    SW AC pop                                   % - expects string, X movement, Y
    exch 4 -1 roll add                          % sum the ax components
    3 1 roll add                                % sum the ay components
    6 -1 roll awidthshow
  } BD


%-----------------------------------
% The following routines add kerning.

% Load kern data onto the stack, taking account of the possibility that
% the y data is missing (KernData holds integers instead of arrays).
% Converts an integer n into n 0, or an array [ x y ] into x y

  /kload {                                      % n -- n 0   OR  [x y] -- x y
    { ceiling } stopped
      { aload pop }
      { 0 } ifelse
  } BD

% kproc gets called with the matrix as of the time kshow was called.

  /kproc {                                      % ax ay dict bool c1 c2
    5 I 5 I RM                                  % ax ay dict bool c1 c2
    2 I
      { exch 256 mul  add                       % ax ay dict bool id
        2 I exch                                % ax ay dict bool dict id
        2 copy known
          {WM2 SCM  get kload RM  WM1 SCM}
          {pop pop}
        ifelse
      }
      { pop pop }
    ifelse                                      % ax ay dict bool (readu for next call)
  } BD

% Kerned text string. Parameters:
% str - the string
% xw, yw: the width to fit it in
% xp, yp: the position to start at

  /KTx {                                        % str xw yw xp yp
    WM1 GCM                                     % str xw yw xp yp curmat
    GCF /FontMatrix get                         % str xw yw xp yp curmat fontmat
    exch WM2 CCM pop                            % str xw yw xp yp 
    M                                           % str xw yw
    2 I SW AC                                 % ax ay str
    GCF /KernData known
      {GCF /KernData get true}
      {null false}
    ifelse                                      % ax ay str dict bool kp
    {kproc} 4 -1 roll    kshow                  % ax ay dict bool ...preserved across kproc calls...
    pop pop pop pop                             % -
  } BD

% Kerned, underlined text.  We get RISC OS to tell us both the kerned and
% unkerned lengths. xw is unkerned, kxw is kerned.Parameters:
% str - the string
% xw, yw: the width to fit it in
% xp, yp: the position to start at
% up, ut: underline position and thickness
% kxw, kyw: the width of the string when kerned

  /UKTx {                                       % str xw yw xp yp up ut kxw kyw
    6 2 roll                                    % str xw yw kxw kyw xp yp up ut
    /ulthick ED                                 %
    /ulpos ED                                   % str xw yw kxw kyw xp yp
    2 copy M   4 2 roll                         % str xw yw xp yp kxw kyw
    Ul  pop pop                                 % str xw yw xp yp
    KTx                                         % -
  } BD

% jkproc gets called with the matrix as of the time kshow was called.

  /jkproc {                                     % sx sy 32 ax ay dict bool c1 c2
    5 I 5 I RM                                  % sx sy 32 ax ay dict bool c1 c2
    1 I 7 I eq                                  % if previous was "space" character
      { 8 I 8 I RM }                            % move the extra space distance
    if                                          % sx sy 32 ax ay dict bool c1 c2
    2 I                                         % 
      { exch 256 mul  add                       % sx sy 32 ax ay dict bool id
        2 I exch                                % sx sy 32 ax ay dict bool dict id
        2 copy known
          {WM2 SCM  get kload RM  WM1 SCM}
          {pop pop}
        ifelse
      }
      { pop pop }
    ifelse                                      % sx sy 32 ax ay dict bool (ready for next call)
  } BD

% Justified, kerned text.
% xw and yw are unkerned lengths, but this balances the fact that stringwidth
% gives an unkerned length. Parameters:
% str - the string
% sx, sy: extra padding to add at each space character
% 32 (usually): the ASCII code for the space character
% cx, cy: extra padding to add between each pair of characters
% xw, yw: the width to fit it in
% xp, yp: the position to start at

  /JKTx {                                       % str sx sy 32 cx cy xw yw xp yp
    WM1 GCM                                     % str sx sy 32 cx cy xw yw xp yp curmat
    GCF /FontMatrix get                         % str sx sy 32 cx cy xw yw xp yp curmat fontmat
    exch WM2 CCM pop                            % str sx sy 32 cx cy xw yw xp yp
    M                                           % str sx sy 32 cx cy xw yw
    8 -1 roll dup 4 1 roll                      % sx sy 32 cx cy str xw yw str
    SW AC 5 1 roll                              % sx sy 32 str cx cy ax ay
    exch 4 -1 roll add                          % sx sy 32 str cy ay tx
    3 1 roll add                                % sx sy 32 str tx ty

    GCF /KernData known
      {GCF /KernData get true}
      {null false}
    ifelse                                      % sx sy 32 str tx ty dict bool kp
    
    {jkproc} 6 -1 roll  kshow                   % sx sy 32 tx ty dict bool    ...what each jkproc call sees...
    7 {pop} repeat
  } BD

% Underlined, justified, kerned text string.  Parameters:
% str - the string
% sx, sy: extra padding to add at each space character
% 32 (usually): the ASCII code for the space character
% cx, cy: extra padding to add between each pair of characters
% xw, yw: the width to fit it in
% uw, uh: the underline vector
% up, ut: underline position and thickness
% xp, yp: the position to start at

  /UJKTx {                                      % str sx sy 32 cx cy xw yw uw uh up ut xp yp
    2 copy M                                    % str sx sy 32 cx cy xw yw uw uh up ut xp yp
    6 2 roll                                    % str sx sy 32 cx cy xw yw xp yp uw uh up ut
    /ulthick ED /ulpos ED                       % str sx sy 32 cx cy xw yw xp yp uw uh
    Ul pop pop                                  % str sx sy 32 cx cy xw yw xp yp
    JKTx                                        % does the rest for us
  } BD


  /cdefs 224 8 mul string def                   % a string holding the VDU 5
                                                % character definitions

  cdefs 127 32 sub 8 mul                        % define the DELETE block
    FFs 0 8 getinterval putinterval

  /DC {                                         % add a VDU 5 character definition to
    32 sub 8 mul                                % 'cdefs'.
    cdefs exch 8 getinterval                    % - expects a character number in the
    currentfile exch                            %  range 32-255 on the stack.
    readhexstring pop pop                       % - expects to be followed by a 16
  } BD                                          %  digit hexadecimal string.

  /ArcFont dup                                  % the font used to print VDU 5
    6 dict dup begin                            % strings.
      /FontMatrix [1. 0. 0. 1. 0. -1.] def      % - note 'Encoding' will never be
      /FontType 3 def                           %  used, but must exist for this to
      /FontBBox [0. 0. 1. 1.] def               %  be regarded as a valid font
      /Encoding 256 array def                   %  dictionary.
      0 1 255
        { Encoding exch /.notdef put }
      for
      /BuildChar {
        xgap ygap setcharwidth
        8 8 true
        8. 0. 0. 8. 0. 0. WM2 astore
        5 -1 roll 32 sub 8 mul
        cdefs exch 8 getinterval
        imagemask
        pop
      } BD
    end
  definefont                                    % Stack ==> /ArcFont font
% fonts 3 1 roll put                            % Store it in PDict.fonts
  def                                           % Store it in PDict

  /V {                                          % prints a VDU 5 string
    GS                                          % - expects string, X position, Y
      2 I div /ygap ED                          %  position, X size, Y size, X
      2 I div /xgap ED                          %  spacing, Y spacing on the stack.
      0. 0. 3 -1 roll 0. 0. WM1 astore
%    fonts /ArcFont get                       % Get the font from PDict.fonts
      ArcFont                                   % Get the font from PDict
      exch makefont setfont
      M show
    GR
  } BD



% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Stuff for handling transformed sprites.
% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


  % Map sprite of size (width, height) onto a parallelogram with the given
  % corners.

  /PAR {                                        % llx lly lrx lry urx ury ulx uly width height -- (set matrix)
          6 -2 roll pop pop                     % llx lly lrx lry ulx uly width height
          10 dict begin
                  dup 0 lt /hflip ED abs /h ED
                  dup 0 lt /wflip ED abs /w ED
                  256. div /uly ED
                  256. div /ulx ED
                  256. div /lry ED
                  256. div /lrx ED
                  256. div /lly ED
                  256. div /llx ED
                  [
                          lrx llx sub w div
                          lry lly sub w div
                          ulx llx sub h div
                          uly lly sub h div
                          llx
                          lly
                  ] concat
                  hflip {0 h T 1 -1 scale} if
                  wflip {w 0 T -1 1 scale} if
          end
  } BD


% %%%%%%%%%%%%%%%
% Procedures to do font remapping, matrix alteration and re-encoding.
% %%%%%%%%%%%%%%%

% Lookup table to see if an accent is valid
  /VALACC 14 dict dup begin
    /acute 1 def
    /grave 1 def
    /circumflex 1 def
    /dieresis 1 def
    /ring 1 def
    /tilde 1 def
    /breve 1 def
    /caron 1 def
    /cedilla 1 def
    /dotaccent 1 def
    /hungarumlaut 1 def
    /slash 1 def
    /macron 1 def
    /ogonek 1 def
  end def

% Is this glyph known, and is it a real charstring?

  /CKN                                          % charstringdict glyphname -- bool
  {
    2 copy known
    {
      get type /arraytype ne
    }
    { pop pop false } ifelse
  } def

% Should/can we auto-accent this character? Takes CharStrings dict and
% glyph name on the stack.

  /OKA                                          % csdict glyphname -- lettername accentname true (success)
                                                % csdict glyphname -- false (failure)
  {
    2 copy known
    { pop pop false }
    {
      dup length dup 1 gt                       % is it big enough?
      {                                         % csdict glyphname length 
        string cvs                              % csdict glyphstr
        dup 0 1 getinterval cvn                 % csdict glyphstr lettername
        exch
        1 1 I length 1 sub                      % csdict lettername glyphstr 1 len-1
        getinterval cvn                         % csdict lettername accentname

        % They must both be in CharStrings and both be real CharStrings
        % (not procs).

        3 -1 roll                               % lettername accentname csdict
        dup 2 I CKN                             % lettername accentname csdict bool
        exch 3 I CKN and                        % lettername accentname bool

        % Check that accentname is a valid accent char
        VALACC 2 I known and                % lettername accentname bool

        {
          true
        }
        { pop pop false }
        ifelse

        % Is the accent a valid one? INSERT TEST HERE
      }
      { pop pop pop false } ifelse
    } ifelse
  } def


  % RF copies a font, possibly applying an additional matrix.

  /RF                                           % newname matrix parentfont -- (font defined)
  {
      findfont false 3 1 roll _RFE
  } def


  /_RFE                                         % newname encoding matrix oldfontdict -- (font defined)
  {
    dup length dict begin                       % newname matrix olddict
      {
        1 I /FID ne
        { def } { pop pop } ifelse
      } forall                                  % newname matrix

      % Deal with the matrix

      dup type /arraytype eq
      { /FontMatrix FontMatrix 3 -1 roll 6 array CCM def }
      { pop } ifelse                            % newname

      % Deal with the encoding
      dup type /arraytype eq  currentdict /Encoding known and
      { /Encoding exch def } { pop } ifelse

    currentdict end
    definefont pop
  } def

  /RFE                                          % newname encoding matrix oldfontname -- (font defined)
  {
    findfont dup /CharStrings known
    { RFET1 } { _RFE } ifelse
  } def


  % RFE copies a font, possibly applying an additional matrix and a new encoding.
  % Adds auto-accent support. encoding may
  % be false, which means copy parent's encoding. matrix may be false
  % which means copy parent's matrix.

  /RFET1                                        % newname encoding matrix oldfontdict -- (font defined)
  {
    dup length 4 add dict begin                 % newname encoding matrix oldfontdict

    % Some useful routines - put them in the font dict itself
    % so that we're self-contained. Perhaps should be in a
    % subdictionary.

    % pathbbox returns too large a bbox if the path is rotated or skewed!
    % Do the sums in font coordinate system.

    /CBOX                                       % (s) -- bbox wx wy (alters path and point)
    {
      newpath 0 0 M
      GS ifm SCM
      false charpath matrix SCM pathbbox currentpoint GR
    } BD

    /CHEI                                       % (s) -- height (alters path and point)
    {
      CBOX pop pop 4 1 roll pop pop pop
    } BD

    % Could use far more efficient code if glyphshow could be relied upon
    % Try to make it conditional on "known", later on.

    /SRCH                                       % glyphname -- str true OR false false
    {
      -1 exch                                   % -1 name
      /Encoding load   0 1                      % -1 name enc 0 1
      2 I length 1 sub                          % -1 name enc 0 1 limit
      {                                         % -1 name enc I
        2 copy get                              % -1 name enc I name2
        3 I eq                                  % -1 name enc I bool
        {                                       % -1 name enc I
          4 -1 roll pop
          3 1 roll
          exit                                  % I name enc
        } {
          pop                                   % -1 name enc
        } ifelse                                % tag name enc
      } for
      pop pop
      dup -1 ne { 1 string dup 0 4 -1 roll put true } { pop false false } ifelse
    } BD


    /MKACC                                      % glyphname|code lettername accentname -- (paints char)
    {
      % Get their character codes from encoding.  Note that we can't
      % do this at re-encode time because we might have re-encoded again
      % in the meantime (also want to keep re-encoding fast).

      SRCH                                      % lettername accentstr bool
      3 -1 roll SRCH                            % accentstr bool letterstr bool
      3 -1 roll and
      {                                         % accentstr letterstr
      % Both chars available, so let's do it.

        3 dict begin
        /letter exch def
        /accent exch def                        % --
        /ifm /FontMatrix load matrix invertmatrix def

      % Centering: horizontally, we must calculate the actual
      % centre of the char, since they differ so much.  Vertically
      % we trust the type designer for lowercase letters, and
      % add the cap-height minus the x-height for letters which
      % extend above the x-height, UNLESS the bottom of the accent
      % is below the baseline, in which case don't adjust vertically. 

      % Ought to precalculate a lot of this!  (Would need to do it
      % all in character coord space, which is more fiddly).

      % Show "kindly" applied the font matrix; we don't want this
      % because the shows and charpaths below apply it again!

        GS

        matrix SCM
        letter CBOX                             % llx lly lux luy wx wy
        6 2 roll                                % wx wy llx lly lux luy
        accent CBOX pop pop                     % wx wy llx lly lux luy alx aly aux auy

      % X adjust is (Lw-Aw)/2 + (Llx - Alx)

        6 -1 roll 7 I sub                       % wx wy llx lly luy alx aly aux auy Lw
        3 -1 roll 4 I sub                       % wx wy llx lly luy alx aly auy Lw Aw
        sub 2 div                               % wx wy llx lly luy alx aly auy Dw/2
        7 -1 roll 5 -1 roll sub                 % wx wy lly luy aly auy Dw/2 xdelta
        add 7 1 roll                            % xadj wx wy lly luy aly auy

      % Y adjust: if top of accent is <= 0, then we don't touch it.
      % Otherwise, find height of letter, x and X.  If the height of letter is > (x+X)/2,
      % then move accent up by X-x.

        0 gt
        {
          (X) CHEI                              % xadj wx wy lly luy aly Xh
          (x) CHEI                              % xadj wx wy lly luy aly Xh xh
          2 copy add 2 div                      % xadj wx wy lly luy aly Xh xh av
          5 -1 roll le {sub} {pop pop 0} ifelse % xadj wx wy lly aly yadj
          5 1 roll pop pop                      % xadj yadj wx wy
        }
        {
          pop pop pop 0 3 1 roll                % xadj yadj wx wy
        } ifelse

        GR                                      % CTM is back to normal
        setcharwidth                            % xadj yadj

        0 0 M GS ifm concat letter show GR      % xadj yadj
        M    GS ifm concat accent show  GR      % -

        end                                     % of temp. dict for variables
      }
      {
        pop pop                                 % One or both chars were not in encoding; give up
      } ifelse
      pop                                       % don't care about glyph name
    } BD

    % Stack: newname encoding matrix oldfontdict

    % How many entries in Encoding are missing in CharStrings?
    dup /CharStrings get                        % name enc mat dict cs
    0 4 I                                       % name enc mat dict cs count enc
    {                                           % name enc mat dict cs count glyph
      2 I exch OKA
      { pop pop 1 add } if                      % name enc mat dict cs count
    } forall                                    % name enc mat dict cs count

    3 -1 roll                                   % name enc mat cs count dict
    {
      1 I /FID ne
      2 I /CharStrings ne and
      {def} {pop pop} ifelse
    } forall                                    % name enc mat cs count

    % Make a writeable copy of /CharStrings with extra space
    % and fill it in

    1 I length add dict                         % name enc mat cs newcs

    % Can't use copy because it transfers the readonly status across!
    exch
    {
      2 I 3 1 roll put
    } forall

    2 I                                         % name enc mat newcs enc
    {                                           % name enc mat newcs glyph
      2 copy OKA
      {                                         % name enc mat newcs glyph lettername accentname
        [ 3 1 roll                              % name enc mat newcs glyph mark lettername accentname
        /MKACC cvx ] cvx                        % name enc mat newcs glyph proc
        2 I 3 1 roll                            % name enc mat newcs newcs glyph proc
        put                                     % name enc mat newcs
      } { pop} ifelse                           % name enc mat newcs
    } forall                                    % name enc mat newcs


    /CharStrings exch def                       % name enc mat

    % Deal with the matrix. This can be false, meaning don't touch

    dup type /arraytype eq
    { /FontMatrix FontMatrix 3 -1 roll 6 array CCM def }
    { pop } ifelse                              % name enc

    % Deal with the encoding.

    /Encoding exch def                          % name

    currentdict
    end                                         % name newfontdict
    definefont pop
  } BD


end

% END OF PDdict
