2022-04-19 19:52:00

4 files changed, 212 insertions, 55 deletions

diff --git a/metapost/context/base/mpxl/mp-cont.mpxl b/metapost/context/base/mpxl/mp-cont.mpxl
index d08a24272..a4f1b18ba 100644
--- a/metapost/context/base/mpxl/mp-cont.mpxl
+++ b/metapost/context/base/mpxl/mp-cont.mpxl
@@ -200,6 +200,60 @@ immutable % permanent
     InnerEdgeDistance, OuterSpaceWidth, InnerSpaceWidth, OuterMargin, InnerMargin,
     OuterEdge, InnerEdge ;
 
+% see node-rul.*
+
+% for the moment we put these here:
+
+% string  RuleDirection ; RuleDirection := "" ;
+% string  RuleOption    ; RuleOption    := "" ;
+% numeric RuleWidth     ; RuleWidth     := 0 ;
+% numeric RuleHeight    ; RuleHeight    := 0 ;
+% numeric RuleDepth     ; RuleDepth     := 0 ;
+% numeric RuleH         ; RuleH         := 0 ;
+% numeric RuleV         ; RuleV         := 0 ;
+% numeric RuleThickness ; RuleThickness := 0 ;
+% numeric RuleFactor    ; RuleFactor    := 0 ;
+% numeric RuleOffset    ; RuleOffset    := 0 ;
+%                     def RuleColor      = (.5white) enddef ; % yet undecided, might become a string
+
+newscriptindex mfid_RuleWidth     ; mfid_RuleWidth     := scriptindex "RuleWidth"     ; vardef RuleWidth     = runscript mfid_RuleWidth     enddef ;
+newscriptindex mfid_RuleHeight    ; mfid_RuleHeight    := scriptindex "RuleHeight"    ; vardef RuleHeight    = runscript mfid_RuleHeight    enddef ;
+newscriptindex mfid_RuleDepth     ; mfid_RuleDepth     := scriptindex "RuleDepth"     ; vardef RuleDepth     = runscript mfid_RuleDepth     enddef ;
+newscriptindex mfid_RuleH         ; mfid_RuleH         := scriptindex "RuleH"         ; vardef RuleH         = runscript mfid_RuleH         enddef ;
+newscriptindex mfid_RuleV         ; mfid_RuleV         := scriptindex "RuleV"         ; vardef RuleV         = runscript mfid_RuleV         enddef ;
+newscriptindex mfid_RuleThickness ; mfid_RuleThickness := scriptindex "RuleThickness" ; vardef RuleThickness = runscript mfid_RuleThickness enddef ;
+newscriptindex mfid_RuleOffset    ; mfid_RuleOffset    := scriptindex "RuleOffset"    ; vardef RuleOffset    = runscript mfid_RuleOffset    enddef ;
+newscriptindex mfid_RuleDirection ; mfid_RuleDirection := scriptindex "RuleDirection" ; vardef RuleDirection = runscript mfid_RuleDirection enddef ;
+newscriptindex mfid_RuleFactor    ; mfid_RuleFactor    := scriptindex "RuleFactor"    ; vardef RuleFactor    = runscript mfid_RuleFactor    enddef ;
+newscriptindex mfid_RuleOption    ; mfid_RuleOption    := scriptindex "RuleOption"    ; vardef RuleOption    = runscript mfid_RuleOption    enddef ;
+newscriptindex mfid_RuleColor     ; mfid_RuleColor     := scriptindex "RuleColor"     ;    def RuleColor     = runscript (mfid_RuleColor)   enddef ;
+
+immutable % permanent
+    RuleWidth, RuleHeight, RuleDepth, RuleH, RuleV, RuleThickness, RuleOffset,
+    RuleDirection, RuleFactor, RuleOption, RuleColor ;
+
+def FakeWord(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) =
+    fill unitsquare
+        xscaled RuleWidth
+        yscaled (RuleDepth-RuleThickness/2)
+        withcolor RuleColor ;
+    fill unitsquare
+        xscaled RuleWidth
+        yscaled (RuleHeight-RuleDepth-RuleThickness/2)
+        shifted (0,RuleDepth+RuleThickness)
+        withcolor RuleColor ;
+enddef ;
+
+def FakeRule(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) =
+    fill unitsquare
+        xscaled RuleWidth
+        yscaled RuleHeight
+        withcolor RuleColor ;
+enddef ;
+
+permanent
+    FakeWord, FakeRule ;
+
 % see typo-ada.*
 
 newscriptindex mfid_AdaptiveWidth     ; mfid_AdaptiveWidth     := scriptindex "AdaptiveWidth"     ; vardef AdaptiveWidth     = runscript mfid_AdaptiveWidth     enddef ;
diff --git a/metapost/context/base/mpxl/mp-lmtx.mpxl b/metapost/context/base/mpxl/mp-lmtx.mpxl
index f8ee2032a..d689f7355 100644
--- a/metapost/context/base/mpxl/mp-lmtx.mpxl
+++ b/metapost/context/base/mpxl/mp-lmtx.mpxl
@@ -1049,11 +1049,13 @@ presetparameters "chart" [
 ] ;
 
 presetparameters "chart:circle" "chart" [
-    height      = 5cm,
-    width       = 5mm,
-    labelanchor = "",
-    labeloffset = 0,
-    labelstrut  = "no",
+    height       = 5cm,
+    width        = 5mm,
+    innerradius  = 0,
+    initialangle = 0, % -90 == top
+    labelanchor  = "",
+    labeloffset  = 0,
+    labelstrut   = "no",
 ] ;
 
 presetparameters "chart:histogram" "chart" [
@@ -1183,8 +1185,12 @@ vardef lmt_do_chart_circle =
             for i = 1 upto nofsamples :
                 fillcolor := getparameter "fillcolors" i ;
                 value := (getparameter "samples" (1) i) * factor ;
-                last := first + (360 / 100) * value ;
+                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 ;
@@ -1213,6 +1219,78 @@ vardef lmt_do_chart_circle =
             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 ;
+
+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 ;
+            clockwise := true ;
+            percentage := getparameter "percentage" ;
+            initial := if not clockwise : - fi getparameter "initialangle" ; % watch sign
+            total := 0 ;
+            for i = 1 upto nofsamples :
+                total := total + getparameter "samples" (1) i ; % () is needed else 1i
+            endfor ;
+            factor := 100/total ;
+            first := initial ;
+            if clockwise :
+                p := (reverse fullcircle rotated first) ysized (height) ;
+            else :
+                p := fullcircle ysized (height) ;
+            fi ;
+            r := origin -- (2*height,0) ;
+            for i = 1 upto nofsamples :
+                fillcolor := getparameter "fillcolors" i ;
+                value := (getparameter "samples" (1) i) * factor ;
+                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 ;
+                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 := initial ;
+                for i = 1 upto nofsamples :
+                    value := getparameter "samples" (1) i ;
+                    last := first if clockwise : - else : + fi (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 ;
     )
diff --git a/metapost/context/base/mpxl/mp-page.mpxl b/metapost/context/base/mpxl/mp-page.mpxl
index c36dd6487..93480e711 100644
--- a/metapost/context/base/mpxl/mp-page.mpxl
+++ b/metapost/context/base/mpxl/mp-page.mpxl
@@ -287,43 +287,3 @@ permanent
 %         cycle
 %     )
 % enddef ;
-
-% for the moment we put these here:
-
-string  RuleDirection ; RuleDirection := "" ;
-string  RuleOption    ; RuleOption    := "" ;
-numeric RuleWidth     ; RuleWidth     := 0 ;
-numeric RuleHeight    ; RuleHeight    := 0 ;
-numeric RuleDepth     ; RuleDepth     := 0 ;
-numeric RuleH         ; RuleH         := 0 ;
-numeric RuleV         ; RuleV         := 0 ;
-numeric RuleThickness ; RuleThickness := 0 ;
-numeric RuleFactor    ; RuleFactor    := 0 ;
-numeric RuleOffset    ; RuleOffset    := 0 ;
-                    def RuleColor      = (.5white) enddef ; % yet undecided, might become a string
-
-def FakeWord(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) =
-    fill unitsquare
-        xscaled RuleWidth
-        yscaled (RuleDepth-RuleThickness/2)
-        withcolor RuleColor ;
-    fill unitsquare
-        xscaled RuleWidth
-        yscaled (RuleHeight-RuleDepth-RuleThickness/2)
-        shifted (0,RuleDepth+RuleThickness)
-        withcolor RuleColor ;
-enddef ;
-
-def FakeRule(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) =
-    fill unitsquare
-        xscaled RuleWidth
-        yscaled RuleHeight
-        withcolor RuleColor ;
-enddef ;
-
-mutable
-    RuleDirection, RuleOption, RuleWidth, RuleHeight, RuleDepth, RuleH, RuleV, RuleThickness,
-    RuleFactor, RuleOffset, RuleColor;
-
-permanent
-    FakeWord, FakeRule ;
diff --git a/metapost/context/base/mpxl/mp-tool.mpxl b/metapost/context/base/mpxl/mp-tool.mpxl
index 749f3d657..f53a6d75b 100644
--- a/metapost/context/base/mpxl/mp-tool.mpxl
+++ b/metapost/context/base/mpxl/mp-tool.mpxl
@@ -3967,6 +3967,8 @@ permanent withdashes ;
 path mfun_b ;
 pair mfun_k ;
 
+path mfun_nullpath ;
+
 tertiarydef p sortedintersectiontimes q =
     sortedpath (p intersectiontimeslist q)
 enddef ;
@@ -3975,24 +3977,87 @@ tertiarydef p intersectionpath q =
     begingroup ;
     save mfun_b ; path mfun_b ; mfun_b := sortedpath (p intersectiontimeslist q) ;
     save mfun_k ; pair mfun_k ; mfun_k := point 0 of mfun_b;
-    .5[point xpart mfun_k of p, point ypart mfun_k of q]
-    for i = 1 upto length(mfun_b) :
-        hide(mfun_k := point i of mfun_b;)
-        -- .5[point xpart mfun_k of p, point ypart mfun_k of q]
-    endfor
+    if mfun_k <> (-1,-1) :
+        .5[point xpart mfun_k of p, point ypart mfun_k of q]
+        for i = 1 upto length(mfun_b) :
+            hide(mfun_k := point i of mfun_b;)
+            -- .5[point xpart mfun_k of p, point ypart mfun_k of q]
+        endfor
+    else :
+        mfun_nullpath
+    fi
     endgroup
 enddef ;
 
 tertiarydef p firstintersectionpath q =
     begingroup ;
     save mfun_b ; path mfun_b ; mfun_b := sortedpath (p intersectiontimeslist q) ;
-    point xpart (point 0 of mfun_b) of p
-    for i = 1 upto length(mfun_b) :
-        -- point xpart (point i of mfun_b) of p
-    endfor
+    if (point 0 of mfun_b) <> (-1,-1) :
+        point xpart (point 0 of mfun_b) of p
+        for i = 1 upto length(mfun_b) :
+            -- point xpart (point i of mfun_b) of p
+        endfor
+    else :
+        mfun_nullpath
+    fi
     endgroup
 enddef ;
 
 tertiarydef p secondintersectionpath q =
     q firstintersectionpath p
 enddef;
+
+vardef intersectionsfound expr p =
+    (point 0 of p) <> (-1,-1)
+enddef ;
+
+%D As part of our intersection journey MS came up with:
+
+tertiarydef p cutbeforefirst q =
+    begingroup ;
+    save mfun_b, mfun_p ; path mfun_b, mfun_p ; mfun_b := sortedpath (p intersectiontimeslist q) ;
+    if (point 0 of mfun_b) <> (-1,-1) :
+        mfun_p := subpath(xpart point 0 of mfun_b, infinity) of p;
+    else :
+        mfun_p := p ;
+    fi ;
+    mfun_p
+    endgroup ;
+enddef ;
+
+tertiarydef p cutafterfirst q =
+    begingroup ;
+    save mfun_b, mfun_p ; path mfun_b, mfun_p ; mfun_b := sortedpath (p intersectiontimeslist q) ;
+    if (point 0 of mfun_b) <> (-1,-1) :
+        mfun_p := subpath(0, xpart point 0 of mfun_b) of p;
+    else :
+        mfun_p := p ;
+    fi ;
+    mfun_p
+    endgroup ;
+enddef ;
+
+
+tertiarydef p cutbeforelast q =
+    begingroup ;
+    save mfun_b, mfun_p ; path mfun_b, mfun_p ; mfun_b := sortedpath (p intersectiontimeslist q) ;
+    if (point 0 of mfun_b) <> (-1,-1) :
+        mfun_p := subpath(xpart point (length mfun_b) of mfun_b, infinity) of p;
+    else :
+        mfun_p := p ;
+    fi ;
+    mfun_p
+    endgroup ;
+enddef ;
+
+tertiarydef p cutafterlast q =
+    begingroup ;
+    save mfun_b, mfun_p ; path mfun_b, mfun_p ; mfun_b := sortedpath (p intersectiontimeslist q) ;
+    if (point 0 of mfun_b) <> (-1,-1) :
+        mfun_p := subpath(0, xpart point (length mfun_b) of mfun_b) of p;
+    else :
+        mfun_p := p ;
+    fi ;
+    mfun_p
+    endgroup ;
+enddef ;