mp-text.mpxl /size: 7099 b    last modification: 2021-10-28 13:50
1
%D \module
2
%D [ file=mp-text.mpiv,
3
%D version=2000.07.10,
4
%D title=\CONTEXT\ \METAPOST\ graphics,
5
%D subtitle=text support,
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
%D This one is only used in metafun so it will become a module.
15 16
if
known
metafun_loaded_text
:
endinput
;
fi
;
17 18
newinternal
boolean
metafun_loaded_text
;
metafun_loaded_text
:
=
true
;
immutable
metafun_loaded_text
;
19 20
% This is still mostly the same as the one discussed in the good old \METAFUN\
21
% example code but modernized abit to suit \LMTX.
22 23
newscriptindex
mfid_setparshapeproperty
;
mfid_setparshapeproperty
:
=
scriptindex
"
setparshapeproperty
"
;
24 25
% this is the old name
26 27
presetparameters
"
parshape
"
[
28
% offset = 0,
29
% path = fullsquare,
30
% dx = 0,
31
% dy = 0,
32
% strutheight = StrutHeight,
33
% strutdepth = StutDepth,
34
% lineheight = LineHeight,
35
% topskip = StrutHeight,
36
% trace = false,
37
]
;
38 39
def
lmt_parshape
=
applyparameters
"
parshape
"
"
lmt_do_parshape
"
enddef
;
40 41
def
lmt_do_parshape
=
% todo: check and improve this rather oldie
42 43
begingroup
;
pushparameters
"
parshape
"
;
44 45
save
46
p
,
q
,
l
,
r
,
line
,
tt
,
bb
,
47
dx
,
dy
,
baselineskip
,
strutheight
,
strutdepth
,
topskip
,
bottomskip
,
offset
,
trace
,
48
n
,
hsize
,
vsize
,
vvsize
,
voffset
,
hoffset
,
width
,
indent
,
49
ll
,
lll
,
rr
,
rrr
,
cp
,
cq
,
t
,
b
,
50
found_point
;
51 52
path
53
p
,
q
,
l
,
r
,
line
,
tt
,
bb
;
54
numeric
55
dx
,
dy
,
baselineskip
,
strutheight
,
strutdepth
,
topskip
,
offset
,
56
n
,
hsize
,
vsize
,
vvsize
,
voffset
,
hoffset
,
width
[
]
,
indent
[
]
;
57
pair
58
ll
,
lll
,
rr
,
rrr
,
cp
,
cq
,
t
,
b
;
59
boolean
60
trace
;
61 62
% specification:
63 64
p
:
=
getparameterdefault
"
path
"
fullsquare
;
65
dx
:
=
getparameterdefault
"
dx
"
0
;
66
dy
:
=
getparameterdefault
"
dy
"
0
;
67
baselineskip
:
=
getparameterdefault
"
baselineskip
"
LineHeight
;
68
strutheight
:
=
getparameterdefault
"
strutheight
"
StrutHeight
;
69
strutdepth
:
=
getparameterdefault
"
strutdepth
"
StrutDepth
;
70
topskip
:
=
getparameterdefault
"
topskip
"
StrutHeight
;
71
bottomskip
:
=
getparameterdefault
"
bottomskip
"
0
;
72
offset
:
=
getparameterdefault
"
offset
"
0
;
73
trace
:
=
getparameterdefault
"
trace
"
false
;
74 75
%
76 77
n
:
=
0
;
78
cp
:
=
center
p
;
79 80
if
hasparameter
"
offsetpath
"
:
81
q
:
=
getparameter
"
offsetpath
"
;
82
voffset
:
=
dy
;
83
hoffset
:
=
dx
;
84
else
:
85
q
:
=
p
;
86
hoffset
:
=
offset
+
dx
;
87
voffset
:
=
offset
+
dy
;
88
fi
;
89 90
cq
:
=
center
q
;
91 92
hsize
:
=
xpart
lrcorner
q
-
xpart
llcorner
q
;
93
vsize
:
=
ypart
urcorner
q
-
ypart
lrcorner
q
;
94 95
q
:
=
p
shifted
-
cp
;
96 97
runscript
mfid_setparshapeproperty
"
voffset
"
voffset
;
98
runscript
mfid_setparshapeproperty
"
hoffset
"
hoffset
;
99
runscript
mfid_setparshapeproperty
"
width
"
hsize
;
100
runscript
mfid_setparshapeproperty
"
height
"
vsize
;
101 102
if
hasparameter
"
offsetpath
"
:
103
q
:
=
q
xscaled
(
(
hsize
-2
hoffset
)
/
hsize
)
yscaled
(
(
vsize
-2
voffset
)
/
vsize
)
;
104
fi
;
105 106
hsize
:
=
xpart
lrcorner
q
-
xpart
llcorner
q
;
107
vsize
:
=
ypart
urcorner
q
-
ypart
lrcorner
q
;
108 109
t
:
=
(
ulcorner
q
--
urcorner
q
)
intersection_point
q
;
110
b
:
=
(
llcorner
q
--
lrcorner
q
)
intersection_point
q
;
111 112
if
xpart
directionpoint
t
of
q
<
0
:
113
q
:
=
reverse
q
;
114
fi
;
115 116
l
:
=
q
cutbefore
t
;
117
l
:
=
l
if
xpart
point
0
of
q
<
0
:
&
q
fi
cutafter
b
;
118 119
r
:
=
q
cutbefore
b
;
120
r
:
=
r
if
xpart
point
0
of
q
>
0
:
&
q
fi
cutafter
t
;
121 122
vardef
found_point
(
expr
lin
,
pat
,
sig
)
=
123
save
a
,
b
;
pair
a
,
b
;
124
a
:
=
pat
intersection_point
(
lin
shifted
(
0
,
strutheight
)
)
;
125
if
intersection_found
:
126
a
:
=
a
shifted
(
0
,
-
strutheight
)
;
127
else
:
128
a
:
=
pat
intersection_point
lin
;
129
fi
;
130
b
:
=
pat
intersection_point
(
lin
shifted
(
0
,
-
strutdepth
)
)
;
131
if
intersection_found
:
132
if
sig
:
133
if
xpart
b
>
xpart
a
:
a
:
=
b
shifted
(
0
,
strutdepth
)
fi
;
134
else
:
135
if
xpart
b
<
xpart
a
:
a
:
=
b
shifted
(
0
,
strutdepth
)
fi
;
136
fi
;
137
fi
;
138
a
139
enddef
;
140 141
if
(
strutheight
+
strutdepth
<
baselineskip
)
:
142
vvsize
:
=
vsize
;
143
else
:
144
vvsize
:
=
(
vsize
div
baselineskip
)
*
baselineskip
;
145
fi
;
146 147
runscript
mfid_setparshapeproperty
"
first
"
false
;
148 149
for
i
=
topskip
step
baselineskip
until
(
vvsize
+
bottomskip
)
:
150 151
line
:
=
(
ulcorner
q
--
urcorner
q
)
shifted
(
0
,
-
i
-
eps
)
;
152 153
ll
:
=
found_point
(
line
,
l
,
true
)
;
154
rr
:
=
found_point
(
line
,
r
,
false
)
;
155 156
if
trace
:
157
fill
(
ll
--
rr
--
rr
shifted
(
0
,
strutheight
)
--
ll
shifted
(
0
,
strutheight
)
--
cycle
)
shifted
cp
withcolor
.6
white
;
158
fill
(
ll
--
rr
--
rr
shifted
(
0
,
-
strutdepth
)
--
ll
shifted
(
0
,
-
strutdepth
)
--
cycle
)
shifted
cp
withcolor
.8
white
;
159
draw
ll
shifted
cp
withpen
pencircle
scaled
2
pt
;
160
draw
rr
shifted
cp
withpen
pencircle
scaled
2
pt
;
161
draw
(
ll
--
rr
)
shifted
cp
withpen
pencircle
scaled
.5
pt
;
162
fi
;
163 164
n
:
=
n
+
1
;
165
indent
[
n
]
:
=
abs
(
xpart
ll
-
xpart
llcorner
q
)
;
166
width
[
n
]
:
=
abs
(
xpart
rr
-
xpart
ll
)
;
167 168
if
(
i
=
strutheight
)
and
(
width
[
n
]
<
baselineskip
)
:
169
n
:
=
n
-
1
;
170
runscript
mfid_setparshapeproperty
"
first
"
true
;
171
fi
;
172 173
endfor
;
174 175
if
trace
:
176
drawarrow
p
withpen
pencircle
scaled
2
pt
withcolor
red
;
177
drawarrow
l
shifted
cp
withpen
pencircle
scaled
1
pt
withcolor
green
;
178
drawarrow
r
shifted
cp
withpen
pencircle
scaled
1
pt
withcolor
blue
;
179
fi
;
180 181
runscript
mfid_setparshapeproperty
"
lines
"
n
;
182 183
for
i
=
1
upto
n
:
184
runscript
mfid_setparshapeproperty
"
line
"
i
(
indent
[
i
]
)
(
width
[
i
]
)
;
185
endfor
;
186 187
popparameters
;
endgroup
;
188 189
enddef
;
190 191
def
build_parshape
(
expr
p
,
offset_or_path
,
dx
,
dy
,
baselineskip
,
strutheight
,
strutdepth
,
topskip
)
=
192
if
path
offset_or_path
:
193
lmt_parshape
[
194
path
=
p
,
195
offsetpath
=
offset_or_path
,
196
dx
=
dx
,
197
dy
=
dy
,
198
strutheight
=
strutheight
,
199
strutdepth
=
strutdepth
,
200
lineheight
=
lineheight
,
201
topskip
=
topskip
,
202
trace
=
(
if
unknown
trace_parshape
:
false
else
:
trace_parshape
fi
)
,
203
]
204
else
:
205
lmt_parshape
[
206
path
=
p
,
207
offset
=
offset_or_path
,
208
dx
=
dx
,
209
dy
=
dy
,
210
strutheight
=
strutheight
,
211
strutdepth
=
strutdepth
,
212
lineheight
=
lineheight
,
213
topskip
=
topskip
,
214
trace
=
(
if
unknown
trace_parshape
:
false
else
:
trace_parshape
fi
)
,
215
]
216
fi
;
217
enddef
;
218