2021-03-01 15:36:00

4 files changed, 85 insertions, 29 deletions

diff --git a/metapost/context/base/mpxl/metafun.mpxl b/metapost/context/base/mpxl/metafun.mpxl
index 6f817e948..7f9530120 100644
--- a/metapost/context/base/mpxl/metafun.mpxl
+++ b/metapost/context/base/mpxl/metafun.mpxl
@@ -48,6 +48,7 @@ input "mp-apos.mpxl" ;
 input "mp-abck.mpxl" ;
 input "mp-blob.mpxl" ;
 input "mp-lmtx.mpxl" ;
+input "mp-text.mpxl" ;
 
 newinternal string metafunversion ; metafunversion := "metafun xl " & mfun_timestamp;
 
diff --git a/metapost/context/base/mpxl/mp-lmtx.mpxl b/metapost/context/base/mpxl/mp-lmtx.mpxl
index 2835dc89a..ec21b150a 100644
--- a/metapost/context/base/mpxl/mp-lmtx.mpxl
+++ b/metapost/context/base/mpxl/mp-lmtx.mpxl
@@ -2373,7 +2373,7 @@ vardef textual primary p = false enddef ;
 
 newscriptindex mfid_labtorgb ; mfid_labtorgb := scriptindex "labtorgb" ;
 
-def labtorgb(expr l,a,b) = runscript mfid_labtorgb l a b enddef ;
+def labtorgb(expr l, a, b) = runscript mfid_labtorgb l a b enddef ;
 
 permanent labtorgb ;
 
diff --git a/metapost/context/base/mpxl/mp-text.mpxl b/metapost/context/base/mpxl/mp-text.mpxl
index 92329c9da..02dbf4479 100644
--- a/metapost/context/base/mpxl/mp-text.mpxl
+++ b/metapost/context/base/mpxl/mp-text.mpxl
@@ -13,50 +13,81 @@
 
 %D This one is only used in metafun so it will become a module.
 
-if known context_text : endinput ; fi ;
+if known metafun_loaded_text : endinput ; fi ;
 
-boolean context_text ; context_text := true ;
+newinternal boolean metafun_loaded_text ; metafun_loaded_text := true ; immutable metafun_loaded_text ;
 
 % 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) =
+% this is the old name
 
-    if unknown trace_parshape :
-        boolean trace_parshape ; trace_parshape := false ;
-    fi ;
+presetparameters "parshape" [
+  % offset      = 0,
+  % path        = fullsquare,
+  % dx          = 0,
+  % dy          = 0,
+  % strutheight = StrutHeight,
+  % strutdepth  = StutDepth,
+  % lineheight  = LineHeight,
+  % topskip     = StrutHeight,
+  % trace       = false,
+] ;
+
+def lmt_parshape = applyparameters "parshape" "lmt_do_parshape" enddef ;
+
+def lmt_do_parshape = % todo: check and improve this rather oldie
 
     begingroup ;
 
     save
-        q, l, r, line, tt, bb,
+        p, q, l, r, line, tt, bb,
+        dx, dy, baselineskip, strutheight, strutdepth, topskip, bottomskip, offset, trace,
         n, hsize, vsize, vvsize, voffset, hoffset, width, indent,
         ll, lll, rr, rrr, cp, cq, t, b ;
 
     path
-        q, l, r, line, tt, bb ;
+        p, q, l, r, line, tt, bb ;
     numeric
+        dx, dy, baselineskip, strutheight, strutdepth, topskip, offset,
         n, hsize, vsize, vvsize, voffset, hoffset, width[], indent[] ;
     pair
         ll, lll, rr, rrr, cp, cq, t, b ;
+    boolean
+        trace ;
+
+    % specification:
+
+    p            := getparameterdefault "parshape" "path"         fullsquare ;
+    dx           := getparameterdefault "parshape" "dx"           0 ;
+    dy           := getparameterdefault "parshape" "dy"           0 ;
+    baselineskip := getparameterdefault "parshape" "baselineskip" LineHeight ;
+    strutheight  := getparameterdefault "parshape" "strutheight"  StrutHeight ;
+    strutdepth   := getparameterdefault "parshape" "strutdepth"   StrutDepth ;
+    topskip      := getparameterdefault "parshape" "topskip"      StrutHeight ;
+    bottomskip   := getparameterdefault "parshape" "bottomskip"   0 ;
+    offset       := getparameterdefault "parshape" "offset"       0 ;
+    trace        := getparameterdefault "parshape" "trace"        false ;
+
+    %
 
     n  := 0 ;
     cp := center p ;
 
-    if path offset_or_path :
-        q       := offset_or_path ;
-        cq      := center q ;
+    if hasparameter "parshape" "offsetpath" :
+        q       := getparameter "parshape" "offsetpath" ;
         voffset := dy ;
         hoffset := dx ;
     else :
         q       := p ;
-        cq      := center q ;
-        hoffset := offset_or_path + dx ;
-        voffset := offset_or_path + dy ;
+        hoffset := offset + dx ;
+        voffset := offset + dy ;
     fi ;
 
+    cq := center q ;
+
     hsize := xpart lrcorner q - xpart llcorner q ;
     vsize := ypart urcorner q - ypart lrcorner q ;
 
@@ -106,7 +137,7 @@ def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, s
         a
     enddef ;
 
-    if (strutheight+strutdepth<baselineskip) :
+    if (strutheight + strutdepth < baselineskip) :
         vvsize := vsize ;
     else :
         vvsize := (vsize div baselineskip) * baselineskip ;
@@ -114,33 +145,33 @@ def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, s
 
     runscript mfid_setparshapeproperty "first" false ;
 
-    for i=topskip step baselineskip until vvsize :
+    for i = topskip step baselineskip until (vvsize + bottomskip) :
 
         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 ;
+        if trace :
+            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 ;
+            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) :
+        if (i = strutheight) and (width[n] < baselineskip) :
             n := n - 1 ;
             runscript mfid_setparshapeproperty "first" true ;
         fi ;
 
     endfor ;
 
-    if trace_parshape :
+    if trace :
         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 ;
@@ -155,3 +186,31 @@ def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, s
     endgroup ;
 
 enddef ;
+
+def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, strutdepth, topskip) =
+    if path offset_or_path :
+        lmt_parshape [
+            path        = p,
+            offsetpath  = offset_or_path,
+            dx          = dx,
+            dy          = dy,
+            strutheight = strutheight,
+            strutdepth  = strutdepth,
+            lineheight  = lineheight,
+            topskip     = topskip,
+            trace       = (if unknown trace_parshape : false else : trace_parshape fi),
+        ]
+    else :
+        lmt_parshape [
+            path        = p,
+            offset      = offset_or_path,
+            dx          = dx,
+            dy          = dy,
+            strutheight = strutheight,
+            strutdepth  = strutdepth,
+            lineheight  = lineheight,
+            topskip     = topskip,
+            trace       = (if unknown trace_parshape : false else : trace_parshape fi),
+        ]
+    fi ;
+enddef ;
diff --git a/metapost/context/base/mpxl/mp-tool.mpxl b/metapost/context/base/mpxl/mp-tool.mpxl
index 1d515ffc8..d5da026f2 100644
--- a/metapost/context/base/mpxl/mp-tool.mpxl
+++ b/metapost/context/base/mpxl/mp-tool.mpxl
@@ -3464,12 +3464,8 @@ let dump = relax ;
 
 def loadmodule expr name = % no vardef
     % input can't be used directly in a macro
-    if unknown scantokens("context_" & name) :
-        save s ; string s ;
-      % s := "mp-" & name & ".mpiv" ;
-      % message("loading module",s) ;
-      % s := "input " & s ;
-        s := "input " & "mp-" & name & ".mpiv" ;
+    if (unknown scantokens("context_" & name)) and (unknown scantokens("metafun_loaded" & name)) :
+        save s ; string s ; s := "input " & ditto & "mp-" & name & ditto;
         expandafter scantokens expandafter s
     fi ;
 enddef ;