stable 2004.06.10

7 files changed, 619 insertions, 352 deletions

diff --git a/metapost/context/base/metafun.mp b/metapost/context/base/metafun.mp
index f8cab41bf..5071013c5 100644
--- a/metapost/context/base/metafun.mp
+++ b/metapost/context/base/metafun.mp
@@ -1,15 +1,15 @@
 %D \module
 %D   [       file=metafun.mp,
 %D        version=2000.07.15,
-%D          title=\CONTEXT\ \METAPOST\ graphics, 
-%D       subtitle=format generation file, 
+%D          title=\CONTEXT\ \METAPOST\ graphics,
+%D       subtitle=format generation file,
 %D         author=Hans Hagen,
 %D           date=\currentdate,
 %D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
 %C
 %C This module is part of the \CONTEXT\ macro||package and is
-%C therefore copyrighted by \PRAGMA. See mreadme.pdf for 
-%C details. 
+%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
+%C details.
 
 %D When generating many graphics at runtime, it can save run
 %D time to use a format file. We could have named this file
@@ -21,28 +21,29 @@
 %D (and as a result in buggy boundingbox and special
 %D handling). By using the name \type {metatex} we make sure
 %D that we use (unless overloaded) the settings of \type
-%D {mpost}. 
-
-if unknown ahangle : 
-  input plain.mp ; % John Hobby's file 
-else : 
-  let dump = relax ; 
-fi ; 
-
-input mp-tool.mp ; 
-input mp-spec.mp ; 
-input mp-core.mp ; 
-input mp-page.mp ; 
-input mp-text.mp ; 
-input mp-shap.mp ; 
-input mp-butt.mp ; 
-input mp-char.mp ; 
-input mp-step.mp ; 
-input mp-grph.mp ; 
-
-%     mp-form.mp ; 
-input mp-grid.mp ; 
-input mp-func.mp ; 
+%D {mpost}.
+
+if unknown ahangle :
+  input plain.mp ; % John Hobby's file
+else :
+  let dump = relax ;
+fi ;
+
+input mp-tool.mp ;
+input mp-spec.mp ;
+input mp-core.mp ;
+input mp-page.mp ;
+input mp-text.mp ;
+input mp-shap.mp ;
+input mp-butt.mp ;
+input mp-char.mp ;
+input mp-step.mp ;
+input mp-grph.mp ;
+input mp-figs.mp ;
+
+%     mp-form.mp ;
+input mp-grid.mp ;
+input mp-func.mp ;
 
 string metafunversion ;
 
@@ -56,7 +57,7 @@ metafunversion = "metafun"                       & " " &
 let normalend = end ;
 
 def end =
-  message "" ; message metafunversion ; message "" ; normalend ;
+  ; message "" ; message metafunversion ; message "" ; normalend ;
 enddef ;
 
 dump ; endinput .
diff --git a/metapost/context/base/mp-char.mp b/metapost/context/base/mp-char.mp
index 9416b1349..cd774d509 100644
--- a/metapost/context/base/mp-char.mp
+++ b/metapost/context/base/mp-char.mp
@@ -10,16 +10,16 @@
 %D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
 %C
 %C This module is part of the \CONTEXT\ macro||package and is
-%C therefore copyrighted by \PRAGMA. See licen-en.pdf for 
-%C details. 
+%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+%C details.
 
-if unknown context_tool :    input mp-tool ; fi ; 
-if unknown context_shap :    input mp-shap ; fi ; 
-if   known context_char : endinput         ; fi ; 
+if unknown context_tool :    input mp-tool ; fi ;
+if unknown context_shap :    input mp-shap ; fi ;
+if   known context_char : endinput         ; fi ;
 
-boolean context_char ; context_char := true ; 
+boolean context_char ; context_char := true ;
 
-% kan naar elders 
+% kan naar elders
 
 current_position := 0 ;
 
@@ -38,7 +38,7 @@ shape_width  := 45pt ; shape_height := 30pt ;
 
 chart_offset :=  2pt ;
 
-color chart_background_color ; chart_background_color := white ; 
+color chart_background_color ; chart_background_color := white ;
 
 %D test mode
 
@@ -70,12 +70,12 @@ shape_left           := 67 ;
 shape_up             := 68 ;
 shape_down           := 69 ;
 
-% vardef some_shape_path (expr type) == imported from mp-shap 
+% vardef some_shape_path (expr type) == imported from mp-shap
 
 def show_shapes (expr n) =
 
   begin_chart(n,8,10) ;
-    show_con_points := true ; 
+    show_con_points := true ;
     for i=0 upto 7 :
       for j=0 upto 9 :
         new_shape(i+1,j+1,i*10+j);
@@ -83,9 +83,9 @@ def show_shapes (expr n) =
     endfor ;
   end_chart ;
 
-enddef ; 
+enddef ;
 
-%D connections 
+%D connections
 
 def new_chart =
 
@@ -96,14 +96,14 @@ def new_chart =
   connection_smooth_size := 5pt ;
   connection_arrow_size  := 4pt ;
   connection_dash_size   := 3pt ;
-  
+
   max_x := 6 ;
   max_y := 4 ;
-  
+
   numeric xypoint       ; xypoint := 0 ;
-  
+
   pair    xypoints []   ;
-  
+
   boolean xyfree   [][] ;
   path    xypath   [][] ;
   numeric xysx     [][] ;
@@ -112,38 +112,38 @@ def new_chart =
   color   xydraw   [][] ;
   numeric xyline   [][] ;
   boolean xypeep   [][] ;
-  
-  numeric cpath         ; cpath := 0 ; 
-  path    cpaths    []  ; 
+
+  numeric cpath         ; cpath := 0 ;
+  path    cpaths    []  ;
   numeric cline     []  ;
   color   ccolor    []  ;
   boolean carrow    []  ;
   boolean cdash     []  ;
-  boolean ccross    []  ; 
-  
+  boolean ccross    []  ;
+
   boolean smooth        ; smooth       := true  ;
   boolean peepshape     ; peepshape    := false ;
   boolean arrowtip      ; arrowtip     := true  ;
   boolean dashline      ; dashline     := false ;
   boolean forcevalid    ; forcevalid   := false ;
-  boolean touchshape    ; touchshape   := false ; 
-  boolean showcrossing  ; showcrossing := false ; 
-  
+  boolean touchshape    ; touchshape   := false ;
+  boolean showcrossing  ; showcrossing := false ;
+
   picture dash_pattern ;
-  
+
   boolean reverse_y ; reverse_y := true ;
-  
-enddef ; 
 
-new_chart ; 
+enddef ;
+
+new_chart ;
 
 def y_pos (expr y) =
   if reverse_y : max_y + 1 - y else : y fi
 enddef ;
-  
+
 def initialize_grid (expr maxx, maxy) =
-  begingroup ; 
-  save i, j ; 
+  begingroup ;
+  save i, j ;
   max_x := maxx ;
   max_y := maxy ;
   dsp_x := 0 ;
@@ -201,19 +201,19 @@ vardef i_point (expr x, y, p, t) =
 enddef ;
 
 vardef trimmed (expr x, y, z, t) =
-  if touchshape and t : xyline[x][y]/z else : epsilon fi  
+  if touchshape and t : xyline[x][y]/z else : epsilon fi
 enddef ;
 
 zfactor := 1/3 ;
 
 vardef xy_bottom (expr x, y, z, t) =
   i_point (x, y, ((0,0)--(0,-2)) shifted (zfactor*z*xysx[x][y],0), "bottom")
-  shifted(0,-trimmed(x,y,grid_height,t)) 
+  shifted(0,-trimmed(x,y,grid_height,t))
 enddef ;
 
 vardef xy_top (expr x, y, z, t) =
   i_point (x, y, ((0,0)--(0,2))  shifted (zfactor*z*xysx[x][y],0), "top")
-  shifted(0,trimmed(x,y,grid_height,t)) 
+  shifted(0,trimmed(x,y,grid_height,t))
 enddef ;
 
 vardef xy_left (expr x, y, z, t) =
@@ -248,10 +248,10 @@ def flush_shape (expr x, yy) =
   y := y_pos(yy) ;
   if not xyfree[x][y] :
     pickup pencircle scaled xyline[x][y] ;
-    if xypeep[x][y] : 
-      fill (xypath[x][y] peepholed (unitsquare shifted (x,y))) 
+    if xypeep[x][y] :
+      fill (xypath[x][y] peepholed (unitsquare shifted (x,y)))
         scaled_to_grid withpen pencircle scaled 0
-        withcolor chart_background_color ; 
+        withcolor chart_background_color ;
     else :
       fill xypath[x][y] scaled_to_grid withcolor xyfill[x][y] ;
     fi ;
@@ -276,7 +276,7 @@ vardef points_initialized (expr xfrom, yfrom, xto, yto, n) =
   fi
 enddef ;
 
-def collapse_points = % this is now an mp-tool macro 
+def collapse_points = % this is now an mp-tool macro
   % remove redundant points
   n := 1 ;
   for i=2 upto xypoint:
@@ -293,36 +293,36 @@ def collapse_points = % this is now an mp-tool macro
   fi ;
 enddef ;
 
-vardef smooth_connection (expr a,b) = 
+vardef smooth_connection (expr a,b) =
   sx := connection_smooth_size/grid_width ;
   sy := connection_smooth_size/grid_height ;
   if ypart a = ypart b :
     a shifted (if xpart a >= xpart b : - fi sx,0)
-% a shifted (sx*xpart unitvector(b-a),0) 
+% a shifted (sx*xpart unitvector(b-a),0)
   else :
     a shifted (0,if ypart a >= ypart b : - fi sy)
-% a shifted (0,sy*ypart unitvector(b-a)) 
+% a shifted (0,sy*ypart unitvector(b-a))
   fi
 enddef ;
 
-vardef trim_points =      
+vardef trim_points =
   begingroup
-  save p, a, b, d, i ; path p ; pair d ; 
-  p := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ; 
-  if touchshape : 
+  save p, a, b, d, i ; path p ; pair d ;
+  p := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ;
+  if touchshape :
     a := shape_line_width/grid_width ;
     b := shape_line_width/grid_height ;
   else :
-    a := epsilon ; 
+    a := epsilon ;
     b := epsilon ;
-  fi ;  
+  fi ;
   d := direction infinity of p ;
   xypoints[xypoint] := xypoints[xypoint] shifted
   if     xpart d < 0 : (+a,0) ;
   elseif xpart d > 0 : (-a,0) ;
   elseif ypart d < 0 : (0,+b) ;
   elseif ypart d > 0 : (0,-b) ;
-  else               : origin ; 
+  else               : origin ;
   fi ;
   d := direction 0 of p ;
   xypoints[1] := xypoints[1] shifted
@@ -330,12 +330,12 @@ vardef trim_points =
   elseif xpart d > 0 : (+a,0) ;
   elseif ypart d < 0 : (0,-b) ;
   elseif ypart d > 0 : (0,+b) ;
-  else               : origin ; 
+  else               : origin ;
   fi ;
   endgroup
-enddef ; 
+enddef ;
 
-vardef trim_points = enddef ; 
+vardef trim_points = enddef ;
 
 vardef connection_path =
   if reverse_connection : reverse fi (xypoints[1]--
@@ -354,35 +354,35 @@ enddef ;
 % vardef connection_path =
 %   sx := connection_smooth_size/grid_width ;
 %   sy := connection_smooth_size/grid_height ;
-%   if reverse_connection : reverse fi 
-%   (for i=1 upto xypoint-1 : xypoints[i] -- endfor xypoints[xypoint]) 
-%   if smooth : cornered max(sx,sy) fi 
+%   if reverse_connection : reverse fi
+%   (for i=1 upto xypoint-1 : xypoints[i] -- endfor xypoints[xypoint])
+%   if smooth : cornered max(sx,sy) fi
 % enddef ;
-% 
-% primarydef p cornered c = 
-%   if cycle p : 
-%     ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- 
+%
+% primarydef p cornered c =
+%   if cycle p :
+%     ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) --
 %      for i=1 upto length(p) :
-%        (point i-1 of p) shifted (c*(unitvector(point i   of p - point i-1 of p))) -- 
+%        (point i-1 of p) shifted (c*(unitvector(point i   of p - point i-1 of p))) --
 %        (point i   of p) shifted (c*(unitvector(point i-1 of p - point i   of p))) ..
-%        controls point i of p .. 
-%      endfor cycle) 
+%        controls point i of p ..
+%      endfor cycle)
 %   else :
-%     ((point 0 of p) -- 
+%     ((point 0 of p) --
 %      for i=1 upto length(p)-1 :
-%        (point i-1 of p) shifted (c*(unitvector(point i   of p - point i-1 of p))) -- 
+%        (point i-1 of p) shifted (c*(unitvector(point i   of p - point i-1 of p))) --
 %        (point i   of p) shifted (c*(unitvector(point i-1 of p - point i   of p))) ..
-%        controls point i of p .. 
+%        controls point i of p ..
 %      endfor
 %      (point length(p) of p))
-%   fi 
+%   fi
 % enddef ;
 
 def draw_connection =
   if xypoint>0 :
     collapse_points ;
-    trim_points ;  
-    cpath := cpath + 1 ; 
+    trim_points ;
+    cpath := cpath + 1 ;
     cpaths[cpath] := connection_path scaled_to_grid ;
     cline[cpath]  := connection_line_width ;
     ccolor[cpath] := connection_line_color ;
@@ -396,30 +396,30 @@ def draw_connection =
 enddef ;
 
 def flush_connections =
-  pair ip ; 
-  boolean crossing ; 
+  pair ip ;
+  boolean crossing ;
   ahlength     := connection_arrow_size ;
   dash_pattern := dashpattern(on connection_dash_size off connection_dash_size ) ;
-  for i=1 upto cpath : 
+  for i=1 upto cpath :
     if ccross[i] :
       crossing := false ;
       for j=1 upto i :
-       %if not ((point infinity of cpaths[i] = point infinity of cpaths[j]) or 
+       %if not ((point infinity of cpaths[i] = point infinity of cpaths[j]) or
        %        (point 0        of cpaths[i] = point 0        of cpaths[j])) :
         if not  (point infinity of cpaths[i] = point infinity of cpaths[j]) :
           ip := cpaths[i] intersection_point cpaths[j] ;
           if intersection_found : crossing := true fi ;
-        fi ;  
-      endfor ; 
-      if crossing : 
+        fi ;
+      endfor ;
+      if crossing :
         pickup pencircle scaled 2cline[i] ;
        %draw cpaths[i] withcolor chart_background_color ;
-        path cp ; cp := cpaths[i] ; 
-        cp := cp cutbefore point .05 length cp of cp ;  
-        cp := cp cutafter  point .95 length cp of cp ;  
+        path cp ; cp := cpaths[i] ;
+        cp := cp cutbefore point .05 length cp of cp ;
+        cp := cp cutafter  point .95 length cp of cp ;
         draw cp withcolor chart_background_color ;
-      fi ; 
-    fi ; 
+      fi ;
+    fi ;
     pickup pencircle scaled cline[i] ;
     if carrow[i] :
       if cdash[i] :
@@ -513,9 +513,9 @@ vardef right_to_grid (expr a,b) =
    ypart xypoints[a])
 enddef ;
 
-% vardef boundingboxfraction(expr p, f) = 
+% vardef boundingboxfraction(expr p, f) =
 %   ((boundingbox p) enlarged (-f*bbwidth(p),-f*bbheight(p)))
-% enddef ; 
+% enddef ;
 
 vardef valid_connection (expr xfrom, yfrom, xto, yto) =
   begingroup ;
@@ -534,30 +534,30 @@ vardef valid_connection (expr xfrom, yfrom, xto, yto) =
   elseif forcevalid :
    %message("force");
     true
-  elseif (xfrom=xto) and (yfrom=yto) : 
+  elseif (xfrom=xto) and (yfrom=yto) :
    %message("self");
-    false 
+    false
   else :
     % check for crossing shapes
     pair vc ;
     path pp ;
 
-    pair xyfirst, xylast ; 
-    xyfirst := xypoints[1] ; 
+    pair xyfirst, xylast ;
+    xyfirst := xypoints[1] ;
     xylast := xypoints[xypoint] ;
-    trim_points ;  
+    trim_points ;
     pp := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ;
-    xypoints[1] := xyfirst ; 
+    xypoints[1] := xyfirst ;
     xypoints[xypoint] := xylast ;
 
     for i=1 upto max_x :
       for j=1 upto max_y :                % was bug: xfrom,yto
-        if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) : 
-          if not xyfree[i][j] : 
+        if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) :
+          if not xyfree[i][j] :
             vc := pp intersection_point xypath[i][j] ;
             if intersection_found : ok := false fi ;
           fi ;
-        fi ; 
+        fi ;
       endfor ;
     endfor ;
    %if not ok: message("crossing") ; fi ;
@@ -588,8 +588,8 @@ def connect_top_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) =
     elseif dsp_y<0 :
       xypoints[4] := xypoints[4] shifted (0,dsp_y) ;
       xypoints[5] := xypoints[5] shifted (0,dsp_y) ;
-    fi 
-    %%%% end experiment 
+    fi
+    %%%% end experiment
     draw_connection ;
   fi ;
 enddef ;
@@ -676,8 +676,8 @@ def connect_right_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) =
     elseif dsp_y<0 :
       xypoints[3] := xypoints[3] shifted (0,dsp_y) ;
       xypoints[4] := xypoints[4] shifted (0,dsp_y) ;
-    fi 
-    %%%% end experiment 
+    fi
+    %%%% end experiment
     draw_connection ;
   fi ;
 enddef ;
@@ -748,15 +748,15 @@ def connect_bottom_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) =
     fi ;
     %%%% begin experiment
     xypoints[3] := xypoints[3] shifted (dsp_x,0) ;
-    xypoints[4] := xypoints[4] shifted (dsp_x) ;
+    xypoints[4] := xypoints[4] shifted (dsp_x,0) ;
     if dsp_y<0 :
       xypoints[2] := xypoints[2] shifted (0,-dsp_y) ;
       xypoints[3] := xypoints[3] shifted (0,-dsp_y) ;
     elseif dsp_y>0 :
       xypoints[4] := xypoints[4] shifted (0,dsp_y) ;
       xypoints[5] := xypoints[5] shifted (0,dsp_y) ;
-    fi 
-    %%%% end experiment 
+    fi
+    %%%% end experiment
     draw_connection ;
   fi ;
 enddef ;
@@ -891,39 +891,39 @@ enddef ;
 def clip_chart (expr minx, miny, maxx, maxy) =
   cmin_x := minx ;
   cmax_x := maxx ;
-  cmin_y := miny ; 
-  cmax_y := maxy ; 
+  cmin_y := miny ;
+  cmax_y := maxy ;
 enddef ;
 
 def begin_chart (expr n, maxx, maxy) =
   new_chart ;
   chart_figure := n ;
-  chart_scale := 1 ; 
+  chart_scale := 1 ;
   if chart_figure>0: beginfig(chart_figure) ; fi ;
   initialize_grid (maxx, maxy) ;
   bboxmargin := 0 ;
-  cmin_x := 1 ; 
+  cmin_x := 1 ;
   cmax_x := maxx ;
-  cmin_y := 1 ; 
-  cmax_y := maxy ; 
+  cmin_y := 1 ;
+  cmax_y := maxy ;
 enddef ;
 
 def end_chart =
   flush_shapes ;
-  flush_connections ; 
-  cmin_x := cmin_x ; 
-  cmax_x := cmin_x+cmax_x ; 
-  cmin_y := cmin_y-1 ; 
-  cmax_y := cmin_y+cmax_y ;  
-  if reverse_y : 
+  flush_connections ;
+  cmin_x := cmin_x ;
+  cmax_x := cmin_x+cmax_x ;
+  cmin_y := cmin_y-1 ;
+  cmax_y := cmin_y+cmax_y ;
+  if reverse_y :
    cmin_y := y_pos(cmin_y) ;
-   cmax_y := y_pos(cmax_y) ; 
-  fi ; 
+   cmax_y := y_pos(cmax_y) ;
+  fi ;
   path p ;
   p := (((cmin_x,cmin_y)--(cmax_x,cmin_y)--
          (cmax_x,cmax_y)--(cmin_x,cmax_y)--cycle))
        scaled_to_grid ;
- %draw p withcolor red ; 
+ %draw p withcolor red ;
   p := p enlarged chart_offset ;
   clip currentpicture to p ;
   setbounds currentpicture to p ;
diff --git a/metapost/context/base/mp-core.mp b/metapost/context/base/mp-core.mp
index 51d2d0025..eb038163e 100644
--- a/metapost/context/base/mp-core.mp
+++ b/metapost/context/base/mp-core.mp
@@ -520,11 +520,12 @@ par_hang_after := ra + estimated_par_lines(py-fy) ;
     if (par_hang_indent>0) and (par_hang_after<0) and obey_multi_par_hang :
       pair _ul_ ; _ul_ := (xpart ulcorner multipar, ypart snapped_multi_pos(ulxy[fpos]));
       pair _pa_ ; _pa_ := _ul_ shifted (0,par_hang_after*par_line_height) ;
-      _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ;
+%       _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ;
+      _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llcorner multipar)) ;
       if same_area :
-        _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])) ;
+%         _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])) ;
+        _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llxy[tpos])) ;
       fi ;
-% vervalt:
       if obey_multi_par_more and (round(par_line_height)>0) :
         par_hang_after := min(0,round(par_hang_after +
           (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ;
@@ -539,7 +540,8 @@ par_hang_after := ra + estimated_par_lines(py-fy) ;
 
   vardef right_top_hang (expr same_area) =
 
-par_hang_after := ra - estimated_par_lines(py-fy) ;
+% par_hang_after := ra - estimated_par_lines(py-fy) ;
+par_hang_after := ra + estimated_par_lines(py-fy) ;
 
     if (par_hang_indent<0) and (par_hang_after<0) and obey_multi_par_hang :
       pair _ur_ ; _ur_ := (xpart urcorner multipar, ypart snapped_multi_pos(urxy[fpos])) ;
@@ -1240,6 +1242,7 @@ vardef PrepareSyncTasks(expr n, collapse, extendtop, prestartnext) =
         NOfSyncPaths := NOfSyncPaths + 1 ;
         if not ok :
           if i>1 :
+% not yet correct when two of the same follow each other
             if sync_t[n][i-1] = sync_t[n][i] :
               SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ;
               SyncTasks[NOfSyncPaths] := i ;
diff --git a/metapost/context/base/mp-figs.mp b/metapost/context/base/mp-figs.mp
new file mode 100644
index 000000000..aa6bc0399
--- /dev/null
+++ b/metapost/context/base/mp-figs.mp
@@ -0,0 +1,50 @@
+%D \module
+%D   [       file=mp-tool.mp,
+%D        version=2003.01.15,
+%D          title=\CONTEXT\ \METAPOST\ graphics,
+%D       subtitle=figures,
+%D         author=Hans Hagen,
+%D           date=\currentdate,
+%D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+%C
+%C This module is part of the \CONTEXT\ macro||package and is
+%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+%C details.
+
+if unknown context_tool :    input mp-tool ; fi ;
+if   known context_figs : endinput         ; fi ;
+
+boolean context_figs ; context_figs := true ;
+
+% todo: check defined
+
+def registerfigure(expr name,width,height) =
+  begingroup ;
+  save s ; string s ; s := cleanstring(name) ;
+  scantokens( s & "_width := " & decimal(width)) ;
+  scantokens( s & "_height := " & decimal(width)) ;
+  endgroup ;
+enddef ;
+
+vardef figuresize(expr name) =
+  save s ; string s ; s := cleanstring(name) ;
+  save p ; pair p ;
+  scantokens( "p := " & "(" & s & "_width" & "," & s & "_height" & ")" ) ;
+  p
+enddef ;
+
+vardef figurewidth(expr name) =
+  xpart figuresize(name)
+enddef ;
+
+vardef figureheight(expr name) =
+  ypart figuresize(name)
+enddef ;
+
+def figuredimensions = figuresize enddef ; % for old times sake
+
+def naturalfigure(expr name) =
+    externalfigure name xyscaled(figuresize(name))
+enddef ;
+
+endinput
diff --git a/metapost/context/base/mp-spec.mp b/metapost/context/base/mp-spec.mp
index b005eb381..bef6cd2fa 100644
--- a/metapost/context/base/mp-spec.mp
+++ b/metapost/context/base/mp-spec.mp
@@ -414,34 +414,106 @@ resetspotcolors ; boolean spotcolors ; spotcolors := false ; % true
 
 string spotcolorpattern[] ; % needed for transparancies
 
+% vardef spotcolor(expr p, s) =
+%   if spotcolors :
+%     save ok, pc_tag ; boolean ok ; string pc_tag ;
+%     pc_tag := "_pct_"&p ;
+%     if not unstringed(pc_tag) :
+%       _spotcolor_number_ := _spotcolor_number_ + 1 ;
+%       setunstringed(pc_tag,_spotcolor_number_) ;
+%     fi ;
+%     pp := getunstringed(pc_tag) ;
+%     if unknown spotcolorhash[pp][s] :
+%       ok := false ; % not yet defined
+%     elseif spotcolorhash[pp][s] = -1 :
+%       ok := false ; % locally defined and undefined
+%     else :
+%       ok := true ;  % globally already defined
+%     fi ;
+%     if not ok :
+%       save ss ; string ss ; ss := p & " " & decimal s ;
+%       _spotcolor_counter_ := _spotcolor_counter_ + 1 ;
+%       spotcolorpattern[_spotcolor_counter_/1000] := ss ;
+%       spotcolorhash[pp][s] := _spotcolor_counter_ ;
+%       flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ;
+%       _local_specials_ := _local_specials_ &
+%         "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ;
+%     fi ;
+%     (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000)
+%   else :
+%     (1-s,1-s,1-s)
+%   fi
+% enddef ;
+
+% vardef spotcolor(expr p, s) =
+%   if spotcolors :
+%     save ok, pc_tag ; boolean ok ; string pc_tag ;
+%     pc_tag := "_pct_"&p ;
+%     if not unstringed(pc_tag) :
+%       _spotcolor_number_ := _spotcolor_number_ + 1 ;
+%       setunstringed(pc_tag,_spotcolor_number_) ;
+%     fi ;
+%     pp := getunstringed(pc_tag) ;
+%     if unknown spotcolorhash[pp][s] :
+%       ok := false ; % not yet defined
+%     elseif spotcolorhash[pp][s] = -1 :
+%       ok := false ; % locally defined and undefined
+%     else :
+%       ok := true ;  % globally already defined
+%     fi ;
+%     if not ok :
+%       save ss ; string ss ; ss := p & " " & decimal s ;
+%       _spotcolor_counter_ := _spotcolor_counter_ + 1 ;
+%       spotcolorpattern[_spotcolor_counter_/1000] := ss ;
+%       spotcolorhash[pp][s] := _spotcolor_counter_ ;
+%       flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ;
+%       _local_specials_ := _local_specials_ &
+%         "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ;
+%     fi ;
+%     (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000)
+%   else :
+%     (1-s,1-s,1-s)
+%   fi
+% enddef ;
+
 vardef spotcolor(expr p, s) =
+  multitonecolor(p, 1, "", decimal s)
+enddef ;
+
+vardef multitonecolor(expr n, f, d, p) = % name fractions names factors
   if spotcolors :
     save ok, pc_tag ; boolean ok ; string pc_tag ;
-    pc_tag := "_pct_"&p ;
+    pc_tag := "_pct_" & n ;
     if not unstringed(pc_tag) :
       _spotcolor_number_ := _spotcolor_number_ + 1 ;
       setunstringed(pc_tag,_spotcolor_number_) ;
     fi ;
     pp := getunstringed(pc_tag) ;
-    if unknown spotcolorhash[pp][s] :
+    pc_tag := "_pct_"& decimal f & "_" & if d = "" : n else : d fi & "_" & p ; % check for d empty
+    if not unstringed(pc_tag) :
+      _spotcolor_number_ := _spotcolor_number_ + 1 ;
+      setunstringed(pc_tag,_spotcolor_number_) ;
+    fi ;
+    ps := getunstringed(pc_tag) ;
+    if unknown spotcolorhash[pp][ps] :
       ok := false ; % not yet defined
-    elseif spotcolorhash[pp][s] = -1 :
+    elseif spotcolorhash[pp][ps] = -1 :
       ok := false ; % locally defined and undefined
     else :
       ok := true ;  % globally already defined
     fi ;
     if not ok :
-      save ss ; string ss ; ss := p & " " & decimal s ;
+      save ss ; string ss ; ss := n & " " & decimal f & " " & if d = "" : n else : d fi & " " & p ;
       _spotcolor_counter_ := _spotcolor_counter_ + 1 ;
       spotcolorpattern[_spotcolor_counter_/1000] := ss ;
-      spotcolorhash[pp][s] := _spotcolor_counter_ ;
-      flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ;
+      spotcolorhash[pp][ps] := _spotcolor_counter_ ;
+      flush_special(2, 7, decimal _spotcolor_counter_ & " " & ss) ;
       _local_specials_ := _local_specials_ &
-        "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ;
+        "spotcolorhash["&decimal pp&"]["&decimal ps&"]:=-1;" ;
     fi ;
-    (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000)
+    (_special_signal_/1000,2/1000,spotcolorhash[pp][ps]/1000)
   else :
-    (1-s,1-s,1-s)
+   .5white
   fi
 enddef ;
 
@@ -459,6 +531,63 @@ differencetransparent := 11 ; exclusiontransparent  := 12 ;
 
 % fill fullcircle scaled 10cm withcolor transparant(.8,3,color) ;
 
+% vardef transparent(expr n, t, c) =
+%   save s, ss, nn, cc, is_cmyk, is_spot, ok ;
+%   string s, ss ; numeric nn ; color cc ; boolean is_cmyk, is_spot, ok ;
+%   % transparancy type
+%   if string n :
+%     if expandafter known scantokens(n&"transparent") :
+%       nn := scantokens(n&"transparent") ;
+%     else :
+%       nn := 0 ;
+%     fi
+%   else : % nn := min(n,13)
+%     nn := if n<13 : n else : nn := 0 fi ;
+%   fi ;
+%   % we need to expand the color (can be cmyk(..) or predefined)
+%   cc := c ; % expand color
+%   % check for cmyk special
+%   is_cmyk := (redpart   cc = _special_signal_/1000)
+%          and (greenpart cc = 1/1000) ;
+%   is_spot := (redpart   cc = _special_signal_/1000)
+%          and (greenpart cc = 2/1000) ;
+%   % build special string, fetch cmyk components
+%   s := decimal nn & " " & decimal t & " " &
+%        if     is_cmyk : cmykcolorpattern[bluepart cc]
+%        elseif is_spot : spotcolorpattern[bluepart cc]
+%        else           : dddecimal cc fi ;
+%   % check if this one is already used
+%   ss := "tr_" & s ;
+%   % efficiency hack
+%   if expandafter unknown scantokens(ss) :
+%     ok := false ; % not yet defined
+%   elseif scantokens(ss) < 0  :
+%     ok := false ; % locally defined and undefined
+%   else :
+%     ok := true ;  % globally already defined
+%   fi ;
+%   if not ok :
+%     if is_spot  :
+%       flush_special(5, 6, s) ;
+%     elseif is_cmyk :
+%       flush_special(4, 8, s) ;
+%     else :
+%       flush_special(3, 7, s) ;
+%     fi ;
+%     scantokens(ss) := _special_counter_ ;
+%     _local_specials_ := _local_specials_ &
+%       "scantokens(" & ditto & ss & ditto & ") := -1 ;" ;
+%   fi ;
+%   % go ahead
+%   if is_spot :
+%     (_special_signal_/1000,5/1000,scantokens(ss)/1000)
+%   elseif is_cmyk :
+%     (_special_signal_/1000,4/1000,scantokens(ss)/1000)
+%   else :
+%     (_special_signal_/1000,3/1000,scantokens(ss)/1000)
+%   fi
+% enddef ;
+
 vardef transparent(expr n, t, c) =
   save s, ss, nn, cc, is_cmyk, is_spot, ok ;
   string s, ss ; numeric nn ; color cc ; boolean is_cmyk, is_spot, ok ;
@@ -485,7 +614,12 @@ vardef transparent(expr n, t, c) =
        elseif is_spot : spotcolorpattern[bluepart cc]
        else           : dddecimal cc fi ;
   % check if this one is already used
-  ss := "tr_" & s ;
+  ss := cleanstring("tr_" & s) ;
+  % we now have rather unique names, i.e. a color spec of .234 becomes
+  % tr..._234.... and metapost gives a number overflow (parse error)
+  % for variables like tr_12345678 which may result from many decimal
+  % positions (imo mp bug)
+  ss := asciistring(ss) ;
   % efficiency hack
   if expandafter unknown scantokens(ss) :
     ok := false ; % not yet defined
@@ -496,7 +630,7 @@ vardef transparent(expr n, t, c) =
   fi ;
   if not ok :
     if is_spot  :
-      flush_special(5, 6, s) ;
+      flush_special(5, 8, s) ;
     elseif is_cmyk :
       flush_special(4, 8, s) ;
     else :
@@ -570,4 +704,4 @@ enddef ;
 
 % spotcolor is already scaled
 
-endinput ;
\ No newline at end of file
+endinput ;
diff --git a/metapost/context/base/mp-text.mp b/metapost/context/base/mp-text.mp
index cb6bb3895..2e061df09 100644
--- a/metapost/context/base/mp-text.mp
+++ b/metapost/context/base/mp-text.mp
@@ -2,165 +2,182 @@
 %D   [       file=mp-text.mp,
 %D        version=2000.07.10,
 %D          title=\CONTEXT\ \METAPOST\ graphics,
-%D       subtitle=text support, 
+%D       subtitle=text support,
 %D         author=Hans Hagen,
 %D           date=\currentdate,
 %D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
 %C
 %C This module is part of the \CONTEXT\ macro||package and is
-%C therefore copyrighted by \PRAGMA. See licen-en.pdf for 
-%C details. 
+%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+%C details.
 
 %D Under construction.
 
-if unknown context_tool :    input mp-tool ; fi ; 
-if   known context_text : endinput         ; fi ; 
+if unknown context_tool :    input mp-tool ; fi ;
+if   known context_text : endinput         ; fi ;
 
-boolean context_text ; context_text := true ; 
+boolean context_text ; context_text := true ;
 
-if unknown noftexpictures : 
-  numeric noftexpictures ; noftexpictures := 0 ; 
-fi ; 
+if unknown noftexpictures :
+  numeric noftexpictures ; noftexpictures := 0 ;
+fi ;
 
-if unknown texpictures[1] : 
-  picture texpictures[] ; 
-fi ; 
+if unknown texpictures[1] :
+  picture texpictures[] ;
+fi ;
 
-numeric textextoffset ; textextoffset := 0 ; 
+numeric textextoffset ; textextoffset := 0 ;
 
-% vardef textext@#(expr txt) = 
-%   interim labeloffset := textextoffset ; 
-%   noftexpictures := noftexpictures + 1 ; 
-%   if string txt : 
-%     write "% figure " & decimal charcode & " : " &  
-%       "texpictures[" & decimal noftexpictures & "] := btex " & 
-%       txt & " etex ;" to jobname & ".mpt" ; 
-%     if unknown texpictures[noftexpictures] : 
-%       thelabel@#("unknown",origin)   
+% vardef textext@#(expr txt) =
+%   interim labeloffset := textextoffset ;
+%   noftexpictures := noftexpictures + 1 ;
+%   if string txt :
+%     write "% figure " & decimal charcode & " : " &
+%       "texpictures[" & decimal noftexpictures & "] := btex " &
+%       txt & " etex ;" to jobname & ".mpt" ;
+%     if unknown texpictures[noftexpictures] :
+%       thelabel@#("unknown",origin)
 %     else :
-%       thelabel@#(texpictures[noftexpictures],origin) 
-%     fi 
+%       thelabel@#(texpictures[noftexpictures],origin)
+%     fi
 %   else :
-%     thelabel@#(txt,origin)   
-%   fi 
-% enddef ; 
-
-boolean hobbiestextext ; hobbiestextext := false ; 
-
-vardef textext@#(expr txt) = 
-  interim labeloffset := textextoffset ; 
-  noftexpictures := noftexpictures + 1 ; 
-  if string txt : 
+%     thelabel@#(txt,origin)
+%   fi
+% enddef ;
+
+boolean hobbiestextext ; hobbiestextext := false ;
+% string  textextstring  ; textextstring  := "" ;
+
+% def resettextextdirective =
+%   textextstring := "" ;
+% enddef ;
+
+% def textextdirective text t =
+%   textextstring := textextstring & t ;
+% enddef ;
+
+vardef textext@#(expr txt) =
+  save _s_ ; string _s_ ;
+  interim labeloffset := textextoffset ;
+  noftexpictures := noftexpictures + 1 ;
+  if string txt :
+%     if textextstring <> "" :
+%       _s_ := "verbatimtex " & textextstring & " etex ;" ;
+%     else :
+%       _s_ := "" ;
+%     fi ;
     if hobbiestextext : % the tex.mp method as fallback (see tex.mp)
-      write "btex " & txt & " etex" to "mptextmp.mp" ;
+%       write _s_ to "mptextmp.mp" ;
+      write _s_ & "btex " & txt & " etex" to "mptextmp.mp" ;
       write EOF to "mptextmp.mp" ;
       scantokens "input mptextmp"
     else :
-      write "% figure " & decimal charcode & " : " &  
-        "texpictures[" & decimal noftexpictures & "] := btex " & 
-        txt & " etex ;" to jobname & ".mpt" ; 
-      if unknown texpictures[noftexpictures] : 
-        thelabel@#("unknown",origin)   
+%       write "% setup : " & _s_ to jobname & ".mpt" ;
+      write "% figure " & decimal charcode & " : " &
+        "texpictures[" & decimal noftexpictures & "] := btex " &
+        txt & " etex ;" to jobname & ".mpt" ;
+      if unknown texpictures[noftexpictures] :
+        thelabel@#("unknown",origin)
       else :
-        thelabel@#(texpictures[noftexpictures],origin) 
+        thelabel@#(texpictures[noftexpictures],origin)
       fi
-    fi  
+    fi
   else :
-    thelabel@#(txt,origin)   
-  fi 
-enddef ; 
-
-string laboff_   ; laboff_   := ""      ; 
-string laboff_c  ; laboff_c  := ""      ; 
-string laboff_l  ; laboff_l  := ".lft"  ;  
-string laboff_r  ; laboff_r  := ".rt"   ;   
-string laboff_b  ; laboff_b  := ".bot"  ;   
-string laboff_t  ; laboff_t  := ".top"  ;   
-string laboff_lt ; laboff_lt := ".ulft" ;   
-string laboff_rt ; laboff_rt := ".urt"  ;   
-string laboff_lb ; laboff_lb := ".llft" ;   
-string laboff_rb ; laboff_rb := ".lrt"  ;   
-string laboff_tl ; laboff_tl := ".ulft" ;   
-string laboff_tr ; laboff_tr := ".urt"  ;  
-string laboff_bl ; laboff_bl := ".llft" ;   
-string laboff_br ; laboff_br := ".lrt"  ;   
-
-vardef textextstr(expr s, a) = 
-  save ss ; string ss ; 
-  ss := "laboff_" & a  ;  
-  ss := scantokens ss ;  
+    thelabel@#(txt,origin)
+  fi
+enddef ;
+
+string laboff_   ; laboff_   := ""      ;
+string laboff_c  ; laboff_c  := ""      ;
+string laboff_l  ; laboff_l  := ".lft"  ;
+string laboff_r  ; laboff_r  := ".rt"   ;
+string laboff_b  ; laboff_b  := ".bot"  ;
+string laboff_t  ; laboff_t  := ".top"  ;
+string laboff_lt ; laboff_lt := ".ulft" ;
+string laboff_rt ; laboff_rt := ".urt"  ;
+string laboff_lb ; laboff_lb := ".llft" ;
+string laboff_rb ; laboff_rb := ".lrt"  ;
+string laboff_tl ; laboff_tl := ".ulft" ;
+string laboff_tr ; laboff_tr := ".urt"  ;
+string laboff_bl ; laboff_bl := ".llft" ;
+string laboff_br ; laboff_br := ".lrt"  ;
+
+vardef textextstr(expr s, a) =
+  save ss ; string ss ;
+  ss := "laboff_" & a  ;
+  ss := scantokens ss ;
   ss := "textext" & ss & "(" & ditto & s & ditto & ")" ;
-  scantokens ss  
-enddef ; 
+  scantokens ss
+enddef ;
 
-pair laboff.origin ; laboff.origin = (infinity,infinity) ; 
-pair laboff.raw    ; laboff.raw    = (infinity,infinity) ; 
+pair laboff.origin ; laboff.origin = (infinity,infinity) ;
+pair laboff.raw    ; laboff.raw    = (infinity,infinity) ;
 
-vardef thelabel@#(expr s, z) = 
+vardef thelabel@#(expr s, z) =
   save p ; picture p ;
   p = s if not picture s : infont defaultfont scaled defaultscale fi ;
-  if laboff@#<>laboff.origin : 
-    (p shifted (z + labeloffset*laboff@# - (labxf@#*lrcorner p + 
+  if laboff@#<>laboff.origin :
+    (p shifted (z + labeloffset*laboff@# - (labxf@#*lrcorner p +
          labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p)))
   else :
     (p shifted z)
   fi
 enddef;
 
-def build_parshape (expr p, offset_or_path, dx, dy, 
+def build_parshape (expr p, offset_or_path, dx, dy,
   baselineskip, strutheight, strutdepth, topskip) =
- 
-  if unknown trace_parshape : 
-    boolean trace_parshape ; trace_parshape := false ; 
+
+  if unknown trace_parshape :
+    boolean trace_parshape ; trace_parshape := false ;
   fi ;
 
   begingroup ;
 
-  save    q, l, r, line, tt, bb, 
-          n, hsize, vsize, vvsize, voffset, hoffset, width, indent, 
-          ll, lll, rr, rrr, cp, cq, t, b ; 
+  save    q, l, r, line, tt, bb,
+          n, hsize, vsize, vvsize, voffset, hoffset, width, indent,
+          ll, lll, rr, rrr, cp, cq, t, b ;
 
-  path    q, l, r, line, tt, bb ; 
+  path    q, l, r, line, tt, bb ;
   numeric n, hsize, vsize, vvsize, voffset, hoffset, width[], indent[] ;
-  pair    ll, lll, rr, rrr, cp, cq, t, b ; 
+  pair    ll, lll, rr, rrr, cp, cq, t, b ;
 
-  n := 0 ; cp := center p ; 
+  n := 0 ; cp := center p ;
 
-  if path offset_or_path : 
-    q := offset_or_path ; cq := center q ; 
-    voffset := dy ; 
-    hoffset := dx ; 
-  else : 
-    q := p ; cq := center q ; 
+  if path offset_or_path :
+    q := offset_or_path ; cq := center q ;
+    voffset := dy ;
+    hoffset := dx ;
+  else :
+    q := p ; cq := center q ;
     hoffset := offset_or_path + dx ;
-    voffset := offset_or_path + dy ; 
-  fi ; 
+    voffset := offset_or_path + dy ;
+  fi ;
 
-  hsize := xpart lrcorner q - xpart llcorner q ; 
-  vsize := ypart urcorner q - ypart lrcorner q ; 
+  hsize := xpart lrcorner q - xpart llcorner q ;
+  vsize := ypart urcorner q - ypart lrcorner q ;
 
-  q := p shifted - cp ; 
+  q := p shifted - cp ;
 
-  startsavingdata ; 
+  startsavingdata ;
 
-  savedata "\global\parvoffset " & decimal voffset&"bp " ; 
-  savedata "\global\parhoffset " & decimal hoffset&"bp " ; 
-  savedata "\global\parwidth   " & decimal   hsize&"bp " ; 
-  savedata "\global\parheight  " & decimal   vsize&"bp " ; 
+  savedata "\global\parvoffset " & decimal voffset&"bp " ;
+  savedata "\global\parhoffset " & decimal hoffset&"bp " ;
+  savedata "\global\parwidth   " & decimal   hsize&"bp " ;
+  savedata "\global\parheight  " & decimal   vsize&"bp " ;
 
-  if not path offset_or_path : 
-    q := q xscaled ((hsize-2hoffset)/hsize) 
-           yscaled ((vsize-2voffset)/vsize) ; 
-  fi ; 
+  if not path offset_or_path :
+    q := q xscaled ((hsize-2hoffset)/hsize)
+           yscaled ((vsize-2voffset)/vsize) ;
+  fi ;
 
-  hsize := xpart lrcorner q - xpart llcorner q ; 
-  vsize := ypart urcorner q - ypart lrcorner q ; 
+  hsize := xpart lrcorner q - xpart llcorner q ;
+  vsize := ypart urcorner q - ypart lrcorner q ;
 
-  t := (ulcorner q -- urcorner q) intersection_point q ; 
-  b := (llcorner q -- lrcorner q) intersection_point q ; 
+  t := (ulcorner q -- urcorner q) intersection_point q ;
+  b := (llcorner q -- lrcorner q) intersection_point q ;
 
-  if xpart directionpoint t of q < 0 : 
-    q := reverse q ; 
+  if xpart directionpoint t of q < 0 :
+    q := reverse q ;
   fi ;
 
   l := q cutbefore t ;
@@ -169,82 +186,82 @@ def build_parshape (expr p, offset_or_path, dx, dy,
   r := q cutbefore b ;
   r := r if xpart point 0 of q > 0 : & q fi cutafter t ;
 
-%  tt := (ulcorner q -- urcorner q) shifted (0,-topskip) ; 
-%  bb := (llcorner q -- lrcorner q) shifted (0,strutdepth) ; 
+%  tt := (ulcorner q -- urcorner q) shifted (0,-topskip) ;
+%  bb := (llcorner q -- lrcorner q) shifted (0,strutdepth) ;
 %
-%  l := l cutbefore (l intersection_point tt) ; 
-%  l := l cutafter  (l intersection_point bb) ; 
-%  r := r cutbefore (r intersection_point bb) ; 
-%  r := r cutafter  (r intersection_point tt) ; 
+%  l := l cutbefore (l intersection_point tt) ;
+%  l := l cutafter  (l intersection_point bb) ;
+%  r := r cutbefore (r intersection_point bb) ;
+%  r := r cutafter  (r intersection_point tt) ;
 
-  if trace_parshape : 
+  if trace_parshape :
     drawarrow p            withpen pencircle scaled 2pt withcolor red ;
     drawarrow l shifted cp withpen pencircle scaled 1pt withcolor green ;
     drawarrow r shifted cp withpen pencircle scaled 1pt withcolor blue ;
-  fi ; 
+  fi ;
 
-  vardef found_point (expr lin, pat, sig) = 
+  vardef found_point (expr lin, pat, sig) =
     pair a, b ;
     a := pat intersection_point (lin shifted (0,strutheight)) ;
-    if intersection_found : 
+    if intersection_found :
       a := a shifted (0,-strutheight) ;
     else :
       a := pat intersection_point lin ;
     fi ;
     b := pat intersection_point (lin shifted (0,-strutdepth)) ;
-    if intersection_found : 
-      if sig : 
-        if xpart b > xpart a : a := b shifted (0,strutdepth) fi ; 
-      else : 
-        if xpart b < xpart a : a := b shifted (0,strutdepth) fi ; 
-      fi ; 
-    fi ; 
-    a 
+    if intersection_found :
+      if sig :
+        if xpart b > xpart a : a := b shifted (0,strutdepth) fi ;
+      else :
+        if xpart b < xpart a : a := b shifted (0,strutdepth) fi ;
+      fi ;
+    fi ;
+    a
   enddef ;
 
-  if (strutheight+strutdepth<baselineskip) : 
-    vvsize := vsize ; 
-  else : 
-    vvsize := (vsize div baselineskip) * baselineskip ; 
-  fi ; 
+  if (strutheight+strutdepth<baselineskip) :
+    vvsize := vsize ;
+  else :
+    vvsize := (vsize div baselineskip) * baselineskip ;
+  fi ;
 
-  for i=topskip step baselineskip until vvsize : 
+  for i=topskip step baselineskip until vvsize :
 
-    line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ;  
+    line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ;
 
     ll := found_point(line,l,true ) ;
     rr := found_point(line,r,false) ;
 
-    if trace_parshape : 
-      fill (ll--rr--rr shifted (0,strutheight)--ll 
+    if trace_parshape :
+      fill (ll--rr--rr shifted (0,strutheight)--ll
         shifted (0,strutheight)--cycle) shifted cp withcolor .5white ;
-      fill (ll--rr--rr shifted (0,-strutdepth)--ll 
+      fill (ll--rr--rr shifted (0,-strutdepth)--ll
         shifted (0,-strutdepth)--cycle) shifted cp withcolor .7white ;
-      draw ll shifted cp withpen pencircle scaled 2pt ;  
-      draw rr shifted cp withpen pencircle scaled 2pt ;    
+      draw ll shifted cp withpen pencircle scaled 2pt ;
+      draw rr shifted cp withpen pencircle scaled 2pt ;
       draw (ll--rr) shifted cp  withpen pencircle scaled .5pt ;
-    fi ; 
+    fi ;
 
-    n := n + 1 ; 
+    n := n + 1 ;
     indent[n] := abs(xpart ll - xpart llcorner q) ;
     width[n]  := abs(xpart rr - xpart ll) ;
 
-    if (i=strutheight) and (width[n]<baselineskip) : 
-      n := n - 1 ; 
-      savedata "\global\chardef\parfirst=1 " ; 
+    if (i=strutheight) and (width[n]<baselineskip) :
+      n := n - 1 ;
+      savedata "\global\chardef\parfirst=1 " ;
     fi ;
 
-  endfor ; 
+  endfor ;
 
-  savedata "\global\parlines  " & decimal n ; 
-  savedata "\global\partoks{  " ; 
-  for i=1 upto n: 
-    savedata decimal indent[i]&"bp " & decimal width[i]&"bp " ;  
-  endfor ; 
+  savedata "\global\parlines  " & decimal n ;
+  savedata "\global\partoks{  " ;
+  for i=1 upto n:
+    savedata decimal indent[i]&"bp " & decimal width[i]&"bp " ;
+  endfor ;
   savedata "}" ;
-  
-  stopsavingdata ; 
+
+  stopsavingdata ;
 
   endgroup ;
 
-enddef ; 
+enddef ;
diff --git a/metapost/context/base/mp-tool.mp b/metapost/context/base/mp-tool.mp
index d78ee43ea..1f299807a 100644
--- a/metapost/context/base/mp-tool.mp
+++ b/metapost/context/base/mp-tool.mp
@@ -1499,52 +1499,89 @@ enddef ;
 % nice: currentpicture := inverted currentpicture ;
 
 primarydef p uncolored c =
-  image
-    (for i within p :
-       addto currentpicture
-       if stroked i or filled i :
-         if filled i : contour else : doublepath fi pathpart i
-         dashed dashpart i withpen penpart i
-       else :
-         also i
-       fi
-       withcolor c-(redpart i, greenpart i, bluepart i) ;
-     endfor ; )
+  if color p :
+    c - p
+  else :
+      image
+        (for i within p :
+           addto currentpicture
+           if stroked i or filled i :
+             if filled i : contour else : doublepath fi pathpart i
+             dashed dashpart i withpen penpart i
+           else :
+             also i
+           fi
+           withcolor c-(redpart i, greenpart i, bluepart i) ;
+         endfor ; )
+  fi
 enddef ;
 
 vardef inverted primary p =
   (p uncolored white)
 enddef ;
 
+% primarydef p softened c =
+%   if color p :
+%     tripled(c) * p
+%   else :
+%     image
+%       (save cc ; color cc ; cc := tripled(c) ;
+%        for i within p :
+%          addto currentpicture
+%          if stroked i or filled i :
+%            if filled i : contour else : doublepath fi pathpart i
+%            dashed dashpart i withpen penpart i
+%          else :
+%           also i
+%          fi
+%          withcolor (redpart   cc * redpart   i,
+%                     greenpart cc * greenpart i,
+%                     bluepart  cc * bluepart  i) ;
+%        endfor ;)
+%   fi
+% enddef ;
+
 primarydef p softened c =
-  image
-    (save cc ; color cc ; cc := tripled(c) ;
-     for i within p :
-       addto currentpicture
-       if stroked i or filled i :
-         if filled i : contour else : doublepath fi pathpart i
-         dashed dashpart i withpen penpart i
-       else :
-        also i
-       fi
-       withcolor (redpart   cc * redpart   i,
-                  greenpart cc * greenpart i,
-                  bluepart  cc * bluepart  i) ;
-     endfor ;)
+  begingroup
+  save cc ; color cc ; cc := tripled(c) ;
+  if color p :
+    (redpart   cc * redpart   p,
+     greenpart cc * greenpart p,
+     bluepart  cc * bluepart  p)
+  else :
+    image
+      (for i within p :
+         addto currentpicture
+         if stroked i or filled i :
+           if filled i : contour else : doublepath fi pathpart i
+           dashed dashpart i withpen penpart i
+         else :
+          also i
+         fi
+         withcolor (redpart   cc * redpart   i,
+                    greenpart cc * greenpart i,
+                    bluepart  cc * bluepart  i) ;
+       endfor ;)
+  fi
+  endgroup
 enddef ;
 
 vardef grayed primary p =
-  image
-    (for i within p :
-       addto currentpicture
-       if stroked i or filled i :
-         if filled i : contour else : doublepath fi pathpart i
-         dashed dashpart i withpen penpart i
-       else :
-         also i
-       fi
-       withcolor tripled(.30redpart i+.59greenpart i+.11bluepart i) ;
-     endfor ; )
+  if color p :
+    tripled(.30redpart p+.59greenpart p+.11bluepart p)
+  else :
+    image
+      (for i within p :
+         addto currentpicture
+         if stroked i or filled i :
+           if filled i : contour else : doublepath fi pathpart i
+           dashed dashpart i withpen penpart i
+         else :
+           also i
+         fi
+         withcolor tripled(.30redpart i+.59greenpart i+.11bluepart i) ;
+       endfor ; )
+  fi
 enddef ;
 
 % yes or no: "text" infont "cmr12" at 24pt ;
@@ -1944,12 +1981,20 @@ vardef dodostraightened(expr sign, p) =
   fi
 enddef ;
 
+% vardef simplified expr p =
+%   dostraightened(+1,p)
+% enddef ;
+
+% vardef unspiked   expr p =
+%   dostraightened(-1,p)
+% enddef ;
+
 vardef simplified expr p =
-  dostraightened(+1,p)
+  (reverse dostraightened(+1,dostraightened(+1,reverse p)))
 enddef ;
 
 vardef unspiked   expr p =
-  dostraightened(-1,p)
+  (reverse dostraightened(-1,dostraightened(-1,reverse p)))
 enddef ;
 
 % path p ;
@@ -2085,17 +2130,34 @@ enddef ;
 % obscure macros: create var from string and replace - and :
 % (needed for process color id's)
 
-string _clean_ascii[] ;
+string _clean_ascii_[] ;
+
+def register_dirty_chars(expr str) =
+    for i = 0 upto length(str)-1 :
+        _clean_ascii_[ASCII substring(i,i+1) of str] := "_" ;
+    endfor ;
+enddef ;
 
-_clean_ascii[ASCII "-"] := "_" ;
-_clean_ascii[ASCII ":"] := "_" ;
-_clean_ascii[ASCII "."] := "_" ;
+register_dirty_chars("+-*/:;., ") ;
 
 vardef cleanstring (expr s) =
-  save ss ; string ss, si ; ss = "" ;
+  save ss ; string ss, si ; ss = "" ; save i ;
   for i=0 upto length(s) :
     si := substring(i,i+1) of s ;
-    ss := ss & if known _clean_ascii[ASCII si] : _clean_ascii[ASCII si] else : si fi ;
+    ss := ss & if known _clean_ascii_[ASCII si] : _clean_ascii_[ASCII si] else : si fi ;
+  endfor ;
+  ss
+enddef ;
+
+vardef asciistring (expr s) =
+  save ss ; string ss, si ; ss = "" ; save i ;
+  for i=0 upto length(s) :
+    si := substring(i,i+1) of s ;
+    if (ASCII si >= ASCII "0") and (ASCII si <= ASCII "9") :
+        ss := ss & char(scantokens(si) + ASCII "A") ;
+    else :
+        ss := ss & si ;
+    fi ;
   endfor ;
   ss
 enddef ;
@@ -2195,4 +2257,4 @@ enddef ;
 
 % done
 
-endinput ;
\ No newline at end of file
+endinput ;