mp-node.mpiv /size: 7912 b    last modification: 2020-07-01 14:35
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 context_node : endinput ; fi ;
18
19boolean context_node ; context_node := true ;
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:
42def clearpath text t =
43    save t ; path t ;
44enddef ;
45
46def clearnodepath = clearpath nodepath enddef ;
47
48clearnodepath ;
49
50% the trailing "," below handles when number of t<3
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% returns a pair suffix if the path is unknown
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% returns a picture
129
130vardef mfun_node@#(suffix p)(expr i)(text t) =
131    if pair mfun_makenode@#(p,i,t) :
132        % nop: enclose in "if ... fi" to gobble the function return.
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% returns a path
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% returns pair: bounding point of the node picture
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% returns pair: scaled laboff direction
228
229vardef relative@#(expr s) =
230    (mfun_laboff@# scaled s)
231enddef ;
232
233% returns pair: vector between nodes (+ optional scale)
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% helpers that save passing tokens
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