]> www.hackdaworld.org Git - lectures/latex.git/blob - nlsop/graphs.header
ci soon and often
[lectures/latex.git] / 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