2016-01-12 16:26:00

1 files changed, 956 insertions, 0 deletions

diff --git a/metapost/context/base/mpiv/mp-base.mpiv b/metapost/context/base/mpiv/mp-base.mpiv
new file mode 100644
index 000000000..28eb57fb8
--- /dev/null
+++ b/metapost/context/base/mpiv/mp-base.mpiv
@@ -0,0 +1,956 @@
+% This is a reformatted copy of the plain.mp file. We use a copy
+% because (1) we want to make sure that there are no unresolved
+% dependencies, and (2) we may patch this file eventually.
+
+% This file gives the macros for plain MetaPost It contains all the
+% features of plain METAFONT except those specific to font-making.
+% There are also a number of macros for labeling figures, etc.
+
+% For practical reasons I have moved some new code here (and might
+% remove some code as well). After all, there is no development in
+% this format.
+
+string base_name, base_version ;
+
+base_name    := "plain" ;
+base_version := "1.004 for metafun iv"  ;
+
+message "loading metafun, including plain.mp version " & base_version ;
+
+delimiters () ; % this makes parentheses behave like parentheses
+
+def upto   = step  1 until enddef ;
+def downto = step -1 until enddef ;
+
+def exitunless expr c =
+    exitif not c
+enddef ;
+
+let relax = \ ; % ignore the word relax, as in TeX
+let \\    = \ ; % double relaxation is like single
+
+def [[ = [ [ enddef ;
+def ]] = ] ] enddef ;
+
+def -- =
+    {curl 1} .. {curl 1}
+enddef ;
+
+def --- =
+    .. tension infinity ..
+enddef ;
+
+def ... =
+    .. tension atleast 1 ..
+enddef ;
+
+def gobble primary g =
+enddef ;
+
+primarydef g gobbled gg =
+enddef ;
+
+def hide(text t) =
+    exitif numeric begingroup t ; endgroup ;
+enddef ;
+
+def ??? =
+    hide (
+        interim showstopping := 1 ;
+        showdependencies
+    )
+enddef ;
+
+def stop expr s =
+    message s ;
+    gobble readstring
+enddef ;
+
+warningcheck     :=1 ;
+tracinglostchars :=1 ;
+
+def interact = % sets up to make "show" commands stop
+    hide (
+        showstopping  := 1 ;
+        tracingonline := 1 ;
+    )
+enddef ;
+
+def loggingall = % puts tracing info into the log
+    tracingcommands  := 3 ;
+    tracingtitles    := 1 ;
+    tracingequations := 1 ;
+    tracingcapsules  := 1 ;
+    tracingspecs     := 2 ;
+    tracingchoices   := 1 ;
+    tracinglostchars := 1 ;
+    tracingstats     := 1 ;
+    tracingoutput    := 1 ;
+    tracingmacros    := 1 ;
+    tracingrestores  := 1 ;
+enddef ;
+
+def tracingall = % turns on every form of tracing
+    tracingonline := 1 ;
+    showstopping  := 1 ;
+    loggingall ;
+enddef ;
+
+def tracingnone = % turns off every form of tracing
+    tracingcommands  := 0 ;
+    tracingtitles    := 0 ;
+    tracingequations := 0 ;
+    tracingcapsules  := 0 ;
+    tracingspecs     := 0 ;
+    tracingchoices   := 0 ;
+    tracinglostchars := 0 ;
+    tracingstats     := 0 ;
+    tracingoutput    := 0 ;
+    tracingmacros    := 0 ;
+    tracingrestores  := 0 ;
+enddef ;
+
+%% dash patterns
+
+vardef dashpattern(text t) =
+    save on, off, w ;
+    let on = _on_ ;
+    let off = _off_ ;
+    w = 0 ;
+    nullpicture t
+enddef ;
+
+tertiarydef p _on_ d =
+    begingroup save pic ;
+        picture pic;
+        pic = p ;
+        addto pic doublepath (w,w) .. (w+d,w) ;
+        w := w + d ;
+        pic shifted (0,d)
+    endgroup
+enddef ;
+
+tertiarydef p _off_ d =
+    begingroup w := w + d ;
+        p shifted (0,d)
+    endgroup
+enddef ;
+
+%% basic constants and mathematical macros
+
+% numeric constants
+
+newinternal eps, epsilon, infinity, _ ;
+
+eps      := .00049 ;      % this is a pretty small positive number
+epsilon  := 1/256/256 ;   % but this is the smallest
+infinity := 4095.99998 ;  % and this is the largest
+_        := -1 ;          % internal constant to make macros unreadable but shorter
+
+% linejoin and linecap types
+
+newinternal mitered, rounded, beveled, butt, squared ;
+
+mitered := 0 ; rounded := 1 ; beveled := 2 ;
+butt    := 0 ; rounded := 1 ; squared := 2 ;
+
+% pair constants
+
+pair right, left, up, down, origin;
+
+origin = (0,0) ;
+up     = -down = (0,1) ;
+right  = -left = (1,0) ;
+
+% path constants
+
+path quartercircle, halfcircle, fullcircle, unitsquare ;
+
+fullcircle    = makepath pencircle ;
+halfcircle    = subpath (0,4) of fullcircle ;
+quartercircle = subpath (0,2) of fullcircle ;
+unitsquare    = (0,0) -- (1,0) -- (1,1) -- (0,1) -- cycle ;
+
+% transform constants
+
+transform identity ;
+
+for z=origin,right,up :
+    z transformed identity = z ;
+endfor
+
+% color constants (all in rgb color space)
+
+color black, white, red, green, blue, cyan, magenta, yellow, background;
+
+black      := (0,0,0) ;
+white      := (1,1,1) ;
+red        := (1,0,0) ;
+green      := (0,1,0) ;
+blue       := (0,0,1) ;
+cyan       := (0,1,1) ;
+magenta    := (1,0,1) ;
+yellow     := (1,1,0) ;
+
+background := white ; % obsolete
+
+let graypart  = greypart  ;
+let greycolor = numeric ;
+let graycolor = numeric ;
+
+% color part (will be overloaded)
+
+def colorpart primary t =
+    if colormodel t=7:
+        (cyanpart t, magentapart t, yellowpart t, blackpart t)
+    elseif colormodel t = 5 :
+        (redpart t, greenpart t, bluepart t)
+    elseif colormodel t = 3 :
+        (greypart t)
+    elseif colormodel t = 1 :
+        false
+    elseif defaultcolormodel = 7 :
+        (0,0,0,1)
+    elseif defaultcolormodel = 5 :
+        black
+    elseif defaultcolormodel = 3 :
+        0
+    else :
+        false
+    fi
+enddef ;
+
+% picture constants
+
+picture blankpicture, evenly, withdots ;
+
+blankpicture = nullpicture ;                       % display blankpicture...
+evenly       = dashpattern(on 3 off 3) ;           % dashed evenly
+withdots     = dashpattern(off 2.5 on 0 off 2.5) ; % dashed withdots
+
+% string constants
+
+string ditto, EOF ;
+
+ditto = char 34 ; % ASCII double-quote mark
+EOF   = char  0 ; % end-of-file for readfrom and write..to
+
+% pen constants
+
+pen pensquare, penrazor, penspeck ;
+
+pensquare = makepen(unitsquare shifted -(.5,.5)) ;
+penrazor  = makepen((-.5,0) -- (.5,0) -- cycle) ;
+penspeck  = pensquare scaled eps ;
+
+% nullary operators
+
+vardef whatever =
+    save ? ;
+    ?
+enddef ;
+
+% unary operators
+
+let abs = length ;
+
+vardef round primary u =
+    if numeric u :
+        floor(u+.5)
+    elseif pair u :
+        (round xpart u, round ypart u)
+    else :
+        u
+    fi
+enddef ;
+
+vardef ceiling primary x =
+    -floor(-x)
+enddef ;
+
+vardef byte primary s =
+    if string s :
+        ASCII
+    fi s
+enddef ;
+
+vardef dir primary d =
+    right rotated d
+enddef ;
+
+vardef unitvector primary z =
+    z/abs z
+enddef ;
+
+vardef inverse primary T =
+    transform T_ ;
+    T_ transformed T = identity ;
+    T_
+enddef ;
+
+vardef counterclockwise primary c =
+    if turningnumber c <= 0 :
+        reverse
+    fi c
+enddef ;
+
+vardef tensepath expr r =
+    for k=0 upto length r - 1 :
+        point k of r ---
+    endfor
+    if cycle r :
+        cycle
+    else :
+        point infinity of r
+    fi
+enddef ;
+
+vardef center primary p =
+    .5[llcorner p, urcorner p]
+enddef ;
+
+% binary operators
+
+primarydef x mod y =
+    (x-y*floor(x/y))
+enddef ;
+
+primarydef x div y =
+    floor(x/y)
+enddef ;
+
+primarydef w dotprod z =
+    (xpart w * xpart z + ypart w * ypart z)
+enddef ;
+
+primarydef x**y =
+    if y = 2 :
+        x*x
+    else :
+        takepower y of x
+    fi
+enddef ;
+
+def takepower expr y of x =
+    if x>0 :
+        mexp(y*mlog x)
+    elseif (x=0) and (y>0) :
+        0
+    else :
+        1
+        if y = floor y :
+            if y >= 0 :
+                for n=1 upto y :
+                    *x
+                endfor
+            else :
+                for n=-1 downto y :
+                    /x
+                endfor
+            fi
+        else :
+            hide(errmessage "Undefined power: " & decimal x & "**" & decimal y)
+        fi
+    fi
+enddef ;
+
+% for big number systems:
+%
+% primarydef x**y =
+%     if y = 1 :
+%         x
+%     elseif y = 2 :
+%         x*x
+%     elseif y = 3 :
+%         x*x*x
+%     else :
+%         takepower y of x
+%     fi
+% enddef ;
+%
+% vardef takepower expr y of x =
+%     if (x=0) and (y>0) :
+%         0
+%     else :
+%         1
+%         if y = floor y :
+%             if y >= 0 :
+%                 for n=1 upto y :
+%                     *x
+%                 endfor
+%             else :
+%                 for n=-1 downto y :
+%                     /x
+%                 endfor
+%             fi
+%         else :
+%             hide(errmessage "Undefined power: " & decimal x & "**" & decimal y)
+%         fi
+%     fi
+% enddef ;
+
+vardef direction expr t of p =
+    postcontrol t of p - precontrol t of p
+enddef ;
+
+vardef directionpoint expr z of p =
+    a_ := directiontime z of p ;
+    if a_ < 0 :
+        errmessage("The direction doesn't occur") ;
+    fi
+    point a_ of p
+enddef ;
+
+secondarydef p intersectionpoint q =
+    begingroup
+    save x_, y_ ;
+    (x_,y_) = p intersectiontimes q ;
+    if x_ < 0 :
+        errmessage("The paths don't intersect") ;
+        origin
+    else :
+        .5[point x_ of p, point y_ of q]
+    fi
+    endgroup
+enddef ;
+
+tertiarydef p softjoin q =
+    begingroup
+    c_ := fullcircle scaled 2join_radius shifted point 0 of q ;
+    a_ := ypart(c_ intersectiontimes p) ;
+    b_ := ypart(c_ intersectiontimes q) ;
+    if a_ < 0 :
+        point 0 of p{direction 0 of p}
+    else :
+        subpath(0,a_) of p
+    fi
+    ...
+    if b_ < 0 :
+        {direction infinity of q} point infinity of q
+    else :
+        subpath(b_,infinity) of q
+    fi
+    endgroup
+enddef ;
+
+newinternal join_radius, a_, b_ ; path c_ ;
+
+path cuttings ; % what got cut off
+
+tertiarydef a cutbefore b =  % tries to cut as little as possible
+    begingroup
+    save t ;
+    (t, whatever) = a intersectiontimes b ;
+    if t < 0 :
+        cuttings := point 0 of a ;
+        a
+    else :
+        cuttings := subpath (0,t) of a ;
+        subpath (t,length a) of a
+    fi
+    endgroup
+enddef ;
+
+tertiarydef a cutafter b =
+    reverse (reverse a  cutbefore  b)
+    hide(cuttings := reverse cuttings)
+enddef ;
+
+% special operators
+
+vardef incr suffix $ = $:=$+1; $ enddef ;
+vardef decr suffix $ = $:=$-1; $ enddef ;
+
+def reflectedabout(expr w,z) = % reflects about the line w..z
+    transformed
+        begingroup
+        transform T_ ;
+        w transformed T_ = w ;
+        z transformed T_ = z ;
+        xxpart T_ = -yypart T_ ;
+        xypart T_ =  yxpart T_ ; % T_ is a reflection
+        T_
+        endgroup
+enddef ;
+
+def rotatedaround(expr z, d) = % rotates d degrees around z
+    shifted -z rotated d shifted z
+enddef ;
+
+let rotatedabout = rotatedaround ; % for roundabout people
+
+vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings
+    save u_ ;
+    setu_ u ;
+    for uu = t :
+        if uu < u_ :
+            u_ := uu ;
+        fi
+    endfor
+    u_
+enddef ;
+
+vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings
+    save u_ ;
+    setu_ u ;
+    for uu = t :
+        if uu > u_ :
+            u_ := uu ;
+        fi
+    endfor
+    u_
+enddef ;
+
+def setu_ primary u =
+    if pair u :
+        pair u_
+    elseif string u :
+        string u_
+    fi ;
+    u_=u
+enddef ;
+
+def flex(text t) = % t is a list of pairs
+    hide (
+        n_ := 0 ;
+        for z=t :
+            z_[incr n_] := z ;
+        endfor
+        dz_ := z_[n_]-z_1
+    )
+    z_1 for k=2 upto n_-1 :
+        ... z_[k]{dz_}
+    endfor ... z_[n_]
+enddef ;
+
+newinternal n_; pair z_[],dz_;
+
+def superellipse(expr r,t,l,b,s) =
+    r { up    } ... (s[xpart t,xpart r],s[ypart r,ypart t]) { t-r } ...
+    t { left  } ... (s[xpart t,xpart l],s[ypart l,ypart t]) { l-t } ...
+    l { down  } ... (s[xpart b,xpart l],s[ypart l,ypart b]) { b-l } ...
+    b { right } ... (s[xpart b,xpart r],s[ypart r,ypart b]) { r-b } ... cycle enddef ;
+
+vardef interpath(expr a,p,q) =
+    for t=0 upto length p-1 :
+        a[point t of p, point t of q] .. controls a[postcontrol t of p, postcontrol t of q] and a[precontrol t+1 of p, precontrol t+1 of q] ..
+    endfor
+    if cycle p :
+        cycle
+    else :
+        a[point infinity of p, point infinity of q]
+    fi
+enddef ;
+
+vardef solve@#(expr true_x,false_x)= % @#(true_x)=true, @#(false_x)=false
+    tx_:=true_x; fx_:=false_x;
+    forever :
+        x_ := .5[tx_,fx_] ;
+        exitif abs(tx_-fx_) <= tolerance ;
+        if @#(x_) :
+            tx_
+        else :
+            fx_
+        fi := x_ ;
+    endfor
+    x_  % now x_ is near where @# changes from true to false
+enddef ;
+
+newinternal tolerance, tx_, fx_, x_ ;
+
+tolerance := .01 ;
+
+vardef buildcycle(text ll) =
+    save ta_, tb_, k_, i_, pp_ ; path pp_[] ;
+    k_ = 0 ;
+    for q=ll :
+        pp_[incr k_] = q ;
+    endfor
+    i_ = k_ ;
+    for i=1 upto k_ :
+        (ta_[i], length pp_[i_]-tb_[i_]) = pp_[i] intersectiontimes reverse pp_[i_] ;
+        if ta_[i]<0 :
+          errmessage("Paths "& decimal i &" and "& decimal i_ &" don't intersect") ;
+        fi
+        i_ := i;
+    endfor
+    for i=1 upto k_ :
+        subpath (ta_[i],tb_[i]) of pp_[i] ..
+    endfor
+    cycle
+enddef ;
+
+%% units of measure
+
+mm :=  2.83464 ;
+pt :=  0.99626 ;
+dd :=  1.06601 ;
+bp :=  1 ;
+cm := 28.34645 ;
+pc := 11.95517 ;
+cc := 12.79213 ;
+in := 72 ;
+
+vardef magstep primary m = % obsolete
+    mexp(46.67432m)
+enddef ;
+
+%% macros for drawing and filling
+
+def drawoptions(text t) =
+    def _op_ = t enddef
+enddef ;
+
+% parameters that effect drawing
+
+linejoin   := rounded ;
+linecap    := rounded ;
+miterlimit := 10 ;
+
+drawoptions() ;
+
+pen currentpen ;
+picture currentpicture ;
+
+def fill expr c =
+    addto currentpicture contour c _op_
+enddef ;
+
+def draw expr p =
+    addto currentpicture
+    if picture p :
+        also p
+    else :
+        doublepath p withpen currentpen
+    fi
+    _op_
+enddef ;
+
+def filldraw expr c =
+    addto currentpicture contour c withpen currentpen _op_
+enddef ;
+
+% def drawdot expr z =
+%     addto currentpicture contour makepath currentpen shifted z _op_
+% enddef ;
+%
+% testcase DEK:
+%
+% for j=1 upto 9 :
+%     pickup pencircle xscaled .4 yscaled .2 ;
+%     drawdot (10j,0) withpen pencircle xscaled .5j yscaled .25j rotated 45 ;
+%     pickup pencircle xscaled .5j yscaled .25j rotated 45 ;
+%     drawdot (10j,10);
+% endfor ;
+%
+% or:
+%
+%\startMPpage
+%
+% def drawdot expr z =
+%     addto currentpicture contour (makepath currentpen shifted z) _op_
+% enddef;
+%
+% drawdot origin shifted (0,-3cm) withpen pencircle scaled 2cm ;
+% pickup pencircle scaled 2cm ; drawdot origin withcolor red ;
+
+def drawdot expr p =
+    if pair p :
+        addto currentpicture doublepath p withpen currentpen _op_
+    else :
+        errmessage("drawdot only accepts a pair expression")
+    fi
+enddef ;
+
+def unfill     expr c = fill     c withcolor background enddef ;
+def undraw     expr p = draw     p withcolor background enddef ;
+def unfilldraw expr c = filldraw c withcolor background enddef ;
+def undrawdot  expr z = drawdot  z withcolor background enddef ;
+
+def erase text t =
+    def _e_ =
+        withcolor background hide(def _e_ = enddef ;)
+    enddef ;
+    t _e_
+enddef ;
+
+def _e_ = enddef ;
+
+def cutdraw text t =
+    begingroup
+        interim linecap := butt ;
+        draw t _e_ ;
+    endgroup
+enddef ;
+
+vardef image(text t) =
+    save currentpicture ;
+    picture currentpicture ;
+    currentpicture := nullpicture ;
+    t ;
+    currentpicture
+enddef ;
+
+def pickup secondary q =
+    if numeric q :
+        numeric_pickup_
+    else :
+        pen_pickup_
+    fi q
+enddef ;
+
+def numeric_pickup_ primary q =
+    if unknown pen_[q] :
+        errmessage "Unknown pen" ;
+        clearpen
+    else :
+        currentpen := pen_ [q] ;
+        pen_lft := pen_lft_[q] ;
+        pen_rt  := pen_rt_ [q] ;
+        pen_top := pen_top_[q] ;
+        pen_bot := pen_bot_[q] ;
+        currentpen_path := pen_path_[q]
+    fi ;
+enddef ;
+
+def pen_pickup_ primary q =
+    currentpen := q ;
+    pen_lft := xpart penoffset down  of currentpen ;
+    pen_rt  := xpart penoffset up    of currentpen ;
+    pen_top := ypart penoffset left  of currentpen ;
+    pen_bot := ypart penoffset right of currentpen ;
+    path currentpen_path ;
+enddef ;
+
+newinternal pen_lft, pen_rt, pen_top, pen_bot, pen_count_ ;
+
+vardef savepen =
+    pen_[incr pen_count_] = currentpen ;
+    pen_lft_ [pen_count_] = pen_lft ;
+    pen_rt_  [pen_count_] = pen_rt ;
+    pen_top_ [pen_count_] = pen_top ;
+    pen_bot_ [pen_count_] = pen_bot ;
+    pen_path_[pen_count_] = currentpen_path ;
+    pen_count_
+enddef ;
+
+def clearpen =
+    currentpen := nullpen;
+    pen_lft := pen_rt := pen_top := pen_bot := 0 ;
+    path currentpen_path ;
+enddef ;
+
+def clear_pen_memory =
+    pen_count_ := 0 ;
+    numeric pen_lft_[], pen_rt_[], pen_top_[], pen_bot_[] ;
+    pen currentpen, pen_[];
+    path currentpen_path, pen_path_[] ;
+enddef ;
+
+vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef ;
+vardef rt  primary x = x + if pair x: (pen_rt,0)  else: pen_rt  fi enddef ;
+vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef ;
+vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef ;
+
+vardef penpos@#(expr b,d) =
+    (x@#r-x@#l,y@#r-y@#l) = (b,0) rotated d ;
+    x@# = .5(x@#l+x@#r) ;
+    y@# = .5(y@#l+y@#r) ; % ; added HH
+enddef ;
+
+path path_.l, path_.r ;
+
+def penstroke text t =
+    forsuffixes e = l, r :
+        path_.e := t ;
+    endfor
+    fill path_.l -- reverse path_.r -- cycle
+enddef ;
+
+%% High level drawing commands
+
+newinternal ahlength, ahangle ;
+
+ahlength :=  4 ; % default arrowhead length 4bp
+ahangle  := 45 ; % default head angle 45 degrees
+
+vardef arrowhead expr p =
+    save q, e ; path q ; pair e ;
+    e = point length p of p ;
+    q = gobble(p shifted -e cutafter makepath(pencircle scaled 2ahlength)) cuttings ;
+    (q rotated .5ahangle & reverse q rotated -.5ahangle -- cycle) shifted e
+enddef ;
+
+path _apth ;
+
+def drawarrow    expr p = _apth := p ; _finarr  enddef ;
+def drawdblarrow expr p = _apth := p ; _findarr enddef ;
+
+def _finarr text t =
+    draw _apth t ;
+    filldraw arrowhead _apth t
+enddef ;
+
+def _findarr text t = % this had fill in 0.63 (potential incompatibility)
+    draw _apth t ;
+    filldraw arrowhead         _apth withpen currentpen t ;
+    filldraw arrowhead reverse _apth withpen currentpen t ; % ; added HH
+enddef ;
+
+%% macros for labels
+
+newinternal bboxmargin ;
+
+bboxmargin := 2bp ; % this can bite you
+
+vardef bbox primary p =
+    llcorner p - ( bboxmargin, bboxmargin) --
+    lrcorner p + ( bboxmargin,-bboxmargin) --
+    urcorner p + ( bboxmargin, bboxmargin) --
+    ulcorner p + (-bboxmargin, bboxmargin) -- cycle
+enddef ;
+
+string defaultfont ; newinternal defaultscale, labeloffset ;
+
+defaultfont  := "cmr10" ;
+defaultscale := 1 ;
+labeloffset  := 3bp ;
+
+vardef thelabel@#(expr s,z) = % Position s near z
+    save p ; picture p ;
+    if picture s :
+        p = s
+    else :
+        p = s infont defaultfont scaled defaultscale
+    fi ;
+    p shifted (z + labeloffset*laboff@# - ( labxf@#*lrcorner p + labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p) )
+enddef ;
+
+def label =
+    draw thelabel
+enddef ;
+
+newinternal dotlabeldiam ;
+
+dotlabeldiam := 3bp ;
+
+vardef dotlabel@#(expr s,z) text t_ =
+    label@#(s,z) t_ ;
+  % label@#(s,z) ;
+    interim linecap := rounded ;
+    draw z withpen pencircle scaled dotlabeldiam t_ ;
+enddef ;
+
+def makelabel =
+    dotlabel
+enddef ;
+
+% this will be overloaded
+
+pair laboff, laboff.lft, laboff.rt, laboff.top, laboff.bot ;
+pair laboff.ulft, laboff.llft, laboff.urt, laboff.lrt ;
+
+laboff      = (0,0)    ; labxf      = .5 ; labyf      = .5 ;
+laboff.lft  = (-1,0)   ; labxf.lft  = 1  ; labyf.lft  = .5 ;
+laboff.rt   = (1,0)    ; labxf.rt   = 0  ; labyf.rt   = .5 ;
+laboff.bot  = (0,-1)   ; labxf.bot  = .5 ; labyf.bot  = 1  ;
+laboff.top  = (0,1)    ; labxf.top  = .5 ; labyf.top  = 0  ;
+laboff.ulft = (-.7,.7) ; labxf.ulft = 1  ; labyf.ulft = 0  ;
+laboff.urt  = (.7,.7)  ; labxf.urt  = 0  ; labyf.urt  = 0  ;
+laboff.llft = -(.7,.7) ; labxf.llft = 1  ; labyf.llft = 1  ;
+laboff.lrt  = (.7,-.7) ; labxf.lrt  = 0  ; labyf.lrt  = 1  ;
+
+vardef labels@#(text t) =
+    forsuffixes $=t :
+        label@#(str$,z$) ;
+    endfor
+enddef ;
+
+% till lhere
+
+vardef dotlabels@#(text t) =
+    forsuffixes $=t:
+        dotlabel@#(str$,z$) ;
+    endfor
+enddef ;
+
+vardef penlabels@#(text t) =
+    forsuffixes $$=l,,r :
+        forsuffixes $=t :
+            makelabel@#(str$.$$,z$.$$) ;
+        endfor
+    endfor
+enddef ;
+
+% range 4 thru 10
+
+def range expr x =
+    _numtok_[x]
+enddef ;
+
+def _numtok_ suffix x =
+    x
+enddef ;
+
+tertiarydef m thru n =
+    m for x=m+1 step 1 until n :
+        , _numtok_[x]
+    endfor
+enddef ;
+
+%% Overall administration
+
+string extra_beginfig, extra_endfig ;
+
+extra_beginfig := "" ;
+extra_endfig   := "" ;
+
+def beginfig(expr c) =
+    begingroup
+    charcode := c ;
+    clearxy ;
+    clearit ;
+    clearpen ;
+    pickup defaultpen ;
+    drawoptions() ;
+    scantokens extra_beginfig ;
+enddef ;
+
+def endfig =
+    ; % added by HH
+    scantokens extra_endfig ;
+    shipit ;
+    endgroup
+enddef ;
+
+%% last-minute items
+
+vardef z@# =
+    (x@#,y@#)
+enddef ;
+
+def clearxy =
+    save x, y
+enddef ;
+
+def clearit =
+    currentpicture := nullpicture
+enddef ;
+
+def shipit =
+    shipout currentpicture
+enddef ;
+
+let bye = end ;
+outer end, bye ;
+
+clear_pen_memory ; % initialize the savepen mechanism
+clearit ;
+
+% set default line width
+
+newinternal defaultpen ;
+
+pickup pencircle scaled .5bp ;
+
+defaultpen := savepen ;