mp-apos.mpxl /size: 15 Kb    last modification: 2023-12-21 09:43
1%D \module
2%D   [       file=mp-apos.mpiv,
3%D        version=2012.02.19, % was mp-core: 1999.08.01, anchoring
4%D          title=\CONTEXT\ \METAPOST\ graphics,
5%D       subtitle=anchored background macros,
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 mreadme.pdf for
12%C details.
13
14%D Massimiliano Farinella added jiggles (zigzags) to the sidebars.
15
16if known metafun_loaded_apos : endinput ; fi ;
17
18newinternal boolean metafun_loaded_apos ; metafun_loaded_apos := true ; immutable metafun_loaded_apos ;
19
20path    posboxes[],
21        posregions[] ;
22
23numeric pospages[],
24        nofposboxes ;
25
26nofposboxes := 0 ;
27
28def boxlineoptions = withcolor .8blue  enddef ;
29def boxfilloptions = withcolor .8white enddef ;
30
31mutable posboxes, posregions, pospages, nofposboxes ;
32
33def connect_positions =
34    if nofposboxes = 2 :
35        pickup pencircle scaled boxlinewidth ;
36        path pa ; pa := posboxes[1] enlarged boxlineoffset ;
37        path pb ; pb := posboxes[2] enlarged boxlineoffset ;
38        if pospages[1] = pospages[2] :
39            draw posboxes[1]  boxlineoptions ;
40            path pc ; pc := center pa {up} .. {down} center pb ;
41            pair cc ; cc := (pc intersection_point pa) ;
42            if intersection_found :
43                pc := pc cutbefore cc ;
44                cc := (pc intersection_point pb) ;
45                if intersection_found :
46                    pc := pc cutafter cc ;
47                    drawarrow pc boxlineoptions ;
48                    drawarrow reverse pc boxlineoptions ;
49                fi ;
50            fi ;
51        elseif pospages[1] == RealPageNumber :
52            draw posboxes[1] boxlineoptions ;
53            path pc ; pc := center pa {up} ... {right} urcorner (posregions[1] enlarged (20pt,20pt)) ;
54            pair cc ; cc := (pc intersection_point pa) ;
55            if intersection_found :
56                pc := pc cutbefore cc ;
57                drawarrow pc boxlineoptions ;
58            fi ;
59        elseif pospages[2] == RealPageNumber :
60            draw posboxes[2] boxlineoptions ;
61            path pc ; pc := ulcorner (posregions[2] enlarged (20pt,20pt)) {right} ... {down} center pb ;
62            pair cc ; cc := (pc intersection_point pb) ;
63            if intersection_found :
64                pc := pc cutafter cc ;
65                drawarrow pc boxlineoptions ;
66            fi ;
67        fi ;
68    fi ;
69enddef ;
70
71% anch-bar:
72
73% When Massimiliano Farinella (aka mf) added the patterns with jiggles the interface got
74% upgraded to lmtx too. So this one is different from the mkiv version! Messed up a little
75% by me to fit in the rest.
76
77vardef anch_sidebars_pattern(expr a, b, pattern, patternlength, patternheight, linewidth) =
78    image (
79        save p, q, s ; pair p, s ; path q ;
80        s := ( (b - a) / arclength (a -- b) ) * patternlength ;
81        q := pattern xscaled patternlength yscaled patternheight rotated (angle(s)) ;
82        p := a ;
83        forever :
84            draw
85                q shifted p
86                withpen pencircle scaled linewidth ;
87            p := p + s ;
88            exitif arclength (a -- p) > arclength (a -- b) ;
89        endfor ;
90        clip currentpicture to
91            (xpart llcorner currentpicture, ypart b) --
92            (xpart lrcorner currentpicture, ypart b) --
93            (xpart urcorner currentpicture, ypart a) --
94            (xpart ulcorner currentpicture, ypart a) -- cycle ;
95    )
96enddef ;
97
98% (performance wise) we can fetch distance and alternative once
99
100def anch_sidebars_draw(expr b_self, e_self, t_anchor) = % even these three can become variables
101    % beware, we anchor at (x,y)
102    begingroup ;
103        interim linecap := if boxalternative = 1 : rounded else : butt fi ;
104        save a, b, lw, by ; pair a, b ; numeric lw, by ;
105        by := getposy(getposregion(b_self)) - getposy(t_anchor) ; % for mf to do: all of them
106        if getpospage(b_self) = getpospage(e_self) :
107            a := (-boxdistance,getposy(b_self) + getposheight(b_self) - getposy(t_anchor)) ;
108            b := (-boxdistance,getposy(e_self) - getposdepth (e_self) - getposy(t_anchor)) ;
109        elseif RealPageNumber = getpospage(b_self) :
110            a := (-boxdistance,getposy(b_self) + getposheight(b_self) - getposy(t_anchor)) ;
111            b := (-boxdistance,by) ;
112        elseif RealPageNumber = getpospage(e_self) :
113            a := (-boxdistance,getposheight(t_anchor)) ;
114            b := (-boxdistance,getposy(e_self) - getposdepth (e_self) - getposy(t_anchor)) ;
115        else :
116            a := (-boxdistance,getposheight(t_anchor)) ;
117            b := (-boxdistance,0) ;
118        fi ;
119        if a == b :
120            message("side bar pattern ignored: a == b") ;
121        else :
122            a := (xpart a, min(ypart a + boxtopoffset,getposheight(t_anchor))) ;
123            b := (xpart b, max(ypart b - boxbottomoffset,0)) ;
124            if boxatright :
125                a := (xpart a + HSize + 2 * boxdistance,ypart a) ;
126                b := (xpart b + HSize + 2 * boxdistance,ypart b) ;
127            fi ;
128            lw := boxlinewidth ;
129            draw
130                if boxalternative = 2 :
131                    anch_sidebars_pattern(a, b,
132                        ((0,0)--(0.25,-0.5)--(0.75,0.5)--(1,0)) scaled lw,
133                        2lw, 2lw, lw
134                    )
135                elseif boxalternative = 3 :
136                    anch_sidebars_pattern(a, b,
137                        ((0,0)--(0.25,-0.5)--(0.75,0.5)--(1,0)) scaled lw,
138                        4lw, 1.5lw, lw
139                    )
140                elseif boxalternative = 4 :
141                    anch_sidebars_pattern(a, b,
142                        (((0,0) .. controls (0,0.5) and (0.5,0.5) .. (0.5,0)) -- ((0.5,0) .. controls (0.5,-0.5) and (1,-0.5) .. (1,0))) scaled lw,
143                        6lw, 4lw, lw
144                    )
145                elseif boxalternative = 5 :
146                    anch_sidebars_pattern(a, b,
147                        ((0,0) .. controls (0,1) and (1,1) .. (1,0)) scaled lw,
148                        4lw, 2lw, lw
149                    )
150                elseif boxalternative = 6 :
151                    anch_sidebars_pattern(a, b,
152                        ((0,0.5) .. (1,-0.5)) scaled lw,
153                        4lw, 2lw, lw
154                    )
155                elseif boxalternative = 7 :
156                    anch_sidebars_pattern(a, b,
157                        ((0,-0.5) .. (1,0.5)) scaled lw,
158                        22lw, 5lw, lw
159                    )
160                else :
161                    (a -- b)
162                        if boxalternative = 1 :
163                            dashed (withdots scaled (lw/2))
164                        fi
165                        withpen pencircle scaled lw
166                fi
167                withcolor boxlinecolor ;
168        fi ;
169    endgroup ;
170enddef ;
171
172% new interface
173
174newscriptindex mfid_getposboxes  ; mfid_getposboxes  := scriptindex "getposboxes" ;
175newscriptindex mfid_getmultipars ; mfid_getmultipars := scriptindex "getmultipars" ;
176
177def getposboxes (expr tags, anchor) = runscript mfid_getposboxes  tags anchor ; enddef ;
178def getmultipars(expr tags, anchor) = runscript mfid_getmultipars tags anchor ; enddef ;
179
180newscriptindex mfid_getpospage      ; mfid_getpospage      := scriptindex "getpospage"      ; vardef getpospage     (expr n) = runscript mfid_getpospage      n enddef ;
181newscriptindex mfid_getposparagraph ; mfid_getposparagraph := scriptindex "getposparagraph" ; vardef getposparagraph(expr n) = runscript mfid_getposparagraph n enddef ;
182newscriptindex mfid_getposcolumn    ; mfid_getposcolumn    := scriptindex "getposcolumn"    ; vardef getposcolumn   (expr n) = runscript mfid_getposcolumn    n enddef ;
183newscriptindex mfid_getposregion    ; mfid_getposregion    := scriptindex "getposregion"    ; vardef getposregion   (expr n) = runscript mfid_getposregion    n enddef ;
184
185newscriptindex mfid_getposx ; mfid_getposx := scriptindex "getposx" ; vardef getposx(expr n) = runscript mfid_getposx n enddef ;
186newscriptindex mfid_getposy ; mfid_getposy := scriptindex "getposy" ; vardef getposy(expr n) = runscript mfid_getposy n enddef ;
187
188newscriptindex mfid_getposwidth  ; mfid_getposwidth  := scriptindex "getposwidth"  ; vardef getposwidth (expr n) = runscript mfid_getposwidth  n enddef ;
189newscriptindex mfid_getposheight ; mfid_getposheight := scriptindex "getposheight" ; vardef getposheight(expr n) = runscript mfid_getposheight n enddef ;
190newscriptindex mfid_getposdepth  ; mfid_getposdepth  := scriptindex "getposdepth"  ; vardef getposdepth (expr n) = runscript mfid_getposdepth  n enddef ;
191
192newscriptindex mfid_getposleftskip   ; mfid_getposleftskip   := scriptindex "getposleftskip"   ; vardef getposleftskip  (expr n) = runscript mfid_getposleftskip   n enddef ;
193newscriptindex mfid_getposrightskip  ; mfid_getposrightskip  := scriptindex "getposrightskip"  ; vardef getposrightskip (expr n) = runscript mfid_getposrightskip  n enddef ;
194newscriptindex mfid_getposhsize      ; mfid_getposhsize      := scriptindex "getposhsize"      ; vardef getposhsize     (expr n) = runscript mfid_getposhsize      n enddef ;
195newscriptindex mfid_getposparindent  ; mfid_getposparindent  := scriptindex "getposparindent"  ; vardef getposparindent (expr n) = runscript mfid_getposparindent  n enddef ;
196newscriptindex mfid_getposhangindent ; mfid_getposhangindent := scriptindex "getposhangindent" ; vardef getposhangindent(expr n) = runscript mfid_getposhangindent n enddef ;
197newscriptindex mfid_getposhangafter  ; mfid_getposhangafter  := scriptindex "getposhangafter"  ; vardef getposhangafter (expr n) = runscript mfid_getposhangafter  n enddef ;
198
199newscriptindex mfid_getposxy         ; mfid_getposxy         := scriptindex "getposxy"         ; vardef getposxy        (expr n) = runscript mfid_getposxy         n enddef ;
200newscriptindex mfid_getposupperleft  ; mfid_getposupperleft  := scriptindex "getposupperleft"  ; vardef getposupperleft (expr n) = runscript mfid_getposupperleft  n enddef ;
201newscriptindex mfid_getposlowerleft  ; mfid_getposlowerleft  := scriptindex "getposlowerleft"  ; vardef getposlowerleft (expr n) = runscript mfid_getposlowerleft  n enddef ;
202newscriptindex mfid_getposupperright ; mfid_getposupperright := scriptindex "getposupperright" ; vardef getposupperright(expr n) = runscript mfid_getposupperright n enddef ;
203newscriptindex mfid_getposlowerright ; mfid_getposlowerright := scriptindex "getposlowerright" ; vardef getposlowerright(expr n) = runscript mfid_getposlowerright n enddef ;
204
205newscriptindex mfid_getposllx ; mfid_getposllx := scriptindex "getposllx" ; vardef getposllx(expr n) = runscript mfid_getposllx n enddef ;
206newscriptindex mfid_getposlly ; mfid_getposlly := scriptindex "getposlly" ; vardef getposlly(expr n) = runscript mfid_getposlly n enddef ;
207newscriptindex mfid_getposurx ; mfid_getposurx := scriptindex "getposurx" ; vardef getposurx(expr n) = runscript mfid_getposurx n enddef ;
208newscriptindex mfid_getposury ; mfid_getposury := scriptindex "getposury" ; vardef getposury(expr n) = runscript mfid_getposury n enddef ;
209
210permanent
211    getposboxes, getmultipars,
212    getpospage, getposparagraph, getposcolumn, getposregion,
213    getposx, getposy, getposwidth, getposheight, getposdepth,
214    getposleftskip, getposrightskip, getposhsize, getposparindent, getposhangindent, getposhangafter,
215    getposxy, getposupperleft, getposlowerleft, getposupperright, getposlowerright,
216    getposllx, getposlly, getposurx, getposury ;
217
218def anch_box_arrows_draw =
219    begingroup ;
220        save f, t, p, alternative, delta, dashtype, edge, arrow, ff, tt, spanpages, spanfirst, spanlast, skip ;
221        pair f, t, ff, tt ; path p ; string alternative, arrow ; boolean spanpages, spanfirst, spanlast, skip ;
222        dashtype := mpvarn("dashtype") ;
223        delta := mpvard("distance");
224        alternative := mpvars("alternative") ;
225        arrow := mpvars("arrow") ;
226        spanpages := false ;
227        spanfirst := true ;
228        spanlast := true ;
229        skip := false ;
230        if positionx(mpvars("rightedge")) > 0 :
231            if alternative = "left" :
232                edge := positionx(mpvars("leftedge"));
233                f := (edge,positiony(mpvars("from"))) ;
234                t := (edge,positiony(mpvars("to"  ))) ;
235                p := (f  -- (f xshifted - delta) -- (t xshifted - delta) --  t) ;
236                draw thetextext.lft(mpvars("text"), (point .5 along p) xshifted -ExHeight) ;
237            elseif alternative = "right" :
238                edge := positionx(mpvars("rightedge"));
239                f := (edge,positiony(mpvars("from"))) ;
240                t := (edge,positiony(mpvars("to"  ))) ;
241                p := (f  -- (f xshifted delta) -- (t xshifted delta) --  t) ;
242                draw thetextext.rt(mpvars("text"), (point .5 along p) xshifted ExHeight) ;
243            elseif alternative = "middle" :
244                p := f  --  t ;
245                draw thetextext.rt(mpvars("text"), (point .5 along p) xshifted ExHeight) ;
246            fi ;
247        else :
248            f := positionxy(mpvars("from")) ;
249            t := positionxy(mpvars("to")) ;
250            spanpages := getpospage(mpvars("to")) > getpospage(mpvars("from")) ;
251            if spanpages :
252                if getpospage(mpvars("from")) = RealPageNumber :
253                    t := (getposwidth(getposregion(mpvars("from"))),ypart f) ;
254                    spanlast := false ;
255                elseif getpospage(mpvars("to")) = RealPageNumber :
256                    f := (getposx(getposregion(mpvars("to"))),ypart t) ;
257                    spanfirst := false ;
258                fi ;
259            fi
260% drawdot f withpen pencircle scaled 2pt;
261% drawdot t withpen pencircle scaled 2pt;
262            %
263            skip := (not spanpages) and ((mpvars("span")) = "yes") ;
264            if skip :
265                % we skip the second just in case
266            elseif alternative = "" :
267                message("invalid alternative in draw box arrow");
268                skip := true;
269            elseif alternative = "bottom" :
270                ff := (xpart f, min(ypart f, ypart t)) ;
271                tt := (xpart t, ypart ff) ;
272                p := (if spanfirst: f -- fi (ff yshifted -delta) -- (tt yshifted -delta) if spanlast : --  t fi) ;
273                draw thetextext.bot(mpvars("text"), (point .5 along p) yshifted -.25ExHeight) ;
274            elseif alternative = "top" :
275                ff := (xpart f, max(ypart f, ypart t)) ;
276                tt := (xpart t, ypart ff) ;
277                p := (if spanfirst: f -- fi (ff yshifted delta) -- (tt yshifted delta) if spanlast : --  t fi) ;
278                draw thetextext.top(mpvars("text"), (point .5 along p) yshifted .25ExHeight) ;
279            elseif alternative = "left" :
280                ff := (min(xpart f, xpart t), ypart f) ;
281                tt := (xpart ff, ypart t) ;
282                p := (f  -- (ff xshifted - delta) -- (tt xshifted - delta) --  t) ;
283                draw thetextext.lft(mpvars("text"), (point .5 along p) xshifted -ExHeight) ;
284            elseif alternative = "right" :
285                ff := (max(xpart f, xpart t), ypart f) ;
286                tt := (xpart ff, ypart t) ;
287                p := (f  -- (ff xshifted delta) -- (tt xshifted delta) --  t) ;
288                draw thetextext.rt(mpvars("text"), (point .5 along p) xshifted ExHeight) ;
289            elseif alternative = "middle" :
290                p := f  --  t ;
291                draw thetextext.rt(mpvars("text"), (point .5 along p) xshifted ExHeight) ;
292            fi ;
293        fi ;
294        if not skip :
295            % 1 = dashed, 2 = dashed with background
296            if arrow ="no" :
297                draw
298            elseif arrow == "reverse" :
299                drawarrow reverse
300            elseif arrow == "both" :
301                drawdblarrow
302            else :
303                drawarrow
304            fi
305                p
306                if dashtype == 1 :
307                    withdashes .5ExHeight
308                fi
309                withpen pencircle scaled mpvard("rulethickness")
310                withcolor mpvars("linecolor") ;
311            positioninregion ;
312        fi ;
313    endgroup ;
314enddef ;
315