2022-07-24 12:18:00

3 files changed, 74 insertions, 96 deletions

diff --git a/metapost/context/base/mpxl/mp-lmtx.mpxl b/metapost/context/base/mpxl/mp-lmtx.mpxl
index be4ae716b..acf3dcbef 100644
--- a/metapost/context/base/mpxl/mp-lmtx.mpxl
+++ b/metapost/context/base/mpxl/mp-lmtx.mpxl
@@ -1,5 +1,5 @@
 %D \module
-%D   [       file=mp-luas.lmtx,
+%D   [       file=mp-lmtx.lmtx,
 %D        version=2019.06.23,
 %D          title=\CONTEXT\ \METAPOST\ graphics,
 %D       subtitle=\LUA,
@@ -1041,9 +1041,11 @@ presetparameters "chart" [
         "darkyellow", "darkmagenta", "darkcyan",
         "darkgray"
     },
+    linecolors      = { },
     colormode       = "global",
 
     linewidth       = .25mm,
+  % linegap         = 0,
 
     legendcolor     = "",
     legendstyle     = "",
@@ -1082,16 +1084,18 @@ def lmt_chart_bar       = applyparameters "chart:bar"       "lmt_do_chart_bar"
 
 def lmt_do_chart_start (expr what) =
     pushparameters what ;
-    save width, height, distance, linewidth, labelgap, labelfraction, value, nofsamples, nofsamplesets ;
-    save fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
-    string fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
+    save width, height, depth, distance, linewidth, linegap, labelgap, labelfraction, value, nofsamples, nofsamplesets ;
+    save fillcolor, linecolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
+    string fillcolor, linecolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
     if hasparameter "sampleset" :
         setluaparameter what "samples" (getparameter "sampleset") ;
     fi ;
     height := getparameter "height" ;
+    depth := max((getparameter "originsize"), (getparameter "innerradius")) ;
     width := getparameter "width" ;
     distance := getparameter "distance" ;
     linewidth := getparameter "linewidth" ;
+    linegap := getparameterdefault "linegap" linewidth ;
     drawcolor := getparameter "drawcolor" ;
     colormode :=  getparameter "colormode" ;
     labelcolor := getparameter "labelcolor" ;
@@ -1168,75 +1172,28 @@ def lmt_do_chart_legend =
     fi ;
 enddef ;
 
-% vardef lmt_do_chart_circle =
-%     image (
-%         lmt_do_chart_start("chart:circle") ;
-%         if (nofsamplesets > 0) and (nofsamples > 0) :
-%             nofsamplesets := 1 ;
-%             save p, r, s, first, last, total, factor, n, percentage ;
-%             path p, r, s[] ; boolean percentage ;
-%             percentage := getparameter "percentage" ;
-%             total := 0 ;
-%             for i = 1 upto nofsamples :
-%                 total := total + getparameter "samples" (1) i ; % () is needed else 1i
-%             endfor ;
-%             factor := 100/total ;
-%             first := 0 ;
-%             p := fullcircle ysized (height) ;
-%             r := origin -- (2*height,0) ;
-%             for i = 1 upto nofsamples :
-%                 fillcolor := getparameter "fillcolors" i ;
-%                 value := (getparameter "samples" (1) i) * factor ;
-%                 last := first + (360/100) * value ;
-%                 s[i] := ((p cutbefore (r rotated first)) cutafter (r rotated last)) ;
-%               % fill
-%               %     (if innerradius > 0 : reverse (s[i] scaled innerradius) else : origin fi) -- s[i] -- cycle
-%               %     withcolor fillcolor
-%               % ;
-%                 fill origin -- s[i] -- cycle withcolor fillcolor ;
-%                 first := last ;
-%             endfor ;
-%             if linewidth > 0 :
-%                 if drawcolor = "" :
-%                     drawcolor := backgroundcolor ;
-%                 fi ;
-%                 for i = 1 upto nofsamples :
-%                     interim linecap := butt ;
-%                     draw origin -- (point 0            of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
-%                     draw origin -- (point length(s[i]) of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
-%                 endfor ;
-%             fi ;
-%             if getparameter "showlabels" :
-%                 first := 0 ;
-%                 for i = 1 upto nofsamples :
-%                     value := getparameter "samples" (1) i ;
-%                     last := first + (360/100) * value * factor ;
-%                     draw lmt_do_chart_text (s,i,value)
-%                         shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ;
-%                     first := last ;
-%                 endfor ;
-%             fi ;
-%             lmt_do_chart_legend ;
-%             n := getparameter "originsize" ;
-%             if n > 0 :
-%                 fill fullcircle scaled n withcolor "white"  ;
-%             fi ;
-%             n := getparameter "innerradius" ;
-%             if n > 0 :
-%                 fill fullcircle scaled n withcolor "white" ;
-%             fi ;
-%         fi ;
-%         lmt_do_chart_stop ;
-%     )
-% enddef ;
+% draw lmt_chart_circle [
+%     height       = 4cm,
+%     innerradius  = 2.0cm,
+%     samples      = { { 10, 20, 30, 40, 50 } },
+%     percentage   = false,
+%     initialangle = 90,
+%     linewidth    = .125mm,
+%     originsize   = 0,
+%     showlabels   = false,
+%     drawcolor    = "white",
+%     fillcolors   = { "red",     "green",  "blue",     "",       "cyan" },
+%     linecolors   = { "magenta", "orange", "darkgray", "orange", "darkgray" }
+%     linecolors   = { "",        "orange", "",         "orange", "" }
+% ] ;
 
 vardef lmt_do_chart_circle =
     image (
         lmt_do_chart_start("chart:circle") ;
         if (nofsamplesets > 0) and (nofsamples > 0) :
             nofsamplesets := 1 ;
-            save p, r, s, first, last, total, factor, n, percentage, initial, clockwise ;
-            path p, r, s[] ; boolean percentage, clockwise ;
+            save p, q, r, s, t, pl, ql, first, last, total, factor, n, percentage, initial, clockwise ;
+            path p, q, r, s[], t[] ; boolean percentage, clockwise ;
             clockwise := true ;
             percentage := getparameter "percentage" ;
             initial := if not clockwise : - fi getparameter "initialangle" ; % watch sign
@@ -1248,54 +1205,67 @@ vardef lmt_do_chart_circle =
             first := initial ;
             if clockwise :
                 p := (reverse fullcircle rotated first) ysized (height) ;
+                q := (reverse fullcircle rotated first) ysized (depth) ;
             else :
                 p := fullcircle ysized (height) ;
+                q := fullcircle ysized (depth) ;
             fi ;
             r := origin -- (2*height,0) ;
+            pl := ((linewidth + linegap) / (arclength p)) * 360;
+            ql := ((linewidth + linegap) / (arclength q)) * 360;
             for i = 1 upto nofsamples :
                 fillcolor := getparameter "fillcolors" i ;
-                value := (getparameter "samples" (1) i) * factor ;
-                if (value > -eps) and (value < eps) :
-                    value := eps ; % otherwise weird effects with zero
+                linecolor := getparameterdefault "linecolors" i "" ;
+                if linecolor = "" :
+                    linecolor := fillcolor ;
                 fi ;
+                value := (getparameter "samples" (1) i) * factor ;
+if (value > -eps) and (value < eps) :
+    s[i] := origin ;
+    t[i] := origin ;
+else :
+%                 if (value > -eps) and (value < eps) :
+%                     value := eps ; % otherwise weird effects with zero
+%                 fi ;
                 last := first if clockwise : - else : + fi (360/100) * value ;
-                s[i] := ((p cutbefore (r rotated first)) cutafter (r rotated last)) ;
-              % fill
-              %     (if innerradius > 0 : reverse (s[i] scaled innerradius) else : origin fi) -- s[i] -- cycle
-              %     withcolor fillcolor
-              % ;
-                fill origin -- s[i] -- cycle withcolor fillcolor ;
+                s[i] :=         ((p cutbefore (r rotated first)) cutafter (r rotated (last + pl))) ;
+                t[i] := reverse ((q cutbefore (r rotated first)) cutafter (r rotated (last + ql))) ;
+                path piece ; piece := s[i] -- t[i] -- cycle ;
+                if fillcolor <> "" :
+                    fill piece
+                        withpen pencircle scaled linewidth
+                        withcolor fillcolor
+                    ;
+                fi ;
+                if linecolor <> "" :
+                    if linewidth > 0 :
+                        interim linecap := butt ;
+                        draw piece
+                            withpen pencircle scaled linewidth
+                            withcolor if linecolor <> "" : linecolor else drawcolor : fi
+                        ;
+                    fi ;
+                fi ;
                 first := last ;
+fi ;
             endfor ;
             if linewidth > 0 :
-                if drawcolor = "" :
-                    drawcolor := backgroundcolor ;
-                fi ;
-                for i = 1 upto nofsamples :
-                    interim linecap := butt ;
-                    draw origin -- (point 0            of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
-                    draw origin -- (point length(s[i]) of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
-                endfor ;
+                clip currentpicture to p enlarged linewidth ;
             fi ;
             if getparameter "showlabels" :
                 first := initial ;
                 for i = 1 upto nofsamples :
                     value := getparameter "samples" (1) i ;
                     last := first if clockwise : - else : + fi (360/100) * value * factor ;
+if (value > -eps) and (value < eps) :
+else :
                     draw lmt_do_chart_text (s,i,value)
                         shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ;
                     first := last ;
+fi ;
                 endfor ;
             fi ;
             lmt_do_chart_legend ;
-            n := getparameter "originsize" ;
-            if n > 0 :
-                fill fullcircle scaled n withcolor "white"  ;
-            fi ;
-            n := getparameter "innerradius" ;
-            if n > 0 :
-                fill fullcircle scaled n withcolor "white" ;
-            fi ;
         fi ;
         lmt_do_chart_stop ;
     )
diff --git a/metapost/context/base/mpxl/mp-luas.mpxl b/metapost/context/base/mpxl/mp-luas.mpxl
index c5c4c77db..7e11b1c9c 100644
--- a/metapost/context/base/mpxl/mp-luas.mpxl
+++ b/metapost/context/base/mpxl/mp-luas.mpxl
@@ -301,6 +301,7 @@ newscriptindex mfid_getparameterpen      ; mfid_getparameterpen      := scriptin
 newscriptindex mfid_getparametertext     ; mfid_getparametertext     := scriptindex "getparametertext" ;
 %              mfid_getparameteroption   ; mfid_getparameteroption   := scriptindex "getparameteroption" ;
 newscriptindex mfid_applyparameters      ; mfid_applyparameters      := scriptindex "applyparameters" ;
+newscriptindex mfid_mergeparameters      ; mfid_mergeparameters      := scriptindex "mergeparameters" ;
 newscriptindex mfid_pushparameters       ; mfid_pushparameters       := scriptindex "pushparameters" ;
 newscriptindex mfid_popparameters        ; mfid_popparameters        := scriptindex "popparameters" ;
 newscriptindex mfid_setluaparameter      ; mfid_setluaparameter      := scriptindex "setluaparameter" ;
@@ -318,13 +319,14 @@ def getparameterpen      = runscript mfid_getparameterpen      enddef ;
 def getparametertext     = runscript mfid_getparametertext     enddef ;
 %   getparameteroption   = runscript mfid_getparameteroption   enddef ;
 def applyparameters      = runscript mfid_applyparameters      enddef ;
+def mergeparameters      = runscript mfid_mergeparameters      enddef ;
 def pushparameters       = runscript mfid_pushparameters       enddef ;
 def popparameters        = runscript mfid_popparameters        enddef ;
 def setluaparameter      = runscript mfid_setluaparameter      enddef ;
 
 permanent getparameters, presetparameters, hasparameter, hasoption, getparameter, getparameterdefault,
     getparametercount, getmaxparametercount, getparameterpath, getparameterpen, getparametertext, % getparameteroption,
-    applyparameters, pushparameters, popparameters, setluaparameter ;
+    applyparameters, mergeparameters, pushparameters, popparameters, setluaparameter ;
 
 newscriptindex mfun_newrecord ; mfun_newrecord := scriptindex "newrecord" ;
 newscriptindex mfun_setrecord ; mfun_setrecord := scriptindex "setrecord" ;
diff --git a/metapost/context/base/mpxl/mp-tool.mpxl b/metapost/context/base/mpxl/mp-tool.mpxl
index e448ebb5a..e77314439 100644
--- a/metapost/context/base/mpxl/mp-tool.mpxl
+++ b/metapost/context/base/mpxl/mp-tool.mpxl
@@ -995,10 +995,16 @@ path unitdiamond, fulldiamond ;
 unitdiamond := (.5,0) -- (1,.5) -- (.5,1) -- (0,.5) -- cycle ;
 fulldiamond := unitdiamond shifted - center unitdiamond ;
 
+path unitoctagon, fulloctagon ;
+
+unitoctagon := for i within (unitcircle rotated 45/2) : pathpoint -- endfor cycle ;
+fulloctagon := unitoctagon shifted - center unitoctagon ;
+
 path unithexagon, fullhexagon ;
 
-unithexagon := for i within (unitcircle rotated 45/2) : pathpoint -- endfor cycle ;
-fullhexagon := unithexagon shifted - center unithexagon ;
+%%%%hexagon := for i = 0 upto 5 : .5dir (60i) -- endfor cycle ;
+fullhexagon := for i = 0 step 60 until 360 : .5 dir(i) -- endfor cycle ;
+unithexagon := fullhexagon shifted (.5,.5) ;
 
 permanent
     fullsquare, unitcircle,
@@ -1006,7 +1012,7 @@ permanent
     tcircle, bcircle, lcircle, rcircle,
     urtriangle, ultriangle, lltriangle, lrtriangle,
     triangle, uptriangle, downtriangle, lefttriangle, righttriangle,
-    unitdiamond, fulldiamond, unithexagon, fullhexagon ;
+    unitdiamond, fulldiamond, unitoctagon, fulloctagon, unithexagon, fullhexagon ;
 
 %D More robust: