diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /usergrps/uktug/baskervi/3_1/pspic.pro |
Initial commit
Diffstat (limited to 'usergrps/uktug/baskervi/3_1/pspic.pro')
-rw-r--r-- | usergrps/uktug/baskervi/3_1/pspic.pro | 227 |
1 files changed, 227 insertions, 0 deletions
diff --git a/usergrps/uktug/baskervi/3_1/pspic.pro b/usergrps/uktug/baskervi/3_1/pspic.pro new file mode 100644 index 0000000000..d1529048be --- /dev/null +++ b/usergrps/uktug/baskervi/3_1/pspic.pro @@ -0,0 +1,227 @@ +%pspicmac + +% arrow head +% <arrow length> pspicmacA +/pspicmacA{ +newpath +0 0 moveto +dup neg dup .4 mul rlineto +.8 mul 0 exch rlineto +closepath +fill +} def + +% vector +% <arrow length> <line width> <x> <y> <len*unitlength> pspicmacV +/pspicmacV{ +/X exch def +/y exch def +/x exch def +newpath +0 0 moveto +x 0 eq {0 y 0 lt {X neg}{X} ifelse} + {x 0 lt {X neg}{X}ifelse X y mul x abs div} ifelse +lineto +setlinewidth % @wholewidth +currentpoint +stroke +translate +y x atan +rotate +pspicmacA % @arrowlength +}def + +% line +% <line width> <x> <y> <len*unitlength> pspicmacL +/pspicmacL{ +/X exch def +/y exch def +/x exch def +newpath +0 0 moveto +x 0 eq {0 y 0 lt {X neg}{X} ifelse} + {x 0 lt {X neg}{X}ifelse X y mul x abs div} ifelse +lineto +setlinewidth % @wholewidth +stroke +}def + +% dashed vector +% <arrow length> <line width> <x> <y> <len*unitlength> pspicmacdV +/pspicmacdV{[3] 0 setdash +/X exch def +/y exch def +/x exch def +newpath +0 0 moveto +x 0 eq {0 y 0 lt {X neg}{X} ifelse} + {x 0 lt {X neg}{X}ifelse X y mul x abs div} ifelse +lineto +setlinewidth % @wholewidth +currentpoint +stroke +translate +y x atan +rotate +pspicmacA % @arrowlength +}def + +% dashed line +% <line width> <x> <y> <len*unitlength> pspicmacdL +/pspicmacdL{[3] 0 setdash +/X exch def +/y exch def +/x exch def +newpath +0 0 moveto +x 0 eq {0 y 0 lt {X neg}{X} ifelse} + {x 0 lt {X neg}{X}ifelse X y mul x abs div} ifelse +lineto +setlinewidth % @wholewidth +stroke +}def + +% circle +% <line width> <diam*unitlength> pspicmacC +/pspicmacC{ +0 0 3 2 roll +2 div 0 360 arc +setlinewidth % @wholewidth +stroke +}def + +% dot aka circle* +% <diam*unitlength> pspicmacD +/pspicmacD{ +0 0 3 2 roll +2 div 0 360 arc fill +}def + +% oval +% <0|1> <0|1> <0|1> <0|1> <line width> <max-radius*unitlength> <x*unitlength> <y*unitlength> pspicmacO +/pspicmacO{ +/y exch 2 div def +/x exch 2 div def +/R exch def +x y lt + {R x lt {/r R def}{/r x def} ifelse} + {R y lt {/r R def}{/r y def} ifelse} ifelse +setlinewidth % @wholewidth +1 eq +{newpath + x neg 0 moveto + x neg y 0 y r arcto 4 {pop} repeat + 0 y lineto + stroke}if +1 eq +{newpath + x 0 moveto + x y 0 y r arcto 4 {pop} repeat + 0 y lineto + stroke}if +1 eq +{newpath + x neg 0 moveto + x neg y neg 0 y neg r arcto 4 {pop} repeat + 0 y neg lineto + stroke}if +1 eq +{newpath + x 0 moveto + x y neg 0 y neg r arcto 4 {pop} repeat + 0 y neg lineto + stroke}if +}def + + +% Vector +% <arrow length> <line width> <x*unitlength> <y*unitlength> pspicmacV2 +/pspicmacV2{ +2 copy exch +atan +/a exch def +2 copy +newpath +0 0 moveto +lineto % <x*unitlength> <y*unitlength> +3 2 roll +setlinewidth % @wholewidth +stroke +translate % <x*unitlength> <y*unitlength> +a rotate +pspicmacA % @arrowlength +}def + +% A rather flexible arrow routine. First, some arithmetic, called: x phi h theta +/mvwd{ cos mul mul 2 div add } def +/mvht{ sin mul mul 2 div add } def + +% Called: dx0 dy0 dx1 dy1 x0 y0 x1 y1 linethickness headwidth headlength arrowfl +/arrowfl +{ newpath gsave + /headlength exch def + /halfheadthickness exch 2 div def /thickness exch def + /tipy exch def /tipx exch def /taily exch def /tailx exch def + /tipoffy exch def /tipoffx exch def /tailoffy exch def /tailoffx exch def + /dx tipx tailx sub def /dy tipy taily sub def + /arrowlength dx dx mul dy dy mul add sqrt def + /angle dy dx atan def + /halfthickness thickness 2 div def + + /tailx tailx 1.4 tailoffx angle mvwd def + /taily taily 1.4 tailoffy angle mvht def + /tipx tipx -1.4 tipoffx angle mvwd def + /tipy tipy -1.4 tipoffy angle mvht def + /dx tipx tailx sub def /dy tipy taily sub def + /arrowlength dx dx mul dy dy mul add sqrt def + /base arrowlength headlength sub def + + tailx taily translate angle rotate + 20 setmiterlimit 1 setlinecap thickness setlinewidth + arrowlength 0 moveto base halfheadthickness lineto + arrowlength 0 moveto base halfheadthickness neg lineto + arrowlength 0 moveto 0 0 lineto stroke grestore newpath} def + +% Line +% <line width> <x*unitlength> <y*unitlength> pspicmacL2 +/pspicmacL2{ +newpath +0 0 moveto +lineto % <x*unitlength> <y*unitlength> +setlinewidth % @wholewidth +stroke +}def + +% Curve +% <line width> <x*unitlength> <y*unitlength> <+/-> pspicmacL2 +/pspicmacC2{ +/s exch def +/y exch def +/x exch def +newpath +0 0 moveto +0 0 +x 2 div y 10 div s mul add +y 2 div x 10 div s mul sub +x y +curveto +setlinewidth % @wholewidth +stroke +}def + +% dashed Curve +% <line width> <x*unitlength> <y*unitlength> <+/-> pspicmacL2 +/pspicmacdC2{[3] 0 setdash +/s exch def +/y exch def +/x exch def +newpath +0 0 moveto +0 0 +x 2 div y 10 div s mul add +y 2 div x 10 div s mul sub +x y +curveto +setlinewidth % @wholewidth +stroke +}def |