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
16if known metafun_loaded_text : endinput ; fi ;
17
18newinternal 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
23newscriptindex mfid_setparshapeproperty ; mfid_setparshapeproperty := scriptindex "setparshapeproperty" ;
24
25% this is the old name
26
27presetparameters "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
39def lmt_parshape = applyparameters "parshape" "lmt_do_parshape" enddef ;
40
41def 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-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,-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 .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