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