% grestore
% special commands for setting up tree macros
%% version .91  - May 16, 1995

TeXDict begin

% the commands needed to get any of this working.  The first section
% may need to be modified if different dvi to postscript programs are
% used. 

% redefinition of /@beginspec suggested by Gintas Grigelionis
% (gintas@theophys.kth.se) 5/95.  also dropped bop_hook and texpsmatrix 
%
% /@beginspec {gsave texpsmatrix setmatrix treedict begin} def
/@beginspec {gsave
             Resolution 72 div VResolution -72 div scale
             treedict begin} def
/@endspec {end grestore} def

% for landscape Landscape=true, letter Landscape=false
% In dvips 5.5 and later, the matrix in landscape was changed from
% [0.0 -1.0 1.0 0.0 0.0 0.0] to the current setting of [0.0 1.0 -1.0
% 0.0 0.0 0.0].  If you are using an earlier version, switch back.

/treedict 200 dict def treedict begin

%  num pt num  (converts a number in TeX pts (72.27 pts/in) to
%  postscript pts (72pts/in)
/pt {72 mul 72.07 div} def

% end of first section

% definition of a node as a box containing the following information
% The x y location of the lower left hand corner of the box
% the height of the box (h) 
% the width of the box (w)
% nodemargin is added to all sides to ensure a boundary around the box
% str w h d node -
% (nodemargin is defined in the TeX file)
/nodemargin 2 def
/nodes 100 dict def
/node { /dpth exch def
	       /hght exch def
	       /wdth exch def
       	       4 dict dup begin
                 /x /y currentpoint 
                       dpth sub nodemargin sub exch 3 1 roll def
                    nodemargin sub def
                 /h hght dpth add nodemargin dup add add def
                 /w wdth nodemargin dup add add def
               end nodes 3 1 roll put} def


% commands to find various locations around the nodebox
%
%                 nodetopleft      nodetop    nodetopright
%                           *--------*--------*
%                           |                 |
%                           |                 |
%                 nodeleft *  (nodebox)      * noderight
%                           |                 |
%                           |                 |
%                           *--------*--------*
%                 nodebotleft     nodebottom  nodebotright
%


% all of these take
% dict nodebottom x1 y1   [dict has x y h w defined]
/nodebottom {begin 
               	x w 2 div add y
               	end} def
/nodetop {begin
            	x w 2 div add y h add
            	end} def
/nodeleft {begin
             	x y h 2 div add
            	end} def
/noderight {begin
              	x w add y h 2 div add
              	end} def
/nodetopleft {begin
		x y h add
		end} def
/nodetopright {begin
	 	x w add y h add
		end} def
/nodebottomleft {begin
		x y
		end} def
/nodebottomright {begin
		x w add y
		end} def

% some more locations of use
/farright {begin
		x w add depth add h 2 div y add
	end} def

/farleft {begin
		x depth sub h 2 div y add
	end} def

/farbottom {begin
		x w 2 div add y depth sub
	end} def

/fartop {begin
		x w 2 div add y h add depth add
	end} def

/farbottomleft {begin
                x depth 45 cos mul sub y depth 45 sin mul sub
	end} def

/farbottomright {begin
                x w add depth 45 cos mul add y depth 45 sin mul sub
	end} def

/fartopright {begin
                x w add depth 45 cos mul add y h add depth 45 sin mul add
	end} def

/fartopleft {begin
                x depth 45 cos mul sub y h add depth 45 sin mul add
	end} def


% connects two nodes with a straight line 
% add location information (e.g., whether to go from
% nodetop to nodeleft ...

% nodename1 loc1 nodename2 loc2 nodeconnect -
% e.g., a nodetop b nodebottom nodeconnect

% to see if straight lines are indeed straight
% x1 x2 alignpoint x1' x2'  finds out if the two numbers are less than
% one pixel apart if so make x1'=x2'

/alignpoint {2 copy sub abs 1 le {add 2 div round dup} if} def

% nodelocation nodename getnodepoint x y 
/getnode {nodes exch get} def

% xfrom yfrom xto yto nodeconnect -
/nodeconnect {       gsave
		       transform 4 2 roll
                       transform
		       exch 4 1 roll alignpoint
                       4 2 roll alignpoint
                       4 1 roll exch
                       itransform moveto itransform lineto
                       stroke
                     grestore
                     } def

% arrowheads
% xtail ytail xtip ytip headthickness headlength insetlength arrow -

/arrowdict 15 dict def

arrowdict begin
	/mtrx matrix def
end

/arrow {arrowdict begin
	/insetlength exch def
	/headlength exch def
	/halfheadthickness exch 2 div def
	/tipy exch def /tipx exch def
	/taily exch def /tailx exch def

	/dx tipx tailx sub def
	/dy tipy taily sub def
	/angle dy dx atan def
	
	/savematrix mtrx currentmatrix def
	tipx tipy translate
	angle rotate
% following is for arrow
	0 0 moveto
	headlength neg halfheadthickness neg lineto
        headlength insetlength sub neg 0 lineto
	headlength neg halfheadthickness lineto
	closepath
        fill
        savematrix setmatrix
	end } def

% does regular filled arrowhead
/arrowfill {gsave
	newpath
	arrowwidth arrowlength arrowinset arrow
	grestore} def

% draws line for arrow but not arrow head(s)
% xtail ytail xtip ytip tailfix tipfix arrowline
/arrowline {arrowdict begin
	gsave
	    newpath
        /tipfix exch def
        /tailfix exch def
	/tipy exch def /tipx exch def
	/taily exch def /tailx exch def

	/dx tipx tailx sub def
	/dy tipy taily sub def
	/angle dy dx atan def
	
	/savematrix mtrx currentmatrix def
	tipx tipy translate
	angle rotate
        tipfix neg 0 moveto
        savematrix setmatrix
	/savematrix mtrx currentmatrix def
        tailx taily translate
        angle rotate
        tailfix 0 lineto
        savematrix setmatrix
        stroke
            grestore
	end} def


% xfrom yfrom xto yto testcmd -
% arrownodeconnect
/arrownodeconnect{    gsave
		transform 4 2 roll
                transform
		exch 4 1 roll alignpoint
                4 2 roll alignpoint
                4 1 roll exch
                itransform 4 2 roll itransform
% line
                4 copy 
		0 arrowdict begin arrowlength arrowinset sub end arrowline
% arrow
		gsave
		newpath
		arrowfill
		grestore
               grestore
		} def


/doublearrownodeconnect{    gsave
		transform 4 2 roll
                transform
		exch 4 1 roll alignpoint
                4 2 roll alignpoint
                4 1 roll exch
                itransform 4 2 roll itransform
% line
%		4 copy moveto lineto
%		stroke
                4 copy 
		arrowdict begin arrowlength arrowinset sub end dup arrowline
		4 copy 
% arrow at one end
		gsave
		newpath
		arrowfill
		grestore
% arrow at other end
	        gsave
		newpath
		4 2 roll arrowfill
		grestore
               grestore
		} def


% connecting with a bar like
%     _______________
%     |             |
% or like
%     _______________
%     |             |
%     |           node
%    node

% depth fromnode fromloc tonode toloc
% depth x1 y1 x2 y2 barnodeconnect -
/barnodeconnect {4 2 roll
          2 copy moveto
          5 -1 roll add
          dup 3 1 roll
          lineto
          2 index exch
          lineto lineto
          stroke
         } def

/arrowbarnodeconnect {4 2 roll
          2 copy moveto
          5 -1 roll add
          dup 3 1 roll
          lineto
          2 index exch
          4 copy lineto lineto
		gsave
		newpath
		4 2 roll
		arrowfill
		fill
		grestore
         stroke
         } def


% Takes two nodes and forms a triangle
%         node1
%         /\
%        /  \
%        ----
%       nodess
%
% fromnodename tonodename nodetriangle -
/nodetriangle {
		gsave
                        exch
			nodes exch get nodebottom moveto
			dup
			nodes exch get nodetopleft lineto
			nodes exch get nodetopright lineto
			closepath
			stroke
		grestore } def


% not sure what I am using the following for
%  x y x y slope num
/slope {/y1 exch def
	/x1 exch def
	/y0 exch def
	/x0 exch def
	y1 y0 sub x1 x0 sub div
	} def

% x y x y midpoint x y 
/midpoint {/y1 exch def
	   /x1 exch def
	   /y0 exch def
	   /x0 exch def
	   x1 x0 sub abs
	   x1 x0 ge {x0 add} {x1 add} ifelse
	   y1 y0 sub abs
	   y1 y0 ge {y0 add} {y1 add} ifelse
	} def


% variant of curveto where x1 y1 = x2 y2
/tancurveto {1 index exch
	curveto} def

/nodetancurve {/depth exch def
	    /to exch def
	    /from exch def
		gsave
		nodes from get noderight moveto

		nodes to get noderight 
		tancurveto
		stroke
		grestore } def



% the node curves draw curves between two points
%
% this swaps a dictionary around an angle, pulls out depth, & dismisses
%   the dictionary.
% node locname farloc angle depth

/getloc {3 -1 roll
          nodes exch get dup 
          begin depth end
          3 1 roll
          exch cvx exec
          4 2 roll} def

% nodename rightcur x1 y1 x2 y2
/rightcur {0 /noderight getloc} def
/leftcur {180 /nodeleft getloc } def
/topcur {90 /nodetop getloc} def
/bottomcur {270 /nodebottom getloc} def
/topleftcur {135 /nodetopleft getloc} def
/toprightcur {45 /nodetopright getloc} def
/bottomleftcur {225 /nodebottomleft getloc} def
/bottomrightcur {315 /nodebottomright getloc} def

% (depth predefined) x1 y1 x2 y2 x3 y3 x4 y4 nodecurve -
% where  nodename nodeposition produces x1 y1 x2 y2
% where x1 y1 are the endpoint, x2 y2 end-control, etc.

% adjustments for arrowheads, etc.
/arrowfiddledict 10 dict def

% x1 y1 angle depth shift twist arrowfiddle x3 y3 x4 y4
%  where x3 y3 are revised endpoint for arrow-headed bezier curves
/arrowfiddle {arrowfiddledict begin
        /twist exch def
        /shift exch def
	/shaft exch def
	/angle exch twist add def
        /tipy exch def /tipx exch def
        tipx angle cos shaft mul add
        tipy angle sin shaft mul add
	tipx angle cos shift mul add
        tipy angle sin shift mul add
  end} def
	
/nodecurve {gsave
            0 fromangle arrowfiddle moveto
            6 2 roll
            0 toangle arrowfiddle curveto 
            stroke
            grestore} def

/arrownodecurve {gsave
            0 fromangle arrowfiddle  % adjust from angle
            moveto
            6 2 roll           
            4 copy 10 4 roll            % prepare arrowhead material
            arrowlength arrowinset sub  %arrowfiddle param.
            toangle                     % ditto
            arrowfiddle        
            curveto            
            0 toangle arrowfiddle arrowfill
            stroke
            grestore} def

/arrow2nodecurve {gsave
            4 copy
            0 fromangle arrowfiddle arrowfill
            arrowlength arrowinset sub fromangle arrowfiddle
            moveto
            6 2 roll           
            4 copy 10 4 roll            % prepare arrowhead material
            arrowlength arrowinset sub  %arrowfiddle param.
            toangle                     % ditto
            arrowfiddle        
            curveto            
            0 toangle arrowfiddle arrowfill
            stroke
            grestore} def


% commands for doing things along line
% blong (predefined)  xfrom yfrom xto yto delink -
% need to find halfway point
/delink {       gsave
		4 copy newslope
		6 2 roll newmidpoint
                delinkline } def

%% calculated (dx dy xmid ymid) now moveto midpoint
%		moveto dup 0 eq 
%% duplicate dy and check whether line is horizontal
%		{blong 2 div neg 0 rmoveto blong 0 rlineto 2 pop}
%% line not horizontal so check whether vertical
%		{exch dup 0 eq 
%		   {0 blong 2 div neg rmoveto 0 blong rlineto 2 pop}
%% If neither than calculate standard case (dy dx)
%                   {div neg dup dup mul 1 add sqrt
%                    blong exch div
%                    2 copy mul 2 copy 2 div neg exch 2 div neg exch
%                    rmoveto rlineto 1 pop} ifelse} ifelse
%                stroke
%                grestore
%                } def

% actually draws the line
% dx dy xmid ymid delinkline -

/delinkline {	moveto dup 0 eq 
% duplicate dy and check whether line is horizontal
		{blong 2 div neg 0 rmoveto blong 0 rlineto 2 pop}
% line not horizontal so check whether vertical
		{exch dup 0 eq 
		   {0 blong 2 div neg rmoveto 0 blong rlineto 2 pop}
% If neither than calculate standard case (dy dx)
                   {div neg dup dup mul 1 add sqrt
                    blong exch div
                    2 copy mul 2 copy 2 div neg exch 2 div neg exch
                    rmoveto rlineto 1 pop} ifelse} ifelse
                stroke
                grestore
                } def


%
%  delink curve
% blong (predefined) x0 y0 x1 y1 x2 y2 x3 y3 delinkcurve -

/delinkcurve { 8 copy 8 copy
               bezslope 10 2 roll % push to back
               bezmidpoint
               delinkline 
} def

% x0 y0 x1 y1 x2 y2 x3 y3 xyarrange x0 x1 x2 x3 y0 y1 y2 y3
                             % x0 y0 x1 y1 x2 y2 x3 y3
/xyarrange { exch            % x0 y0 x1 y1 x2 y2 y3 x3 
           3 1 roll          % x0 y0 x1 y1 x2 x3 y2 y3
           5 -1 roll         % x0 y0 x1 x2 x3 y2 y3 y1
           7 -1 roll         % x0 x1 x2 x3 y2 y3 y1 y0
           exch              % x0 x1 x2 x3 y2 y3 y0 y1
           4 2 roll } def    % x0 x1 x2 x3 y0 y1 y2 y3

% x0 x1 x2 x3 calcx xn    8(x3+3x2+3x1+x0)=xn
/calcx { exch 3 mul
         3 -1 roll 3 mul
         add add add 8 mul} def

% x0 x1 x2 x3 calcx xn    x3+x2-x1-x0=xn
/calcy { add exch sub exch sub } def


% x0 y0 x1 y1 x2 y2 x3 y3 bezmidpoint xm ym
% using the following equations
% xb=8*(x3+3x2+3x1+x0)
% yb=8*(y3+3y2+3y1+y0)

/bezmidpoint {xyarrange
calcx 5 1 roll calcx exch
} def


% x0 y0 x1 y1 x2 y2 x3 y3 bezslope dx dy
% equations are dx=x3+x2-x1-x0 
%               dy=y3+y2-y1-y0 
/bezslope {xyarrange
calcy 5 1 roll calcy exch
} def

% finds midpoint between two points   xfrom yfrom xto yto newmidpoint xmid ymid
/newmidpoint {  exch
             	4 -1 roll
		add 2 div
		3 1 roll
		add 2 div
		} def

% finds slope between two points: xfrom yfrom xto yto newslope dx dy
/newslope {	4 -1 roll
		exch
		4 1 roll
		sub 3 1 roll sub exch
		} def


%% commands for drawing things around nodes
% nodename nodebox -
/nodebox {nodes exch get begin
                   gsave
                     newpath
                     x y moveto
		     h w dobox
		    cleanup
	             stroke
                   grestore
                  end} def


% nodename nodecircle -
% would be nice to have a parameter that adjusts diameter of circle
% depth nodename nodecircle -
/nodecircle {nodes exch get begin
		gsave
		newpath
		w 2 div x add h 2 div y add 
		w w mul h h mul add sqrt 2 div 4 -1 roll add
		360 0 arcn 
		cleanup
		stroke
		grestore
	    end} def

% no cleanup
/nodecircletrans {nodes exch get begin
		gsave
		newpath
		w 2 div x add h 2 div y add 
		w w mul h h mul add sqrt 2 div 4 -1 roll add
		360 0 arcn 
		stroke
		grestore
	    end} def

% nodename nodeoval -
/nodeoval {nodes exch get begin
	gsave
	newpath
	x 2 sub y 2 sub moveto 
	h 4 add w 4 add dooval
	cleanup
	stroke
	grestore
	end } def

%  ratio depth nodename testnodeoval -
%  ratio should be between 0 and 1
/testnodeoval {nodes exch get begin
	gsave
	newpath
        h h mul w w mul add sqrt div dup dup dup
        w mul neg x add exch 
        h mul neg y add 
        moveto
	dup
        h mul 2 mul h add exch
        w mul 2 mul w add  
	testdooval
	stroke
	grestore
	end } def


/cleanup{gsave 
	x y moveto
	h nodemargin sub .5 add w nodemargin sub .5 add doccbox
	1 setgray fill grestore
}def

/boxdict 4 dict def
boxdict /mtrx matrix put

/dobox{boxdict begin
	/w exch def
	/h exch def
	/savematrix mtrx currentmatrix def
	0 h rlineto
        w 0 rlineto
        0 h neg rlineto
        closepath
	savematrix setmatrix
        end} def

% do box in counterclockwise fashion
/doccbox{boxdict begin
	/w exch def
	/h exch def
	/savematrix mtrx currentmatrix def
	w 0 rlineto
	0 h rlineto
	w neg 0 rlineto
	closepath
	savematrix setmatrix
	end} def


/ovaldict 6 dict def
ovaldict /mtrx matrix put

% h w ovaldict -
/dooval{ovaldict begin
	/w exch def
	/h exch def
	/savematrix mtrx currentmatrix def
	0 h 2 div rmoveto
	0 h 2 div nodemargin sub
	nodemargin h 2 div
	w 2 div h 2 div
	rcurveto
	w 2 div nodemargin sub 0
        w 2 div nodemargin neg 
	w 2 div h 2 div neg
	rcurveto
	0 h 2 div neg nodemargin add 
	nodemargin neg h 2 div neg
	w 2 div neg h 2 div neg
	rcurveto
	w 2 div neg nodemargin add 0
	w 2 div neg nodemargin
	w 2 div neg h 2 div 
	rcurveto
	savematrix setmatrix
	end} def

% give height and width of a box and the lower left hand point
% produce a curve that will enclose the box.
% initial point already defined
% ratio h w testdooval -
/testdooval{ovaldict begin
	/w exch def
	/h exch def
	/r exch def
	h 2 div neg r mul dup 
        h 2 div dup 
        r mul 3 1 roll 
        2 r sub mul
	0 h
	rcurveto
	w 2 div dup
        r mul exch
        2 r sub mul 
        w 2 div r mul dup 3 1 roll
        w 0
	rcurveto
	h 2 div r mul dup
        h 2 div neg dup
        r mul 3 1 roll
        2 r sub mul
        0 h neg
	rcurveto
        w 2 div neg dup
        r mul exch
        2 r sub mul 
        w 2 div neg r mul dup 3 1 roll
        w neg 0
	rcurveto
	end} def

end % of treedict

end % of TeXdict
% gsave