path: root/Master/texmf-dist/dvips/geomsty/math.pro

% 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