mp-shap.mpxl /size: 10 Kb    last modification: 2021-10-28 13:50
1
%D \module
2
%D [ file=mp-shap.mpiv,
3
%D version=2000.05.31,
4
%D title=\CONTEXT\ \METAPOST\ graphics,
5
%D subtitle=shapes,
6
%D author=Hans Hagen,
7
%D date=\currentdate,
8
%D copyright={PRAGMA ADE \& \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 licen-en.pdf for
12
%C details.
13 14
if
known
metafun_loaded_shap
:
endinput
;
fi
;
15 16
newinternal
boolean
metafun_loaded_shap
;
metafun_loaded_shap
:
=
true
;
immutable
metafun_loaded_shap
;
17 18
path
predefined_shapes
[
]
;
19 20
def
start_predefined_shape_definition
=
21 22
begingroup
;
23 24
save
xradius
,
yradius
,
xxradius
,
yyradius
;
25
save
ll
,
lr
,
ur
,
ul
,
llx
,
lly
,
lrx
,
lry
,
urx
,
ury
,
ulx
,
uly
,
llxx
,
llyy
,
lrxx
,
lryy
,
urxx
,
uryy
,
ulxx
,
ulyy
,
lc
,
rc
,
tc
,
bc
;
26 27
numeric
xradius
,
yradius
,
xxradius
,
yyradius
;
28
pair
ll
,
lr
,
ur
,
ul
,
llx
,
lly
,
lrx
,
lry
,
urx
,
ury
,
ulx
,
uly
,
llxx
,
llyy
,
lrxx
,
lryy
,
urxx
,
uryy
,
ulxx
,
ulyy
,
lc
,
rc
,
tc
,
bc
;
29 30
xradius
:
=
.15
;
31
yradius
:
=
.15
;
32
xxradius
:
=
.10
;
33
yyradius
:
=
.10
;
34 35
ll
:
=
llcorner
(
unitsquare
shifted
(
-.5
,
-.5
)
)
;
36
lr
:
=
lrcorner
(
unitsquare
shifted
(
-.5
,
-.5
)
)
;
37
ur
:
=
urcorner
(
unitsquare
shifted
(
-.5
,
-.5
)
)
;
38
ul
:
=
ulcorner
(
unitsquare
shifted
(
-.5
,
-.5
)
)
;
39 40
llx
:
=
ll
shifted
(
xradius
,
0
)
;
41
lly
:
=
ll
shifted
(
0
,
yradius
)
;
42 43
lrx
:
=
lr
shifted
(
-
xradius
,
0
)
;
44
lry
:
=
lr
shifted
(
0
,
yradius
)
;
45 46
urx
:
=
ur
shifted
(
-
xradius
,
0
)
;
47
ury
:
=
ur
shifted
(
0
,
-
yradius
)
;
48 49
ulx
:
=
ul
shifted
(
xradius
,
0
)
;
50
uly
:
=
ul
shifted
(
0
,
-
yradius
)
;
51 52
llxx
:
=
ll
shifted
(
xxradius
,
0
)
;
53
llyy
:
=
ll
shifted
(
0
,
yyradius
)
;
54 55
lrxx
:
=
lr
shifted
(
-
xxradius
,
0
)
;
56
lryy
:
=
lr
shifted
(
0
,
yyradius
)
;
57 58
urxx
:
=
ur
shifted
(
-
xxradius
,
0
)
;
59
uryy
:
=
ur
shifted
(
0
,
-
yyradius
)
;
60 61
ulxx
:
=
ul
shifted
(
xxradius
,
0
)
;
62
ulyy
:
=
ul
shifted
(
0
,
-
yyradius
)
;
63 64
lc
:
=
ll
shifted
(
0
,
.5
)
;
65
rc
:
=
lr
shifted
(
0
,
.5
)
;
66
tc
:
=
ul
shifted
(
.5
,
0
)
;
67
bc
:
=
ll
shifted
(
.5
,
0
)
;
68 69
enddef
;
70 71
def
stop_predefined_shape_definition
=
72 73
endgroup
;
74 75
enddef
;
76 77
% this can be delayed
78 79
start_predefined_shape_definition
;
80 81
predefined_shapes
[
0
]
:
=
(
origin
-
-
cycle
)
;
82
predefined_shapes
[
5
]
:
=
(
llx
-
-
lrx
{
right
}
.
.
.
rc
...
{
left
}
urx
-
-
ulx
{
left
}
.
.
.
lc
...
{
right
}
cycle
)
;
83
predefined_shapes
[
6
]
:
=
(
ll
-
-
lrx
{
right
}
.
.
.
rc
...
{
left
}
urx
-
-
ul
-
-
cycle
)
;
84
predefined_shapes
[
7
]
:
=
(
ll
-
-
lrx
{
right
}
.
.
.
rc
...
{
left
}
urx
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
85
predefined_shapes
[
8
]
:
=
(
lr
-
-
ury
{
up
}
.
.
.
tc
...
{
down
}
uly
-
-
ll
-
-
cycle
)
;
86
predefined_shapes
[
9
]
:
=
(
lr
-
-
ury
{
up
}
.
.
.
tc
...
{
down
}
uly
-
-
ll
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
87
predefined_shapes
[
10
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
ul
-
-
ll
-
-
ur
-
-
ul
-
-
ll
-
-
cycle
)
;
88
predefined_shapes
[
11
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
ul
-
-
ll
-
-
lr
-
-
ul
-
-
ll
-
-
cycle
)
;
89
predefined_shapes
[
12
]
:
=
(
ll
-
-
lrx
-
-
ur
-
-
ulx
-
-
cycle
)
;
90
predefined_shapes
[
13
]
:
=
(
llx
-
-
lr
-
-
urx
-
-
ul
-
-
cycle
)
;
91
predefined_shapes
[
14
]
:
=
(
lly
-
-
bc
-
-
lry
-
-
ury
-
-
tc
-
-
uly
-
-
cycle
)
;
92
predefined_shapes
[
15
]
:
=
(
llx
-
-
lrx
-
-
rc
-
-
urx
-
-
ulx
-
-
lc
-
-
cycle
)
;
93
predefined_shapes
[
16
]
:
=
(
ll
-
-
lrx
-
-
rc
-
-
urx
-
-
ul
-
-
cycle
)
;
94
predefined_shapes
[
17
]
:
=
(
ll
-
-
lrx
-
-
rc
-
-
urx
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
95
predefined_shapes
[
18
]
:
=
(
lr
-
-
ury
-
-
tc
-
-
uly
-
-
ll
-
-
cycle
)
;
96
predefined_shapes
[
19
]
:
=
(
lr
-
-
ury
-
-
tc
-
-
uly
-
-
ll
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
97
predefined_shapes
[
20
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
ul
-
-
ll
-
-
llxx
-
-
ulxx
-
-
ul
-
-
ll
-
-
lr
-
-
ur
-
-
urxx
-
-
lrxx
-
-
cycle
)
;
98
predefined_shapes
[
21
]
:
=
(
ul
-
-
ll
-
-
lr
-
-
ur
-
-
ul
-
-
ulyy
-
-
uryy
-
-
ur
-
-
ul
-
-
ll
-
-
lr
-
-
lryy
-
-
llyy
-
-
cycle
)
;
99
predefined_shapes
[
22
]
:
=
(
ll
-
-
lrx
-
-
lry
-
-
ur
-
-
ulx
-
-
uly
-
-
cycle
)
;
100
predefined_shapes
[
23
]
:
=
(
llx
-
-
lr
-
-
ury
-
-
urx
-
-
ul
-
-
lly
-
-
cycle
)
;
101
predefined_shapes
[
24
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
ul
-
-
cycle
)
;
102
predefined_shapes
[
25
]
:
=
(
llx
-
-
lrx
-
-
lry
-
-
ury
-
-
urx
-
-
ulx
-
-
uly
-
-
lly
-
-
cycle
)
;
103
predefined_shapes
[
26
]
:
=
(
ll
-
-
lrx
-
-
lry
-
-
ur
-
-
ul
-
-
cycle
)
;
104
predefined_shapes
[
27
]
:
=
(
ll
-
-
lr
-
-
ury
-
-
urx
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
105
predefined_shapes
[
28
]
:
=
(
ll
-
-
lr
-
-
ury
-
-
urx
-
-
ul
-
-
cycle
)
;
106
predefined_shapes
[
29
]
:
=
(
ll
-
-
lrx
-
-
lry
-
-
ur
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
107
predefined_shapes
[
30
]
:
=
(
bc
{
right
}
...
{
up
}
rc
.
.
.
tc
{
left
}
...
{
down
}
lc
...
{
right
}
bc
&
bc
-
-
tc
&
tc
{
left
}
..
{
down
}
lc
&
lc
-
-
rc
&
rc
{
up
}
.
.
tc
{
left
}
...
{
down
}
lc
...
{
right
}
bc
&
cycle
)
rotated
45
;
108
predefined_shapes
[
31
]
:
=
(
bc
{
right
}
...
{
up
}
rc
.
.
.
tc
{
left
}
...
{
down
}
lc
...
{
right
}
bc
&
bc
-
-
tc
&
tc
{
left
}
..
{
down
}
lc
&
lc
-
-
rc
&
rc
{
up
}
.
.
tc
{
left
}
...
{
down
}
lc
...
{
right
}
bc
&
cycle
)
;
109
predefined_shapes
[
32
]
:
=
(
ll
{
right
}
...
{
right
}
lry
-
-
ur
-
-
ul
-
-
ll
-
-
cycle
)
;
110
predefined_shapes
[
33
]
:
=
(
ll
{
right
}
...
{
right
}
lry
-
-
ur
-
-
ul
-
-
ll
-
-
cycle
-
-
ul
-
-
ulx
-
-
ulx
shifted
(
0
,
yyradius
)
-
-
ur
shifted
(
yyradius
,
yyradius
)
-
-
lry
shifted
(
yyradius
,
yyradius
)
-
-
lry
shifted
(
0
,
yyradius
)
-
-
ur
-
-
ul
-
-
cycle
)
;
111
predefined_shapes
[
34
]
:
=
(
uly
.
.
tc
.
.
ury
&
ury
.
.
tc
shifted
(
0
,
-2
yradius
)
.
.
uly
&
uly
-
-
lly
&
lly
.
.
bc
.
.
lry
&
lry
-
-
ury
&
ury
.
.
tc
shifted
(
0
,
-2
yradius
)
.
.
uly
&
cycle
)
;
112
predefined_shapes
[
35
]
:
=
(
bc
{
right
}
.
.
.
rc
{
up
}
.
.
.
tc
{
left
}
.
.
.
lc
{
down
}
.
.
.
cycle
)
;
113
predefined_shapes
[
36
]
:
=
(
ul
-
-
tc
{
right
}
.
.
rc
{
down
}
..
{
left
}
bc
-
-
ll
&
ll
..
(
xpart
llx
,
ypart
lc
)
.
.
ul
&
cycle
)
;
114
predefined_shapes
[
37
]
:
=
(
ul
-
-
tc
{
right
}
.
.
rc
{
down
}
..
{
left
}
bc
-
-
ll
&
ll
..
(
xpart
llx
,
ypart
lc
)
.
.
ul
&
cycle
)
rotatedaround
(
origin
,
180
)
;
115
predefined_shapes
[
38
]
:
=
(
ll
-
-
lc
{
up
}
.
.
tc
{
right
}
..
{
down
}
rc
-
-
lr
&
lr
..
(
xpart
bc
,
ypart
lly
)
.
.
ll
&
cycle
)
;
116
predefined_shapes
[
39
]
:
=
(
ll
-
-
lc
{
up
}
.
.
tc
{
right
}
..
{
down
}
rc
-
-
lr
&
lr
..
(
xpart
bc
,
ypart
lly
)
.
.
ll
&
cycle
)
rotatedaround
(
origin
,
180
)
;
117
predefined_shapes
[
40
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
ul
-
-
ll
-
-
ur
-
-
ul
-
-
ll
-
-
lr
-
-
ul
-
-
ll
-
-
cycle
)
;
118
predefined_shapes
[
41
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
ul
-
-
ll
-
-
lr
-
-
rc
-
-
lc
-
-
ll
-
-
bc
-
-
tc
-
-
ul
-
-
ll
&
cycle
)
;
119
predefined_shapes
[
42
]
:
=
(
ll
-
-
lr
-
-
origin
shifted
(
+
epsilon
,
0
)
-
-
ur
-
-
ul
-
-
origin
shifted
(
-
epsilon
,
0
)
-
-
cycle
)
;
120
predefined_shapes
[
43
]
:
=
(
ll
-
-
ul
-
-
origin
shifted
(
0
,
+
epsilon
)
-
-
ur
-
-
lr
-
-
origin
shifted
(
0
,
-
epsilon
)
-
-
cycle
)
;
121
predefined_shapes
[
45
]
:
=
(
bc
-
-
rc
-
-
tc
-
-
lc
-
-
cycle
)
;
122
predefined_shapes
[
46
]
:
=
(
ll
-
-
ul
-
-
rc
-
-
cycle
)
;
123
predefined_shapes
[
47
]
:
=
(
ll
-
-
ul
-
-
rc
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
124
predefined_shapes
[
48
]
:
=
(
ul
-
-
ur
-
-
bc
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
125
predefined_shapes
[
49
]
:
=
(
ul
-
-
ur
-
-
bc
-
-
cycle
)
;
126
predefined_shapes
[
56
]
:
=
(
ll
-
-
lry
-
-
ury
-
-
ul
-
-
cycle
)
;
127
predefined_shapes
[
57
]
:
=
(
ll
-
-
lry
-
-
ury
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
128
predefined_shapes
[
58
]
:
=
(
ll
-
-
ulx
-
-
urx
-
-
lr
-
-
cycle
)
;
129
predefined_shapes
[
59
]
:
=
(
ll
-
-
ulx
-
-
urx
-
-
lr
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
130
predefined_shapes
[
66
]
:
=
(
rc
-
-
origin
shifted
(
epsilon
,
0
)
-
-
cycle
&
rc
-
-
origin
-
-
cycle
)
;
131
predefined_shapes
[
67
]
:
=
(
lc
-
-
origin
shifted
(
-
epsilon
,
0
)
-
-
cycle
&
lc
-
-
origin
-
-
cycle
)
;
132
predefined_shapes
[
68
]
:
=
(
tc
-
-
origin
shifted
(
0
,
epsilon
)
-
-
cycle
&
tc
-
-
origin
-
-
cycle
)
;
133
predefined_shapes
[
69
]
:
=
(
bc
-
-
origin
shifted
(
0
,
-
epsilon
)
-
-
cycle
&
bc
-
-
origin
-
-
cycle
)
;
134
predefined_shapes
[
75
]
:
=
(
lly
-
-
lry
-
-
ury
-
-
uly
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
135
predefined_shapes
[
76
]
:
=
(
ll
-
-
lr
-
-
ur
-
-
uly
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
136
predefined_shapes
[
77
]
:
=
(
ll
-
-
lr
-
-
ury
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
137
predefined_shapes
[
78
]
:
=
(
lly
-
-
lr
-
-
ur
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
138
predefined_shapes
[
79
]
:
=
(
ll
-
-
lry
-
-
ur
-
-
ul
-
-
cycle
)
rotatedaround
(
origin
,
180
)
;
139 140
numeric
predefined_shapes_xradius
;
predefined_shapes_xradius
:
=
xradius
;
141
numeric
predefined_shapes_yradius
;
predefined_shapes_yradius
:
=
yradius
;
142
numeric
predefined_shapes_xxradius
;
predefined_shapes_xxradius
:
=
xxradius
;
143
numeric
predefined_shapes_yyradius
;
predefined_shapes_yyradius
:
=
yyradius
;
144 145
stop_predefined_shape_definition
;
146 147
vardef
some_shape_path
(
expr
type
)
=
148
if
known
predefined_shapes
[
type
]
:
predefined_shapes
[
type
]
else
:
predefined_shapes
[
24
]
fi
149
enddef
;
150 151
def
some_shape
(
expr
shape_type
,
shape_width
,
shape_height
,
shape_linewidth
,
shape_linecolor
,
shape_fillcolor
)
=
152
begingroup
;
153
save
p
;
path
p
;
154
p
:
=
some_shape_path
(
shape_type
)
xscaled
shape_width
yscaled
shape_height
;
155
pickup
pencircle
scaled
shape_linewidth
;
156
fill
p
withcolor
shape_fillcolor
;
157
draw
p
withcolor
shape_linecolor
;
158
endgroup
;
159
enddef
;
160 161
% maybe:
162
%
163
% if t>1 : % normal shape
164
% path pp ; pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) ;
165
% pp := pp shifted - center pp shifted center p ;
166
% fill pp withcolor fc ;
167
% draw pp withpen pencircle scaled lw withcolor lc ;
168 169
vardef
drawpredefinedshape
(
expr
t
,
p
,
lw
,
lc
,
fc
)
=
170
save
pp
;
171
if
t
>
1
:
% normal shape
172
path
pp
;
173
pp
:
=
some_shape_path
(
t
)
xyscaled
(
bbwidth
(
p
)
,
bbheight
(
p
)
)
shifted
center
p
;
174
fill
pp
withcolor
fc
;
175
draw
pp
withpen
pencircle
scaled
lw
withcolor
lc
;
176
elseif
t
=
1
:
% background only
177
path
pp
;
178
pp
:
=
fullsquare
xyscaled
(
bbwidth
(
p
)
,
bbheight
(
p
)
)
shifted
center
p
;
179
fill
pp
withcolor
fc
;
180
else
:
% dimensions only
181
picture
pp
;
pp
:
=
nullpicture
;
182
setbounds
pp
to
fullsquare
xyscaled
(
bbwidth
(
p
)
,
bbheight
(
p
)
)
shifted
center
p
;
183
draw
pp
;
184
fi
;
185
enddef
;
186 187
vardef
drawpredefinedline
(
expr
t
,
p
,
lw
,
lc
)
=
188
if
(
t
>
0
)
and
(
length
(
p
)
>
1
)
:
189
saveoptions
;
190
drawoptions
(
withpen
pencircle
scaled
lw
withcolor
lc
)
;
191
draw
p
;
192
if
t
=
1
:
193
draw
arrowheadonpath
(
p
,
1
)
;
194
elseif
t
=
2
:
195
draw
arrowheadonpath
(
reverse
p
,
1
)
;
196
elseif
t
=
3
:
197
for
$
=
p
,
reverse
p
:
198
draw
arrowheadonpath
(
$
,
1
)
;
199
endfor
;
200
elseif
t
=
11
:
201
draw
arrowheadonpath
(
p
,
1
/
2
)
;
202
elseif
t
=
12
:
203
draw
arrowheadonpath
(
reverse
p
,
1
/
2
)
;
204
elseif
t
=
13
:
205
for
$
=
p
,
reverse
p
:
206
draw
arrowheadonpath
(
$
,
1
)
;
207
endfor
;
208
for
$
=
p
,
reverse
p
:
209
draw
arrowheadonpath
(
$
,
3
/
4
)
;
210
endfor
;
211
elseif
t
=
21
:
212
for
$
=
1
/
5
,
1
/
2
,
4
/
5
:
213
draw
arrowheadonpath
(
p
,
$
)
;
214
endfor
;
215
elseif
t
=
22
:
216
for
$
=
1
/
5
,
1
/
2
,
4
/
5
:
217
draw
arrowheadonpath
(
reverse
p
,
$
)
;
218
endfor
;
219
elseif
t
=
23
:
220
for
$
=
p
,
reverse
p
:
221
draw
arrowheadonpath
(
$
,
1
/
4
)
;
222
endfor
;
223
fi
;
224
fi
;
225
enddef
;
226 227
let
drawshape
=
drawpredefinedshape
;
228
let
drawline
=
drawpredefinedline
;
229