beta 2011.02.14 18:50

4 files changed, 260 insertions, 70 deletions

diff --git a/metapost/context/base/mp-form.mp b/metapost/context/base/mp-form.mp
index 1a80d618c..60ea4cac2 100644
--- a/metapost/context/base/mp-form.mp
+++ b/metapost/context/base/mp-form.mp
@@ -15,6 +15,11 @@
 
 boolean mant_font ; mant_font := true ; % signals graph not to load form
 
+if known mplib :
+    boolean fmt_loaded ; fmt_loaded := true ;
+    expandafter endinput
+fi ;
+
 if   known fmt_loaded : expandafter endinput fi ;
    boolean fmt_loaded ; fmt_loaded := true ;
 
diff --git a/metapost/context/base/mp-grph.mp b/metapost/context/base/mp-grph.mp
index 243b45318..3cd9f2cfb 100644
--- a/metapost/context/base/mp-grph.mp
+++ b/metapost/context/base/mp-grph.mp
@@ -59,21 +59,25 @@ string  graphictextfile    ; graphictextfile    := "dummy.mpo" ;
 def data_mpo_file = job_name & "-mpgraph.mpo" enddef ;
 def data_mpy_file = job_name & "-mpgraph.mpy" enddef ;
 
-def savegraphictext (expr str) =
-  if (graphictextstring<>"") :
-    write graphictextstring to data_mpo_file ;
-    graphictextstring := "" ;
-  fi ;
-  write str to data_mpo_file ;
-  let erasegraphictextfile = relax ;
-enddef ;
+if unknown mplib :
 
-def erasegraphictextfile =
-  write EOF to data_mpo_file ;
-  let erasegraphictextfile = relax ;
-enddef ;
+    def savegraphictext (expr str) =
+      if (graphictextstring<>"") :
+        write graphictextstring to data_mpo_file ;
+        graphictextstring := "" ;
+      fi ;
+      write str to data_mpo_file ;
+      let erasegraphictextfile = relax ;
+    enddef ;
 
-extra_beginfig := extra_beginfig & " erasegraphictextfile ;" ;
+    def erasegraphictextfile =
+      write EOF to data_mpo_file ;
+      let erasegraphictextfile = relax ;
+    enddef ;
+
+    extra_beginfig := extra_beginfig & " erasegraphictextfile ;" ;
+
+fi ;
 
 def begingraphictextfig (expr n) =
   foundpicture := n ; scratchpicture := nullpicture ;
@@ -138,7 +142,9 @@ def dographictext (expr t) =
     graphictextformat := "" ;
   fi ;
   currentgraphictext := currentgraphictext + 1 ;
-  savegraphictext ("\startTEXpage[scale=10000]" & t & "\stopTEXpage") ;
+  if unknown mplib :
+    savegraphictext ("\startTEXpage[scale=10000]" & t & "\stopTEXpage") ;
+  fi ;
   dofinishgraphictext
 enddef ;
 
diff --git a/metapost/context/base/mp-mlib.mp b/metapost/context/base/mp-mlib.mp
index f6229f2ff..7b3491539 100644
--- a/metapost/context/base/mp-mlib.mp
+++ b/metapost/context/base/mp-mlib.mp
@@ -2,7 +2,7 @@
 %D   [       file=mp-mlib.mp,
 %D        version=2008.03.21,
 %D          title=\CONTEXT\ \METAPOST\ graphics,
-%D       subtitle=specials,
+%D       subtitle=plugins,
 %D         author=Hans Hagen,
 %D           date=\currentdate,
 %D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
@@ -16,6 +16,52 @@ if known   context_mlib : endinput ; fi ;
 
 boolean context_mlib ; context_mlib := true ;
 
+%D Color and transparency
+
+newinternal normaltransparent     ; normaltransparent     :=  1 ;
+newinternal multiplytransparent   ; multiplytransparent   :=  2 ;
+newinternal screentransparent     ; screentransparent     :=  3 ;
+newinternal overlaytransparent    ; overlaytransparent    :=  4 ;
+newinternal softlighttransparent  ; softlighttransparent  :=  5 ;
+newinternal hardlighttransparent  ; hardlighttransparent  :=  6 ;
+newinternal colordodgetransparent ; colordodgetransparent :=  7 ;
+newinternal colorburntransparent  ; colorburntransparent  :=  8 ;
+newinternal darkentransparent     ; darkentransparent     :=  9 ;
+newinternal lightentransparent    ; lightentransparent    := 10 ;
+newinternal differencetransparent ; differencetransparent := 11 ;
+newinternal exclusiontransparent  ; exclusiontransparent  := 12 ;
+
+def spotcolor(expr n, v) =
+    1
+    withprescript "sp_name="  & n
+    withprescript "sp_value=" & v
+enddef ;
+
+def multitonecolor(expr name, fractions, components, value) =
+    1
+    withprescript "sp_name="       & name
+    withprescript "sp_fractions="  & decimal fractions
+    withprescript "sp_components=" & components
+    withprescript "sp_value="      & value
+enddef ;
+
+def transparent(expr alternative, transparency)(text c) =
+     c
+     withprescript "tr_alternative="  & decimal alternative
+     withprescript "tr_transparency=" & decimal transparency
+enddef ;
+
+def withtransparency(expr alternative, transparency) =
+     withprescript "tr_alternative="  & decimal alternative
+     withprescript "tr_transparency=" & decimal transparency
+enddef ;
+
+def cmyk(expr c, m, y, k) =
+    (c,m,y,k)
+enddef ;
+
+% Texts
+
 numeric _tt_w_[], _tt_h_[], _tt_d_[] ;
 numeric _tt_n_ ; _tt_n_ := 0 ;
 picture _tt_p_ ; _tt_p_ := nullpicture ;
@@ -26,20 +72,32 @@ def resettextexts =
     _tt_p_ := nullpicture ;
 enddef ;
 
-extra_endfig   := ";addto currentpicture also _tt_p_; " & extra_endfig; % was draw _tt_p_
+def flushtextexts =
+    addto currentpicture also _tt_p_
+enddef ;
+
+extra_endfig   := "flushtextexts;" & extra_endfig;
 extra_beginfig := extra_beginfig & "resettextexts;";
 
+% We collect and flush them all, as we can also have temporary textexts
+% that gets never really flushed but are used for calculations. So, we
+% flush twice: once in location in order to pick up e.g. color properties,
+% and once at the end because we need to flush missing ones.
+
 vardef rawtextext(expr str) =
     if str = "" :
         nullpicture
     elseif _trial_run_ :
+        _tt_n_ := _tt_n_ + 1 ;
+        addto _tt_p_ doublepath unitsquare
+            withprescript "tx_number=" & decimal _tt_n_
+            withprescript "tx_stage=extra"
+            withpostscript str ;
         image (
-            _tt_n_ := _tt_n_ + 1 ;
-            _tt_p_ := image (
-                addto currentpicture also _tt_p_ ;
-                addto currentpicture doublepath unitsquare withprescript "tf" withpostscript decimal _tt_n_ & ":" & str ;
-            ) ;
-            addto currentpicture doublepath unitsquare withpen pencircle scaled 0 ;
+            addto currentpicture doublepath unitsquare
+                withprescript "tx_number=" & decimal _tt_n_
+                withprescript "tx_stage=trial"
+                withpostscript str
         )
     else :
         image (
@@ -47,13 +105,14 @@ vardef rawtextext(expr str) =
             addto currentpicture doublepath unitsquare
                 xscaled _tt_w_[_tt_n_]
                 yscaled (_tt_h_[_tt_n_] + _tt_d_[_tt_n_])
-                withprescript "ts"
-                withpostscript decimal _tt_n_ & ":" & str ;
+                withprescript "tx_number=" & decimal _tt_n_
+                withprescript "tx_stage=final"
+                ; % withpostscript str ;
         ) shifted (0,-_tt_d_[_tt_n_])
     fi
 enddef ;
 
-% not ok yet
+% More text
 
 pair laboff.d, laboff.dlft, laboff.drt ; % new positional suffixes
 pair laboff.origin, laboff.raw         ; % graph mess
@@ -175,6 +234,34 @@ primarydef str infont name = % very naughty !
     fi
 enddef ;
 
+% Shades
+
+newinternal shadefactor  ; shadefactor  := 1 ;
+pair        shadeoffset  ; shadeoffset  := origin ;
+boolean     trace_shades ; trace_shades := false ;
+
+def set_linear_vector (suffix a,b)(expr p,n) =
+    if     (n=1) : a := llcorner p ; b := urcorner p ;
+    elseif (n=2) : a := lrcorner p ; b := ulcorner p ;
+    elseif (n=3) : a := urcorner p ; b := llcorner p ;
+    elseif (n=4) : a := ulcorner p ; b := lrcorner p ;
+    elseif (n=5) : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ;
+    elseif (n=6) : a := .5[llcorner p,lrcorner p] ; b := .5[ulcorner p,urcorner p] ;
+    elseif (n=7) : a := .5[lrcorner p,urcorner p] ; b := .5[llcorner p,ulcorner p] ;
+    elseif (n=8) : a := .5[urcorner p,ulcorner p] ; b := .5[lrcorner p,llcorner p] ;
+    else         : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ;
+    fi ;
+enddef ;
+
+def set_circular_vector (suffix ab, r)(expr p,n) =
+    if     (n=1) : ab := llcorner p ;
+    elseif (n=2) : ab := lrcorner p ;
+    elseif (n=3) : ab := urcorner p ;
+    elseif (n=4) : ab := ulcorner p ;
+    else         : ab := center   p ; r := .5r ;
+    fi ;
+enddef ;
+
 def circular_shade (expr p, n, ca, cb) =
     begingroup ;
         save ab, r ; pair ab ; numeric r ;
@@ -186,6 +273,7 @@ def circular_shade (expr p, n, ca, cb) =
         fi ;
     endgroup ;
 enddef ;
+
 def linear_shade (expr p, n, ca, cb) =
     begingroup ;
         save a, b, sh ; pair a, b ;
@@ -196,46 +284,80 @@ def linear_shade (expr p, n, ca, cb) =
         fi ;
     endgroup ;
 enddef ;
+
 def withcircularshade (expr a, b, ra, rb, ca, cb) =
-    withprescript
-        "cs"
-    withpostscript
-        "0 1 " & decimal shadefactor & " " &
-        colordecimals ca & " " & ddecimal (a shifted shadeoffset) & " " & decimal ra & " " &
-        colordecimals cb & " " & ddecimal (b shifted shadeoffset) & " " & decimal rb
+    withprescript "sh_type=circular"
+    withprescript "sh_domain=0 1"
+    withprescript "sh_factor="   & decimal shadefactor
+    withprescript "sh_color_a="  & colordecimals ca
+    withprescript "sh_color_b="  & colordecimals cb
+    withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset)
+    withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset)
+    withprescript "sh_radius_a=" & decimal ra
+    withprescript "sh_radius_b=" & decimal rb
 enddef ;
+
 def withlinearshade (expr a, b, ca, cb) =
-    withprescript
-        "ls"
-    withpostscript
-        "0 1 " & decimal shadefactor & " " &
-        colordecimals ca  & " " & ddecimal (a shifted shadeoffset) & " " &
-        colordecimals cb  & " " & ddecimal (b shifted shadeoffset)
+    withprescript "sh_type=linear"
+    withprescript "sh_domain=0 1"
+    withprescript "sh_factor="   & decimal shadefactor
+    withprescript "sh_color_a="  & colordecimals ca
+    withprescript "sh_color_b="  & colordecimals cb
+    withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset)
+    withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset)
 enddef ;
-string _defined_cs_pre_[], _defined_cs_post_[] ; numeric _defined_cs_ ; _defined_cs_:= 0 ;
+
+string _defined_cs_pre_[] ; numeric _defined_cs_ ; _defined_cs_:= 0 ;
+string prescript_separator ; prescript_separator := char(13) ;
+
 vardef define_circular_shade (expr a, b, ra, rb, ca, cb) =
     _defined_cs_ := _defined_cs_ + 1 ;
-    _defined_cs_pre_ [_defined_cs_] := "cs" ;
-    _defined_cs_post_[_defined_cs_] := "0 1 " & decimal shadefactor & " " &
-        colordecimals ca & " " & ddecimal (a shifted shadeoffset) & " " & decimal ra & " " &
-        colordecimals cb & " " & ddecimal (b shifted shadeoffset) & " " & decimal rb ;
+    _defined_cs_pre_ [_defined_cs_] := "sh_type=circular"
+      & prescript_separator & "sh_domain=0 1"
+      & prescript_separator & "sh_factor="   & decimal shadefactor
+      & prescript_separator & "sh_color_a="  & colordecimals ca
+      & prescript_separator & "sh_color_b="  & colordecimals cb
+      & prescript_separator & "sh_center_a=" & ddecimal (a shifted shadeoffset)
+      & prescript_separator & "sh_center_b=" & ddecimal (b shifted shadeoffset)
+      & prescript_separator & "sh_radius_a=" & decimal ra
+      & prescript_separator & "sh_radius_b=" & decimal rb
+    ;
     _defined_cs_
 enddef ;
+
 vardef define_linear_shade (expr a, b, ca, cb) =
     _defined_cs_ := _defined_cs_ + 1 ;
-    _defined_cs_pre_ [_defined_cs_] := "ls" ;
-    _defined_cs_post_[_defined_cs_] := "0 1 " & decimal shadefactor & " " &
-        colordecimals ca & " " & ddecimal (a shifted shadeoffset) & " " &
-        colordecimals cb & " " & ddecimal (b shifted shadeoffset) ;
+    _defined_cs_pre_ [_defined_cs_] := "sh_type=linear"
+      & prescript_separator & "sh_domain=0 1"
+      & prescript_separator & "sh_factor=" & decimal shadefactor
+      & prescript_separator & "sh_color_a=" & colordecimals ca
+      & prescript_separator & "sh_color_b=" & colordecimals cb
+      & prescript_separator & "sh_center_a=" & ddecimal (a shifted shadeoffset)
+      & prescript_separator & "sh_center_b=" & ddecimal (b shifted shadeoffset)
+    ;
     _defined_cs_
 enddef ;
+
 primarydef p withshade sc =
-    p withprescript _defined_cs_pre_[sc] withpostscript _defined_cs_post_[sc]
-enddef ;
-def shadecolor(expr sc) = % obsolete
-    1 withprescript _defined_cs_pre_[sc] withpostscript _defined_cs_post_[sc]
+    p
+        withprescript _defined_cs_pre_[sc]
 enddef ;
 
+% vardef predefined_linear_shade (expr p, n, ca, cb) =
+%     save a, b, sh ; pair a, b ;
+%     set_linear_vector(a,b)(p,n) ;
+%     define_linear_shade (a,b,ca,cb)
+% enddef ;
+%
+% vardef predefined_circular_shade (expr p, n, ca, cb) =
+%     save ab, r ; pair ab ; numeric r ;
+%     r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ;
+%     set_circular_vector(ab,r)(p,n) ;
+%     define_circular_shade(ab,ab,0,r,ca,cb)
+% enddef ;
+
+% Graphic text (we will move code here)
+
 def graphictext primary t =
     if _trial_run_ :
         let dographictextindeed = nographictext ;
@@ -244,32 +366,66 @@ def graphictext primary t =
     fi
     dographictextindeed(t)
 enddef ;
+
 def dographictext (expr t) =
+    % withprescript "gt_stage=final"
     begingroup ;
     save figurepicture ; picture figurepicture ;
     figurepicture := currentpicture ; currentpicture := nullpicture ;
     currentgraphictext := currentgraphictext + 1 ;
     dofinishgraphictext
 enddef ;
+
 def nographictext (expr t) text rest =
-    draw unitsquare withprescript "gt" withpostscript t ;
-enddef ;
-def savegraphictext (expr str) =
-enddef ;
-def erasegraphictextfile =
+    draw unitsquare withprescript "gt_stage=trial" withpostscript t ;
 enddef ;
 
+% def savegraphictext (expr str) =
+% enddef ;
+
+% def erasegraphictextfile =
+% enddef ;
+
+% Figures
+
+% def externalfigure primary filename =
+%     doexternalfigure (filename)
+% enddef ;
+%
+% def doexternalfigure (expr filename) text transformation =
+%     if true : % a bit incompatible esp scaled 1cm now scaled the natural size
+%         draw rawtextext("\externalfigure[" & filename & "]") transformation ;
+%     else :
+%         draw unitsquare transformation withprescript "fg_name=" & filename ;
+%     fi ;
+% enddef ;
+
 def externalfigure primary filename =
-    doexternalfigure (filename)
+    if true :
+        draw rawtextext("\externalfigure[" & filename & "]")
+    else :
+        image (
+            addto currentpicture doublepath unitsquare
+                withprescript "fg_name=" & filename ;
+        )
+    fi
 enddef ;
-def doexternalfigure (expr filename) text transformation =
-    draw unitsquare transformation withprescript "fg" withpostscript filename ;
+
+def figure primary filename =
+    rawtextext("\externalfigure[" & filename & "]")
 enddef ;
 
+% Positions
+
 def register (expr label, width, height, offset) =
-    draw unitsquare xscaled width yscaled height shifted offset withprescript "ps" withpostscript label ;
+    image (
+        addto currentpicture doublepath unitsquare xscaled width yscaled height shifted offset
+            withprescript "ps_label=" & label ;
+    ) ; % no transformations
 enddef ;
 
+% Housekeeping
+
 extra_beginfig := extra_beginfig & "currentgraphictext := 0 ; " ;
 extra_endfig   := extra_endfig   & "finishsavingdata ; " ;
 extra_endfig   := extra_endfig   & "resettextexts ; " ;
@@ -277,6 +433,19 @@ extra_endfig   := extra_endfig   & "resettextexts ; " ;
 boolean cmykcolors ; cmykcolors := true ;
 boolean spotcolors ; spotcolors := true ;
 
+% Bonus
+
 vardef verbatim(expr str) =
     ditto & "\detokenize{" & str & "}" & ditto
 enddef ;
+
+% New
+
+def bitmapimage(expr xresolution, yresolution, data) =
+    image (
+        addto currentpicture doublepath unitsquare
+            withprescript  "bm_xresolution=" & decimal xresolution
+            withprescript  "bm_yresolution=" & decimal yresolution
+            withpostscript data ;
+    )
+enddef ;
diff --git a/metapost/context/base/mp-spec.mp b/metapost/context/base/mp-spec.mp
index 9125b4b8b..123e75faa 100644
--- a/metapost/context/base/mp-spec.mp
+++ b/metapost/context/base/mp-spec.mp
@@ -47,6 +47,7 @@
 %D for instance shading. More information can be found in
 %D type {supp-mpe.tex}.
 
+if   known mplib        : endinput         ; fi ;
 if unknown context_tool :    input mp-tool ; fi ;
 if   known context_spec : endinput         ; fi ;
 
@@ -366,18 +367,16 @@ def circular_shade (expr p, n, ca, cb) =
 enddef ;
 
 vardef predefined_linear_shade (expr p, n, ca, cb) =
-  save a, b, sh ; pair a, b ;
-  set_linear_vector(a,b)(p,n) ;
-  set_shade_vector(a,b)(p,n) ;
-  define_linear_shade (a,b,ca,cb)
+    save a, b, sh ; pair a, b ;
+    set_linear_vector(a,b)(p,n) ;
+    define_linear_shade (a,b,ca,cb)
 enddef ;
 
 vardef predefined_circular_shade (expr p, n, ca, cb) =
-  save ab, r ; pair ab ; numeric r ;
-  r := (xpart lrcorner p - xpart llcorner p) ++
-       (ypart urcorner p - ypart lrcorner p) ;
-  set_circular_vector(ab,r)(p,n) ;
-  define_circular_shade(ab,ab,0,r,ca,cb)
+    save ab, r ; pair ab ; numeric r ;
+    r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ;
+    set_circular_vector(ab,r)(p,n) ;
+    define_circular_shade(ab,ab,0,r,ca,cb)
 enddef ;
 
 %D Since a \type {fill p withshade s} syntax looks better
@@ -638,8 +637,7 @@ vardef transparent(expr n, t, c) =
       flush_special(3, 7, s) ;
     fi ;
     scantokens(ss) := _special_counter_ ;
-    _local_specials_ := _local_specials_ &
-      "scantokens(" & ditto & ss & ditto & ") := -1 ;" ;
+    _local_specials_ := _local_specials_ & "scantokens(" & ditto & ss & ditto & ") := -1 ;" ;
   fi ;
   % go ahead
   if is_spot :
@@ -661,6 +659,18 @@ vardef is_transparent(text t) =
   endgroup
 enddef ;
 
+% boolean _b_ ; better namespacing
+% color   _c_ ;
+% vardef _transparent_(expr nn, tt, cc) = _b_ := true ; cc enddef ;
+% vardef is_transparent(text t) =
+%   begingroup ;
+%     save transparent ;
+%     transparent := _transparent_ ;
+%     _b_ := false ;
+%     _c_ := t ; _b_
+%   endgroup
+% enddef ;
+
 %D This function returns the not transparent color.
 
 vardef not_transparent(text t) =