2021-02-27 19:30:00

3 files changed, 171 insertions, 1 deletions

diff --git a/metapost/context/base/mpiv/mp-luas.mpiv b/metapost/context/base/mpiv/mp-luas.mpiv
index 57937c0c1..2b1266a6c 100644
--- a/metapost/context/base/mpiv/mp-luas.mpiv
+++ b/metapost/context/base/mpiv/mp-luas.mpiv
@@ -149,6 +149,11 @@ def setdimen(expr k,v) = lua.mp._set_dimen_(k,v) enddef ;
 def setcount(expr k,v) = lua.mp._set_count_(k,v) enddef ;
 def settoks (expr k,v) = lua.mp._set_toks_ (k,v) enddef ;
 
+def setglobalmacro(expr k,v) = lua.mp._set_global_macro_(k,v) enddef ;
+def setglobaldimen(expr k,v) = lua.mp._set_global_dimen_(k,v) enddef ;
+def setglobalcount(expr k,v) = lua.mp._set_global_count_(k,v) enddef ;
+def setglobaltoks (expr k,v) = lua.mp._set_global_toks_ (k,v) enddef ;
+
 vardef positionpath  (expr name) = lua.mp.positionpath  (name) enddef ;
 vardef positioncurve (expr name) = lua.mp.positioncurve (name) enddef ;
 vardef positionxy    (expr name) = lua.mp.positionxy    (name) enddef ;
diff --git a/metapost/context/base/mpxl/mp-luas.mpxl b/metapost/context/base/mpxl/mp-luas.mpxl
index 3e99ae7f7..9d013a790 100644
--- a/metapost/context/base/mpxl/mp-luas.mpxl
+++ b/metapost/context/base/mpxl/mp-luas.mpxl
@@ -161,7 +161,15 @@ newscriptindex mfid_setdimen ; mfid_setdimen := scriptindex "setdimen" ; def set
 newscriptindex mfid_setcount ; mfid_setcount := scriptindex "setcount" ; def setcount(expr k, v) = runscript mfid_setcount k v ; enddef ;
 newscriptindex mfid_settoks  ; mfid_settoks  := scriptindex "settoks"  ; def settoks (expr k, v) = runscript mfid_settoks  k v ; enddef ;
 
-permanent getmacro, getdimen, getcount, gettoks, setmacro, setdimen, setcount, settoks ;
+newscriptindex mfid_setglobalmacro ; mfid_setglobalmacro := scriptindex "setglobalmacro" ; def setglobalmacro(expr k, v) = runscript mfid_setglobalmacro k v ; enddef ;
+newscriptindex mfid_setglobaldimen ; mfid_setglobaldimen := scriptindex "setglobaldimen" ; def setglobaldimen(expr k, v) = runscript mfid_setglobaldimen k v ; enddef ;
+newscriptindex mfid_setglobalcount ; mfid_setglobalcount := scriptindex "setglobalcount" ; def setglobalcount(expr k, v) = runscript mfid_setglobalcount k v ; enddef ;
+newscriptindex mfid_setglobaltoks  ; mfid_setglobaltoks  := scriptindex "setglobaltoks"  ; def setglobaltoks (expr k, v) = runscript mfid_setglobaltoks  k v ; enddef ;
+
+permanent
+    getmacro, getdimen, getcount, gettoks,
+    setmacro, setdimen, setcount, settoks,
+    setglobalmacro, setglobaldimen, setglobalcount, setglobaltoks ;
 
 vardef positionpath  (expr name) = lua.mp.positionpath  (name) enddef ;
 vardef positioncurve (expr name) = lua.mp.positioncurve (name) enddef ;
diff --git a/metapost/context/base/mpxl/mp-text.mpxl b/metapost/context/base/mpxl/mp-text.mpxl
new file mode 100644
index 000000000..92329c9da
--- /dev/null
+++ b/metapost/context/base/mpxl/mp-text.mpxl
@@ -0,0 +1,157 @@
+%D \module
+%D   [       file=mp-text.mpiv,
+%D        version=2000.07.10,
+%D          title=\CONTEXT\ \METAPOST\ graphics,
+%D       subtitle=text support,
+%D         author=Hans Hagen,
+%D           date=\currentdate,
+%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
+%C
+%C This module is part of the \CONTEXT\ macro||package and is
+%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+%C details.
+
+%D This one is only used in metafun so it will become a module.
+
+if known context_text : endinput ; fi ;
+
+boolean context_text ; context_text := true ;
+
+% This is still mostly the same as the one discussed in the good old \METAFUN\
+% example code but modernized abit to suit \LMTX.
+
+newscriptindex mfid_setparshapeproperty ; mfid_setparshapeproperty := scriptindex "setparshapeproperty" ;
+
+def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, strutdepth, topskip) =
+
+    if unknown trace_parshape :
+        boolean trace_parshape ; trace_parshape := false ;
+    fi ;
+
+    begingroup ;
+
+    save
+        q, l, r, line, tt, bb,
+        n, hsize, vsize, vvsize, voffset, hoffset, width, indent,
+        ll, lll, rr, rrr, cp, cq, t, b ;
+
+    path
+        q, l, r, line, tt, bb ;
+    numeric
+        n, hsize, vsize, vvsize, voffset, hoffset, width[], indent[] ;
+    pair
+        ll, lll, rr, rrr, cp, cq, t, b ;
+
+    n  := 0 ;
+    cp := center p ;
+
+    if path offset_or_path :
+        q       := offset_or_path ;
+        cq      := center q ;
+        voffset := dy ;
+        hoffset := dx ;
+    else :
+        q       := p ;
+        cq      := center q ;
+        hoffset := offset_or_path + dx ;
+        voffset := offset_or_path + dy ;
+    fi ;
+
+    hsize := xpart lrcorner q - xpart llcorner q ;
+    vsize := ypart urcorner q - ypart lrcorner q ;
+
+    q := p shifted - cp ;
+
+    runscript mfid_setparshapeproperty "voffset" voffset ;
+    runscript mfid_setparshapeproperty "hoffset" hoffset ;
+    runscript mfid_setparshapeproperty "width"   hsize ;
+    runscript mfid_setparshapeproperty "height"  vsize ;
+
+    if not path offset_or_path :
+        q := q xscaled ((hsize-2hoffset)/hsize) yscaled ((vsize-2voffset)/vsize) ;
+    fi ;
+
+    hsize := xpart lrcorner q - xpart llcorner q ;
+    vsize := ypart urcorner q - ypart lrcorner q ;
+
+    t := (ulcorner q -- urcorner q) intersection_point q ;
+    b := (llcorner q -- lrcorner q) intersection_point q ;
+
+    if xpart directionpoint t of q < 0 :
+        q := reverse q ;
+    fi ;
+
+    l := q cutbefore t ;
+    l := l if xpart point 0 of q < 0 : & q fi cutafter b ;
+
+    r := q cutbefore b ;
+    r := r if xpart point 0 of q > 0 : & q fi cutafter t ;
+
+    vardef found_point (expr lin, pat, sig) =
+        pair a, b ;
+        a := pat intersection_point (lin shifted (0,strutheight)) ;
+        if intersection_found :
+        a := a shifted (0,-strutheight) ;
+        else :
+        a := pat intersection_point lin ;
+        fi ;
+        b := pat intersection_point (lin shifted (0,-strutdepth)) ;
+        if intersection_found :
+            if sig :
+                if xpart b > xpart a : a := b shifted (0,strutdepth) fi ;
+            else :
+                if xpart b < xpart a : a := b shifted (0,strutdepth) fi ;
+            fi ;
+        fi ;
+        a
+    enddef ;
+
+    if (strutheight+strutdepth<baselineskip) :
+        vvsize := vsize ;
+    else :
+        vvsize := (vsize div baselineskip) * baselineskip ;
+    fi ;
+
+    runscript mfid_setparshapeproperty "first" false ;
+
+    for i=topskip step baselineskip until vvsize :
+
+        line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ;
+
+        ll := found_point(line,l,true ) ;
+        rr := found_point(line,r,false) ;
+
+        if trace_parshape :
+            fill (ll--rr--rr shifted (0,strutheight)--ll shifted (0,strutheight)--cycle) shifted cp withcolor .6white ;
+            fill (ll--rr--rr shifted (0,-strutdepth)--ll shifted (0,-strutdepth)--cycle) shifted cp withcolor .8white ;
+            draw ll shifted cp withpen pencircle scaled 2pt ;
+            draw rr shifted cp withpen pencircle scaled 2pt ;
+            draw (ll--rr) shifted cp  withpen pencircle scaled .5pt ;
+        fi ;
+
+        n := n + 1 ;
+        indent[n] := abs(xpart ll - xpart llcorner q) ;
+        width[n]  := abs(xpart rr - xpart ll) ;
+
+        if (i=strutheight) and (width[n]<baselineskip) :
+            n := n - 1 ;
+            runscript mfid_setparshapeproperty "first" true ;
+        fi ;
+
+    endfor ;
+
+    if trace_parshape :
+        drawarrow p            withpen pencircle scaled 2pt withcolor red ;
+        drawarrow l shifted cp withpen pencircle scaled 1pt withcolor green ;
+        drawarrow r shifted cp withpen pencircle scaled 1pt withcolor blue ;
+    fi ;
+
+    runscript mfid_setparshapeproperty "lines" n ;
+
+    for i=1 upto n:
+        runscript mfid_setparshapeproperty "line" i (indent[i]) (width[i]) ;
+    endfor ;
+
+    endgroup ;
+
+enddef ;