![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to daglib.ps CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / dag|
Return to daglib.ps CVS log | Up to [Research Unix] / researchv10dc / cmd / dag |
1.1 root 1: /dagnodefont /Times-Roman findfont Reset_Node_Pointsize scalefont def
2: /dagedgefont /Times-Roman findfont Reset_Edge_Pointsize scalefont def
3:
4: % interface to set color
5: /setdagcolor {aload pop sethsbcolor} bind def
6:
7: % draw label in bounding box over current point
8: /daglabel {
9: /height exch .8 mul def
10: /width exch .9 mul def
11: /nodename exch def
12: gsave
13: currentpoint newpath
14: 0 0 moveto (X) false charpath flattenpath pathbbox
15: exch pop exch sub /fontheight exch def pop
16: newpath moveto
17: nodename stringwidth pop
18: -2 div fontheight -2 div rmoveto
19: nodename show
20: grestore
21: } bind def
22:
23: /midpoint {
24: exch 4 -1 roll add 2 div
25: 3 1 roll add 2 div
26: } bind def
27:
28: % takes an angle and draws an arrowhead at current point
29: /arrowhead {
30: gsave
31: rotate
32: currentpoint
33: newpath
34: moveto
35: arrowlength arrowwidth 2 div rlineto
36: 0 arrowwidth neg rlineto
37: closepath fill
38: grestore
39: } bind def
40:
41: % takes a point, draws an arrowhead at currentpoint on ray from other point
42: /makearrow {
43: currentpoint exch pop sub exch currentpoint pop sub atan
44: arrowhead
45: } bind def
46:
47: % --- shapes ---
48:
49: /Box {
50: /height exch def
51: /width exch def
52: /nodename exch def
53: currentpoint 2 copy
54: newpath
55: moveto
56: width -2 div
57: height -2 div
58: rmoveto
59: width 0 rlineto
60: 0 height rlineto
61: width neg 0 rlineto
62: closepath
63: stroke
64: moveto
65: nodename width .9 mul height .9 mul daglabel
66: } bind def
67:
68: /Box_clip { % height width x0 y0 x1 y1 -> x1 y1
69: 6 2 roll
70: pop pop pop pop
71: } bind def
72:
73: /Square {
74: 2 copy
75: gt {exch pop dup} {pop dup} ifelse
76: Box
77: } bind def
78:
79: /Square_clip {
80: Box_clip
81: } bind def
82:
83: /Plaintext {
84: daglabel
85: } bind def
86:
87: /Plaintext_clip {
88: Box_clip
89: } bind def
90:
91:
92: /Diamond {
93: /height exch def
94: /width exch def
95: /nodename exch def
96: /hh height 2 div def
97: /hw width 2 div def
98: currentpoint 2 copy
99: newpath
100: moveto
101: 0 hh neg rmoveto
102: hw hh rlineto
103: hw neg hh rlineto
104: hw neg hh neg rlineto
105: closepath
106: stroke
107: moveto
108: nodename width .9 mul height .9 mul daglabel
109: } bind def
110:
111: /between {
112: sub 3 1 roll sub mul 0 ge
113: } bind def
114:
115: /seginter { % x2 y2 x3 y3 -> false OR xinter yinter true
116: % use x0 y0 x1 y1 of current dict
117: /y3 exch def
118: /x3 exch def
119: /y2 exch def
120: /x2 exch def
121: x0 x1 ne x2 x3 ne or
122: {
123: x2 x3 eq { /x2 x0 /x0 x2 def def
124: /y2 y0 /y0 y2 def def
125: /x1 x3 /x3 x1 def def
126: /y1 y3 /y3 y1 def def
127: } if
128:
129: x0 x1 eq {
130: /x x0 def false
131: }
132: {
133: /m0 y1 y0 sub x1 x0 sub div def
134: /b0 y0 m0 x0 mul sub def
135: /m1 y3 y2 sub x3 x2 sub div def
136: /b1 y2 m1 x2 mul sub def
137: m1 m0 eq {
138: b0 b1 ne {false}
139: { /l0lowx x0 x1 min def
140: /l0highx x0 x1 max def
141: /l1lowx x2 x3 min def
142: /l1highx x2 x3 max def
143: l0lowx l1lowx dup l0highx between
144: {/x l1lowx def true}
145: {
146: l0lowx l1highx dup l0highx between
147: {/x l1highx def true}
148: {
149: l1lowx l0lowx dup l1highx between
150: {/x l0lowx def true}
151: {false} ifelse
152: } ifelse
153: } ifelse
154: } ifelse
155: }
156: {
157: /x b1 b0 sub m0 m1 sub div def true
158: } ifelse
159: } ifelse
160: {
161: x2 x x x3 between
162: {
163: y2 m1 x mul b1 add dup y3 between
164: {
165: x
166: m1 x mul b1 add
167: true
168: }
169: {
170: false
171: } ifelse
172: }
173: { false } ifelse
174: }
175: {false} ifelse
176: }
177: {false} ifelse
178: } bind def
179:
180: /Diamond_clip {
181: /y1 exch def
182: /x1 exch def
183: /y0 exch def
184: /x0 exch def
185: 2 div /height2 exch def
186: 2 div /width2 exch def
187: x0 x1 eq y0 y1 eq and {x1 y1} {
188: x0 0 ge y0 0 ge and {
189: width2 0 0 height2 seginter
190: }
191: {
192: x0 0 le y0 0 ge and {
193: 0 height2 width2 neg 0 seginter
194: }
195: {
196: x0 0 le y0 0 le and {
197: width2 neg 0 0 height2 neg seginter
198: }
199: {
200: 0 height2 neg width2 0 seginter
201: } ifelse
202: } ifelse
203: } ifelse
204: not {x1 y1} if
205: } ifelse
206: } bind def
207:
208: /Circle {
209: /y exch def
210: /x exch def
211: /nodename exch def
212: currentpoint 2 copy 2 copy
213: newpath
214: moveto
215: /rad x y lt {x} {y} ifelse 2 div def
216: rad 0 rmoveto
217: rad 0 360 arc stroke
218: moveto
219: nodename x .85 mul y .85 mul daglabel
220: } bind def
221:
222: /Circle_clip {
223: Ellipse_clip
224: } bind def
225:
226: /Doublecircle {
227: /height exch def
228: /width exch def
229: /nodename exch def
230: currentpoint 2 copy 2 copy 2 copy
231: newpath
232: moveto
233: width height lt {width} {height} ifelse
234: 2 div /rad exch def
235: rad 0 rmoveto
236: rad 0 360 arc stroke
237: rad .9 mul 0 360 arc stroke
238: moveto
239: nodename width .85 mul height .85 mul daglabel
240: } bind def
241:
242: /Doublecircle_clip {
243: Circle_clip
244: } bind def
245:
246: /Ellipse {
247: /height exch def
248: /width exch def
249: /nodename exch def
250: currentpoint % save for label
251: % distort user space
252: gsave
253: currentpoint translate
254: 0 0 moveto
255: width height div 1 scale % scale in x
256: height 2 div 0 rmoveto
257: newpath 0 0 height 2 div 0 360 arc stroke
258: grestore
259: moveto nodename width height daglabel
260: } bind def
261:
262: /Ellipse_clip {
263: /y1 exch def
264: /x1 exch def
265: /y0 exch def
266: /x0 exch def
267: 2 div /ry exch def
268: 2 div /rx exch def
269: x0 x1 eq
270: { % degenerate case
271: x1 y1
272: }
273: { % normal case
274: {
275: /gotanswer false def
276: /m y1 y0 sub x1 x0 sub div def % m = (y1 - y0)/(x1 - x0);
277: /b y0 x0 m mul sub def % b = y0 - m * x0
278: % aa = 1/(rx*rx)+ (m*m)/(ry*ry);
279: /aa 1 rx rx mul div m m mul ry ry mul div add def
280: % bb = (2*m*b)/(ry*ry);
281: /bb 2 m b mul mul ry ry mul div def
282: % cc = (b*b)/(ry*ry) - 1;
283: /cc b b mul ry ry mul div 1 sub def
284: m 0 eq {
285: /s0 rx def
286: /s1 rx neg def
287: /gotanswer true def
288: }
289: {
290: % t = b^2 - 4ac
291: /t bb bb mul 4 aa cc mul mul sub def
292: t 0 lt {
293: x1 0 ne y1 0 ne or {
294: % try again, aim at origin
295: /x1 0 def
296: /y1 0 def
297: }
298: {
299: % give up
300: x1 y1
301: exit
302: } ifelse
303: }
304: {
305: /s0 bb neg t sqrt add 2 aa mul div def
306: /s1 bb neg t sqrt sub 2 aa mul div def
307: /gotanswer true def
308: } ifelse
309: } ifelse
310: gotanswer {
311: % by here, s0 and s1 are set.
312: s0 x0 sub abs s1 x0 sub abs le {s0} {s1} ifelse
313: dup m mul b add
314: exit
315: } if
316: } loop
317: } ifelse
318: } bind def
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.