summaryrefslogtreecommitdiff
path: root/dviware/dvitops/pspict.ps
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