nlsop/graphs.header

   1 % Postscript header file for version 1.53 of graphs.sty. Frank Drewes, 19.12.2000
   2 % Small bug in psdirbowoncircle and psdirbowonrectangle removed on 8. Dec. 97
   3 % (hopefully)
   4
   5 /psloadcolour % [ r g b ] colour array
   6 { aload pop setrgbcolor } def
   7
   8 /psrectangle % width, height, interior color, linecolour, linewidth, linedash
   9 {/filled exch def
  10 0 setdash
  11 /lwidth exch def
  12 /lcolour exch def
  13 /colour exch def
  14 /height exch def
  15 /width exch def
  16 width lwidth gt
  17   {/width width lwidth sub def}
  18   {/width 0 def}
  19 ifelse
  20 height lwidth gt
  21   {/height height lwidth sub def}
  22   {/height 0 def}
  23 ifelse
  24 newpath
  25 width 2 div neg height 2 div neg moveto
  26 width 0 rlineto
  27 0 height rlineto
  28 width neg 0 rlineto
  29 closepath
  30 filled {
  31   colour psloadcolour
  32   gsave
  33   fill
  34   grestore
  35 } if
  36 lcolour psloadcolour
  37 lwidth setlinewidth
  38 stroke} def
  39
  40 %-----------------------------------------------------------------------------%
  41
  42 /pscircle % diameter, interior color, line colour, line width, line dash
  43 {/filled exch def
  44 0 setdash
  45 /lwidth exch def
  46 /lcolour exch def
  47 /colour exch def
  48 /diam exch def
  49 diam lwidth gt
  50   {/diam diam lwidth sub def}
  51   {/diam 0 def}
  52 ifelse
  53 newpath
  54 diam 2 div 0 moveto
  55 0 0 diam 2 div 0 360 arc
  56 closepath
  57 filled {
  58   colour psloadcolour
  59   gsave
  60   fill
  61   grestore
  62 } if
  63 lcolour psloadcolour
  64 lwidth setlinewidth
  65 stroke} def
  66
  67 %-----------------------------------------------------------------------------%
  68
  69 /psline % end x, end y, line width, line colour, line dash
  70 {0 setdash
  71 psloadcolour
  72 setlinewidth
  73 /endy exch def
  74 /endx exch def
  75 newpath
  76 0 0 moveto
  77 endx endy lineto
  78 stroke} def
  79
  80 %-----------------------------------------------------------------------------%
  81
  82 /psloop % from (#1,#2) to (#3,#4), line colour, line width, line dash
  83 {0 setdash
  84 setlinewidth
  85 psloadcolour
  86 /varw exch def
  87 /varv exch def
  88 /vary exch def
  89 /varx exch def
  90 newpath 0 0 moveto
  91 varx vary lineto
  92 /varxb varx 2 mul def
  93 /varyb vary 2 mul def
  94 /varvb varv 2 mul def
  95 /varwb varw 2 mul def
  96 varxb varyb varvb varwb varv varw curveto
  97 closepath
  98 stroke} def
  99
 100 %-----------------------------------------------------------------------------%
 101
 102 /psloopbyangle % angle #1, axis (#2,#3), line colour, line width, line dash
 103 {/axisY exch def
 104 /axisX exch def
 105 /alpha exch def
 106 /len axisX dup mul axisY dup mul add sqrt def
 107 /betaA axisY axisX atan alpha 2 div sub def
 108 /betaB betaA alpha add def
 109 len betaA cos mul len betaA sin mul
 110 len betaB cos mul len betaB sin mul} def
 111
 112 %-----------------------------------------------------------------------------%
 113
 114 /pslooparrowonrectangle % (#1,#2), (#3,#4), width, height, line colour,
 115                         % line width, line dash, arrow length, arrow width
 116 {/atype exch def
 117 /awid exch def
 118 /len exch def
 119 0 setdash
 120 setlinewidth
 121 psloadcolour
 122 /height exch def
 123 /width exch def
 124 /varw exch def
 125 /varv exch def
 126 /vary exch def
 127 /varx exch def
 128 newpath 0 0 moveto
 129 varx vary lineto
 130 /varxb varx 2 mul def
 131 /varyb vary 2 mul def
 132 /varvb varv 2 mul def
 133 /varwb varw 2 mul def
 134 varxb varyb varvb varwb varv varw curveto
 135 varv varw translate
 136 /varv varv neg def /varw varw neg def
 137 varv abs varw abs
 138 varv abs varw abs gt { exch } if
 139 div dup mul 1 add width height mul mul sqrt 2 div /dist exch def
 140 /getlen {
 141         /size exch def
 142         abs exch abs exch
 143         div dup mul 1 add size dup mul mul sqrt 2 div
 144 } def
 145 varv 0 eq
 146         {/dist height 2 div def}
 147         {varw 0 eq
 148                 {/dist width 2 div def}
 149                 {
 150                 /fstdist varv varw height getlen def
 151                 /snddist varw varv width getlen def
 152                 fstdist snddist lt
 153                         {/dist fstdist def} {/dist snddist def} ifelse
 154                 } ifelse
 155         } ifelse
 156 varw varv atan rotate
 157 /pos varv dup mul varw dup mul add sqrt dist sub def
 158 pos len sub 0 lineto
 159 stroke
 160 pos len awid atype psdrawarrow
 161 } def
 162
 163 %-----------------------------------------------------------------------------%
 164
 165 /pslooparrowoncircle % (#1,#2), (#3,#4), diameter, line colour, line width,
 166                      % line dash, arrow length, arrow width
 167 {/atype exch def
 168 /awid exch def
 169 /len exch def
 170 0 setdash
 171 setlinewidth
 172 psloadcolour
 173 /diam exch def
 174 /varw exch def
 175 /varv exch def
 176 /vary exch def
 177 /varx exch def
 178 newpath 0 0 moveto
 179 varx vary lineto
 180 /varxb varx 2 mul def
 181 /varyb vary 2 mul def
 182 /varvb varv 2 mul def
 183 /varwb varw 2 mul def
 184 varxb varyb varvb varwb varv varw curveto
 185 varv varw translate
 186 /varv varv neg def /varw varw neg def
 187 varw varv atan rotate
 188 /pos varv dup mul varw dup mul add sqrt diam 2 div sub def
 189 pos len sub 0 lineto
 190 stroke
 191 pos len awid atype psdrawarrow
 192 } def
 193
 194 %-----------------------------------------------------------------------------%
 195
 196 /psdeletebox % width, height
 197 {/height exch def
 198 /width exch def
 199 newpath
 200 width 2 div neg height 2 div neg moveto
 201 width 0 rlineto
 202 0 height rlineto
 203 width neg 0 rlineto
 204 closepath
 205 1 setgray
 206 fill} def
 207
 208 %-----------------------------------------------------------------------------%
 209
 210 /psarrowonrectangle % x, y, width, height, arrow length, arrow width,
 211                     % line colour, line width, dash array
 212 {0 setdash
 213 setlinewidth
 214 psloadcolour
 215 /atype exch def
 216 /awid exch def
 217 /len exch def
 218 /height exch def
 219 /width exch def
 220 /ypos exch def
 221 /xpos exch def
 222 /getlen {
 223         /size exch def
 224         abs exch abs exch
 225         div dup mul 1 add size dup mul mul sqrt 2 div
 226 } def
 227 xpos 0 eq
 228         {/dist height 2 div def}
 229         {ypos 0 eq
 230                 {/dist width 2 div def}
 231                 {
 232                 /fstdist xpos ypos height getlen def
 233                 /snddist ypos xpos width getlen def
 234                 fstdist snddist lt
 235                         {/dist fstdist def} {/dist snddist def} ifelse
 236                 } ifelse
 237         } ifelse
 238 ypos xpos atan rotate
 239 /pos xpos dup mul ypos dup mul add sqrt dist sub def
 240 pos len awid atype psdrawarrow
 241 0 0 moveto
 242 pos len sub 0 lineto
 243 stroke} def
 244
 245 %-----------------------------------------------------------------------------%
 246
 247 /psarrowoncircle
 248 {0 setdash
 249 setlinewidth
 250 psloadcolour
 251 /atype exch def
 252 /awid exch def
 253 /len exch def
 254 /diam exch def
 255 /ypos exch def
 256 /xpos exch def
 257 ypos xpos atan rotate
 258 /pos xpos dup mul ypos dup mul add sqrt diam 2 div sub def
 259 pos len awid atype psdrawarrow
 260 0 0 moveto
 261 pos len sub 0 lineto
 262 stroke} def
 263
 264 %-----------------------------------------------------------------------------%
 265
 266 /pspath
 267 {/fillyes exch def
 268 /fillcolour exch def
 269 0 setdash
 270 psloadcolour
 271 setlinewidth
 272 /curry exch def
 273 /currx exch def
 274 /sqr { dup mul } def
 275 /mtrx matrix currentmatrix def
 276 newpath currx curry moveto
 277 counttomark 3 idiv
 278 {       /displace exch def
 279         displace abs 0 gt
 280         {       currx curry translate
 281                 dup curry sub /ypos exch def /curry exch def
 282                 dup currx sub /xpos exch def /currx exch def
 283                 /len xpos sqr ypos sqr add sqrt def
 284                 /displace displace len mul def
 285                 ypos xpos atan rotate
 286                 /db len 2 div def
 287                 /rad displace db sqr displace div add 2 div def
 288                 /radb rad displace sub def
 289                 /anglea radb db atan def
 290                 /angleb 180 anglea sub def
 291                 displace 0 gt
 292                         { db radb neg rad angleb anglea arcn }
 293                         { db radb neg rad 360 anglea sub angleb neg arc }
 294                 ifelse
 295                 mtrx setmatrix
 296         }
 297         {       /curry exch def
 298                 /currx exch def
 299                 currx curry lineto
 300         }
 301         ifelse
 302 }
 303 repeat
 304 pop
 305 fillyes {gsave fillcolour psloadcolour fill grestore} if
 306 0 setlinecap
 307 0 setlinejoin
 308 stroke
 309 } def
 310
 311 %-----------------------------------------------------------------------------%
 312
 313 /pscurve
 314 {/fillyes exch def
 315 /fillcolour exch def
 316 0 setdash
 317 psloadcolour
 318 setlinewidth
 319 /currx exch def
 320 /curry exch def
 321 /angle exch def
 322 /factora exch def
 323 /factorb exch def
 324 newpath currx curry moveto
 325 counttomark 5 idiv
 326 {       /newx exch def
 327         /newy exch def
 328         /len newx currx sub dup mul newy curry sub dup mul add sqrt def
 329         /firstx len factora mul angle cos mul currx add def
 330         /firsty len factora mul angle sin mul curry add def
 331         /currx newx def
 332         /curry newy def
 333         /angle exch def
 334         firstx
 335         firsty
 336         len factorb mul angle cos mul neg currx add
 337         len factorb mul angle sin mul neg curry add
 338         currx
 339         curry
 340         curveto
 341         /factora exch def
 342         /factorb exch def
 343 }
 344 repeat
 345 pop
 346 fillyes {gsave fillcolour psloadcolour fill grestore} if
 347 0 setlinecap
 348 0 setlinejoin
 349 stroke
 350 } def
 351
 352 %-----------------------------------------------------------------------------%
 353
 354 /psbubble
 355 {/fillyes exch def
 356 /fillcolour exch def
 357 0 setdash
 358 psloadcolour
 359 setlinewidth
 360 /lenfactor exch def
 361 /fetch {/arg exch def dup arg exch def counttomark 1 roll} def
 362 /compangle {
 363         /firstangle exch def
 364         /scndangle exch def
 365         firstangle sin scndangle sin add 2 div
 366         firstangle cos scndangle cos add 2 div
 367         atan
 368 } def
 369 /currax fetch
 370 /curray fetch
 371 counttomark 2 idiv
 372 {
 373 /currbx exch def
 374 /currby exch def
 375 currax currbx ne curray currby ne or
 376         {currby currbx /currax fetch /curray fetch}
 377 if
 378 }
 379 repeat
 380 /lastx fetch
 381 /lasty fetch
 382 /currax fetch
 383 /curray fetch
 384 /currbx fetch
 385 /currby fetch
 386 newpath currax curray moveto
 387 counttomark 2 idiv
 388 {       /nextx fetch
 389         /nexty fetch
 390         /fstangle
 391                 curray lasty sub currax lastx sub atan
 392                 currby curray sub currbx currax sub atan
 393                 compangle
 394         def
 395         /sndangle
 396                 currby curray sub currbx currax sub atan
 397                 nexty currby sub nextx currbx sub atan
 398                 compangle
 399         def
 400         /len currax currbx sub dup mul curray currby sub dup mul add sqrt lenfactor mul def
 401         fstangle cos len mul currax add
 402         fstangle sin len mul curray add
 403         currbx sndangle cos len mul sub
 404         currby sndangle sin len mul sub
 405         currbx currby
 406         curveto
 407         /lastx currax def
 408         /lasty curray def
 409         /currax currbx def
 410         /curray currby def
 411         /currbx nextx def
 412         /currby nexty def
 413 }
 414 repeat
 415 pop
 416 fillyes {gsave fillcolour psloadcolour fill grestore} if
 417 0 setlinecap
 418 0 setlinejoin
 419 stroke
 420 } def
 421
 422 %-----------------------------------------------------------------------------%
 423
 424 /psdrawarrow
 425 {gsave
 426 /type exch def
 427 /wid exch def
 428 /len exch def
 429 0 translate -1 1 scale
 430 newpath 0 0 moveto
 431 type 1 eq
 432 {       len len wid 2 div mul lineto
 433         0 len wid neg mul rlineto}
 434 {       /mid len 2 div def
 435         0 0
 436         mid 0
 437         len len wid 2 div mul curveto
 438         len len wid -2 div mul lineto
 439         mid 0
 440         0 0
 441         0 0 curveto
 442 } ifelse
 443 closepath
 444 fill
 445 grestore
 446 } def
 447
 448 %-----------------------------------------------------------------------------%
 449
 450 /psdirbowoncircle
 451 {0 setdash
 452 psloadcolour
 453 setlinewidth
 454 /atype exch def
 455 /awid exch def
 456 /arrowlen exch def
 457 2 div /targetradius exch def
 458 /displace exch def
 459 /othery exch def
 460 /otherx exch def
 461 /curry exch def
 462 /currx exch def
 463 /sqr { dup mul } def
 464
 465 currx curry translate
 466 othery curry sub /othery exch def
 467 otherx currx sub /otherx exch def
 468 /angle otherx neg othery atan def
 469 /distance otherx sqr othery sqr add sqrt def
 470 /displace displace distance mul def
 471 /radius displace distance 2 div sqr displace div add 2 div def
 472 /centerx angle cos radius displace sub mul otherx 2 div add def
 473 /centery angle sin radius displace sub mul othery 2 div add def
 474 displace 0 gt
 475 { /anglea othery centery sub otherx centerx sub atan def
 476   /angleb centery neg centerx neg atan def
 477   angleb anglea lt
 478   { /anglea anglea 360 sub def }
 479   if
 480 }
 481 { /anglea centery othery sub centerx otherx sub atan def
 482   /angleb centery centerx atan def
 483   angleb anglea gt
 484   { /anglea anglea 360 add def }
 485   if
 486 }
 487 ifelse
 488
 489 anglea angleb targetradius pscomputeposoncircle
 490 /tipy exch def /tipx exch def
 491 anglea angleb targetradius arrowlen add pscomputeposoncircle
 492 /taily exch def /tailx exch def
 493
 494 newpath 0 0 moveto
 495 0 setlinecap
 496 0 setlinejoin
 497 displace 0 gt
 498 { centerx centery radius angleb taily centery sub tailx centerx sub atan arcn }
 499 { centerx centery radius angleb centery taily sub centerx tailx sub atan arc }
 500 ifelse
 501 stroke
 502
 503 tailx taily translate
 504 /tipx tipx tailx sub def
 505 /tipy tipy taily sub def
 506 tipy tipx atan rotate
 507 arrowlen arrowlen awid atype psdrawarrow
 508 } def
 509
 510 /pscomputeposoncircle
 511 {/otherr exch def
 512 /beta exch def
 513 /alpha exch def
 514 {
 515   /currangle alpha beta add 2 div def
 516   /xpos currangle cos radius mul centerx add def
 517   /ypos currangle sin radius mul centery add def
 518     otherx xpos sub sqr othery ypos sub sqr add sqrt
 519     /newdist exch def
 520   newdist otherr sub abs .001 le
 521   {exit}
 522   if
 523   newdist otherr le
 524   {/alpha currangle def}
 525   {/beta currangle def}
 526   ifelse
 527 } loop
 528 currangle cos radius mul centerx add
 529 currangle sin radius mul centery add
 530 } def
 531
 532
 533 %-----------------------------------------------------------------------------%
 534
 535 /psdirbowonrectangle
 536 {0 setdash
 537 psloadcolour
 538 setlinewidth
 539 /atype exch def
 540 /awid exch def
 541 /arrowlen exch def
 542 2 div /sizey exch def
 543 2 div /sizex exch def
 544 /displace exch def
 545 /othery exch def
 546 /otherx exch def
 547 /curry exch def
 548 /currx exch def
 549 /sqr { dup mul } def
 550
 551 currx curry translate
 552 othery curry sub /othery exch def
 553 otherx currx sub /otherx exch def
 554 /angle otherx neg othery atan def
 555 /distance otherx sqr othery sqr add sqrt def
 556 /displace displace distance mul def
 557 /radius displace distance 2 div sqr displace div add 2 div def
 558 /centerx angle cos radius displace sub mul otherx 2 div add def
 559 /centery angle sin radius displace sub mul othery 2 div add def
 560 displace 0 gt
 561 { /anglea othery centery sub otherx centerx sub atan def
 562   /angleb centery neg centerx neg atan def
 563   angleb anglea lt
 564   { /anglea anglea 360 sub def }
 565   if
 566 }
 567 { /anglea centery othery sub centerx otherx sub atan def
 568   /angleb centery centerx atan def
 569   angleb anglea gt
 570   { /anglea anglea 360 add def }
 571   if
 572 }
 573 ifelse
 574
 575 anglea angleb pscomputeposonrectangle /tipy exch def /tipx exch def
 576 /targetradius otherx tipx sub sqr othery tipy sub sqr add sqrt def
 577 anglea angleb targetradius arrowlen add pscomputeposoncircle
 578 /taily exch def /tailx exch def
 579
 580 newpath 0 0 moveto
 581 0 setlinecap
 582 0 setlinejoin
 583 displace 0 gt
 584 { centerx centery radius angleb taily centery sub tailx centerx sub atan arcn }
 585 { centerx centery radius angleb centery taily sub centerx tailx sub atan arc }
 586 ifelse
 587 stroke
 588
 589 tailx taily translate
 590 /tipx tipx tailx sub def
 591 /tipy tipy taily sub def
 592 tipy tipx atan rotate
 593 arrowlen arrowlen awid atype psdrawarrow
 594 } def
 595
 596 /pscomputeposonrectangle
 597 {/beta exch def
 598 /alpha exch def
 599 /counter 0 def
 600 {
 601   /currangle alpha beta add 2 div def
 602   /xpos currangle cos radius mul centerx add def
 603   /ypos currangle sin radius mul centery add def
 604   /xdiff xpos otherx sub abs sizex sub def
 605   /ydiff ypos othery sub abs sizey sub def
 606   xdiff abs .001 le ydiff abs .001 le and
 607    xdiff abs .001 le ydiff 0 le and
 608    xdiff 0 le ydiff  abs .001 le and
 609    or
 610   {exit}
 611   if
 612   /counter counter 1 add def
 613   xdiff 0 le ydiff 0 le and
 614   {/alpha currangle def}
 615   {/beta currangle def}
 616   ifelse
 617 } loop
 618 currangle cos radius mul centerx add
 619 currangle sin radius mul centery add
 620 } def