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