% This file is adapted from the PostScript code that gets
% included by the psfix filter, provided with Mathematica.
% The only differences are the addition of the first two lines
% (MyDict) and of the abbreviations at the end (starting with /Ma).
%$Revision: 1.3 $
%$Date: 95/06/27 12:16:53 $
/MyDict 200 dict def
MyDict begin
% The externally visible functions are:
% MathPictureStart- start page.
% MathPictureEnd - finish off page.
% MathSubStart - start a sub-page.
% MathSubEnd - finish off a sub-page.
% Mdot - draw a dot.
% Mtetra - draw a filled tetragon.
% Metetra - draw a filled tetragon with black edges.
% Mistroke - intermediate stroke of multi-stroke line/curve.
% Mfstroke - final stroke of multi-stroke line/curve.
% Msboxa - compute coordinates of text bounding box.
% Mshowa - plot characters.
% MathScale - compute scaling info to contain array of points.
% The following are only for backwards compatibility with earlier versions
% of Mathematica:
% Mpstart - identical to MathPictureStart.
% Mpend - identical to MathPictureEnd.
% Mscale - like MathScale but without user coordinate info.
/Mpstart { % - Mpstart -
MathPictureStart
} bind def
/Mpend { % - Mpend -
MathPictureEnd
} bind def
/Mscale { % [pnts] Mscale -
0 1 0 1 % [pnts] xbias xscale ybias yscale
5 -1 roll % xbias xscale ybias yscale [pnts]
MathScale % -
} bind def
%start of ISOLatin1 stuff
/ISOLatin1Encoding dup where
{ pop pop }
{
[
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/space /exclam /quotedbl /numbersign /dollar /percent /ampersand /quoteright
/parenleft /parenright /asterisk /plus /comma /minus /period /slash
/zero /one /two /three /four /five /six /seven
/eight /nine /colon /semicolon /less /equal /greater /question
/at /A /B /C /D /E /F /G
/H /I /J /K /L /M /N /O
/P /Q /R /S /T /U /V /W
/X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
/quoteleft /a /b /c /d /e /f /g
/h /i /j /k /l /m /n /o
/p /q /r /s /t /u /v /w
/x /y /z /braceleft /bar /braceright /asciitilde /.notdef
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
/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
] def
} ifelse
/MFontDict 50 dict def
/MStrCat % string1 string2 MStrCat string
{
exch % s2 s1
dup length % s2 s1 len
2 index length add % s2 s1 len
string % s2 s1 s
dup 3 1 roll % s2 s s1 s
copy % s2 s s1
length % s2 s where
exch dup % s2 where s s
4 2 roll exch % s s where s2
putinterval
} def
/MCreateEncoding % name encoding MCreateEncoding newname
{
% get base name
1 index % name encoding name
% concatenate (-) and encoding to the name
255 string cvs
(-) MStrCat
1 index MStrCat
cvn exch % basename newname encoding
% make encoding name
(Encoding) MStrCat
cvn dup where
{
exch get
}
{
pop
StandardEncoding
} ifelse
3 1 roll % vector basename newname
% make the font if we haven't before
dup MFontDict exch known not
{
1 index findfont
dup length dict
begin
{1 index /FID ne
{def}
{pop pop}
ifelse} forall
/Encoding 3 index
def
currentdict
end
1 index exch definefont pop
MFontDict 1 index
null put
}
if
exch pop % vector newname
exch pop % newname
} def
/ISOLatin1 { (ISOLatin1) MCreateEncoding } def
/ISO8859 { (ISOLatin1) MCreateEncoding } def
%end of ISOLatin1 stuff
%
% Include old font names for backward compatibility
%
/Mcopyfont { % procedure to copy font
dup
maxlength
dict
exch
{
1 index
/FID
eq
{
pop pop
}
{
2 index
3 1 roll
put
}
ifelse
}
forall
} def
/Plain /Courier findfont Mcopyfont definefont pop
/Bold /Courier-Bold findfont Mcopyfont definefont pop
/Italic /Courier-Oblique findfont Mcopyfont definefont pop
% Set up for the start of a page.
/MathPictureStart { % - MathPictureStart -
gsave % -
Mtransform % possibly rotate to landscape mode
Mlmarg % left_margin
Mbmarg % bottom_margin
translate % -
Mwidth % init_width
Mlmarg Mrmarg add % init_width lmarg+rmarg
sub % true_width
/Mwidth exch def %
Mheight % init_height
Mbmarg Mtmarg add % init_height tmarg+bmarg
sub % true_height
/Mheight exch def
/Mtmatrix % /Mtmatrix
matrix currentmatrix % /Mtmatrix text_matrix
def
/Mgmatrix % /Mgmatrix
matrix currentmatrix % /Mgmatrix graphics_matrix
def % -
} bind def
% Finish off a page.
/MathPictureEnd {
grestore
} bind def
%MFill fills the drawing area with the current color.
/MFill {
0 0 moveto
Mwidth 0 lineto
Mwidth Mheight lineto
0 Mheight lineto
fill
} bind def
% xmin xmax ymin ymax MPlotRegion alters the origin, Mwidth and Mheight
% so that the picture fills the altered region
/MPlotRegion { % xmin xmax ymin ymax MPlotRegion
3 index % xmin xmax ymin ymax xmin
Mwidth mul % xmin xmax ymin ymax xmin_pos
2 index % xmin xmax ymin ymax xmin_pos ymin
Mheight mul % xmin xmax ymin ymax xmin_pos ymin_pos
translate % xmin xmax ymin ymax
exch sub % xmin xmax ymax-ymin
Mheight mul % xmin xmax new_height
/Mheight
exch def % xmin xmax
exch sub % xmax-xmin
Mwidth mul % new-width
/Mwidth
exch def
} bind def
% Given a rectangle, set it up as a sub-picture.
/MathSubStart { % xmin ymin xmax ymax MathSubStart <saved state(8)>
Momatrix
Mgmatrix Mtmatrix
Mwidth Mheight % xmin ymin xmax ymax <ss(8)>
7 -2 roll % xmin ymin <ss(8)> xmax ymax
moveto % xmin ymin <ss(8)>
Mtmatrix setmatrix % xmin ymin <ss(8)>
currentpoint % xmin ymin <ss(8)> xmax(t) ymax(t)
Mgmatrix setmatrix % xmin ymin <ss(8)> xmax(t) ymax(t)
9 -2 roll % <ss(8)> xmax(t) ymax(t) xmin ymin
moveto % <ss(8)> xmax(t) ymax(t)
Mtmatrix setmatrix % <ss(8)> xmax(t) ymax(t)
currentpoint % <ss(8)> xmax(t) ymax(t) xmin(t) ymin(t)
2 copy translate % <ss(8)> xmax ymax xmin ymin
/Mtmatrix matrix currentmatrix def
3 -1 roll % <ss(8)> xmax xmin ymin ymax
exch sub % <ss(8)> xmax xmin height
/Mheight exch def % <ss(8)> xmax xmin
sub % <ss(8)> width
/Mwidth exch def % <ss(8)>
} bind def
% Restore the saved state left by the matching MathSubStart.
% Note, we also leave with the new Mgmatrix as the current matrix.
/MathSubEnd { % gmat tmat lm rm bm tm w h MathSubStart -
/Mheight exch def % gmat tmat lm rm bm tm w
/Mwidth exch def % gmat tmat lm rm bm tm
/Mtmatrix exch def % gmat
dup setmatrix % gmat
/Mgmatrix exch def % -
/Momatrix exch def % -
} bind def
% Given a point, draw a dot.
/Mdot { % x y Mdot -
moveto % -
0 0 rlineto % -
stroke % -
} bind def
% Given 4 points, draw the corresponding filled tetragon.
/Mtetra { % x0 y0 x1 y1 x2 y2 x3 y3 Mtetra -
moveto % x0 y0 x1 y1 x2 y2
lineto % x0 y0 x1 y1
lineto % x0 y0
lineto % -
fill % -
} bind def
% Given 4 points, draw the corresponding filled tetragon with black edges.
% Note, this leaves the gray level at 0 (for compatibility with the old
% C code.
/Metetra { % x0 y0 x1 y1 x2 y2 x3 y3 Metetra -
moveto % x0 y0 x1 y1 x2 y2
lineto % x0 y0 x1 y1
lineto % x0 y0
lineto % -
closepath % -
gsave % -
fill % -
grestore % -
0 setgray % -
stroke % -
} bind def
% Mistroke is called to stroke intermediate parts of a path. It makes
% sure to resynchronize the dashing pattern and to leave the current point
% as the final point of the path.
/Mistroke { % - Mistroke -
flattenpath % -
0 0 0 % length x y
{ % length x y new_x new_y (for moves)
4 2 roll % length new_x new_y x y
pop pop % length new_x new_y
}
{ % length x y new_x new_y (for lines)
4 -1 roll % length y new_x new_y x
2 index % length y new_x new_y x new_x
sub dup mul % length y new_x new_y dx*dx
4 -1 roll % length new_x new_y dx*dx y
2 index % length new_x new_y dx*dx y new_y
sub dup mul % length new_x new_y dx*dx dy*dy
add sqrt % length new_x new_y dlen
4 -1 roll % new_x new_y dlen length
add % new_x new_y new_length
3 1 roll % new_length new_x new_y
}
{ % length x y x1 y1 x2 y2 x3 y3 (for curves)
stop % should never be called
}
{ % length x y (for closepaths)
stop % should never be called
}
pathforall % length x y
pop pop % length
currentpoint % length final_x final_y
stroke % length final_x final_y
moveto % length
currentdash % length dash_array dash_offset
3 -1 roll % dash_array dash_offset length
add % dash_array new_offset
setdash % -
} bind def
% Mfstroke is called to stroke the final parts of a path. It resets
% the dashing pattern to compensate for any adjustments made by Mistroke.
/Mfstroke { % - Mfstroke -
stroke % -
currentdash % dash_array dash_offset
pop 0 % dash_array 0
setdash % -
} bind def
% Mrotsboxa is the same as Msboxa except that it takes an angle
% form the stack and the box is calculated for text rendered at this angle.
% It gsaves in case we are starting a MathSubStart
% save Mrot so that Msboxa can convert bouding box back to the non-rotated
% coordinate system
% call Mrotcheck to alter the offsets into the rotated system
% converts Mtmatrix to render in the rotated system
% the calls Msboxa which does all the work
% at the end Mtmatrix is restored and Mrot is reset to 0
/Mrotsboxa { % [str..] gx gy sx sy ang Mrotsboxa ... Msboxa
gsave % in case in MathSubStart
dup % [str..] gx gy sx sy ang ang
/Mrot
exch def % [str..] gx gy sx sy ang
Mrotcheck % [str..] gx gy sx_new sy_new ang
Mtmatrix % [str..] gx gy sx sy ang Mtmatrix
dup
setmatrix
7 1 roll % Mtmatrix [str..] gx gy sx sy ang
4 index % Mtmatrix [str..] gx gy sx sy ang gx
4 index % Mtmatrix [str..] gx gy sx sy ang gx gy
translate % Mtmatrix [str..] gx gy sx sy ang
rotate % Mtmatrix [str..] gx gy sx sy
3 index % Mtmatrix [str..] gx gy sx sy gx
-1 mul % Mtmatrix [str..] gx gy sx sy -gx
3 index % Mtmatrix [str..] gx gy sx sy -gx gy
-1 mul % Mtmatrix [str..] gx gy sx sy -gx -gy
translate % Mtmatrix [str..] gx gy sx sy
/Mtmatrix % now change Mtmatrix to be this new currentmatrix
matrix
currentmatrix
def
grestore % grestore to deal with MathSubStart
Msboxa % Mtmatrix [ x y x y] [ x y x y]
3 -1 roll % [x y x y ] [x y x y] Mtmatrix
/Mtmatrix
exch def % restore Mtmatrix
/Mrot
0 def % restore Mrot
} bind def
% Given an array of strings ([str...]), which represent consecutive lines
% of text, a position in graphics coordinates (gx,gy) and a position in
% the bounding box coordinates (sx,sy), compute the low and high coordinates
% of the resulting text, in the [gx gy tx ty] form, which corresponds to
% the point (gx,gy) (in graphics coordinates) plus the offset (tx,ty) (in
% text coordinates).
% Note, Msboxa assumes that the current matrix is the text matrix.
% Mboxout is called in case we are in Mouter to make the box bigger
% Mboxrot adjusts the box to account for a rotation to convert the box
% into a nonrotated coordinate system
%
/Msboxa { % [str...] gx gy sx sy Msboxa [gx gy tlx tly] [gx gy thx thy]
newpath % [str...] gx gy sx sy (just in case)
5 -1 roll % gx gy sx sy [str...]
Mvboxa % gx gy sx sy blx bly bhx bhy [off...]
pop % gx gy sx sy blx bly bhx bhy
Mboxout % adjust box for Minner
6 -1 roll % gx gy sy blx bly bhx bhy sx
5 -1 roll % gx gy sy bly bhx bhy sx blx
4 -1 roll % gx gy sy bly bhy sx blx bhx
Msboxa1 % gx gy sy bly bhy tlx thx
5 -3 roll % gx gy tlx thx sy bly bhy
Msboxa1 % gx gy tlx thx tly thy
Mboxrot % adjust box for rotation
[ % gx gy tlx thx tly thy mark
7 -2 roll % tlx thx tly thy mark gx gy
2 copy % tlx thx tly thy mark gx gy gx gy
[ % tlx thx tly thy mark gx gy gx gy mark
3 1 roll % tlx thx tly thy mark gx gy mark gx gy
10 -1 roll % thx tly thy mark gx gy mark gx gy tlx
9 -1 roll % thx thy mark gx gy mark gx gy tlx tly
] % thx thy mark gx gy [gx gy tlx tly]
6 1 roll % [gx gy tlx tly] thx thy mark gx gy
5 -2 roll % [gx gy tlx tly] mark gx gy thx thy
] % [gx gy tlx tly] [gx gy thx thy]
} bind def
% Msboxa1 is an internal function which, given a bounding box coordinate
% (sz), and the bounding box limits (blz and bhz), computes the actual
% offsets (tlz = (blz-bhz)(sz+1)/2, thz = (blz-bhz)(sz-1)/2).
/Msboxa1 { % sz blz bhz Msboxa1 tlz thz
sub % sz blz-bhz
2 div % sz (blz-bhz)/2
dup % sz (blz-bhz)/2 (blz-bhz)/2
2 index % sz (blz-bhz)/2 (blz-bhz)/2 sz
1 add % sz (blz-bhz)/2 (blz-bhz)/2 sz+1
mul % sz (blz-bhz)/2 tlz
3 -1 roll % (blz-bhz)/2 tlz sz
-1 add % (blz-bhz)/2 tlz sz-1
3 -1 roll % tlz sz-1 (blz-bhz)/2
mul % tlz thz
} bind def
% Given a (non-empty) array of strings ([str...]) calculate the
% bounding box. We do this for fixedwidth fonts or nonfixedwidth fonts
% depending upon the setting of Mfixwid. Mvboxa1 actually does a lot
% of the work. For nonfixedwidth fonts the length of the bounding
% box length is made to be the summation of [(str)..] Mwidthcal
% ie the maximum length of the strings and xlow
%
/Mvboxa { % [str...] Mvboxa xlow ylow xhigh yhigh [off...]
Mfixwid
{
Mvboxa1
}
{
dup % [str...] [str...]
Mwidthcal % [str...] [ w1 w2...]
0 exch % [str...] 0 [ w1 w2...]
{
add
}
forall % [str...] length
exch
Mvboxa1 % length xlow ylow xhigh yhigh [off...]
4 index % length xlow ylow xhigh yhigh [off...] xlow
7 -1 roll % xlow ylow xhigh yhigh [off...] xlow length
add % xlow ylow xhigh yhigh [off...] new_xhigh
4 -1 roll
pop % xlow ylow yhigh [off...] new_xhigh
3 1 roll % xlow ylow new_xhigh yhigh [off...]
}
ifelse
} bind def
% Given a (non-empty) array of strings ([str...]) which represent consecutive
% lines of text, compute the total bounding box assuming that we start at
% (0,0) and the array of y offsets to place the lines correctly.
% Note, Mvboxa assumes that the current matrix is the text matrix.
% Note, Mvboxa does not alter the current path.
% The vertical spacing is set so that the bounding boxes of adjacent lines
% are .3 times the width of an `m' apart.
/Mvboxa1 { % [str...] Mvboxa xlow ylow xhigh yhigh [off...]
gsave % [str...]
newpath % [str...] (clear path fragments)
[ true % [str...] mark true
3 -1 roll % mark true [str...]
{ % mark {true -or- off... Xl Yl Xh Yh false} str
Mbbox % mark {true -or- off... Xl Yl Xh Yh false} xl yl xh yh
5 -1 roll % mark { - -or- off... Xl Yl Xh Yh} xl yl xh yh first?
{ % mark xl yl xh yh
0 % mark xl yl xh yh off1
5 1 roll % mark off1 xl yl xh yh
} % mark off1 XL YL XH YH
{ % mark off... Xl Yl Xh Yh xl yl xh yh
7 -1 roll % mark off... Xl Xh Yh xl yl xh yh Yl
exch sub % mark off... Xl Xh Yh xl yl xh yh-Yl
(m) stringwidth pop % mark off... Xl Xh Yh xl yl xh yh-Yl pntsize
.3 mul % mark off... Xl Xh Yh xl yl xh yh-Yl fudge
sub % mark off... Xl Xh Yh xl yl xh off
7 1 roll % mark off... off Xl Xh Yh xl yl xh
6 -1 roll % mark off... off Xh Yh xl yl xh Xl
4 -1 roll % mark off... off Xh Yh yl xh Xl xl
Mmin % mark off... off Xh Yh yl xh XL
3 -1 roll % mark off... off Xh Yh xh XL yl
5 index % mark off... off Xh Yh xh XL yl off
add % mark off... off Xh Yh xh XL YL
5 -1 roll % mark off... off Yh xh XL YL Xh
4 -1 roll % mark off... off Yh XL YL Xh xh
Mmax % mark off... off Yh XL YL XH
4 -1 roll % mark off... off XL YL XH YH
} % mark off... XL YL XH YH
ifelse % mark off... XL YL XH YH
false % mark off... XL YL XH YH false
} % mark off... XL YL XH YH false
forall % mark off... xlow ylow xhigh yhigh false
{ stop } if % mark off... xlow ylow xhigh yhigh
counttomark % mark off... xlow ylow xhigh yhigh (#off's+4)
1 add % mark off... xlow ylow xhigh yhigh (#off's+5)
4 roll % xlow ylow xhigh yhigh mark off...
] % xlow ylow xhigh yhigh [off...]
grestore % xlow ylow xhigh yhigh [off...]
} bind def
% Given a string, compute the bounding box assuming that we start at (0,0).
% Note, the path is assumed to be empty, and we are assumed to be in text
% coordinates. Allows for long strings.
/Mbbox { % str Mbbox xlow ylow xhigh yhigh
1 dict begin
0 0 moveto % str
/temp (T) def
{ gsave
currentpoint newpath moveto
temp 0 3 -1 roll put temp
false charpath flattenpath currentpoint
pathbbox
grestore moveto lineto moveto} forall
pathbbox
newpath
end
} bind def
% Compute the minimum of two numbers.
/Mmin { % p q Mmin min(p,q)
2 copy % p q p q
gt % p q p>q?
{ exch } if % min(p,q) max(p,q)
pop % min(p,q)
} bind def
% Compute the maximum of two numbers.
/Mmax { % p q Mmax max(p,q)
2 copy % p q p q
lt % p q p<q?
{ exch } if % max(p,q) min(p,q)
pop % max(p,q)
} bind def
% Mrotshowa is the same as Mshowa except that it takes an angle
% from the stack and the text is rendered at this angle.
% It saves Mrot (not really needed but saved anyway)
% calls Mrotcheck to adjust the offsets into the rotated coordinate system
% converts Mtmatrix to render in the rotated system
% and calls Mshowa which does all the work
% at the end Mtmatrix is restored and Mrot is reset to zero.
%
/Mrotshowa { %[str..] gx gy sx sy ang Mrotshowa
dup
/Mrot
exch def
Mrotcheck
Mtmatrix %[str..] gx gy sx sy ang Mtmatrix
dup
setmatrix
7 1 roll %Mtmatrix [str..] gx gy sx sy ang
4 index %Mtmatrix [str..] gx gy sx sy ang gx
4 index %Mtmatrix [str..] gx gy sx sy ang gx gy
translate
rotate %Mtmatrix [str..] gx gy sx sy
3 index
-1 mul
3 index
-1 mul %Mtmatrix [str..] gx gy sx sy -gx -gy
translate
/Mtmatrix
matrix
currentmatrix
def %Mtmatrix [str..] gx gy sx sy
Mgmatrix setmatrix
Mshowa %Mtmatrix
/Mtmatrix
exch def
/Mrot 0 def % restore Mrot
} bind def
%
% Given an array of strings ([str...]), which represent consecutive lines
% of text, a position in graphics coordinates (gx,gy) and a position in
% the bounding box coordinates (sx,sy), display the strings.
% Mboxout is called in case we are in Mouter
%
/Mshowa { % [str...] gx gy sx sy Mshowa -
4 -2 roll % [str...] sx sy gx gy
moveto % [str...] sx sy
2 index % [str...] sx sy [str...]
Mtmatrix setmatrix % [str...] sx sy [str...]
Mvboxa % [str...] sx sy tlx tly thx thy [off...]
7 1 roll % [str...] [off...] sx sy tlx tly thx thy
Mboxout
6 -1 roll % [str...] [off...] sy tlx tly thx thy sx
5 -1 roll % [str...] [off...] sy tly thx thy sx tlx
4 -1 roll % [str...] [off...] sy tly thy sx tlx thx
Mshowa1 % [str...] [off...] sy tly thy relx
4 1 roll % [str...] [off...] relx sy tly thy
Mshowa1 % [str...] [off...] relx rely
rmoveto % [str...] [off...]
currentpoint % [str...] [off...] x y
Mfixwid
{
Mshowax
}
{
Mshoway
}
ifelse
pop pop pop pop
Mgmatrix setmatrix
} bind def
% This is used for fixedwidth fonts
% It simply shows each string and advances the y direction by the offset
%
/Mshowax {
0 1
4 index length % [str...] [off...] x y 0 1 (#strings)
-1 add % [str...] [off...] x y 0 1 (#strings-1)
{ % [str...] [off...] x y strnum
2 index % [str...] [off...] x y strnum x
4 index % [str...] [off...] x y strnum x [off...]
2 index % [str...] [off...] x y strnum [off...] strnum
get % [str...] [off...] x y strnum x off
3 index % [str...] [off...] x y strnum x off y
add % [str...] [off...] x y strnum x Y
moveto % [str...] [off...] x y strnum
4 index % [str...] [off...] x y strnum [str...]
exch get % [str...] [off...] x y str
Mfixdash
{
Mfixdashp
}
if
show % [str...] [off...] x y
} for % [str...] [off...] x y
} bind def
% Fix if all dashes and length > 1
/Mfixdashp { % str
dup
length % str n
1
gt % str bool
1 index % str bool str
true exch % str bool true str
{
45
eq
and
} forall
and % str bool
{
gsave
(--)
stringwidth pop
(-)
stringwidth pop
sub
2 div % str lenfix
0 rmoveto % str
dup % str str
length
1 sub % str len-1
{
(-)
show
}
repeat
grestore
}
if % x y str
} bind def
% This is for non-fixedwidth fonts
% It shows each character individually advancing the x position by
% the maximum width of any character in that position
%
/Mshoway {
3 index % [str...] [off...] x y [str...]
Mwidthcal % [str...] [off...] x y [w1 w2 w3...]
5 1 roll % [w1 w2 w3..] [str...] [off...] x y
0 1 % [w1 w2 w3..] [str...] [off...] x y 0 1
4 index length % [w1 w2 w3..] [str...] [off...] x y 0 1 (#strings)
-1 add % [w1 w2 w3..] [str...] [off...] x y 0 1 (#strings-1)
{ % [w1 w2 w3..] [str...] [off...] x y strnum
2 index % [w1 w2 w3..] [str...] [off...] x y strnum x
4 index % [w1 w2 w3..] [str...] [off...] x y strnum x [off...]
2 index % [w1 w2 w3..] [str...] [off...] x y
% strnum [off...] strnum
get % [w1 w2 w3..] [str...] [off...] x y strnum x off
3 index % [w1 w2 w3..] [str...] [off...] x y strnum x off y
add % [w1 w2 w3..] [str...] [off...] x y strnum x Y
moveto % [w1 w2 w3..] [str...] [off...] x y strnum
4 index % [w1 w2 w3..] [str...] [off...] x y strnum [str...]
exch get % [w1 w2 w3..] [str...] [off...] x y str
[
6 index % [w1 w2 w3..] [str...] [off...] x y str [ [w1 w2..]
aload
length % [w1 w2 w3..] [str...] [off...] x y str [ w1 w2.. len
2 add
-1 roll % [w1 w2 w3..] [str...] [off...] x y [ w1 w2.. str
{
pop % [w1 w2 w3..] [str...] [off...] x y [ w1 c2.. str am
Strform % [w1 w2 w3..] [str...] [off...] x y [ w1 w2.. str 1str
stringwidth
pop
neg
exch % [w1 w2 w3..] [str...] [off...] x y [ w1 w2..
% str -cm cn
add
0 rmoveto % [w1 w2 w3..] [str...] [off...] x y [ w1 w2.. str
}
exch
kshow % [w1 w2 w3..] [str...] [off...] x y [
cleartomark
} for % [w1 w2 w3..] [str...] [off...] x y
pop
} bind def
%
% This is a central mechanism for dealing with non-fixedwidth fonts.
% Given an array of strings Mwidthcal returns an array of the lengths
% of the longest character in the corresponding positions in the arrays.
% Thus the 4th element of the result is the maximum character width of
% each strin at the 4th position.
%
/Mwidthcal { % [(abc) (abc) ..] Mwidthcal [w1 w2 w3 ...]
[
exch % [ [(abc) (abd) ..]
{
Mwidthcal1
}
forall
] % [[w w w] [w w w] ..]
[ % call this [chr ..] now
exch % [ [chr ..]
dup % [ [chr ..] [chr ..]
Maxlen % [ [chr ..] maxlen
-1 add
0 1
3 -1 roll % [chr ..] [ [chr ..] 0 1 maxlen-1
{
[ % [chr ..] [ [chr ..] n [
exch % [chr ..] [ [chr ..] [ n
2 index % [chr ..] [ [chr ..] [ n [chr ..]
{
1 index
Mget % [chr ..] [ [chr ..] [ n [w1 w2 ..] n
exch % [chr ..] [ [chr ..] [ wn n
}
forall
pop % [chr ..] [ [chr ..] [ w1 w2 w3
Maxget % [chr ..] [ [chr ..] wmax
exch % [chr ..] [ wmax [chr ..]
}
for
pop
] % [ wmax1 wmax2 wmax3 ..]
Mreva
} bind def
%Reverse an array
/Mreva { %[a b c ..] Mreva [.. c b a]
[
exch %[ [a b c ..]
aload
length %[a b c .. len
-1 1 %[a b c .. len -1 1
{1 roll}
for
] %[.. c b a]
} bind def
% take an array and an index and return that element if index exits
% if array not long enougth return zero
/Mget { %[a b c d..] index
1 index
length %[a b c d..] index len
-1 add
1 index %[a b c d..] index (len-1) index
ge
{
get %if long enough return entry
}
{
pop pop
0 %if not long enough return zero
}
ifelse
} bind def
%Take an array of arrays and return the longest length
/Maxlen { %[ arr1 arr2 arr3 ] Maxlen maxlen
[ %[ arr1 arr2 arr3 ] [
exch %[ [ arr1 arr2 arr3 ]
{
length
}
forall %[ len1 len2 len3..
Maxget
} bind def
%Take a series of numbers starting with [ and return the largest member
/Maxget { %[n1 n2 n3 .. Maxget nmax
counttomark %[n1 n2 n3 .. len
-1 add %[n1 n2 n3 .. len-1
1 1 %[n1 n2 n3 .. len 1 1
3 -1 roll %[n1 n2 n3 .. 1 1 (len-1)
{
pop
Mmax
}
for %[ nmax
exch % nmax [
pop % nmax
} bind def
%Take a string and return an array of the lengths of the characters
/Mwidthcal1 { % str Mwidthcal1 [w1 w2 w3 ..]
[
exch %[ (str)
{
Strform
stringwidth
pop
}
forall %[w1 w2 w3 ..
] %[w1 w2 w3 ..]
} bind def
%put a string onto the stack
/Strform { % num
/tem (x) def
tem 0
3 -1 roll
put
tem
} bind def
%/Mwidmax { % [str...]
% dup % [str...] [str...]
% [ % [str...] [str...] [
% exch % [str...] [ [str...]
% {
% stringwidth
% pop
% }
% forall % [str...] [ w1 w2 ... wm wn
% 0
% counttomark % [str...] [ w1 w2 ... wm wn 0 n
% -2 add % [str...] [ w1 w2 ... wm wn 0 (n-1)
% 1 exch % [str...] [ w1 w2 ... wm wn 0 1 (n-1)
% 1 exch % [str...] [ w1 w2 ... wm wn 0 1 1 (n-1)
% {
% 3 index % [str...] [ w1 w2 ... wm wn num pos wm
% 3 index % [str...] [ w1 w2 ... wm wn num pos wm wn
% ge
% { % wm >= wn
% exch pop
% exch pop % [str...] [ w1 w2 ... wm num
% }
% { % wm < wn
% pop
% 3 -1 roll
% pop % [str...] [ w1 w2 ... wn pos < pos -> num >
% }
% ifelse % [str...] [ w1 w2 ... wmax nmax
% }
% for % [str...] [ wmax nmax
% 4 1 roll
% pop pop % nmax [str...]
% length % nmax len
% -1 add % nmax (len - 1)
% exch
% sub % max_pos
%} bind def
% Mshowa1 is an internal routine which, given a bounding box coordinate
% (sz), and the bounding box limits if we started drawing at 0 (tlz and thz),
% computes the offset at which to start drawing
% (relz = (sz-1)tlz/2 - (sz+1)thz/2 = sz(tlz-thz)/2-(tlz+thz)/2).
/Mshowa1 { % sz tlz thz Mshowa1 relz
2 copy % sz tlz thz tlz thz
add % sz tlz thz tlz+thz
4 1 roll % tlz+thz sz tlz thz
sub % tlz+thz sz tlz-thz
mul % tlz+thz sz(tlz-thz)
sub % tlz+thz-sz(tlz-thz)
-2 div % sz(tlz-thz)/2-(tlz+thz)/2
} bind def
% Given the x and y scaling to user coordinates and an array of points to
% fit (xbias xscale ybias yscale [pnts]), set up the scaling. The array
% must contain atleast two points, and the last two must be of the form
% [gxlow gylow 0 0] and [gxhigh gyhigh 0 0].
% Note, MathScale assumes that we are already scaled so that the active area
% is the rectangle [0,Mwidth-Mlmarg-Mrmarg]x[0,Mheight-Mbmarg-Mtmarg].
% also keep bias and scale info for PostScript commands
/MathScale { % <user> [pnts] MathScale -
Mwidth % <user> [pnts] width
Mheight % <user> [pnts] width height
Mlp % <user> Ax Ay Bx By
translate % <user> Ax Ay
scale % <user>
/yscale exch def
/ybias exch def
/xscale exch def
/xbias exch def
/Momatrix % this transforms from
xscale yscale matrix scale % Original to Display coordinates
xbias ybias matrix translate
matrix concatmatrix def
/Mgmatrix % /Mgmatrix
matrix currentmatrix % /Mgmatrix graphics_matrix
def % -
} bind def
% Given a non-empty array of points to fit ([p]) and a maximum width (sx)
% and height (sy) find the largest scale (Ax and Ay) and offsets (Bx and By)
% such that the transformation
% [gx gy tx ty] -> (Ax gx + tx + bx, Ay gy + ty + By)
% maps the points into the rectangle [0,sx]x[0,sy]
/Mlp { % [p] sx sy Mlp Ax Ay Bx By
3 copy % [p] sx sy [p] sx sy
Mlpfirst % [p] sx sy Ax Ay
{ % [p] sx sy Ax Ay
Mnodistort % [p] sx sy Ax Ay nodistort?
{ % [p] sx sy Ax Ay
Mmin % [p] sx sy A
dup % [p] sx sy Ax Ay
} if % [p] sx sy Ax Ay
4 index % [p] sx sy Ax Ay [p]
2 index % [p] sx sy Ax Ay [p] Ax
2 index % [p] sx sy Ax Ay [p] Ax Ay
Mlprun % [p] sx sy Ax Ay ctx wtx cgx wgx cty wty cgy wgy
11 index % [p] sx sy Ax Ay ctx wtx cgx wgx cty wty cgy wgy sx
11 -1 roll % [p] sx sy Ay ctx wtx cgx wgx cty wty cgy wgy sx Ax
10 -4 roll % [p] sx sy Ay cty wty cgy wgy sx Ax ctx wtx cgx wgx
Mlp1 % [p] sx sy Ay cty wty cgy wgy Ax Bx xok?
8 index % [p] sx sy Ay cty wty cgy wgy Ax Bx xok? sy
9 -5 roll % [p] sx sy Ax Bx xok? sy Ay cty wty cgy wgy
Mlp1 % [p] sx sy Ax Bx xok? Ay By yok?
4 -1 roll % [p] sx sy Ax Bx Ay By yok? xok?
and % [p] sx sy Ax Bx Ay By ok?
{ exit } if % [p] sx sy Ax Bx Ay By
3 -1 roll % [p] sx sy Ax Ay Bx By
pop pop % [p] sx sy Ax Ay
} loop % [p] sx sy Ax Bx Ay By
exch % [p] sx sy Ax Bx By Ay
3 1 roll % [p] sx sy Ax Ay Bx By
7 -3 roll % Ax Ay Bx By [p] sx sy
pop pop pop % Ax Ay Bx By
} bind def
% Given an array of points in the [gx gy tx ty] form, with the last two
% being [gxlow gylow 0 0] and [gxhigh gyhigh 0 0], and the width and height
% (sx and sy) in which to fit them, compute the maximum scaling (Ax and Ay).
/Mlpfirst { % [pnts] sx sy Mlpfirst Ax Ay
3 -1 roll % sx sy [pnts]
dup length % sx sy [pnts] #pnts
2 copy % sx sy [pnts] #pnts [pnts] #pnts
-2 add % sx sy [pnts] #pnts [pnts] #pnts-2
get % sx sy [pnts] #pnts [gxl gyl 0 0]
aload % sx sy [pnts] #pnts gxl gyl 0 0 [gxl gyl 0 0]
pop pop pop % sx sy [pnts] #pnts gxl gyl
4 -2 roll % sx sy gxl gyl [pnts] #pnts
-1 add % sx sy gxl gyl [pnts] #pnts-1
get % sx sy gxl gyl [gxh gyh 0 0]
aload % sx sy gxl gyl gxh gyh 0 0 [gxh gyh 0 0]
pop pop pop % sx sy gxl gyl gxh gyh
6 -1 roll % sy gxl gyl gxh gyh sx
3 -1 roll % sy gxl gyl gyh sx gxh
5 -1 roll % sy gyl gyh sx gxh gxl
sub % sy gyl gyh sx delx
div % sy gyl gyh Ax
4 1 roll % Ax sy gyl gyh
exch sub % Ax sy dely
div % Ax Ay
} bind def
% Given a non-empty array of points to fit ([pnts]) and scale factors
% for graphics->text (Ax and Ay), compute the limiting points.
/Mlprun { % [pnts] Ax Ay Mlprun ctx wtx cgx wgx cty wty cgy wgy
2 copy % [pnts] Ax Ay Ax Ay
4 index % [pnts] Ax Ay Ax Ay [pnts]
0 get % [pnts] Ax Ay Ax Ay [first]
dup % [pnts] Ax Ay Ax Ay [first] [first]
4 1 roll % [pnts] Ax Ay [first] Ax Ay [first]
Mlprun1 % [pnts] Ax Ay [first] fx fy
3 copy % [pnts] Ax Ay [low] lx ly [high] hx hy
8 -2 roll % [pnts] [low] lx ly [high] hx hy Ax Ay
9 -1 roll % [low] lx ly [high] hx hy Ax Ay [pnts]
{ % [low] lx ly [high] hx hy Ax Ay [pnt]
3 copy % [low] lx ly [high] hx hy Ax Ay [pnt] Ax Ay [pnt]
Mlprun1 % [low] lx ly [high] hx hy Ax Ay [pnt] px py
3 copy % [low] lx ly [high] hx hy Ax Ay [pnt] px py [pnt] px py
11 -3 roll % [low] lx ly Ax Ay [pnt] px py [pnt] px py [high] hx hy
/gt Mlpminmax % [low] lx ly Ax Ay [pnt] px py [high] hx hy
8 3 roll % [low] lx ly [high] hx hy Ax Ay [pnt] px py
11 -3 roll % [high] hx hy Ax Ay [pnt] px py [low] lx ly
/lt Mlpminmax % [high] hx hy Ax Ay [low] lx ly
8 3 roll % [low] lx ly [high] hx hy Ax Ay
} forall % [low] lx ly [high] hx hy Ax Ay
pop pop pop pop % [low] lx ly [high]
3 1 roll % [low] [high] lx ly
pop pop % [low] [high]
aload pop % [low] hgx hgy htx hty
5 -1 roll % hgx hgy htx hty [low]
aload pop % hgx hgy htx hty lgx lgy ltx lty
exch % hgx hgy htx hty lgx lgy lty ltx
6 -1 roll % hgx hgy hty lgx lgy lty ltx htx
Mlprun2 % hgx hgy hty lgx lgy lty ctx wtx
8 2 roll % ctx wtx hgx hgy hty lgx lgy lty
4 -1 roll % ctx wtx hgx hgy lgx lgy lty hty
Mlprun2 % ctx wtx hgx hgy lgx lgy cty wty
6 2 roll % ctx wtx cty wty hgx hgy lgx lgy
3 -1 roll % ctx wtx cty wty hgx lgx lgy hgy
Mlprun2 % ctx wtx cty wty hgx lgx cgy wgy
4 2 roll % ctx wtx cty wty cgy wgy hgx lgx
exch % ctx wtx cty wty cgy wgy lgx hgx
Mlprun2 % ctx wtx cty wty cgy wgy cgx wgx
6 2 roll % ctx wtx cgx wgx cty wty cgy wgy
} bind def
% Given scale factors for graphics->text (Ax and Ay) and a point in the
% [gx gy tx ty] form, return the text x and y coordinate that results.
/Mlprun1 { % Ax Ay [gx gy tx ty] Mlprun1 rx ry
aload pop % Ax Ay gx gy tx ty
exch % Ax Ay gx gy ty tx
6 -1 roll % Ay gx gy ty tx Ax
5 -1 roll % Ay gy ty tx Ax gx
mul add % Ay gy ty rx
4 -2 roll % ty rx Ay gy
mul % ty rx Ay*gy
3 -1 roll % rx Ay*gy ty
add % rx ry
} bind def
% Given a low and high coordinate, compute the center and width.
/Mlprun2 { % low high Mlprun2 center width
2 copy % low high low high
add 2 div % low high (low+high)/2
3 1 roll % (low+high)/2 low high
exch sub % (low+high)/2 high-low
} bind def
% Given two points stored as [gx gy tx ty] followed by the scaled
% result (rx, ry), and a comparison function (lt or gt) leave the
% point which is the minimum (or maximum) in each dimension.
/Mlpminmax { % [pnt1] r1x r1y [pnt2] r2x r2y cmp Mlpminmax [pnt] x y
cvx % [pnt1] r1x r1y [pnt2] r2x r2y cmp
2 index % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2x
6 index % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2x r1x
2 index % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2x r1x cmp
exec % [pnt1] r1x r1y [pnt2] r2x r2y cmp take2?
{ % [pnt1] r1x r1y [pnt2] r2x r2y cmp
7 -3 roll % [pnt2] r2x r2y cmp [pnt1] r1x r1y
4 -1 roll % [pnt2] r2x r2y [pnt1] r1x r1y cmp
} if % [pnt1] r1x r1y [pnt2] r2x r2y cmp
1 index % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2y
5 index % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2y r1y
3 -1 roll % [pnt1] r1x r1y [pnt2] r2x r2y r2y r1y cmp
exec % [pnt1] r1x r1y [pnt2] r2x r2y take2y?
{ % [gx ? tx ?] rx ? [? gy ? ty] ? ry
4 1 roll % [gx ? tx ?] rx ry ? [? gy ? ty] ?
pop % [gx ? tx ?] rx ry ? [? gy ? ty]
5 -1 roll % rx ry ? [? gy ? ty] [gx ? tx ?]
aload % rx ry ? [? gy ? ty] gx ? tx ? [gx ? tx ?]
pop pop % rx ry ? [? gy ? ty] gx ? tx
4 -1 roll % rx ry ? gx ? tx [? gy ? ty]
aload pop % rx ry ? gx ? tx ? gy ? ty
[ % rx ry ? gx ? tx ? gy ? ty mark
8 -2 roll % rx ry ? tx ? gy ? ty mark gx ?
pop % rx ry ? tx ? gy ? ty mark gx
5 -2 roll % rx ry ? tx ? ty mark gx gy ?
pop % rx ry ? tx ? ty mark gx gy
6 -2 roll % rx ry ? ty mark gx gy tx ?
pop % rx ry ? ty mark gx gy tx
5 -1 roll % rx ry ? mark gx gy tx ty
] % rx ry ? [pnt]
4 1 roll % [pnt] rx ry ?
pop % [pnt] rx ry
}
{ % [gx gy tx ty] rx ry ? ? ?
pop pop pop % [pnt] rx ry
} ifelse % [pnt] rx ry
} bind def
% Given a size (s), graphics->text scale (A), text center (ct), text
% width (wt), graphics center (cg) and graphics width (wg), compute
% a new graphics->text scale (Anew) and offset (B) and whether or not
% we are done.
% Note, the mysterious .99999 is magic juju which is supposed to ward
% off the possibility that floating point errors would cause this
% routine to return the old A and yet claim not-done.
/Mlp1 { % s A ct wt cg wg Mlp1 Anew B done?
5 index % s A ct wt cg wg s
3 index sub % s A ct wt cg wg s-wt
5 index % s A ct wg cg wg s-wt A
2 index mul % s A ct wg cg wg s-wt A*wg
1 index % s A ct wg cg wg s-wt A*wg s-wt
le % s A ct wg cg wg s-wt fits?
1 index % s A ct wg cg wg s-wt fits? s-wt
0 le % s A ct wg cg wg s-wt fits? impossible?
or % s A ct wg cg wg s-wt done?
dup % s A ct wg cg wg s-wt done? done?
not % s A ct wg cg wg s-wt done? notdone?
{ % s A ct wg cg wg s-wt done? (not done case)
1 index % s A ct wg cg wg s-wt done? s-wt
3 index div % s A ct wg cg wg s-wt done? (s-wt)/wg
.99999 mul % s A ct wg cg wg s-wt done? Anew
8 -1 roll % s ct wg cg wg s-wt done? Anew A
pop % s ct wg cg wg s-wt done? Anew
7 1 roll % s Anew ct wg cg wg s-wt done?
}
if % s Anew ct wg cg wg s-wt done?
8 -1 roll % Anew ct wg cg wg s-wt done? s
2 div % Anew ct wg cg wg s-wt done? s/2
7 -2 roll % Anew cg wg s-wt done? s/2 ct wg
pop sub % Anew cg wg s-wt done? s/2-ct
5 index % Anew cg wg s-wt done? s/2-ct Anew
6 -3 roll % Anew done? s/2-ct Anew cg wg s-wt
pop pop % Anew done? s/2-ct Anew cg
mul sub % Anew done? s/2-ct-Anew*cg
exch % Anew B done?
} bind def
% The following are the workings of the tick, axes and plot labels.
% NOTE a possible source of confusion is that for xticks ie tickmarks on
% the x axis we keep y information and vice versa for yticks
%
% When Minner is found then
%
% assumes that box starts at zero on the left lower side
%
% 0) if outflag = 1 then intop = 0, inrht = 0 outflag = 0
% 1) Save intop largest top of box
% 2) Save inrht largest rht of box
% 3) set inflag notifies that inner marks are present
%
% When Mouter is found then
%
% if inflag is set then
% 1) get vecx and vecy off the stack (points in direcn to move)
% 2) vecx < 1 xadrht = inrht*abs(vecx)
% 3) vecx > 1 xadlft = inrht*abs(vecx)
% 4) vecy < 1 yadtop = intop*abs(vecy)
% 5) vecy > 1 yadbot = intop*abs(vecy)
% 6) set outflag = 1
% 7) clear inflag, inrht, intop
% guaranteed to be zero if no inner is present??
%
%
% These all have effects in Mrotsboxa and Mrotshowa
% check inflag and if set
%
% 1) increase top of bbox by yadtop
% 2) decrease bot of bbox by yadbot
% 3) increase rht of bbox by xadrht
% 4) increase lft of bbox by xadlft
% 5) clear outflag, yadtop, yadbot,
% xadrht, xadlft
%
%/
/intop 0 def
/inrht 0 def
/inflag 0 def
/outflag 0 def
/xadrht 0 def
/xadlft 0 def
/yadtop 0 def
/yadbot 0 def
% This saves the top right corner of the bounding box as a side effect
% This is to allow the adjustment of text placed with Mouter so that
% it misses the Minner text. It is assumed that the ang is 0
% in the same way it is assumed that the text of Mouter is 0 or 90
%
/Minner { % [(str)] gx gy sx sy ang Minner [(str)] gx gy sx sy ang
outflag % do a bit of tidying up if necessary
1
eq
{
/outflag 0 def
/intop 0 def
/inrht 0 def
} if
5 index % [(str)] gx gy sx sy ang [(str)]
gsave
Mtmatrix setmatrix
Mvboxa pop % [(str)] gx gy sx sy ang xlow ylow xhigh yhigh
grestore
3 -1 roll % [(str)] gx gy sx sy ang xlow xhigh yhigh ylow
pop % [(str)] gx gy sx sy ang xlow xhigh yhigh
dup % [(str)] gx gy sx sy ang xlow xhigh yhigh yhigh
intop % is intop smaller than yhigh ?
gt
{
/intop % update if it is
exch def
}
{ pop } % pop if it is not
ifelse % [(str)] gx gy sx sy ang xlow xhigh
dup % [(str)] gx gy sx sy ang xlow xhigh xhigh
inrht % is inrht smaller than xhigh
gt
{
/inrht % update if it is
exch def
}
{ pop } % pop if it is no
ifelse % [(str)] gx gy sx sy ang xlow
pop % [(str)] gx gy sx sy ang
/inflag % set the inflag
1 def
} bind def
% This takes two number off the stack and uses them as a vector in graphics
% coordinates which points in the direction in which the Mouter text is to move
% it calculates the bouding box adjustments yadtop yadbot xadrht and xadlft
% these are in Mboxout to adjust the bounding box to compensate.
/Mouter { % vecx vecy Mouter ..
/xadrht 0 def % reset everything
/xadlft 0 def
/yadtop 0 def
/yadbot 0 def
inflag % was there an inflag ?
1 eq
{
dup % vecx vecy vecy
0 lt
{
dup % vecx vecy vecy
intop % vecx vecy vecy intop
mul
neg % vecx vecy -vecy*intop
/yadtop % make into yadtop
exch def % vecx vecy
} if
dup % vecx vecy vecy
0 gt
{
dup % vecx vecy vecy
intop % vecx vecy vecy intop
mul % vecx vecy vecy*intop
/yadbot % make into yadbot
exch def % vecx vecy
}
if
pop % vecx
dup % vecx vecx
0 lt
{
dup % vecx vecx
inrht % vecx vecx inrht
mul
neg % vecx -vecx*inrht
/xadrht % make into xadrht
exch def % vecx
} if
dup % vecx vecx
0 gt
{
dup % vecx vecx
inrht % vecx vecx inrht
mul % vecx vecx*inrht
/xadlft % make into xadlft
exch def
} if
pop %
/outflag 1 def % set outflag
}
{ pop pop} %
ifelse
/inflag 0 def
/inrht 0 def
/intop 0 def
} bind def
%
% This adjusts the bounding box to account for adjacent text
% This allows the two text strings to avoid each other
% current matrix is the text matrix
/Mboxout { % tlx tly thx thy Mboxout new_tlx new_tly new_thx new_thy
outflag % do nothing unless Minner was found
1
eq
{
4 -1
roll % tly thx thy tlx
xadlft
leadjust
add % tly thx thy tlx xadlft+lead
sub % tly thx thy tlx_new
4 1 roll % tlx_new tly thx thy
3 -1
roll % tlx_new thx thy tly
yadbot % tlx_new thx thy tly yadbot
leadjust % tlx_new thx thy tly yadbot lead
add % tlx_new thx thy tly yadbot+lead
sub % tlx_new thx thy tly_new
3 1
roll % tlx_new tly_new thx thy
exch % tlx_new tly_new thy thx
xadrht % tlx_new tly_new thy thx xadrht
leadjust % tlx_new tly_new thy thx xadrht lead
add % tlx_new tly_new thy thx xadrht+lead
add % tlx_new tly_new thy thx_new
exch % tlx_new tly_new thx_new thy
yadtop % tlx_new tly_new thx_new thy yadtop
leadjust % tlx_new tly_new thx_new thy yadtop lead
add % tlx_new tly_new thx_new thy yadtop+lead
add % tlx_new tly_new thx_new thy_new
/outflag 0 def % reset everything to 0
/xadlft 0 def
/yadbot 0 def
/xadrht 0 def
/yadtop 0 def
} if
} bind def
/leadjust {
(m) stringwidth pop
.5 mul
} bind def
% The offsets sx and sy refer to the graphics coordinate system
% thus they must be altered if a rotation has taken place.
% We must also change the bounding box computations for Minner
%
/Mrotcheck { % sx sy ang Mrotcheck new_sx new_sy ang
dup
90
eq
{
%
% Mouter only applies to strings which are either at 0 or 90
% sort out the box adjust factors
%
% xadrht -> yadbot
% xadlft -> yadtop
% yadtop -> xadrht
% yadbot -> xadlft
yadbot
/yadbot
xadrht
def
/xadrht
yadtop
def
/yadtop
xadlft
def
/xadlft
exch
def
}
if
dup % sx sy ang ang
cos % sx sy ang Cos
1 index % sx sy ang Cos ang
sin % sx sy ang Cos Sin
Checkaux % new_sx sx sy ang
dup % new_sx sx sy ang ang
cos % new_sx sx sy ang Cos
1 index % new_sx sx sy ang Cos ang
sin neg % new_sx sx sy ang Cos -Sin
exch % new_sx sx sy ang -Sin Cos
Checkaux % new_sx new_sy sx sy ang
3 1 roll % new_sx new_sy ang sx sy
pop pop % new_sx new_sy ang
} bind def
%
% Checkaux is an auxilliary function for Mrotcheck it multiplies a
% row vector by a column vector
%
/Checkaux { % r1 r2 dumy c1 c2 Checkaux r1 r2 dumy r1*c1+r2*c2
4 index % r1 r2 dumy c1 c2 r1
exch % r1 r2 dumy c1 r1 c2
4 index % r1 r2 dumy c1 r1 c2 r2
mul % r1 r2 dumy c1 r1 c2*r2
3 1 roll % r1 r2 dumy c2*r2 c1 r1
mul add % r1 r2 dumy c2*r2+c1*r1
4 1 roll % c2*r2+c1*r1 r1 r2 dumy
} bind def
%
% Mboxrot converts the bounding box back from the rotated coordinate
% system to the Mgmatrix system to compensate for a rotation
% It has the opposite functionality of Mrotcheck
% This is not the most neatest or most efficient implementation but it works
%
/Mboxrot { % tlx thx tly thy Mboxrot new_tlx new_thx new_tly new_thy
Mrot
90 eq
{
% old tlx thx tly thy
% new -thy -tly tlx thx
%
brotaux % tlx thx -thy -tly
4 2
roll % -thy -tly tlx thx
}
if
Mrot
180 eq
{
% old tlx thx tly thy
% new -thx -tlx -thx -tly
%
4 2
roll % tly thy tlx thx
brotaux % tly thy -thx -tlx
4 2
roll % -thx -tlx tlx thy
brotaux % -thx -tlx -thy -tly
}
if
Mrot
270 eq
{
% old tlx thx tly thy
% new tly thy -thx -tlx
%
4 2
roll % tly thy tlx thx
brotaux % tly thy -thx -tlx
}
if
} bind def
%
% auxilliary function negate and reverse
/brotaux { % x y boxrotaux -y -x
neg
exch
neg
} bind def
%
% Mabsproc takes a measurement in the default user units and converts
% it to the present units. This allows absolute thickness and dashing
% to work. It works by using a {0, x} vector and using the RMS of the result.
/Mabsproc { % abs thing Mabsproc
0
matrix defaultmatrix
dtransform idtransform
dup mul exch
dup mul
add sqrt
} bind def
%
% Mabswid allows the linewidth to be specified in absolute coordinates
% It does this by recording the graphics transformation matrix at the
% begining of the plot.
% This will break if the scaling in the x and y directions is
% different. This is the case if Mnodistort is false
%
/Mabswid { %abswid Mabswid
Mabsproc
setlinewidth
} bind def
% Mabsdash allows the dashing pattern to be specified in absolute coordinates
% It does this by recording the graphics transformation matrix at the
% begining of the plot.
% This will break if the scaling in the x and y directions is
% different. This is the case if Mnodistort is false
%
/Mabsdash { %[d1 d2 d3 .. ] off Mabsdash
exch % off [d1 d2 d3 ..]
[ % off [d1 d2 d3 ..]
exch % off [ [d1 d2 d3 ..]
{
Mabsproc
}
forall
] % off [ fact*d1 fact*d2 fact*d3 .. ]
exch % [ nd1 nd2 nd3 .. ] off
setdash
} bind def
%MBeginOrig start coordinates in user coordinates
/MBeginOrig { Momatrix concat} bind def
%MEndOrig start coordinates in user coordinates
/MEndOrig { Mgmatrix setmatrix} bind def
/sampledsound where
{ pop}
{ /sampledsound { % str rate nsamp bs proc bool nchan
exch
pop % str rate nsamp bs proc nchan
exch % str rate nsamp bs nchan proc
5 1 roll % str proc rate nsamp bs nchan
mul
4 idiv % str proc rate nsamp bs*nchan/4
mul % str proc rate nsamp*bs*nchan/4
2 idiv % str proc rate nbytes
exch pop % str proc nbytes
exch % str nbytes proc
/Mtempproc exch def
{ Mtempproc pop}
repeat
} bind def
} ifelse
%
% now simple conversion of cmykcolor to rgbcolor
% subtract k and then take complements
/setcmykcolor where
{ pop}
{ /setcmykcolor { % c m y k
4 1
roll % k c m y
[ % k c m y [
4 1
roll % k [ c m y
] % k [ c m y ]
{
1 index % k elem k
sub % k elem-k
1
sub neg % k 1-(elem-k)
dup
0
lt
{
pop
0
}
if
dup
1
gt
{
pop
1
}
if
exch % 1-(elem-k) k
} forall % r g b k
pop
setrgbcolor
} bind def
} ifelse
/Mcharproc % max
{
currentfile
(x)
readhexstring
pop % max val
0 get
exch % val max
div % nval
} bind def
/Mshadeproc % max ncols
{
dup % max ncols ncols
3 1
roll % ncols max ncols
{ % ncols max
dup % ncols max max
Mcharproc % ncols max val
3 1
roll % v1.. ncols max
} repeat
1 eq
{
setgray
}
{
3 eq
{
setrgbcolor
}
{
setcmykcolor
} ifelse
} ifelse
} bind def
/Mrectproc % x0 x1 y0 y1
{
3 index % x0 x1 y0 y1 x0
2 index % x0 x1 y0 y1 x0 y0
moveto % x0 x1 y0 y1
2 index % x0 x1 y0 y1 x1
3 -1
roll % x0 x1 y1 x1 y0
lineto % x0 x1 y1
dup % x0 x1 y1 y1
3 1
roll % x0 y1 x1 y1
lineto % x0 y1
lineto
fill
} bind def
/Mcolorimage % nx ny depth matrix proc bool ncols
{
7 1
roll % ncols nx ny depth matrix proc bool
pop
pop
matrix
invertmatrix
concat % ncols nx ny depth
2 exch exp % ncols nx ny 2^depth
1 sub % ncols nx ny max
3 1 roll % ncols max nx ny
1 1 % ncols max nx ny 1 1
2 index % ncols max nx ny 1 1 ny
{ % ncols max nx ny iy
1 1 % ncols max nx ny iy 1 1
4 index % ncols max nx ny iy 1 1 nx
{ % ncols max nx ny iy ix
dup % ncols max nx ny iy ix ix
1 sub % ncols max nx ny iy ix x0
exch % ncols max nx ny iy x0 x1
2 index % ncols max nx ny iy x0 x1 iy
dup % ncols max nx ny iy x0 x1 iy iy
1 sub % ncols max nx ny iy x0 x1 iy y0
exch % ncols max nx ny iy x0 x1 y0 y1
7 index % ncols max nx ny iy x0 x1 y0 y1 max
9 index % ncols max nx ny iy x0 x1 y0 y1 max ncols
Mshadeproc % ncols max nx ny iy x0 x1 y0 y1
Mrectproc % max nx ny iy
} for % x loop
pop % max nx ny
} for % y loop
pop pop pop pop
} bind def
/Mimage % nx ny depth matrix proc
{
pop
matrix
invertmatrix
concat % nx ny depth
2 exch exp % nx ny 2^depth
1 sub % nx ny max
3 1 roll % max nx ny
1 1 % max nx ny 1 1
2 index % max nx ny 1 1 ny
{ % max nx ny iy
1 1 % max nx ny iy 1 1
4 index % max nx ny iy 1 1 nx
{ % max nx ny iy ix
dup % max nx ny iy ix ix
1 sub % max nx ny iy ix x0
exch % max nx ny iy x0 x1
2 index % max nx ny iy x0 x1 iy
dup % max nx ny iy x0 x1 iy iy
1 sub % max nx ny iy x0 x1 iy y0
exch % max nx ny iy x0 x1 y0 y1
7 index % max nx ny iy x0 x1 y0 y1 max
Mcharproc % max nx ny iy x0 x1 y0 y1 val
setgray % max nx ny iy x0 x1 y0 y1
Mrectproc % max nx ny iy
} for % x loop
pop % max nx ny
} for % y loop
pop pop pop
} bind def
/Ma /Mabswid load def
/a /arc load def
/c /curveto load def
/C /curveto load def
/d /setdash load def
/f /fill load def
/F /fill load def
/g /setgray load def
/gr /grestore load def
/gs /gsave load def
/k /stroke load def
/l /lineto load def
/L /lineto load def
/lw /setlinewidth load def
/m /moveto load def
/n /newpath load def
/p /gsave load def
/P /grestore load def
/r /setrgbcolor load def
/s /stroke load def
/w /setlinewidth load def
/beginmath /MBeginOrig load def
/endmath /MEndOrig load def
end