|
|
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.