2016-08-19 00:35:00

4 files changed, 213 insertions, 41 deletions

diff --git a/metapost/context/base/mpiv/metafun.mpiv b/metapost/context/base/mpiv/metafun.mpiv
index b1d4f32e7..ab3fa8638 100644
--- a/metapost/context/base/mpiv/metafun.mpiv
+++ b/metapost/context/base/mpiv/metafun.mpiv
@@ -35,6 +35,8 @@ input "mp-func.mpiv" ; % under construction
 %     "mp-char.mpiv" ; % loaded on demand
 %     "mp-step.mpiv" ; % loaded on demand
 %     "mp-chem.mpiv" ; % loaded on demand
+input "mp-apos.mpiv" ;
+input "mp-abck.mpiv" ;
 
 string metafunversion ; metafunversion =
     "metafun iv"                        & " " &
diff --git a/metapost/context/base/mpiv/mp-abck.mpiv b/metapost/context/base/mpiv/mp-abck.mpiv
index 68706b1d9..abd7d8848 100644
--- a/metapost/context/base/mpiv/mp-abck.mpiv
+++ b/metapost/context/base/mpiv/mp-abck.mpiv
@@ -267,41 +267,3 @@ enddef ;
 def anchor_box (expr n,x,y,w,h,d) =
     currentpicture := currentpicture shifted (-x,-y) ;
 enddef ;
-
-vardef shaped (suffix p) =
-    save l ; pair l[] ;
-    save r ; pair r[] ;
-    save i ; i := 1 ;
-    save n ; n := 0 ;
-    forever :
-        exitif unknown p[i] ;
-        n := n + 1 ;
-        l[n] := ulcorner p[i] ;
-        r[n] := urcorner p[i] ;
-        n := n + 1 ;
-        l[n] := llcorner p[i] ;
-        r[n] := lrcorner p[i] ;
-        i := i + 1 ;
-    endfor ;
-    for i = 3 upto n :
-        if xpart r[i] < xpart r[i-1] :
-            r[i] := (xpart r[i],ypart r[i-1]) ;
-        elseif xpart r[i] > xpart r[i-1] :
-            r[i] := (xpart r[i],ypart r[i-1]) ;
-        fi ;
-        if xpart l[i] < xpart l[i-1] :
-            l[i] := (xpart l[i],ypart l[i-1]) ;
-        elseif xpart l[i] > xpart l[i-1] :
-            l[i] := (xpart l[i],ypart l[i-1]) ;
-        fi ;
-    endfor ;
-    if n > 0 :
-        simplified (
-            for i = 1 upto   n : r[i] -- endfor
-            for i = n downto 1 : l[i] -- endfor
-            cycle
-        )
-    else :
-        origin -- cycle
-    fi
-enddef ;
diff --git a/metapost/context/base/mpiv/mp-mlib.mpiv b/metapost/context/base/mpiv/mp-mlib.mpiv
index ea148d0c1..add58a43b 100644
--- a/metapost/context/base/mpiv/mp-mlib.mpiv
+++ b/metapost/context/base/mpiv/mp-mlib.mpiv
@@ -429,6 +429,75 @@ vardef onetimetextext@#(expr p) = % no draw here
     thetextext@#(p,origin)
 enddef ;
 
+% formatted text
+
+pair mfun_tt_z ;
+
+vardef rawfmttext(text t) = % todo: avoid currentpicture
+    mfun_tt_n := mfun_tt_n + 1 ;
+    mfun_tt_c := nullpicture ;
+    if mfun_trial_run :
+        mfun_tt_o := nullpicture ;
+        addto mfun_tt_o doublepath origin _op_ ; % save drawoptions
+        addto mfun_tt_c doublepath unitsquare
+            withprescript "tx_number=" & decimal mfun_tt_n
+            withprescript "tx_stage=trial"
+            withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
+            % begin of fmt specific
+            withprescript "tx_type=format"
+            for s = t :
+                        if string  s : withpostscript "s:" & s
+                    elseif numeric s : withpostscript "n:" & decimal s
+                    elseif boolean s : withpostscript "b:" & if s : "true" else : "false" fi
+                    elseif pair    s : hide(mfun_tt_z := s ; )
+                    fi
+            endfor ;
+            % end of fmt specific
+        if not mfun_onetime_textext :
+            addto mfun_tt_p also mfun_tt_c
+                withprescript "tx_global=yes" ;
+        fi ;
+    else :
+        mfun_tt_b := lua.mp.tt_dimensions(mfun_tt_n) ;
+        addto mfun_tt_c doublepath unitsquare
+            xscaled redpart mfun_tt_b
+            yscaled (greenpart mfun_tt_b + bluepart mfun_tt_b)
+            shifted (0,- bluepart mfun_tt_b)
+            withprescript "tx_number=" & decimal mfun_tt_n
+            withprescript "tx_stage=final" ;
+        % begin of fmt specific
+        for s = t :
+            if pair s : mfun_tt_z := s ; fi
+        endfor ;
+        % end of fmt specific
+    fi ;
+    mfun_onetime_textext := false ;
+    mfun_tt_c
+enddef ;
+
+vardef thefmttext@#(text t) =
+    mfun_tt_z := origin ;
+    save p ; picture p ; p := rawfmttext(t) ;
+    p
+        if (mfun_labtype@# >= 10) :
+            shifted (0,ypart center p)
+        fi
+        shifted (mfun_tt_z + textextoffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p))
+enddef ;
+
+vardef fmttext@#(text t) = % no draw here
+    thefmttext@#(t,origin)
+enddef ;
+
+% or just: def fmttext = thefmttext enddef ;
+
+vardef onetimefmttext@#(text t) = % no draw here
+    mfun_onetime_textext := true ;
+    thefmttext@#(t,origin)
+enddef ;
+
+% so much for formatted text
+
 vardef thetexbox@#(expr category, name, z) =
     save p ; picture p ; p := rawtexbox(category,name) ;
     p
@@ -1584,7 +1653,7 @@ vardef formatted(expr f, x) = textext(varfmt(f, x)) enddef ;
 % def varfmt = formatted enddef ; % old
 
 
-def fmttext = lua.mp.formatted enddef ;
+% def fmttext = lua.mp.formatted enddef ;
 
 % new
 
diff --git a/metapost/context/base/mpiv/mp-tool.mpiv b/metapost/context/base/mpiv/mp-tool.mpiv
index 220a7b6a9..01691724f 100644
--- a/metapost/context/base/mpiv/mp-tool.mpiv
+++ b/metapost/context/base/mpiv/mp-tool.mpiv
@@ -11,8 +11,6 @@
 %C therefore copyrighted by \PRAGMA. See mreadme.pdf for
 %C details.
 
-% def loadfile(expr name) = scantokens("input " & name & ";") enddef ;
-
 if known context_tool : endinput ; fi ;
 
 boolean context_tool ; context_tool := true ;
@@ -2833,4 +2831,145 @@ fulltriangle := point 0   along fullcircle
              -- point 2/3 along fullcircle
              -- cycle ;
 
+%D Kind of special and undocumented. On Wikipedia one can find examples
+%D of quick sort routines. Here we have a variant that permits a
+%D method.
+
+vardef listsize(suffix list) =
+    numeric len ; len := 0 ;
+    forever :
+        exitif unknown list[len+1] ;
+        len := len + 1 ;
+    endfor ;
+    len
+enddef ;
+
+vardef mfun_quick_sort(suffix list)(expr _min_, _max_)(text what) =
+    numeric l ; l := _min_ ;
+    numeric r ; r := _max_ ;
+    numeric m ; m := _min_ ;
+    numeric m ; m := floor(.5[_min_,_max_]) ;
+    _mid_ := what list[m] ;
+    forever :
+        exitif l >= r ;
+        forever :
+            exitif l > _max_ ;
+          % exitif (what list[l]) >= (what list[m]) ;
+            exitif (what list[l]) >= _mid_ ;
+            l := l + 1 ;
+        endfor ;
+        forever :
+            exitif r < _min_ ;
+          % exitif (what list[m]) >= (what list[r]) ;
+            exitif _mid_ >= (what list[r]) ;
+            r := r - 1 ;
+        endfor ;
+        if l <= r :
+          temp := list[l] ;
+          list[l] := list[r] ;
+          list[r] := temp ;
+          l := l + 1 ;
+          r := r - 1 ;
+        fi ;
+    endfor ;
+    if _min_ < r :
+        mfun_quick_sort(list)(_min_,r)(what) ;
+    fi ;
+    if l < _max_ :
+        mfun_quick_sort(list)(l,_max_)(what) ;
+    fi ;
+enddef ;
+
+vardef sortlist(suffix list)(text what) =
+    save _max_ ; numeric _max_ ; _max_ := listsize(list) ;
+    save _mid_ ; numeric _mid_ ;
+    save temp ;
+    if pair list[_max_] :
+        pair temp ;
+    else :
+        numeric temp ;
+    fi ;
+    if pair what list[_max_] :
+        pair _mid_ ;
+    else :
+        numeric _mid_ ;
+    fi ;
+    if _max_ > 1 :
+        mfun_quick_sort(list)(1,_max_)(what) ;
+    fi ;
+enddef ;
+
+vardef copylist(suffix list, target) =
+    save i ; i := 1 ;
+    forever :
+        exitif unknown list[i] ;
+        target[i] := list[i] ;
+        i := i + 1 ;
+    endfor ;
+enddef ;
+
+vardef listtolines(suffix list) =
+    list[1] for i=2 upto listsize(list) : -- list[i] endfor
+enddef ;
+
+vardef listtocurves(suffix list) =
+    list[1] for i=2 upto listsize(list) : .. list[i] endfor
+enddef ;
+
+%D The sorter is used in:
+
+vardef shaped (suffix p) = % takes a list of paths
+    save l ; pair l[] ;
+    save r ; pair r[] ;
+    save i ; i := 1 ;
+    save n ; n := 0 ;
+    forever :
+        exitif unknown p[i] ;
+        n := n + 1 ;
+        l[n] := ulcorner p[i] ;
+        r[n] := urcorner p[i] ;
+        n := n + 1 ;
+        l[n] := llcorner p[i] ;
+        r[n] := lrcorner p[i] ;
+        i := i + 1 ;
+    endfor ;
+    for i = 3 upto n :
+        if xpart r[i] < xpart r[i-1] :
+            r[i] := (xpart r[i],ypart r[i-1]) ;
+        elseif xpart r[i] > xpart r[i-1] :
+            r[i-1] := (xpart r[i-1],ypart r[i]) ;
+        fi ;
+        if xpart l[i] < xpart l[i-1] :
+            l[i-1] := (xpart l[i-1],ypart l[i]) ;
+        elseif xpart l[i] > xpart l[i-1] :
+            l[i] := (xpart l[i],ypart l[i-1]) ;
+        fi ;
+    endfor ;
+    if n > 0 :
+        simplified (
+            for i = 1 upto   n : r[i] -- endfor
+            for i = n downto 1 : l[i] -- endfor
+            cycle
+        )
+    else :
+        origin -- cycle
+    fi
+enddef ;
+
+%D Dumping is fake anyway but let's keep this:
+
 let dump = relax ;
+
+%D Loading modules can be done with:
+
+vardef loadmodule expr name =
+    % 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" ;
+        expandafter scantokens expandafter s
+    fi ;
+enddef ;