Source Browser ?

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. We can actually use \hsplit
22% now!
23
24newscriptindex mfid_setparshapeproperty ; mfid_setparshapeproperty := scriptindex "setparshapeproperty" ;
25
26% this is the old name
27
28presetparameters "parshape" [
29  % offset      = 0,
30  % path        = fullsquare,
31  % dx          = 0,
32  % dy          = 0,
33  % strutheight = StrutHeight,
34  % strutdepth  = StutDepth,
35  % lineheight  = LineHeight,
36  % topskip     = StrutHeight,
37  % trace       = false,
38] ;
39
40def lmt_parshape = applyparameters "parshape" "lmt_do_parshape" enddef ;
41
42def lmt_do_parshape = % todo: check and improve this rather oldie
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    % specification:
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,-i-eps) ;
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