From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- dviware/dvitops/pspict.ps | 142 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 dviware/dvitops/pspict.ps (limited to 'dviware/dvitops/pspict.ps') diff --git a/dviware/dvitops/pspict.ps b/dviware/dvitops/pspict.ps new file mode 100644 index 0000000000..ec89398950 --- /dev/null +++ b/dviware/dvitops/pspict.ps @@ -0,0 +1,142 @@ +%! +% $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 + -- cgit v1.2.3