mp-node.mpxl /size: 8144 b    last modification: 2021-10-28 13:50
1%D \module
2%D   [       file=mp-node.mpiv,
3%D        version=1998.02.15,
4%D          title=\CONTEXT\ \METAPOST\ graphics,
5%D       subtitle=Node Based Graphics,
6%D         author=Alan Braslau,
7%D           date=\currentdate,
8%D      copyright={Alan Braslau & \CONTEXT\ Development Team}]
9%C
10%C This module is part of the \CONTEXT\ macro||package and is
11%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
12%C details.
13
14%D The crossing macros were written as part of this module but as they
15%D can be of use elsewhere they are defined in mp-tool.
16
17if known metafun_loaded_node : endinput ; fi ;
18
19newinternal boolean metafun_loaded_node ; metafun_loaded_node := true ; immutable metafun_loaded_node ;
20
21% Build a path from the node positions.
22% Must be integer and continuous in index starting at 0.
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% can take a list:
42
43def clearpath text t =
44    save t ; path t ;
45enddef ;
46
47def clearnodepath = clearpath nodepath enddef ;
48
49clearnodepath ;
50
51% the trailing "," below handles when number of t<3
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% returns a pair suffix if the path is unknown
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% returns a picture
130
131vardef mfun_node@#(suffix p)(expr i)(text t) =
132    if pair mfun_makenode@#(p,i,t) :
133        % nop: enclose in "if ... fi" to gobble the function return.
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% returns a path
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% returns pair: bounding point of the node picture
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% returns pair: scaled laboff direction
229
230vardef relative@#(expr s) =
231    (mfun_laboff@# scaled s)
232enddef ;
233
234% returns pair: vector between nodes (+ optional scale)
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% helpers that save passing tokens
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