blob: ec893989509b322f0775b9034fb31bb468a912dc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
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
|
