summaryrefslogtreecommitdiff
path: root/usergrps/uktug/baskervi/3_1/pspic.pro
diff options
context:
space:
mode:
Diffstat (limited to 'usergrps/uktug/baskervi/3_1/pspic.pro')
-rw-r--r--usergrps/uktug/baskervi/3_1/pspic.pro227
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