1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17if known context_node : endinput ; fi ;
18
19boolean context_node ; context_node := true ;
20
21
22
23
24vardef makenodepath(suffix p) =
25 if unknown p :
26 if not path p :
27 d := dimension p ;
28 if d>0 :
29 scantokens("path " & prefix p & for i=1 upto d : "[]" & endfor " ;") ;
30 else :
31 path p ;
32 fi
33 fi
34 save i ; i = -1 ;
35 p = forever : exitif unknown p.pos[incr i] ;
36 p.pos[i] --
37 endfor cycle ;
38 fi
39enddef ;
40
41
42def clearpath text t =
43 save t ; path t ;
44enddef ;
45
46def clearnodepath = clearpath nodepath enddef ;
47
48clearnodepath ;
49
50
51
52vardef makenode@#(text t) =
53 for a = t :
54 if (path a) or (unknown a) :
55 mfun_makenode@#(t,)
56 elseif (string a) and (length(a) = 0) :
57 mfun_makenode@#(t,)
58 else :
59 mfun_makenode@#(nodepath, t,)
60 fi
61 exitif true ;
62 endfor
63enddef ;
64
65vardef node@#(text t) =
66 for a = t :
67 if (path a) or (unknown a) :
68 mfun_node@#(t,)
69 elseif (string a) and (length(a) = 0) :
70 mfun_node@#(t,)
71 else :
72 mfun_node@#(nodepath, t,)
73 fi
74 exitif true ;
75 endfor
76enddef ;
77
78vardef nodeboundingpoint@#(text t) =
79 for a = t :
80 if (path a) or (unknown a) :
81 mfun_nodeboundingpoint@#(t)
82 elseif (string a) and (length(a) = 0) :
83 mfun_nodeboundingpoint@#(t)
84 else :
85 mfun_nodeboundingpoint@#(nodepath,a)
86 fi
87 exitif true ;
88 endfor
89enddef ;
90
91vardef fromto@#(expr d, f)(text t) =
92 fromtopaths@#(d,nodepath,f,nodepath,t)
93enddef ;
94
95
96
97vardef mfun_makenode@#(suffix p)(expr i)(text t) =
98 save d, b ; string b ;
99 d = dimension p ;
100 if d > 0 :
101 b := prefix p ;
102 if not picture p.pic[i] : scantokens("picture " & b &
103 for j=1 upto d : "[]" & endfor
104 "pic[] ;") ; fi
105 if not pair p.pos[i] : scantokens("pair " & b &
106 for j=1 upto d : "[]" & endfor
107 "pos[] ;") ; fi
108 else :
109 if not picture p.pic[i] : picture p.pic[] ; fi
110 if not pair p.pos[i] : pair p.pos[] ; fi
111 fi
112 for a = t :
113 if known p.pic[i] :
114 addto p.pic[i] also
115 else :
116 p.pic[i] =
117 fi
118 if picture a : a
119 elseif string a : if (length(a) > 0) : textext@#(a) else : nullpicture fi
120 elseif numeric a : textext@#(decimal a)
121 elseif ((boolean a) and a) : image(draw origin withpen currentpen scaled 4)
122 else : nullpicture
123 fi ;
124 endfor
125 p.pos[i] if known p : := point i of p ; fi
126enddef ;
127
128
129
130vardef mfun_node@#(suffix p)(expr i)(text t) =
131 if pair mfun_makenode@#(p,i,t) :
132
133 fi
134 if (unknown p) and (known p.pos[i]) :
135 makenodepath(p) ;
136 fi
137 if known p.pic[i] :
138 p.pic[i] if known p : shifted point i of p fi
139 else :
140 nullpicture
141 fi
142enddef ;
143
144newinternal node_loopback_yscale ; node_loopback_yscale := 1 ;
145
146
147
148vardef fromtopaths@#(expr d)(suffix p)(expr f)(suffix q)(text s) =
149 save r, t, l ;
150 path r[] ; picture l ;
151 for a = s :
152 if unknown t :
153 t = a ;
154 if (unknown p) and (known p.pos[f]) :
155 makenodepath(p) ;
156 fi
157 if (unknown q) and (known q.pos[t]) :
158 makenodepath(q) ;
159 fi
160 r0 = if ((not numeric d) and
161 (point f of p = point f of q) and
162 (point t of p = point t of q)) :
163 subpath (f,t) of p
164 else :
165 point f of p -- point t of q
166 fi ;
167 save deviation ;
168 deviation := if numeric d: d else: 0 fi ;
169 r1 = if (point 0 of r0) = (point length r0 of r0) :
170 (fullcircle yscaled node_loopback_yscale rotated 180
171 if mfun_laboff@# <> origin :
172 rotated angle mfun_laboff@#
173 shifted .5mfun_laboff@#
174 fi)
175 scaled deviation
176 shifted point 0 of r0
177 elseif deviation=0 :
178 r0
179 else :
180 point 0 of r0 ..
181 unitvector direction .5length r0 of r0 rotated 90
182 scaled deviation arclength r0
183 shifted point .5length r0 of r0 ..
184 point length r0 of r0
185 fi ;
186 else :
187 if known l :
188 addto l also
189 else :
190 l :=
191 fi
192 if picture a : a
193 elseif string a : if (length(a) > 0) : textext@#(a) else : nullpicture fi
194 elseif numeric a : textext@#(decimal a)
195 elseif ((boolean a) and a) : image(draw origin withpen currentpen scaled 4)
196 else : nullpicture
197 fi ;
198 fi
199 endfor
200 r2 = r1
201 if known p.pic[f if cycle p: mod length p fi] :
202 cutbefore boundingbox (p.pic[f if cycle p: mod length p fi] shifted point f of p)
203 fi
204 if known q.pic[t if cycle q: mod length q fi] :
205 cutafter boundingbox (q.pic[t if cycle q: mod length q fi] shifted point t of q)
206 fi
207 ;
208 if known l :
209 l := l shifted point .5length r2 of r2 ;
210 draw l ;
211 (r2 if str @# = "" : crossingunder l fi)
212 else :
213 r2
214 fi
215enddef ;
216
217
218
219vardef mfun_nodeboundingpoint@#(suffix p)(expr i) =
220 if known p.pic[i] :
221 boundingpoint@#(p.pic[i])
222 else :
223 origin
224 fi
225enddef ;
226
227
228
229vardef relative@#(expr s) =
230 (mfun_laboff@# scaled s)
231enddef ;
232
233
234
235vardef betweennodes@#(suffix p)(expr f)(suffix q)(text s) =
236 save t ;
237 for a = s :
238 if unknown t :
239 t = a ;
240 mfun_nodeboundingpoint@#(q,t) mfun_nodeboundingpoint@#(p,f)
241 else :
242 relative@#(a)
243 fi
244 endfor
245enddef ;
246
247
248
249def mfun_node_init(expr dx, dy, da) =
250 save nodelattice ; pair nodelattice[] ;
251 nodelattice0 = (dx,0) ;
252 nodelattice1 = dy dir(da) ;
253 clearnodepath ;
254 save nodecount ; nodecount = -1;
255enddef ;
256
257def mfun_node_make(expr x, y, s) =
258 nodecount := nodecount 1 ;
259 makenode(nodecount,s) = x nodelattice0 y nodelattice1 ;
260enddef ;
261
262def mfun_node_flush =
263 for i=0 upto nodecount:
264 draw node(i) ;
265 endfor
266enddef ;
267
268vardef mfun_nodes_fromto@#(expr d, f)(text t) =
269 fromtopaths@#(d,nodepath,f,nodepath,t)
270enddef ;
271 |