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
23newscriptindex mfid_setparshapeproperty ; mfid_setparshapeproperty := scriptindex "setparshapeproperty" ;
24
25
26
27presetparameters "parshape" [
28
29
30
31
32
33
34
35
36
37] ;
38
39def lmt_parshape = applyparameters "parshape" "lmt_do_parshape" enddef ;
40
41def lmt_do_parshape =
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
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-2hoffset)hsize) yscaled ((vsize-2voffset)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,ieps) ;
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 .6white ;
158 fill (ll -- rr -- rr shifted (0,strutdepth) -- ll shifted (0,strutdepth) -- cycle) shifted cp withcolor .8white ;
159 draw ll shifted cp withpen pencircle scaled 2pt ;
160 draw rr shifted cp withpen pencircle scaled 2pt ;
161 draw (ll -- rr) shifted cp withpen pencircle scaled .5pt ;
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 2pt withcolor red ;
177 drawarrow l shifted cp withpen pencircle scaled 1pt withcolor green ;
178 drawarrow r shifted cp withpen pencircle scaled 1pt 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
189enddef ;
190
191def 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 ;
217enddef ;
218 |