%! % $Header: /usr/jjc/dvitops/RCS/pspict.ps,v 1.2 89/02/20 14:22:58 jjc Rel $ /min { 2 copy gt {exch} if pop } bind def % x y roundpoint -- rx ry /roundpoint { transform round exch round exch itransform } bind def % x y sign -- (y < 0 ? -x : x) /sign { 0 lt { neg } if } bind def % x y len endpoint -- endx endy /endpoint { %def /len exch def /y exch def /x exch def x 0 eq { %ifelse currentpoint len y sign sub } { %else currentpoint len x abs div y mul sub exch len x sign add exch } ifelse } bind def % linewidth diameter circle -- /circle { %def gsave currentpoint newpath roundpoint 3 -1 roll 2 div 0 360 arc setlinewidth stroke grestore } bind def % diameter dot -- /dot { %def gsave % a zero-length line is a convenient way to draw a solid circle 1 setlinecap [] 0 setdash setlinewidth currentpoint roundpoint moveto 0 0 rlineto stroke grestore } bind def % linewidth dx dy len line -- /line { %def gsave 1 setlinecap endpoint roundpoint currentpoint roundpoint moveto lineto setlinewidth stroke grestore } bind def % arrowlength arrowheight linewidth dx dy len vector -- /vector { %def 4 copy line 3 copy endpoint moveto pop arrowhead } bind def /char 1 string def % linewidth width height ([tblr]*) oval -- /oval { %def gsave 1 setlinecap 1 setlinejoin /t false def /b false def /l false def /r false def { char exch 0 exch put char cvn true def } forall 2 div /halfheight exch def 2 div /halfwidth exch def halfheight halfwidth min /radius exch def currentpoint roundpoint translate newpath % we are assuming y coordinates increase down the page % this code won't print a dashed [l] oval as well as it might l t or not { %ifelse % bottom right quadrant halfwidth 0 moveto halfwidth radius sub halfheight radius sub radius 0 90 arc 0 halfheight lineto } { %else 0 halfheight moveto } ifelse r t or not { %ifelse % bottom left quadrant halfwidth neg radius add halfheight radius sub radius 90 180 arc halfwidth neg 0 lineto } { %else halfwidth neg 0 moveto } ifelse r b or not { %ifelse % top left quadrant halfwidth neg radius add halfheight neg radius add radius 180 270 arc 0 halfheight neg lineto } { %else 0 halfheight neg moveto } ifelse l b or not { %if % top right quadrant halfwidth radius sub halfheight neg radius add radius 270 360 arc halfwidth 0 lineto } if setlinewidth stroke grestore } bind def % length height linewidth dx dy arrowhead -- /arrowhead { %def gsave 1 setlinejoin 1 setlinecap neg exch atan rotate currentpoint roundpoint moveto setlinewidth 2 div 1 index neg 1 index neg rmoveto 2 copy rlineto exch neg exch rlineto closepath gsave [] 0 setdash stroke grestore fill grestore } bind def % linewidth width height ellipse -- /tempmatrix matrix def /ellipse { %def tempmatrix currentmatrix pop currentpoint roundpoint translate newpath scale 0 0 1 0 360 arc tempmatrix setmatrix setlinewidth stroke } bind def