2021-08-19 19:43:00

4 files changed, 142 insertions, 152 deletions

diff --git a/metapost/context/base/mpxl/mp-apos.mpxl b/metapost/context/base/mpxl/mp-apos.mpxl
index 65d3e86fb..3070d3a8a 100644
--- a/metapost/context/base/mpxl/mp-apos.mpxl
+++ b/metapost/context/base/mpxl/mp-apos.mpxl
@@ -179,16 +179,17 @@ newscriptindex mfid_getmultipars ; mfid_getmultipars := scriptindex "getmultipar
 def getposboxes (expr tags, anchor) = runscript mfid_getposboxes  tags anchor ; enddef ;
 def getmultipars(expr tags, anchor) = runscript mfid_getmultipars tags anchor ; enddef ;
 
-newscriptindex mfid_getpospage       ; mfid_getpospage       := scriptindex "getpospage"       ; vardef getpospage      (expr n) = runscript mfid_getpospage       n enddef ;
-newscriptindex mfid_getposparagraph  ; mfid_getposparagraph  := scriptindex "getposparagraph"  ; vardef getposparagraph (expr n) = runscript mfid_getposparagraph  n enddef ;
-newscriptindex mfid_getposcolumn     ; mfid_getposcolumn     := scriptindex "getposcolumn"     ; vardef getposcolumn    (expr n) = runscript mfid_getposcolumn     n enddef ;
-newscriptindex mfid_getposregion     ; mfid_getposregion     := scriptindex "getposregion"     ; vardef getposregion    (expr n) = runscript mfid_getposregion     n enddef ;
+newscriptindex mfid_getpospage      ; mfid_getpospage      := scriptindex "getpospage"      ; vardef getpospage     (expr n) = runscript mfid_getpospage      n enddef ;
+newscriptindex mfid_getposparagraph ; mfid_getposparagraph := scriptindex "getposparagraph" ; vardef getposparagraph(expr n) = runscript mfid_getposparagraph n enddef ;
+newscriptindex mfid_getposcolumn    ; mfid_getposcolumn    := scriptindex "getposcolumn"    ; vardef getposcolumn   (expr n) = runscript mfid_getposcolumn    n enddef ;
+newscriptindex mfid_getposregion    ; mfid_getposregion    := scriptindex "getposregion"    ; vardef getposregion   (expr n) = runscript mfid_getposregion    n enddef ;
 
-newscriptindex mfid_getposx          ; mfid_getposx          := scriptindex "getposx"          ; vardef getposx         (expr n) = runscript mfid_getposx          n enddef ;
-newscriptindex mfid_getposy          ; mfid_getposy          := scriptindex "getposy"          ; vardef getposy         (expr n) = runscript mfid_getposy          n enddef ;
-newscriptindex mfid_getposwidth      ; mfid_getposwidth      := scriptindex "getposwidth"      ; vardef getposwidth     (expr n) = runscript mfid_getposwidth      n enddef ;
-newscriptindex mfid_getposheight     ; mfid_getposheight     := scriptindex "getposheight"     ; vardef getposheight    (expr n) = runscript mfid_getposheight     n enddef ;
-newscriptindex mfid_getposdepth      ; mfid_getposdepth      := scriptindex "getposdepth"      ; vardef getposdepth     (expr n) = runscript mfid_getposdepth      n enddef ;
+newscriptindex mfid_getposx ; mfid_getposx := scriptindex "getposx" ; vardef getposx(expr n) = runscript mfid_getposx n enddef ;
+newscriptindex mfid_getposy ; mfid_getposy := scriptindex "getposy" ; vardef getposy(expr n) = runscript mfid_getposy n enddef ;
+
+newscriptindex mfid_getposwidth  ; mfid_getposwidth  := scriptindex "getposwidth"  ; vardef getposwidth (expr n) = runscript mfid_getposwidth  n enddef ;
+newscriptindex mfid_getposheight ; mfid_getposheight := scriptindex "getposheight" ; vardef getposheight(expr n) = runscript mfid_getposheight n enddef ;
+newscriptindex mfid_getposdepth  ; mfid_getposdepth  := scriptindex "getposdepth"  ; vardef getposdepth (expr n) = runscript mfid_getposdepth  n enddef ;
 
 newscriptindex mfid_getposleftskip   ; mfid_getposleftskip   := scriptindex "getposleftskip"   ; vardef getposleftskip  (expr n) = runscript mfid_getposleftskip   n enddef ;
 newscriptindex mfid_getposrightskip  ; mfid_getposrightskip  := scriptindex "getposrightskip"  ; vardef getposrightskip (expr n) = runscript mfid_getposrightskip  n enddef ;
@@ -203,9 +204,15 @@ newscriptindex mfid_getposlowerleft  ; mfid_getposlowerleft  := scriptindex "get
 newscriptindex mfid_getposupperright ; mfid_getposupperright := scriptindex "getposupperright" ; vardef getposupperright(expr n) = runscript mfid_getposupperright n enddef ;
 newscriptindex mfid_getposlowerright ; mfid_getposlowerright := scriptindex "getposlowerright" ; vardef getposlowerright(expr n) = runscript mfid_getposlowerright n enddef ;
 
+newscriptindex mfid_getposllx ; mfid_getposllx := scriptindex "getposllx" ; vardef getposllx(expr n) = runscript mfid_getposllx n enddef ;
+newscriptindex mfid_getposlly ; mfid_getposlly := scriptindex "getposlly" ; vardef getposlly(expr n) = runscript mfid_getposlly n enddef ;
+newscriptindex mfid_getposurx ; mfid_getposurx := scriptindex "getposurx" ; vardef getposurx(expr n) = runscript mfid_getposurx n enddef ;
+newscriptindex mfid_getposury ; mfid_getposury := scriptindex "getposury" ; vardef getposury(expr n) = runscript mfid_getposury n enddef ;
+
 permanent
     getposboxes, getmultipars,
     getpospage, getposparagraph, getposcolumn, getposregion,
     getposx, getposy, getposwidth, getposheight, getposdepth,
     getposleftskip, getposrightskip, getposhsize, getposparindent, getposhangindent, getposhangafter,
-    getposxy, getposupperleft, getposlowerleft, getposupperright, getposlowerright ;
+    getposxy, getposupperleft, getposlowerleft, getposupperright, getposlowerright,
+    getposllx, getposlly, getposurx, getposury ;
diff --git a/metapost/context/base/mpxl/mp-luas.mpxl b/metapost/context/base/mpxl/mp-luas.mpxl
index 00e7876a8..24a2fc8fe 100644
--- a/metapost/context/base/mpxl/mp-luas.mpxl
+++ b/metapost/context/base/mpxl/mp-luas.mpxl
@@ -138,18 +138,30 @@ permanent resolvedcolor ;
 
 % Modes:
 
-vardef texmode   (expr s) = lua.mp("mode",      s) enddef ;
-vardef systemmode(expr s) = lua.mp("systemmode",s) enddef ;
+newscriptindex mfid_mode       ; mfid_mode       := scriptindex "mode" ;
+newscriptindex mfid_systemmode ; mfid_systemmode := scriptindex "systemmode" ;
+
+vardef texmode    (expr s) = runscript mfid_mode       s enddef ;
+vardef systemmode (expr s) = runscript mfid_systemmode s enddef ;
+
+% let processingmode = systemmode ;
 
 permanent texmode, systemmode ;
 
 % A few helpers
 
-vardef isarray   suffix a = lua.mp.isarray  (str a) enddef ;
-vardef prefix    suffix a = lua.mp.prefix   (str a) enddef ;
-vardef dimension suffix a = lua.mp.dimension(str a) enddef ;
+newscriptindex mfid_isarray   ; mfid_isarray   := scriptindex "isarray"   ;
+newscriptindex mfid_prefix    ; mfid_prefix    := scriptindex "prefix"    ;
+newscriptindex mfid_dimension ; mfid_dimension := scriptindex "dimension" ;
+newscriptindex mfid_isobject  ; mfid_isobject  := scriptindex "isobject"  ;
+
+vardef isarray   suffix a = runscript mfid_isarray  (str a) enddef ;
+vardef prefix    suffix a = runscript mfid_prefix   (str a) enddef ;
+vardef dimension suffix a = runscript mfid_dimension(str a) enddef ;
 
-permanent isarray, prefix, dimension ;
+vardef isobject  expr p = if picture p : runscript mfid_isobject prescriptpart p else : false fi enddef ;
+
+permanent isarray, prefix, dimension, isobject ;
 
 % More access
 
@@ -175,17 +187,31 @@ permanent
     setmacro, setdimen, setcount, settoks,
     setglobalmacro, setglobaldimen, setglobalcount, setglobaltoks ;
 
-% todo: mfid_
-
-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 ;
-vardef positionpxy   (expr name) = lua.mp.positionpxy   (name) enddef ;
-vardef positionwhd   (expr name) = lua.mp.positionwhd   (name) enddef ;
-vardef positionpage  (expr name) = lua.mp.positionpage  (name) enddef ;
-vardef positionregion(expr name) = lua.mp.positionregion(name) enddef ;
-vardef positionbox   (expr name) = lua.mp.positionbox   (name) enddef ;
-vardef positionanchor            = lua.mp.positionanchor()     enddef ;
+newscriptindex mfid_positionpath   ; mfid_positionpath   := scriptindex("positionpath") ;
+newscriptindex mfid_positioncurve  ; mfid_positioncurve  := scriptindex("positioncurve") ;
+newscriptindex mfid_positionxy     ; mfid_positionxy     := scriptindex("positionxy") ;
+newscriptindex mfid_positionx      ; mfid_positionx      := scriptindex("positionx") ;
+newscriptindex mfid_positiony      ; mfid_positiony      := scriptindex("positiony") ;
+newscriptindex mfid_positionpar    ; mfid_positionpar    := scriptindex("positionpar") ;
+newscriptindex mfid_positionwhd    ; mfid_positionwhd    := scriptindex("positionwhd") ;
+newscriptindex mfid_positionpage   ; mfid_positionpage   := scriptindex("positionpage") ;
+newscriptindex mfid_positionregion ; mfid_positionregion := scriptindex("positionregion") ;
+newscriptindex mfid_positionbox    ; mfid_positionbox    := scriptindex("positionbox") ;
+newscriptindex mfid_positionanchor ; mfid_positionanchor := scriptindex("positionanchor") ;
+
+vardef positionpath     (expr name) = runscript mfid_positionpath      name enddef ;
+vardef positioncurve    (expr name) = runscript mfid_positioncurve     name enddef ;
+vardef positionxy       (expr name) = runscript mfid_positionxy        name enddef ;
+vardef positionx        (expr name) = runscript mfid_positionx         name enddef ;
+vardef positiony        (expr name) = runscript mfid_positiony         name enddef ;
+vardef positionpar      (expr name) = runscript mfid_positionpar       name enddef ;
+vardef positionwhd      (expr name) = runscript mfid_positionwhd       name enddef ;
+vardef positionpage     (expr name) = runscript mfid_positionpage      name enddef ;
+vardef positioncolumn   (expr name) = runscript mfid_positioncolumn    name enddef ;
+vardef positionparagraph(expr name) = runscript mfid_positionparagraph name enddef ;
+vardef positionregion   (expr name) = runscript mfid_positionregion    name enddef ;
+vardef positionbox      (expr name) = runscript mfid_positionbox       name enddef ;
+vardef positionanchor               = runscript mfid_positionanchor         enddef ;
 
 vardef positioninregion =
     currentpicture := currentpicture shifted - positionxy(positionanchor) ;
@@ -195,8 +221,9 @@ vardef positionatanchor(expr name) =
     currentpicture := currentpicture shifted - positionxy(name) ;
 enddef ;
 
-permanent positionpath, positioncurve, positionxy, positionpxy, positionwhd, positionpage,
-    positionregion, positionbox, positionanchor, positioninregion, positionatanchor ;
+permanent positionpath, positioncurve, positionxy, positionwhd,
+    positionpage, positionregion, positioncolumn, positionparagraph,
+    positionbox, positionanchor, positioninregion, positionatanchor ;
 
 let wdpart = redpart ;
 let htpart = greenpart ;
@@ -204,8 +231,8 @@ let dppart = bluepart ;
 
 permanent wdpart, htpart, dppart;
 
-vardef texvar(expr name) = lua.mp.texvar(name) enddef ;
-vardef texstr(expr name) = lua.mp.texstr(name) enddef ;
+newscriptindex mfid_texvar ; mfid_texvar := scriptindex "texvar" ; vardef texvar(expr s) = runscript mfid_texvar s enddef ;
+newscriptindex mfid_texstr ; mfid_texstr := scriptindex "texstr" ; vardef texstr(expr s) = runscript mfid_texstr s enddef ;
 
 newscriptindex mfid_path_lengthof ; mfid_path_lengthof := scriptindex "pathlengthof" ;
 newscriptindex mfid_path_pointof  ; mfid_path_pointof  := scriptindex "pathpointof" ;
diff --git a/metapost/context/base/mpxl/mp-mlib.mpxl b/metapost/context/base/mpxl/mp-mlib.mpxl
index 35854a987..65146081e 100644
--- a/metapost/context/base/mpxl/mp-mlib.mpxl
+++ b/metapost/context/base/mpxl/mp-mlib.mpxl
@@ -17,19 +17,6 @@ newinternal boolean metafun_loaded_mlib ; metafun_loaded_mlib := true ; immutabl
 
 % numeric LUATEXFUNCTIONALITY ; LUATEXFUNCTIONALITY := runscript("mp.print(LUATEXFUNCTIONALITY or (status and status.development_id) or 6346)") ;
 
-%D Objects:
-
-vardef isobject expr p =
-    if picture p :
-      % lua.mp.isobject(prescriptpart p)
-        runscript("mp.isobject(" & prescriptpart p & ")")
-    else :
-        false
-    fi
-enddef ;
-
-permanent isobject ;
-
 %D Color and transparency
 %D
 %D Separable:
@@ -146,12 +133,11 @@ newinternal textextoffset ; textextoffset := 0 ;
 
 permanent textextoffset ;
 
-%%%%%%% mfun_tt_w[], mfun_tt_h[], mfun_tt_d[] ; % we can consider using colors (less hash space)
-color   mfun_tt_b ;
-numeric mfun_tt_n ; mfun_tt_n := 0 ;
-picture mfun_tt_p ; mfun_tt_p := nullpicture ;
-picture mfun_tt_o ; mfun_tt_o := nullpicture ;
-picture mfun_tt_c ; mfun_tt_c := nullpicture ;
+rgbcolor mfun_tt_r ;
+numeric  mfun_tt_n ; mfun_tt_n := 0 ;
+picture  mfun_tt_p ; mfun_tt_p := nullpicture ;
+picture  mfun_tt_o ; mfun_tt_o := nullpicture ;
+picture  mfun_tt_c ; mfun_tt_c := nullpicture ;
 
 if unknown mfun_trial_run :
     boolean mfun_trial_run ;
@@ -213,8 +199,9 @@ immutable inicatcoderegime, texcatcoderegime, luacatcoderegime, notcatcoderegime
 
 permanent catcoderegime ;
 
-newscriptindex mfid_sometextext ; mfid_sometextext := scriptindex "sometextext" ;
-newscriptindex mfid_madetextext ; mfid_madetextext := scriptindex "madetextext" ;
+newscriptindex mfid_sometextext   ; mfid_sometextext   := scriptindex "sometextext" ;
+newscriptindex mfid_madetextext   ; mfid_madetextext   := scriptindex "madetextext" ;
+newscriptindex mfid_boxdimensions ; mfid_boxdimensions := scriptindex "boxdimensions" ;
 
 vardef rawtextext(expr s) =
     if s = "" :
@@ -254,6 +241,10 @@ vardef rawmadetext =
     mfun_tt_c
 enddef ;
 
+% \setbox\scratchbox\hbox{!!!!!!!!!!!!!}
+% \putboxincache{one}{a}\scratchbox
+% \startMPcode draw rawtexbox("one","a") ; \stopMPcode
+
 vardef validtexbox(expr category, name) =
     if category == "" :
         false
@@ -269,11 +260,12 @@ enddef ;
 vardef rawtexbox(expr category, name) =
     mfun_tt_c := nullpicture ;
     if validtexbox(category,name) :
-        mfun_tt_b := lua.mp.mf_tb_dimensions(category, name) ;
+      % mfun_tt_r := lua.mp.mf_tb_dimensions(category, name) ;
+        mfun_tt_r := runscript mfid_boxdimensions category name ;
         addto mfun_tt_c doublepath unitsquare
-            xscaled wdpart mfun_tt_b
-            yscaled (htpart mfun_tt_b + dppart mfun_tt_b)
-            shifted (0,- dppart mfun_tt_b)
+            xscaled wdpart mfun_tt_r
+            yscaled (htpart mfun_tt_r + dppart mfun_tt_r)
+            shifted (0,- dppart mfun_tt_r)
             withprescript "mf_object=box"
             withprescript "bx_category=" & if numeric category : decimal fi category
             withprescript "bx_name=" & if numeric name : decimal fi name ;
@@ -1671,102 +1663,20 @@ permanent tostring, topair, quote, quotation ;
 % but running lua is fast enough so we can gain on string construction in metapost
 % which is also not that efficient.
 
-vardef mfun_key_to_lua(expr k) =
-    if numeric k : decimal k else : "'" & k & "'" fi
-enddef ;
-
-vardef mfun_point_to_lua(expr k,p,i) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
-        decimal xpart (point       i of p) & "," &
-        decimal ypart (point       i of p) & "," &
-        decimal xpart (precontrol  i of p) & "," &
-        decimal ypart (precontrol  i of p) & "," &
-        decimal xpart (postcontrol i of p) & "," &
-        decimal ypart (postcontrol i of p)
-    & "})" ) ;
-enddef ;
-
-vardef mfun_transform_to_lua(expr k,t) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
-        decimal xxpart t & "," &   % rx
-        decimal xypart t & "," &   % sx
-        decimal yxpart t & "," &   % sy
-        decimal yypart t & "," &   % ry
-        decimal xpart  t & "," &   % tx
-        decimal ypart  t           % ty
-    & "})" ) ;
-enddef ;
-
-vardef mfun_numeric_to_lua(expr k,n) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & "," & decimal n & ")" ) ;
-enddef ;
-
-vardef mfun_pair_to_lua(expr k,p) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
-        decimal xpart p & "," &
-        decimal ypart p
-    & "})" ) ;
-enddef ;
-
-vardef mfun_rgbcolor_to_lua(expr k,c) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
-        decimal redpart   c & "," &
-        decimal greenpart c & "," &
-        decimal bluepart  c
-    & "})" ) ;
-enddef ;
-
-vardef mfun_cmykcolor_to_lua(expr k,c) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
-        decimal cyanpart    c & "," &
-        decimal magentapart c & "," &
-        decimal yellowpart  c & "," &
-        decimal blackpart   c
-    & "})" ) ;
-enddef ;
-
-vardef mfun_path_to_lua(expr k,p) =
-    runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ;
-    for i=0 upto length(p) :
-        mfun_point_to_lua(i+1,p,i) ;
-    endfor ;
-    runscript("metapost.popvariable()") ;
-enddef ;
-
-vardef mfun_boolean_to_lua(expr k,b) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & if b : ",true)" else : ",false)" fi ) ;
-enddef ;
-
-vardef mfun_string_to_lua(expr k,s) =
-    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",[==[" & s & "]==])" ) ;
-enddef ;
+newscriptindex mfid_passvariable ; mfid_passvariable := scriptindex("passvariable") ;
+newscriptindex mfid_pushvariable ; mfid_pushvariable := scriptindex("pushvariable") ;
+newscriptindex mfid_popvariable  ; mfid_popvariable  := scriptindex("popvariable") ;
 
-def passvariable(expr key, value) =
-    if     numeric   value : mfun_numeric_to_lua  (key,value) ;
-    elseif pair      value : mfun_pair_to_lua     (key,value) ;
-    elseif string    value : mfun_string_to_lua   (key,value) ;
-    elseif boolean   value : mfun_boolean_to_lua  (key,value) ;
-    elseif path      value : mfun_path_to_lua     (key,value) ;
-    elseif rgbcolor  value : mfun_rgbcolor_to_lua (key,value) ;
-    elseif cmykcolor value : mfun_cmykcolor_to_lua(key,value) ;
-    elseif transform value : mfun_transform_to_lua(key,value) ;
-    fi ;
-enddef ;
+def passvariable        (expr key, value) = runscript mfid_passvariable key value ; enddef ;
+def startpassingvariable(expr key)        = runscript mfid_pushvariable key ; enddef ;
+def stoppassingvariable                   = runscript mfid_popvariable ; enddef ;
 
 def passarrayvariable(expr key)(suffix values)(expr first, last, stp) =
-    runscript("metapost.pushvariable(" & mfun_key_to_lua(key) & ")") ;
+    startpassingvariable(key) ;
     for i=first step stp until last :
         passvariable(i, values[i]) ;
     endfor
-    runscript("metapost.popvariable()") ;
-enddef ;
-
-def startpassingvariable(expr k) =
-    runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ;
-enddef ;
-
-def stoppassingvariable =
-    runscript("metapost.popvariable()") ;
+    stoppassingvariable ;
 enddef ;
 
 permanent passvariable, passarrayvariable, startpassingvariable, stoppassingvariable ;
@@ -1844,7 +1754,6 @@ permanent format, formatted ;
 % def strfmt = format    enddef ; % old
 % def varfmt = formatted enddef ; % old
 
-
 % def fmttext = lua.mp.formatted enddef ;
 
 % new
@@ -1894,6 +1803,18 @@ permanent comment, report ;
 
 % todo: use mfid_* cum suis
 
+newscriptindex mfid_hash_new     ; mfid_hash_new     := scriptindex("lmt_hash_new") ;
+newscriptindex mfid_hash_dispose ; mfid_hash_dispose := scriptindex("lmt_hash_dispose") ;
+newscriptindex mfid_hash_in      ; mfid_hash_in      := scriptindex("lmt_hash_in") ;
+newscriptindex mfid_hash_from    ; mfid_hash_from    := scriptindex("lmt_hash_from") ;
+newscriptindex mfid_hash_to      ; mfid_hash_to      := scriptindex("lmt_hash_to") ;
+
+def newhash                          = runscript mfid_hash_new                 enddef ;
+def disposehash (expr n)             = runscript mfid_hash_dispose n           enddef ;
+def inhash      (expr n, key)        = runscript mfid_hash_in      n key       enddef ;
+def fromhash    (expr n, key)        = runscript mfid_hash_from    n key       enddef ;
+def tohash      (expr n, key, value) = runscript mfid_hash_to      n key value enddef ;
+
 vardef uniquelist(suffix list) =
     % this can be optimized by passing all values at once and returning
     % a result but for now this is ok .. we need an undef foo
@@ -1905,20 +1826,20 @@ vardef uniquelist(suffix list) =
         i := 1 ;
         j := 0 ;
     fi ;
-    h := lua.mp.newhash() ;
+    h := runscript mfid_hash_new ;
     forever :
         exitif unknown list[i] ;
-        if not lua.mp.inhash(h,list[i]) :
+        if not (runscript mfid_hash_in h list[i]) :
             j := j + 1 ;
             list[j] := list[i] ;
-            lua.mp.tohash(h,list[i]) ;
+            runscript mfid_hash_to h list[i] ;
         fi ;
         i := i + 1 ;
     endfor ;
     for n = j+1 step 1 until i-1 :
         dispose(list[n])
     endfor ;
-    lua.mp.disposehash(h) ;
+    runscript mfid_hash_dispose h ;
 enddef ;
 
 permanent uniquelist ;
diff --git a/metapost/context/base/mpxl/mp-xbox.mpxl b/metapost/context/base/mpxl/mp-xbox.mpxl
index 2b8b94c27..08589cb93 100644
--- a/metapost/context/base/mpxl/mp-xbox.mpxl
+++ b/metapost/context/base/mpxl/mp-xbox.mpxl
@@ -5,6 +5,14 @@
 % copyright : Public domain
 % patched   : Hans Hagen
 %
+% author    : Karl Berry
+% version   : $Id: rboxes.mp,v 1.2 2004/09/19 21:47:11 karl Exp $
+% copyright : Public domain
+% patched   : Hans Hagen
+%
+% The code is the same but I've added a boxes_ namespace for some so that we don't
+% clash with metafun.
+
 % The code is the same but I've added s boxes_ namespace for soem so that we don't
 % clash with metafun. Loading and initialization is now under metafun control.
 
@@ -13,7 +21,8 @@ if known metafun_loaded_xbox : endinput ; fi ;
 newinternal boolean metafun_loaded_xbox ; metafun_loaded_xbox := true ; immutable metafun_loaded_xbox ;
 
 % Find the length of the prefix of string s for which cond is true for each character
-% c of the prefix.
+% c of the prefix. Loading and initialization is now under metafun control. Only the
+% mpxl variant will be adapted. When needed this file will be adapted.
 
 vardef boxes_str_prefix (expr s) (text cond) =
     save i_, c; string c; i_ = 0;
@@ -295,3 +304,29 @@ if makingfigure :
     boxes_init_all;
 fi ;
 
+% Rectangular boxes with rounded corners
+
+newinternal rbox_radius ; rbox_radius := 8bp ;
+
+vardef rboxit@#(text tt) =
+    boxes_begin("boxes_the_rounded","boxes_size",@#,tt) ;
+    boxes_generic_declare (pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w ;
+    0 = xpart(@#nw - @#sw) = ypart(@#se - @#sw) ;
+    0 = xpart(@#ne - @#se) = ypart(@#ne - @#nw) ;
+    @#w = .5[@#nw,@#sw] ;
+    @#s = .5[@#sw,@#se] ;
+    @#e = .5[@#ne,@#se] ;
+    @#n = .5[@#ne,@#nw] ;
+    @#ne - @#c = @#c - @#sw = (@#dx,@#dy) + .5*(urcorner boxes_pic@# - llcorner boxes_pic@#) ;
+    boxes_end(boxes_clear,@#) ;
+enddef;
+
+def boxes_the_rounded(suffix $) =
+    save _r ; _r = min(rbox_radius, .5*ypart($.n-$.s), .5*xpart($.e-$.w));
+    $.sw + (_r,0) {right} .. {right} $.se - (_r,0) ..
+    $.se + (0,_r)    {up} .. {up}    $.ne - (0,_r) ..
+    $.ne - (_r,0)  {left} .. {left}  $.nw + (_r,0) ..
+    $.nw - (0,_r)  {down} .. {down}  $.sw + (0,_r) ..
+    cycle
+enddef;
+