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 17
if
known
metafun_loaded_node
:
endinput
;
fi
;
18 19
newinternal
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 24
vardef
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
39
enddef
;
40 41
% can take a list:
42 43
def
clearpath
text
t
=
44
save
t
;
path
t
;
45
enddef
;
46 47
def
clearnodepath
=
clearpath
nodepath
enddef
;
48 49
clearnodepath
;
50 51
% the trailing "," below handles when number of t<3
52 53
vardef
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
64
enddef
;
65 66
vardef
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
77
enddef
;
78 79
vardef
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
90
enddef
;
91 92
vardef
fromto
@#
(
expr
d
,
f
)
(
text
t
)
=
93
fromtopaths
@#
(
d
,
nodepath
,
f
,
nodepath
,
t
)
94
enddef
;
95 96
% returns a pair suffix if the path is unknown
97 98
vardef
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
127
enddef
;
128 129
% returns a picture
130 131
vardef
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
143
enddef
;
144 145
newinternal
node_loopback_yscale
;
node_loopback_yscale
:
=
1
;
146 147
% returns a path
148 149
vardef
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
r
0
=
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
r
1
=
if
(
point
0
of
r
0
)
=
(
point
length
r
0
of
r
0
)
:
171
(
fullcircle
yscaled
node_loopback_yscale
rotated
180
172
if
mfun_laboff
@#
<
>
origin
:
173
rotated
angle
mfun_laboff
@#
174
shifted
.5
mfun_laboff
@#
175
fi
)
176
scaled
deviation
177
shifted
point
0
of
r
0
178
elseif
deviation
=
0
:
179
r
0
180
else
:
181
point
0
of
r
0
..
182
unitvector
direction
.5
length
r
0
of
r
0
rotated
90
183
scaled
deviation
*
arclength
r
0
184
shifted
point
.5
length
r
0
of
r
0
..
185
point
length
r
0
of
r
0
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
r
2
=
r
1
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
.5
length
r
2
of
r
2
;
211
draw
l
;
212
(
r
2
if
str
@#
=
"
"
:
crossingunder
l
fi
)
213
else
:
214
r
2
215
fi
216
enddef
;
217 218
% returns pair: bounding point of the node picture
219 220
vardef
mfun_nodeboundingpoint
@#
(
suffix
p
)
(
expr
i
)
=
221
if
known
p
.
pic
[
i
]
:
222
boundingpoint
@#
(
p
.
pic
[
i
]
)
223
else
:
224
origin
225
fi
226
enddef
;
227 228
% returns pair: scaled laboff direction
229 230
vardef
relative
@#
(
expr
s
)
=
231
(
mfun_laboff
@#
scaled
s
)
232
enddef
;
233 234
% returns pair: vector between nodes (+ optional scale)
235 236
vardef
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
246
enddef
;
247 248
% helpers that save passing tokens
249 250
def
mfun_node_init
(
expr
dx
,
dy
,
da
)
=
251
save
nodelattice
;
pair
nodelattice
[
]
;
252
nodelattice
0
=
(
dx
,
0
)
;
253
nodelattice
1
=
dy
*
dir
(
da
)
;
254
clearnodepath
;
255
save
nodecount
;
nodecount
=
-1
;
256
enddef
;
257 258
def
mfun_node_make
(
expr
x
,
y
,
s
)
=
259
nodecount
:
=
nodecount
+
1
;
260
makenode
(
nodecount
,
s
)
=
x
*
nodelattice
0
+
y
*
nodelattice
1
;
261
enddef
;
262 263
def
mfun_node_flush
=
264
for
i
=
0
upto
nodecount
:
265
draw
node
(
i
)
;
266
endfor
267
enddef
;
268 269
vardef
mfun_nodes_fromto
@#
(
expr
d
,
f
)
(
text
t
)
=
270
fromtopaths
@#
(
d
,
nodepath
,
f
,
nodepath
,
t
)
271
enddef
;
272 273
permanent
makenodepath
,
clearpath
,
clearnodepath
,
makenode
,
node
,
nodeboundingpoint
,
fromto
,
fromtopaths
,
relative
,
betweennodes
;
274
permanent
node_loopback_yscale
;
275 276