% grestore
% special commands for setting up tree macros
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. 

/@beginspec {gsave texpsmatrix setmatrix treedict begin} def
/@endspec {end grestore} def

%% definition of letter matrix
%/testorient
%  { gsave
%    matrix defaultmatrix
%    72 Resolution div dup neg 
%    3 -1 roll scale          % set scaling to 1.
%    310 -3005 
%    3 -1 roll translate      % move origin to top (these are not exactly 1"
%    Mtrx 
%  } def
%

% /Landscape false def 

% for landscape Landscape=true, letter Landscape=false
/texpsmatrix 
matrix defaultmatrix 
isls {dup [0.0 -1.0 1.0 0.0 0.0 0.0] exch concatmatrix} if
def
userdict begin
/bop-hook
{/texpsmatrix 
matrix defaultmatrix 
isls {dup [0.0 -1.0 1.0 0.0 0.0 0.0] exch concatmatrix} if
def}
B
end
%/texpsmatrix matrix defaultmatrix def
/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
%                           *--------*--------*
%                           |                 |
%                           |                 |
%   farleft        nodeleft *  (nodebox)      * noderight    farright
%                           |                 |
%                           |                 |
%                           *--------*--------*
%                 nodebotleft     nodebottom  nodebotright
%
%
%  farbotleft                     farbottom

% 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 arrow -

/arrowdict 14 dict def
arrowdict begin
	/mtrx matrix def
end

/arrow {arrowdict begin
	/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
	0 0 moveto
	headlength neg halfheadthickness neg lineto
	headlength neg halfheadthickness lineto
	closepath
savematrix setmatrix
	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 4 2 roll 4 copy moveto lineto
		gsave
		newpath
		4 2 roll arrowwidth arrowlength arrow	
		fill
		grestore
                stroke
               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
		arrowwidth arrowlength arrow	
		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
%
%

% nodename rightcur x1 y1 x2 y2
/rightcur {nodes exch get dup noderight 3 -1 roll farright} def
/leftcur {nodes exch get dup nodeleft 3 -1 roll farleft} def
/topcur {nodes exch get dup nodetop 3 -1 roll fartop} def
/bottomcur {nodes exch get dup nodebottom 3 -1 roll farbottom} def
/topleftcur {nodes exch get dup nodetopleft 3 -1 roll fartopleft} def
/toprightcur {nodes exch get dup nodetopright 3 -1 roll fartopright} def
/bottomleftcur {nodes exch get dup nodebottomleft 3 -1 roll farbottomleft} def
/bottomrightcur {nodes exch get dup nodebottomright 3 -1 roll farbottomright} 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

/nodecurve {gsave
            4 2 roll moveto
            6 2 roll 4 2 roll curveto 
            stroke
            grestore} def

/arrownodecurve {gsave
            4 2 roll moveto
            6 2 roll 4 2 roll 4 copy 10 4 roll curveto 
	    gsave
	    newpath
            arrowwidth arrowlength arrow
            fill
	    grestore
            stroke
            grestore} 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