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 -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
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 |