CRVOFSET.PS

%!PS-Adobe-2.0
%%Title: Arrow1.ps
%%Author: Rob
%%EndComments

%Routines for arrow drawing

/tomove { %def
	/newy exch def
	/newx exch def
	/firstx newx def
	/firsty newy def
	/ovr 0 def
	newx newy transform
	/cpy exch def
	/cpx exch def
}bind def

/toline { %def
	/oldx newx def
	/oldy newy def
	/newy exch def
	/newx exch def
	/dx newx oldx sub def
	/dy newy oldy sub def
	/dist dx dup mul dy dup mul add sqrt def
	dist 0 ne { %if
		/dsx dx dist div ovr mul def
		/dsy dy dist div ovr mul def
		oldx dsx add oldy dsy add transform
		/cpy exch def /cpx exch def
		/pathdist pathdist dist add def
		 { %loop
			{ %ifelse
				charcount str length lt
				{ setchar } { exit } ifelse }
			}{ %elseif
				/ovr setdist pathdist sub def
				exit
			} ifelse
		} loop					
	} if
} bind def

/tocurve { %def
	{ (ERROR! No curves after flattenpath!) print
} bind def

/closepathproc { %def
	firstx firsty toline
	firstx firsty tomove
} bind def

/setchar { %def
	gsave
	
	cpx cpy itransform translate
	dx dy atan rotate
	0 0 moveto
	char show
	currentpoint transform
	/cpy exch def /cpx exch def
	
	grestore
	
	/setdist setdist charwidth add def
}def


%Rename text commands

	/*scalefont /scalefont load def

     	/*show /show load def    %rename show

%Redefine text commands

	/scalefont { %def
		dup
		/fsize exch def
		scalefont
	} bind def

	/show { %def             %redefine show for filled characters only
                { %forall
                    /charcode exch def
                    /thischar ( ) dup 0 charcode put def
                    
                    gsave
                        currentpoint   %save starting point
                        /currenty exch def
                        /currentx exch def
		thischar cvs show
		currentx currenty moveto
                        thischar false charpath  %get character outline
                      	flattenpath
		/sfont currentfont def
		/Symbol findfont fsize 10 div scalefont setfont
		/char (\257) def
		/charwidth char stringwidth pop def
		{ tomove } { toline } { tocurve } { toclose } pathforall
		sfont findfont fsize scalefont setfont
                    grestore
               
                    thischar stringwidth pop 0 rmoveto
                    currentpoint pop currenty moveto
                } forall
     } bind def
%%EndProlog

/Helvetica findfont 90 scalefont setfont
100 100 moveto
(viral) show

showpage