% Header file for PMW PostScript output
% Last modified for Acorn version: 23 February 1997
% Last modified for Linux version: 28 August 2003

% Set up encoding vector a la Acorn for use with fonts
% that normally have the standard encoding. We must include
% all the accent characters and the dotless i for the benefit
% of older printers that need them to construct the composites.

/PMWencoding StandardEncoding length array def
PMWencoding dup dup dup dup 0 StandardEncoding putinterval
28 [/tilde/circumflex/cedilla/dotlessi]putinterval
39/quotesingle put 96/grave put
143 [/bullet/quoteleft/quoteright/guilsinglleft/guilsinglright
/quotedblleft/quotedblright/quotedblbase/endash/endash/emdash
/minus/OE/oe/dagger/fi/fl/space/exclamdown/cent/sterling
/currency/yen/brokenbar/section/dieresis/copyright/ordfeminine
/guillemotleft/logicalnot/hyphen/registered/macron
/degree/plusminus/twosuperior/threesuperior/acute/mu
/paragraph/periodcentered/cedilla/onesuperior/ordmasculine
/guillemotright/onequarter/onehalf/threequarters/questiondown
/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla
/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex
/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis
/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn
/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae
/ccedilla/egrave/eacute/ecircumflex/edieresis/igrave/iacute
/icircumflex/idieresis/eth/ntilde/ograve/oacute/ocircumflex/otilde
/odieresis/divide/oslash/ugrave/uacute/ucircumflex/udieresis
/yacute/thorn/ydieresis]putinterval

% Straightforward abbreviations

/F/fill load def
/GS/gsave load def
/GR/grestore load def
/Mt/moveto load def/Lt/lineto load def
/R/rotate load def
/Rl/rlineto load def/Rm/rmoveto load def
/Ct/curveto load def/Rc/rcurveto load def
/S/stroke load def
/Slw/setlinewidth load def
/Slc/setlinecap load def
/Slj/setlinejoin load def
/Sg/setgray load def
/Sd/setdash load def
/T/translate load def

% Additional control values for slurs: normally zero
/clx 0 def/cly 0 def/crx 0 def/cry 0 def

% For EPS files we must define *all* variables before defining the
% procedures (PRM p. 715) in case they are previously defined.

%EPS /u 0 def /v 0 def /w 0 def /x 0 def /y 0 def /z 0 def
%EPS /x0 0 def /x1 0 def /x2 0 def /y0 0 def /y1 0 def /y2 0 def
%EPS /t1 0 def /t2 0 def /t 0 def /gg 0 def /newfont 0 def
%EPS /a 0 def /b 0 def /c 0 def

% Routine to initially find a font and re-encode it if necessary.
% We find first, and then look to see if it's in the directory,
% to cope with the case of loading from an auxiliary store.
/inf{dup dup findfont 3 1 roll FontDirectory exch known {pop}{(**** Font ")print
100 string cvs print (" is not loaded ****\r\n)print stop}ifelse
dup dup/Encoding get StandardEncoding eq{maxlength dict/newfont
exch def{1 index/FID eq{pop pop}{newfont 3 1 roll put}ifelse}forall
newfont/Encoding PMWencoding put dup newfont definefont}{pop}ifelse def
}bind def

% Font selection
/ss{scalefont setfont}bind def

% Transformed font selection
/sm{makefont setfont}bind def

% Print deep bar line: char-height, ybot, char, x, ytop
/b{/y exch def/x exch def/w exch def/z exch def/v exch def
{x y Mt w show
y z gt{/y y v sub def y z lt{/y z def}if}
{exit}ifelse}loop}bind def

% Print brace: scale, x, ymid
/br{gsave translate dup 0.11 gt {0.11}{dup 2.0 div 0.055 add}ifelse
exch scale 2{0.0 0.0 Mt 100.0 20.0 -50.0 245.0 60.0 260.0
curveto -50.0 245.0 60.0 20.0 0.0 0.0
curveto fill 1.0 -1.0 scale}repeat grestore}bind def

% Print alternate brace: scale, x, ymid
/br2{gsave translate dup 0.11 gt {0.11}{dup 2.0 div 0.055 add}ifelse
exch scale 2{0.0 0.0 Mt 95.0 40.0 -43.0 218.0 37.0 256.0
curveto -59.0 219.0 66.0 34.0 0.0 0.0
curveto fill 1.0 -1.0 scale}repeat grestore}bind def

% Coordinate setup for slurs: x0 y0 x1 y1 "depth"
/cc{/u exch def/y1 exch def/x1 exch def/y0 exch def/x0 exch def
/w y1 y0 sub dup mul x1 x0 sub dup mul add sqrt 2 div def
/v w 2 mul 3 div dup 10 gt {pop 10} if def
x0 x1 add 2.0 div y0 y1 add 2.0 div translate
y1 y0 sub x1 x0 sub atan rotate}bind def

% Set up additional control for slurs: clx cly crx cry
/cA{/cry exch def/crx exch def/cly exch def/clx exch def}bind def

% Draw ordinary slur or tie in preset coordinate system
/cd{w neg 0.05 moveto v w sub clx add u cly add w v sub crx add u cry add
w 0.05 curveto w -0.05 lineto w v sub crx add u cry add 1 sub v w sub clx add
u cly add 1 sub w neg -0.05 curveto closepath fill}bind def

% Print tie or ordinary slur
/cv{gsave cc cd grestore}bind def

% Draw wiggly ordinary slur in preset coordinate system
/cwd{w neg 0.05 moveto v w sub clx add u cly add w v sub crx add cry u sub
w 0.05 curveto w -0.05 lineto w v sub crx add cry u sub 1 sub v w sub clx add
u cly add 1 sub w neg -0.05 curveto closepath fill}bind def

% Print wiggly ordinary slur
/cvw{gsave cc cwd grestore}bind def

% Print editorial marking on slur; trivial when the y control point movements
% are equal; very messy otherwise. On stack: length-adjust, wiggle value (1, -1)
/cem{dup 1 eq cly cry eq and{pop 0 u cly add 0.75 mul /t2 0 def}
{/x1 v w sub clx add def /x2 w v sub crx add def
/y1 u cly add def u mul cry add /y2 exch def

/t 0.5 def

% Put x value on stack; dx value in /t1
/a 2 w mul x1 x2 sub 3 mul add def
/b x2 2 x1 mul sub w sub 3 mul def
/c x1 w add 3 mul def 
a t mul b add t mul c add t mul w sub
/t1 a 3 mul t mul b 2 mul add t mul c add def

% Put y value on stack; dy value in /t2
/a y1 y2 sub 3 mul def
/b 3 y2 mul 6 y1 mul sub def
/c 3 y1 mul def
a t mul b add t mul c add t mul
/t2 a 3 mul t mul b 2 mul add t mul c add def
}ifelse 
translate t2 0 ne {t2 t1 atan rotate} if
0 2 moveto 4 add neg 0 exch rlineto 0.4 Slw stroke}bind def

% Print editorial slur
/cve{gsave cc cd 0.8 1 cem grestore}bind def

% Print wiggly editorial slur
/cvwe{gsave cc cwd 0.8 -1 cem grestore}bind def

% Print straight dashed line: x1 y1 x0 y0 width [dash1 dash2]
% Do some device-specific stuff on the width, as this is used
% for dotted bar lines, which must all look the same width.
/dl{gsave 0 Sd 0 dtransform exch floor exch idtransform pop
Slw Mt Lt stroke grestore}bind def

% Print system bracket: x, ytop, ybot
/k{/y1 exch def/y2 exch def/x exch def
currentfont mf
y2 y1 sub dup 16 gt {pop 16}if 
dup 1 sub /y exch def
dup y2 exch sub /y2 exch def
16 div 10 mul ss
x y2 Mt
(\260) show
{/y2 y2 y sub def 
y2 y1 le {exit}if x y2 Mt (B)show}loop
x y1 Mt (\261)show
setfont}bind def

% Print straight line: x1 y1 x0 y0 width
/l{Slw Mt Lt stroke}bind def

% Print sequence of straight lines: xn yn ... count x0 y0 width
/ll{Slw Mt 1 1 3 -1 roll{pop Lt}for stroke}bind def

% Print beam: z x1 y1 x0 y0
/m{/y0 exch def/x0 exch def/y1 exch def/x1 exch def/z exch def
x0 y0 Mt x1 y1 Lt x1 y1 z add Lt x0 y0 z add Lt fill}bind def

% Print string relative to current point: string x y
/rs{rmoveto show}bind def

% Print string: string x y
/s{moveto show}bind def

% Print string relative to current point, widening spaces: string w x y
/wrs{rmoveto 0 32 4 -1 roll widthshow}bind def

% Print string, widening spaces: string w x y
/ws{moveto 0 32 4 -1 roll widthshow}bind def

% End of PostScript header for PMW
