2022-03-24 21:17:00

4 files changed, 86 insertions, 29 deletions

diff --git a/metapost/context/base/mpiv/mp-tool.mpiv b/metapost/context/base/mpiv/mp-tool.mpiv
index 495900fa2..f41811413 100644
--- a/metapost/context/base/mpiv/mp-tool.mpiv
+++ b/metapost/context/base/mpiv/mp-tool.mpiv
@@ -2470,6 +2470,23 @@ primarydef p cornered c =
     endfor cycle)
 enddef ;
 
+% Mikael Sundqvist came up with this one. We made it robust for points being too close
+% for smoothing.
+
+primarydef p smoothcornered c =
+    ( begingroup ;
+        save cc ;
+        if not cycle p: (point 0 of p) -- fi
+        for i=1 upto length(p) :
+            hide (cc := min(c,arclength (subpath(i-1,i) of p)/2);)
+            (point i-1 of p) shifted (cc*(unitvector(point i   of p - point i-1 of p))) --
+            (point i   of p) shifted (cc*(unitvector(point i-1 of p - point i   of p))) ..
+            controls point i of p ..
+        endfor
+        if cycle p : cycle else : point 1 along p fi
+    endgroup )
+enddef ;
+
 % cmyk color support
 
 % vardef cmyk(expr c,m,y,k) = % elsewhere
@@ -3730,3 +3747,20 @@ vardef hatched(expr o) primary c =
     clip r_ to o;
     r_
 enddef;
+
+% By Mikael Sundqvist, with a little evolution:
+
+numeric mfun_dash_on, mfun_dash_off ;
+
+primarydef p withdashes len =
+    hide (
+        save l, t, n, m ; pair t ;
+        l := arclength p ;
+        t := paired(len) ;
+        m := xpart t + ypart t ;
+        n := l / (l div m) / m ;
+        mfun_dash_on  := n * xpart t ;
+        mfun_dash_off := n * ypart t ;
+    )
+    p dashed dashpattern (on mfun_dash_on off mfun_dash_off)
+enddef ;
diff --git a/metapost/context/base/mpxl/mp-luas.mpxl b/metapost/context/base/mpxl/mp-luas.mpxl
index 18b4391f2..8f093bbfe 100644
--- a/metapost/context/base/mpxl/mp-luas.mpxl
+++ b/metapost/context/base/mpxl/mp-luas.mpxl
@@ -199,19 +199,19 @@ newscriptindex mfid_positionregion ; mfid_positionregion := scriptindex("positio
 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 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) ;
diff --git a/metapost/context/base/mpxl/mp-mlib.mpxl b/metapost/context/base/mpxl/mp-mlib.mpxl
index f29ba9c44..0958d8767 100644
--- a/metapost/context/base/mpxl/mp-mlib.mpxl
+++ b/metapost/context/base/mpxl/mp-mlib.mpxl
@@ -1799,7 +1799,8 @@ enddef ;
 
 permanent comment, report ;
 
-% This overloads a dummy:
+% This nechanism is not really promoted and more an experiment. It scales better than
+% \METAPOST\ own hash.
 
 % todo: use mfid_* cum suis
 
@@ -1809,16 +1810,18 @@ 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 newhash                          = runscript mfid_hash_new                 enddef ; % optional, returns index
 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 ;
 
+string mfun_u_l_h ; mfun_u_l_h := "mfun_u_l_h" ;
+
 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
-    save i, j, h ;
+    save i, j ;
     if known lis[0] :
         i := 0 ;
         j := -1 ;
@@ -1826,20 +1829,20 @@ vardef uniquelist(suffix list) =
         i := 1 ;
         j := 0 ;
     fi ;
-    h := runscript mfid_hash_new ;
+  % mfun_u_l_h := runscript mfid_hash_new ; % here mfun_u_l_h has to be a numeric
     forever :
         exitif unknown list[i] ;
-        if not (runscript mfid_hash_in h list[i]) :
+        if not (runscript mfid_hash_in (mfun_u_l_h) list[i]) :
             j := j + 1 ;
             list[j] := list[i] ;
-            runscript mfid_hash_to h list[i] ;
+            runscript mfid_hash_to (mfun_u_l_h) (j) list[i] ;
         fi ;
         i := i + 1 ;
     endfor ;
-    for n = j+1 step 1 until i-1 :
+    for n = j + 1 step 1 until i - 1 :
         dispose(list[n])
     endfor ;
-    runscript mfid_hash_dispose h ;
+    runscript mfid_hash_dispose mfun_u_l_h ;
 enddef ;
 
 permanent uniquelist ;
diff --git a/metapost/context/base/mpxl/mp-tool.mpxl b/metapost/context/base/mpxl/mp-tool.mpxl
index 294dddcb9..28d1bbf3e 100644
--- a/metapost/context/base/mpxl/mp-tool.mpxl
+++ b/metapost/context/base/mpxl/mp-tool.mpxl
@@ -2593,7 +2593,24 @@ primarydef p cornered c =
     endfor cycle)
 enddef ;
 
-permanent smoothed, cornered ;
+% Mikael Sundqvist came up with this one. We made it robust for points being too close
+% for smoothing.
+
+primarydef p smoothcornered c =
+    ( begingroup ;
+        save cc ;
+        if not cycle p: (point 0 of p) -- fi
+        for i=1 upto length(p) :
+            hide (cc := min(c,arclength (subpath(i-1,i) of p)/2);)
+            (point i-1 of p) shifted (cc*(unitvector(point i   of p - point i-1 of p))) --
+            (point i   of p) shifted (cc*(unitvector(point i-1 of p - point i   of p))) ..
+            controls point i of p ..
+        endfor
+        if cycle p : cycle else : point 1 along p fi
+    endgroup )
+enddef ;
+
+permanent smoothed, cornered, smoothcornered ;
 
 % cmyk color support
 
@@ -3911,18 +3928,21 @@ enddef;
 
 permanent hatched ;
 
-% By Mikael Sundqvist:
+% By Mikael Sundqvist, with a little evolution:
 
-numeric mfun_dash_len ;
+numeric mfun_dash_on, mfun_dash_off ;
 
 primarydef p withdashes len =
     hide (
-        save l, n ;
+        save l, t, n, m ; pair t ;
         l := arclength p ;
-        n := l div len ;
-        if odd(n) : n := n + 1 fi ;
-        mfun_dash_len := l / n ;
+        t := paired(len) ;
+        m := xpart t + ypart t ;
+        n := l / (l div m) / m ;
+        mfun_dash_on  := n * xpart t ;
+        mfun_dash_off := n * ypart t ;
     )
-    p dashed dashpattern (on mfun_dash_len off mfun_dash_len)
+    p dashed dashpattern (on mfun_dash_on off mfun_dash_off)
 enddef ;
 
+permanent withdashes ;