summaryrefslogtreecommitdiff
path: root/metapost
diff options
context:
space:
mode:
Diffstat (limited to 'metapost')
-rw-r--r--metapost/context/metafun.mp4
-rw-r--r--metapost/context/mp-char.mp105
-rw-r--r--metapost/context/mp-form.mp378
-rw-r--r--metapost/context/mp-func.mp59
-rw-r--r--metapost/context/mp-grid.mp129
-rw-r--r--metapost/context/mp-grph.mp167
-rw-r--r--metapost/context/mp-page.mp22
-rw-r--r--metapost/context/mp-shap.mp22
-rw-r--r--metapost/context/mp-spec.mp217
-rw-r--r--metapost/context/mp-text.mp62
-rw-r--r--metapost/context/mp-tool.mp456
11 files changed, 1346 insertions, 275 deletions
diff --git a/metapost/context/metafun.mp b/metapost/context/metafun.mp
index cf63d289f..474a10eb3 100644
--- a/metapost/context/metafun.mp
+++ b/metapost/context/metafun.mp
@@ -40,4 +40,8 @@ input mp-char.mp ;
input mp-step.mp ;
input mp-grph.mp ;
+% mp-form.mp ;
+input mp-grid.mp ;
+input mp-func.mp ;
+
dump ; endinput .
diff --git a/metapost/context/mp-char.mp b/metapost/context/mp-char.mp
index 476199e23..740d36c37 100644
--- a/metapost/context/mp-char.mp
+++ b/metapost/context/mp-char.mp
@@ -19,10 +19,10 @@ if known context_char : endinput ; fi ;
boolean context_char ; context_char := true ;
-current_position := 0 ;
-
% kan naar elders
+current_position := 0 ;
+
def save_text_position (expr p) = % beware: clip shift needed
current_position := current_position + 1 ;
savedata
@@ -85,56 +85,62 @@ def show_shapes (expr n) =
enddef ;
-%D connections -> namespace needed ! ! !
-
-color connection_line_color ;
-
-connection_line_width := shape_line_width ;
-connection_line_color := .8white ;
-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 [][] ;
-numeric xysy [][] ;
-color xyfill [][] ;
-color xydraw [][] ;
-numeric xyline [][] ;
-boolean xypeep [][] ;
-
-numeric cpath ; cpath := 0 ;
-path cpaths [] ;
-numeric cline [] ;
-color ccolor [] ;
-boolean carrow [] ;
-boolean cdash [] ;
-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 ;
-
-picture dash_pattern ;
+%D connections
+
+def new_chart =
+
+ color connection_line_color ;
+
+ connection_line_width := shape_line_width ;
+ connection_line_color := .8white ;
+ 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 [][] ;
+ numeric xysy [][] ;
+ color xyfill [][] ;
+ color xydraw [][] ;
+ numeric xyline [][] ;
+ boolean xypeep [][] ;
+
+ numeric cpath ; cpath := 0 ;
+ path cpaths [] ;
+ numeric cline [] ;
+ color ccolor [] ;
+ boolean carrow [] ;
+ boolean cdash [] ;
+ 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 ;
+
+ picture dash_pattern ;
+
+ boolean reverse_y ; reverse_y := true ;
+
+enddef ;
-boolean reverse_y ; reverse_y := true ;
+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 ;
@@ -268,7 +274,7 @@ vardef points_initialized (expr xfrom, yfrom, xto, yto, n) =
fi
enddef ;
-def collapse_points =
+def collapse_points = % this is now an mp-tool macro
% remove redundant points
n := 1 ;
for i=2 upto xypoint:
@@ -285,7 +291,7 @@ def collapse_points =
fi ;
enddef ;
-vardef smooth_connection (expr a,b) =
+vardef smooth_connection (expr a,b) = % also a mp-tool macro
sx := connection_smooth_size/grid_width ;
sy := connection_smooth_size/grid_height ;
if ypart a = ypart b :
@@ -822,6 +828,7 @@ def clip_chart (expr minx, miny, maxx, maxy) =
enddef ;
def begin_chart (expr n, maxx, maxy) =
+ new_chart ;
chart_figure := n ;
chart_scale := 1 ;
if chart_figure>0: beginfig(chart_figure) ; fi ;
diff --git a/metapost/context/mp-form.mp b/metapost/context/mp-form.mp
new file mode 100644
index 000000000..51c1fb5c5
--- /dev/null
+++ b/metapost/context/mp-form.mp
@@ -0,0 +1,378 @@
+% Hans Hagen / October 2000
+%
+% This file is mostly a copy from the file format.mp, that
+% comes with MetaPost and is written by John Hobby. This file
+% is meant to be compatible, but has a few more features,
+% controlled by the variables:
+%
+% fmt_initialize when false, initialization is skipped
+% fmt_precision the default accuracy (default=3)
+% fmt_separator the pattern separator (default=%)
+% fmt_zerocheck activate extra sci notation zero check
+%
+% instead of a picture, one can format a number in a for TeX
+% acceptable input string
+
+if known fmt_loaded : expandafter endinput fi ;
+ boolean fmt_loaded ; fmt_loaded := true ;
+
+if unknown fmt_precision :
+ numeric fmt_precision ; fmt_precision := 3 ;
+fi ;
+
+if unknown fmt_initialize :
+ boolean fmt_initialize ; fmt_initialize := true ;
+fi ;
+
+if unknown fmt_separator :
+ string fmt_separator ; fmt_separator := "%" ;
+fi ;
+
+if unknown fmt_zerocheck :
+ boolean fmt_zerocheck ; fmt_zerocheck := false ;
+fi ;
+
+boolean fmt_metapost ; fmt_metapost := true ; % == use old method
+
+% As said, all clever code is from John, the more stupid
+% extensions are mine. The following string variables are
+% responsible for the TeX formatting.
+
+% TeX specs when using TeX instead of pseudo TeX.
+
+string sFebraise_ ; sFebraise_ := "{" ;
+string sFeeraise_ ; sFeeraise_ := "}" ;
+string sFebmath_ ; sFebmath_ := "$" ;
+string sFeemath_ ; sFeemath_ := "$" ;
+
+string sFmneg_ ; sFmneg_ := "-" ;
+string sFemarker_ ; sFemarker_ := "{\times}10^" ;
+string sFeneg_ ; sFeneg_ := "-" ;
+string sFe_plus ; sFe_plus := "" ; % "+"
+
+def sFe_base = Fline_up_("1", sFemarker_) enddef ;
+
+% Macros for generating typeset pictures of computed numbers
+%
+% format(f,x) typeset generalized number x using format string f
+% Mformat(f,x) like format, but x is in Mlog form (see marith.mp)
+% init_numbers(s,m,x,sn,e) choose typeset style given sample sign, mantissa,...
+% roundd(x,d) round numeric x to d places right of decimal point
+% Fe_base what precedes the exponent for typeset powers of 10
+% Fe_plus plus sign if any for typesetting positive exponents
+% Ten_to[] powers of ten for indices 0,1,2,3,4
+%
+% New are:
+%
+% formatstr(f,x) TeX string representing x using format f
+% Mformatstr(f,x) like Mformatstr, but x is in Mlog form
+
+% Other than the above-documented user interface, all
+% externally visible names start with F and end with _.
+
+% Allow big numbers in token lists
+
+begingroup interim warningcheck := 0 ;
+
+%%% Load auxiliary macros.
+
+input string
+input marith
+
+%%% Choosing the Layout %%%
+
+picture Fmneg_, Femarker_, Feneg_, Fe_base, Fe_plus ;
+string Fmfont_, Fefont_ ;
+numeric Fmscale_, Fescale_, Feraise_ ;
+
+% Argument
+%
+% s is a leading minus sign
+% m is a 1-digit mantissa
+% x is whatever follows the mantissa
+% sn is a leading minus for the exponent, and
+% e is a 1-digit exponent.
+%
+% Numbers in scientific notation are constructed by placing
+% these pieces side-by-side; decimal numbers use only m
+% and/or s. To get exponents with leading plus signs, assign
+% to Fe_plus after calling init_numbers. To do something
+% special with a unit mantissa followed by x, assign to
+% Fe_base after calling init_numbers.
+
+vardef init_numbers(expr s, m, x, sn, e) =
+ Fmneg_ := s ;
+ for p within m :
+ Fmfont_ := fontpart p ;
+ Fmscale_ := xxpart p ;
+ exitif true ;
+ endfor
+ Femarker_ := x ;
+ Feneg_ := sn ;
+ for p within e :
+ Fefont_ := fontpart p ;
+ Fescale_ := xxpart p ;
+ Feraise_ := ypart llcorner p ;
+ exitif true ;
+ endfor
+ Fe_base := Fline_up_("1" infont Fmfont_ scaled Fmscale_, Femarker_) ;
+ Fe_plus := nullpicture ;
+enddef ;
+
+%%% Low-Level Typesetting %%%
+
+vardef Fmant_(expr x) = %%% adapted by HH %%%
+ if fmt_metapost :
+ (decimal abs x infont Fmfont_ scaled Fmscale_)
+ else :
+ (decimal abs x)
+ fi
+enddef ;
+
+vardef Fexp_(expr x) = %%% adapted by HH %%%
+ if fmt_metapost :
+ (decimal x infont Fefont_ scaled Fescale_ shifted (0,Feraise_))
+ else :
+ (decimal x)
+ fi
+enddef ;
+
+vardef Fline_up_(text t_) = %%% adapted by HH %%%
+ if fmt_metapost :
+ save p_, c_ ;
+ picture p_ ; p_ = nullpicture ;
+ pair c_ ; c_ = (0,0) ;
+ for q_ = t_ :
+ addto p_ also q_ if string q_ : infont defaultfont scaled defaultscale fi
+ shifted c_ ;
+ c_ := (xpart lrcorner p_, 0) ;
+ endfor
+ p_
+ else :
+ "" for q_ = t_ : & q_ endfor
+ fi
+enddef ;
+
+vardef Fdec_o_(expr x) = %%% adapted by HH %%%
+ if x<0 :
+ Fline_up_(if fmt_metapost : Fmneg_ else : sFmneg_ fi, Fmant_(x))
+ else :
+ Fmant_(x)
+ fi
+enddef ;
+
+vardef Fsci_o_(expr x, e) = %%% adapted by HH %%%
+ if fmt_metapost :
+ Fline_up_
+ (if x < 0 : Fmneg_,fi
+ if abs x = 1 : Fe_base else : Fmant_(x), Femarker_ fi,
+ if e < 0 : Feneg_ else : Fe_plus fi,
+ Fexp_(abs e))
+ else :
+ Fline_up_
+ (if x < 0 : sFmneg_, fi
+ if abs x = 1 : sFe_base else : Fmant_(x), sFemarker_ fi,
+ sFebraise_,
+ if e < 0 : sFeneg_ else : sFe_plus fi,
+ Fexp_(abs e),
+ sFeeraise_)
+ fi
+enddef ;
+
+% Assume prologues=1 implies troff mode. TeX users who want
+% prologues on should use some other positive value. The mpx
+% file mechanism requires separate input files here.
+
+if fmt_initialize : %%% adapted by HH
+ if prologues = 1 : input troffnum else : input texnum fi
+fi ;
+
+%%% Scaling and Rounding %%%
+
+% Find a pair p where x = xpart p*10**ypart p and either p =
+% (0,0) or xpart p is between 1000 and 9999.99999. This is
+% the `exponent form' of x.
+
+vardef Feform_(expr x) =
+ interim warningcheck := 0 ;
+ if string x :
+ Meform(Mlog_str x)
+ else :
+ save b, e ;
+ b = x ; e = 0 ;
+ if abs b >= 10000 :
+ (b/10, 1)
+ elseif b = 0 :
+ origin
+ else :
+ forever :
+ exitif abs b >= 1000 ;
+ b := b*10 ; e := e-1 ;
+ endfor
+ (b, e)
+ fi
+ fi
+enddef ;
+
+% The marith.mp macros include a similar macro Meform that
+% converts from `Mlog form' to exponent form. In case
+% rounding has made the xpart of an exponent form number too
+% large, fix it.
+
+vardef Feadj_(expr x, y) =
+ if abs x >= 10000 : (x/10, y+1) else : (x,y) fi
+enddef ;
+
+% Round x to d places right of the decimal point. When d<0,
+% round to the nearest multiple of 10 to the -d.
+
+vardef roundd(expr x, d) =
+ if abs d > 4 :
+ if d > 0 : x else : 0 fi
+ elseif d > 0 :
+ save i ; i = floor x ;
+ i + round(Ten_to[d]*(x-i))/Ten_to[d]
+ else :
+ round(x/Ten_to[-d])*Ten_to[-d]
+ fi
+enddef ;
+
+Ten_to0 = 1 ;
+Ten_to1 = 10 ;
+Ten_to2 = 100 ;
+Ten_to3 = 1000 ;
+Ten_to4 = 10000 ;
+
+% Round an exponent form number p to k significant figures.
+
+primarydef p Fprec_ k =
+ Feadj_(roundd(xpart p,k-4), ypart p)
+enddef ;
+
+% Round an exponent form number p to k digits right of the
+% decimal point.
+
+primarydef p Fdigs_ k =
+ Feadj_(roundd(xpart p,k+ypart p), ypart p)
+enddef ;
+
+%%% High-Level Routines %%%
+
+% The following operators convert z from exponent form and
+% produce typeset output: Formsci_ generates scientific
+% notation; Formdec_ generates decimal notation; and
+% Formgen_ generates whatever is likely to be most compact.
+
+vardef Formsci_(expr z) = %%% adapted by HH %%%
+ if fmt_zerocheck and (z = origin) :
+ Fsci_o_(0,0)
+ else :
+ Fsci_o_(xpart z/1000, ypart z + 3)
+ fi
+enddef ;
+
+vardef Formdec_(expr z) =
+ if ypart z > 0 :
+ Formsci_(z)
+ else :
+ Fdec_o_
+ (xpart z if ypart z >= -4 :
+ /Ten_to[-ypart z]
+ else :
+ for i = ypart z upto -5 : /(10) endfor /10000
+ fi)
+ fi
+enddef ;
+
+vardef Formgen_(expr q) =
+ clearxy ; (x,y) = q ;
+ if x = 0 : Formdec_
+ elseif y >= -6 : Formdec_
+ else : Formsci_
+ fi (q)
+enddef ;
+
+def Fset_item_(expr s) = %%% adapted by HH %%%
+ if s <> "" :
+ if fmt_metapost :
+ s infont defaultfont scaled defaultscale,
+ else :
+ s,
+ fi
+ fi
+enddef ;
+
+% For each format letter, the table below tells how to
+% round and typeset a quantity z in exponent form.
+%
+% e scientific, p significant figures
+% p decimal, p digits right of the point
+% g decimal or scientific, p sig. figs.
+% G decimal or scientific, p digits
+
+string fmt_[] ;
+
+fmt_[ASCII "e"] = "Formsci_(z Fprec_ p)" ;
+fmt_[ASCII "f"] = "Formdec_(z Fdigs_ p)" ;
+fmt_[ASCII "g"] = "Formgen_(z Fprec_ p)" ;
+fmt_[ASCII "G"] = "Formgen_(z Fdigs_ p)" ;
+
+% The format and Mformat macros take a format string f and
+% generate typeset output for a numeric quantity x. String f
+% should contain a `%' followed by an optional number and one
+% of the format letters defined above. The number should be
+% an integer giving the precision (default 3).
+
+vardef dofmt_@#(expr f, x) = %%% adapted by HH %%%
+ if f = "" :
+ if fmt_metapost : nullpicture else : "" fi
+ else :
+ interim warningcheck := 0 ;
+ save k, l, s, p, z ;
+ pair z ; z = @#(x) ;
+ k = 1 + cspan(f, fmt_separator <> ) ;
+ l-k = cspan(substring(k,infinity) of f, isdigit) ;
+ p = if l > k :
+ scantokens substring(k,l) of f
+ else :
+ fmt_precision
+ fi ;
+ string s ; s = fmt_[ASCII substring (l,l+1) of f] ;
+ if unknown s :
+ if k <= length f :
+ errmessage("No valid format letter found in "&f) ;
+ fi
+ s = if fmt_metapost : nullpicture else : "" fi ;
+ fi
+ Fline_up_
+ (Fset_item_(substring (0,k-1) of f)
+ if not fmt_metapost : sFebmath_, fi
+ scantokens s,
+ if not fmt_metapost : sFeemath_, fi
+ Fset_item_(substring (l+1,infinity) of f)
+ if fmt_metapost : nullpicture else : "" fi)
+ fi
+ hide (fmt_metapost := true)
+enddef ;
+
+%%% so far %%%
+
+vardef format (expr f, x) =
+ fmt_metapost := true ; dofmt_.Feform_(f,x)
+enddef ;
+
+vardef Mformat(expr f, x) =
+ fmt_metapost := true ; dofmt_.Meform (f,x)
+enddef ;
+
+vardef formatstr (expr f, x) =
+ fmt_metapost := false ; dofmt_.Feform_(f,x)
+enddef ;
+
+vardef Mformatstr(expr f, x) =
+ fmt_metapost := false ; dofmt_.Meform (f,x)
+enddef ;
+
+% Restore warningcheck to previous value.
+
+endgroup ;
diff --git a/metapost/context/mp-func.mp b/metapost/context/mp-func.mp
new file mode 100644
index 000000000..d8646ef3b
--- /dev/null
+++ b/metapost/context/mp-func.mp
@@ -0,0 +1,59 @@
+%D \module
+%D [ file=mp-func.mp,
+%D version=2001.12.29,
+%D title=\CONTEXT\ \METAPOST\ graphics,
+%D subtitle=function hacks,
+%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.
+
+%D Under construction.
+
+if unknown context_tool : input mp-tool ; fi ;
+if known context_func : endinput ; fi ;
+
+boolean context_func ; context_func := true ;
+
+string pathconnectors[] ;
+
+pathconnectors[0] := "," ;
+pathconnectors[1] := "--" ;
+pathconnectors[2] := ".." ;
+pathconnectors[3] := "..." ;
+
+vardef function (expr f) (expr u, t, b, e, s) = save x ; numeric x ;
+ for xx := b step s until e :
+ hide (x := xx ;) if xx>b : scantokens(pathconnectors[f]) fi
+ (scantokens(u),scantokens(t))
+ endfor
+enddef ;
+
+def punkedfunction = function (1) enddef ;
+def curvedfunction = function (2) enddef ;
+def tightfunction = function (3) enddef ;
+
+vardef constructedpath (expr f) (text t) =
+ save ok ; boolean ok ; ok := false ;
+ for i=t :
+ if ok : scantokens(pathconnectors[f]) else : ok := true ; fi i
+ endfor
+enddef ;
+
+def punkedpath = constructedpath (1) enddef ;
+def curvedpath = constructedpath (2) enddef ;
+def tightpath = constructedpath (3) enddef ;
+
+vardef constructedpairs (expr f) (text p) =
+ save i ; i := -1 ;
+ forever : exitif unknown p[incr(i)] ;
+ if i>0 : scantokens(pathconnectors[f]) fi p[i]
+ endfor
+enddef ;
+
+def punkedpairs = constructedpairs (1) enddef ;
+def curvedpairs = constructedpairs (2) enddef ;
+def tightpairs = constructedpairs (3) enddef ;
diff --git a/metapost/context/mp-grid.mp b/metapost/context/mp-grid.mp
new file mode 100644
index 000000000..c684963d8
--- /dev/null
+++ b/metapost/context/mp-grid.mp
@@ -0,0 +1,129 @@
+%D \module
+%D [ file=mp-grid.mp,
+%D version=2000.07.10,
+%D title=\CONTEXT\ \METAPOST\ graphics,
+%D subtitle=grid 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.
+
+%D Under construction.
+
+if unknown context_tool : input mp-tool ; fi ;
+if known context_grid : endinput ; fi ;
+
+boolean context_grid ; context_grid := true ;
+
+string fmt_separator ; fmt_separator := "@" ;
+numeric fmt_precision ; fmt_precision := 3 ;
+boolean fmt_initialize ; fmt_initialize := false ;
+boolean fmt_zerocheck ; fmt_zerocheck := true ;
+
+if unknown fmt_loaded : input mp-form ; fi ;
+
+boolean fmt_pictures ; fmt_pictures := true ;
+
+def do_format = if fmt_pictures : format else : formatstr fi enddef ;
+def do_mformat = if fmt_pictures : Mformat else : Mformatstr fi enddef ;
+
+def hlingrid (expr Min, Max, Step, Length, Width) text t =
+ image ( for i=Min step Step until Max :
+ draw (origin--(Width,0)) shifted (0,i*Length/Max) t ;
+ endfor ; ) ;
+enddef ;
+
+def vlingrid (expr Min, Max, Step, Length, Height) text t =
+ image ( for i=Min step Step until Max :
+ draw (origin--(0,Height)) shifted (i*Length/Max,0) t ;
+ endfor ; ) ;
+enddef ;
+
+def hloggrid (expr Min, Max, Step, Length, Width) text t =
+ image ( for i=max(Min,1) step Step until min(Max,10) :
+ draw (origin--(Width,0)) shifted (0,Length*log(i)) t ;
+ endfor ; ) ;
+enddef ;
+
+def vloggrid (expr Min, Max, Step, Length, Height) text t =
+ image ( for i=max(Min,1) step Step until min(Max,10) :
+ draw (origin--(0,Height)) shifted (Length*log(i),0) t ;
+ endfor ; ) ;
+enddef ;
+
+vardef hlintext@#(expr Min, Max, Step, Length, Format) text t =
+ image ( do_initialize_numbers ;
+ for i=Min step Step until Max :
+ draw textext@#(do_format(Format,i)) shifted (0,i*Length/Max) t ;
+ endfor ; )
+enddef ;
+
+vardef vlintext@#(expr Min, Max, Step, Length, Format) text t =
+ image ( do_initialize_numbers ;
+ for i=Min step Step until Max :
+ draw textext@#(do_format(Format,i)) shifted (i*Length/Max,0) t ;
+ endfor ; )
+enddef ;
+
+vardef hlogtext@#(expr Min, Max, Step, Length, Format) text t =
+ image ( do_initialize_numbers ;
+ for i=max(Min,1) step Step until min(Max,10) :
+ draw textext@#(do_format(Format,i)) shifted (0,Length*log(i)) t ;
+ endfor ; )
+enddef ;
+
+vardef vlogtext@#(expr Min, Max, Step, Length, Format) text t =
+ image ( do_initialize_numbers ;
+ for i=max(Min,1) step Step until min(Max,10) :
+ draw textext@#(do_format(Format,i)) shifted (Length*log(i),0) t ;
+ endfor ; )
+enddef ;
+
+boolean numbers_initialized ; numbers_initialized := false ;
+
+def do_initialize_numbers =
+ if not numbers_initialized :
+ init_numbers ( textext.raw("$-$") ,
+ textext.raw("$1$") ,
+ textext.raw("${\times}10$") ,
+ textext.raw("${}^-$") ,
+ textext.raw("${}^2$") ) ;
+ numbers_initialized := true ;
+ fi ;
+enddef ;
+
+def initialize_numbers =
+ numbers_initialized := false ; do_initialize_numbers ;
+enddef ;
+
+vardef linlog(expr xy) = ( xpart xy, log(ypart xy)) enddef ;
+vardef loglin(expr xy) = (log(xpart xy), ypart xy) enddef ;
+vardef loglog(expr xy) = (log(xpart xy), log(ypart xy)) enddef ;
+vardef linlin(expr xy) = ( (xpart xy), (ypart xy)) enddef ;
+
+vardef loglinpath primary p = processpath (p) (loglin) enddef ;
+vardef linlogpath primary p = processpath (p) (linlog) enddef ;
+vardef loglogpath primary p = processpath (p) (loglog) enddef ;
+vardef linlinpath primary p = processpath (p) (linlin) enddef ;
+
+def processpath (expr p) (text pp) =
+ if path p :
+ for i=0 upto length(p)-1 :
+ (pp(point i of p)) .. controls
+ (pp(postcontrol i of p)) and
+ (pp(precontrol (i+1) of p)) ..
+ endfor
+ if cycle p :
+ cycle
+ else :
+ (pp(point length(p) of p))
+ fi
+ elseif pair p :
+ (pp(p))
+ else :
+ p
+ fi
+enddef ;
diff --git a/metapost/context/mp-grph.mp b/metapost/context/mp-grph.mp
index 26202d61a..207b2b4f0 100644
--- a/metapost/context/mp-grph.mp
+++ b/metapost/context/mp-grph.mp
@@ -22,14 +22,33 @@ string CRLF ; CRLF := char 10 & char 13 ;
picture _currentpicture_ ;
+def beginfig (expr c) =
+ begingroup
+ charcode := c ;
+ resetfig ;
+ scantokens extra_beginfig ;
+enddef ;
+
+def resetfig =
+ clearxy ;
+ clearit ;
+ clearpen ;
+ pickup defaultpen ;
+ interim linecap := linecap ;
+ interim linejoin := linejoin ;
+ interim miterlimit := miterlimit ;
+ save _background_ ; color _background_ ; _background_ := background ;
+ save background ; color background ; background := _background_ ;
+ drawoptions () ;
+enddef ;
+
def protectgraphicmacros =
save showtext ;
save beginfig ; let beginfig = begingraphictextfig ;
save endfig ; let endfig = endgraphictextfig ;
save end ; let end = relax ;
interim prologues := prologues ;
- interim linecap := butt ;
- interim linejoin := mitered ;
+ resetfig ;
enddef ;
numeric currentgraphictext ; currentgraphictext := 0 ;
@@ -53,7 +72,7 @@ def erasegraphictextfile =
let erasegraphictextfile = relax ;
enddef ;
-extra_beginfig := extra_beginfig & "erasegraphictextfile ;" ;
+extra_beginfig := extra_beginfig & " erasegraphictextfile ;" ;
def begingraphictextfig (expr n) =
foundpicture := n ; scratchpicture := nullpicture ;
@@ -67,25 +86,6 @@ def endgraphictextfig =
fi ;
enddef ;
-% def loadfigure (expr filename, n) =
-% begingroup ;
-% protectgraphicmacros ; % also save linewidth, color, options etc ?
-% save sp ; picture sp ; sp := currentpicture ;
-% save ok ; boolean ok ; ok := false ;
-% def beginfig (expr m) =
-% if n=m :
-% currentpicture := sp ; ok := true ;
-% def endfig = endinput ; enddef ;
-% else :
-% currentpicture := nullpicture ;
-% fi ;
-% enddef ;
-% let endfig = relax ;
-% readfile(filename) ;
-% if not ok : currentpicture := sp ; fi ;
-% endgroup ;
-% enddef ;
-
def loadfigure primary filename =
doloadfigure (filename)
enddef ;
@@ -97,6 +97,11 @@ def doloadfigure (expr filename) text figureattributes =
picture figurepicture ; figurepicture := currentpicture ;
def number primary n = hide(figurenumber := n) enddef ;
protectgraphicmacros ;
+ % defaults
+ interim linecap := rounded ;
+ interim linejoin := rounded ;
+ interim miterlimit := 10 ;
+ %
currentpicture := nullpicture ;
def beginfig (expr n) =
currentpicture := nullpicture ;
@@ -114,37 +119,59 @@ def graphictext primary t =
dographictext(t)
enddef ;
-def dographictext (expr t) text x_op_x =
+def dographictext (expr t) =
begingroup ;
- protectgraphicmacros ;
if graphictextformat<>"" :
- graphictextstring :=
+ graphictextstring :=
"% format=" & graphictextformat & CRLF & graphictextstring ;
- graphictextformat := "" ;
+ graphictextformat := "" ;
fi ;
- let normalwithshade = withshade ;
- save foundpicture, scratchpicture, str ;
- save fill, draw, withshade, reversefill, outlinefill ;
- numeric foundpicture ; picture scratchpicture ; string str ;
currentgraphictext := currentgraphictext + 1 ;
savegraphictext ("\startTEXpage[scale=10000]" & t & "\stopTEXpage") ;
+ dofinishgraphictext
+enddef ;
+
+def redographictext primary t =
+ regraphictext(t)
+enddef ;
+
+def regraphictext (expr t) =
+ begingroup ;
+ save currentgraphictext ; numeric currentgraphictext ;
+ currentgraphictext := t ;
+ dofinishgraphictext
+enddef ;
+
+def dofinishgraphictext text x_op_x =
+ protectgraphicmacros ;
+ interim linecap := butt ; % normally rounded
+ interim linejoin := mitered ; % normally rounded
+ interim miterlimit := 10 ; % todo
+ let normalwithshade = withshade ;
+ save foundpicture, scratchpicture, str ;
+ save fill, draw, withshade, reversefill, outlinefill ;
+ numeric foundpicture ; picture scratchpicture ; string str ;
def draw expr p =
- addto scratchpicture doublepath p withpen currentpen ;
+ % the first, naive implementation was:
+ % addto scratchpicture doublepath p withpen currentpen ;
+ % but it is better to turn lines into fills
+ addto scratchpicture contour boundingbox
+ image (addto currentpicture doublepath p withpen currentpen) ;
enddef ;
def fill expr p =
addto scratchpicture contour p withpen currentpen ;
enddef ;
- def f_op_f = enddef ; boolean f_color ; f_color := false ;
- def d_op_d = enddef ; boolean d_color ; d_color := false ;
- def s_op_s = enddef ; boolean s_color ; s_color := false ;
- boolean reverse_fill ; reverse_fill := false ;
- boolean outline_fill ; outline_fill := false ;
- def reversefill =
- hide(reverse_fill := true )
- enddef ;
- def outlinefill =
- hide(outline_fill := true )
- enddef ;
+ def f_op_f = enddef ; boolean f_color ; f_color := false ;
+ def d_op_d = enddef ; boolean d_color ; d_color := false ;
+ def s_op_s = enddef ; boolean s_color ; s_color := false ;
+ boolean reverse_fill ; reverse_fill := false ;
+ boolean outline_fill ; outline_fill := false ;
+ def reversefill =
+ hide(reverse_fill := true )
+ enddef ;
+ def outlinefill =
+ hide(outline_fill := true )
+ enddef ;
def withshade primary c =
hide(def s_op_s = normalwithshade c enddef ; s_color := true )
enddef ;
@@ -156,53 +183,53 @@ def dographictext (expr t) text x_op_x =
enddef ;
scratchpicture := nullpicture ;
addto scratchpicture doublepath origin x_op_x ; % pre-roll
- for i within scratchpicture : % Below here is a dirty tricky test!
- if (urcorner dashpart i) = origin : outline_fill := false ; fi ;
- endfor ;
+ for i within scratchpicture : % Below here is a dirty tricky test!
+ if (urcorner dashpart i) = origin : outline_fill := false ; fi ;
+ endfor ;
scratchpicture := nullpicture ;
- readfile(jobname & ".mpy") ;
+ readfile(jobname & ".mpy") ;
scratchpicture := (scratchpicture shifted -llcorner scratchpicture) scaled (1/10) ;
- if not d_color and not f_color : d_color := true ; fi
- if s_color : d_color := false ; f_color := false ; fi ;
- if d_color and not reverse_fill :
- for i within scratchpicture :
- if f_color and outline_fill :
- addto currentpicture doublepath pathpart i _op_ x_op_x f_op_f
+ if not d_color and not f_color : d_color := true ; fi
+ if s_color : d_color := false ; f_color := false ; fi ;
+ if d_color and not reverse_fill :
+ for i within scratchpicture :
+ if f_color and outline_fill :
+ addto currentpicture doublepath pathpart i _op_ x_op_x f_op_f
dashed nullpicture ;
- fi ;
- if filled i :
+ fi ;
+ if filled i :
addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ;
- fi ;
+ fi ;
endfor ;
fi ;
- if f_color :
+ if f_color :
for i within scratchpicture :
- if filled i :
- addto currentpicture contour pathpart i _op_ x_op_x f_op_f
- withpen pencircle scaled 0 ;
- fi ;
+ if filled i :
+ addto currentpicture contour pathpart i _op_ x_op_x f_op_f
+ withpen pencircle scaled 0 ;
+ fi ;
endfor ;
fi ;
- if d_color and reverse_fill :
+ if d_color and reverse_fill :
for i within scratchpicture :
- if filled i :
+ if filled i :
addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ;
- fi ;
+ fi ;
endfor ;
fi ;
- if s_color :
+ if s_color :
for i within scratchpicture :
- if filled i :
+ if filled i :
addto currentpicture contour pathpart i _op_ x_op_x s_op_s ;
- fi ;
+ fi ;
endfor ;
- else :
+ else :
for i within scratchpicture :
- if stroked i :
+ if stroked i :
addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ;
- fi ;
+ fi ;
endfor ;
- fi ;
+ fi ;
endgroup ;
enddef ;
diff --git a/metapost/context/mp-page.mp b/metapost/context/mp-page.mp
index 7133ae6ff..285f84c41 100644
--- a/metapost/context/mp-page.mp
+++ b/metapost/context/mp-page.mp
@@ -27,6 +27,10 @@ if unknown OnRightPage :
boolean OnRightPage ; OnRightPage := true ;
fi ;
+if unknown InPageBody :
+ boolean InPageBody ; InPageBody := false ;
+fi ;
+
PageNumber := 0 ;
PaperHeight := 845.04684pt ;
PaperWidth := 597.50787pt ;
@@ -88,7 +92,7 @@ for VerPos=Top step 10 until Bottom:
Field[HorPos][VerPos] := origin--cycle ;
Field[VerPos][HorPos] := Field[HorPos][VerPos] ;
endfor ;
-endfor ;
+endfor ;
% def LoadPageState =
% scantokens "input mp-state.tmp" ;
@@ -201,6 +205,22 @@ def StopPage =
enddef ;
+def OverlayBox =
+ (unitsquare xyscaled (OverlayWidth,OverlayHeight))
+enddef ;
+
+% handy
+
+def innerenlarged =
+ hide(LoadPageState)
+ if OnRightPage : leftenlarged else : rightenlarged fi
+enddef ;
+
+def outerenlarged =
+ hide(LoadPageState)
+ if OnRightPage : rightenlarged else : leftenlarged fi
+enddef ;
+
% obsolete
def llEnlarged (expr p,d) = (llcorner p shifted (-d,-d)) enddef ;
diff --git a/metapost/context/mp-shap.mp b/metapost/context/mp-shap.mp
index f8bfd50cf..0f5fe431d 100644
--- a/metapost/context/mp-shap.mp
+++ b/metapost/context/mp-shap.mp
@@ -199,33 +199,33 @@ vardef some_shape_path (expr type) =
elseif type=59 :
border := mirror (ll--ulx--urx--lr--cycle) ;
- elseif type= 61 :
+ elseif type=61 :
border := normal (fullcircle scaled (1.5*yradius) xscaled (grid_height/grid_width)) ;
- elseif type= 62 :
+ elseif type=62 :
border := normal (fullcircle scaled (2.0*yradius) xscaled (grid_height/grid_width)) ;
- elseif type= 66 :
+ elseif type=66 :
border := normal (rc--origin shifted ( epsilon,0) --cycle &
rc--origin --cycle ) ;
- elseif type= 67 :
+ elseif type=67 :
border := normal (lc--origin shifted (-epsilon,0) --cycle &
lc--origin --cycle ) ;
- elseif type= 68 :
+ elseif type=68 :
border := normal (tc--origin shifted (0, epsilon) --cycle &
tc--origin --cycle ) ;
- elseif type= 69 :
+ elseif type=69 :
border := normal (bc--origin shifted (0,-epsilon) --cycle &
bc--origin --cycle ) ;
- elseif type= 75 :
+ elseif type=75 :
border := mirror (lly--lry--ury--uly--cycle) ;
- elseif type= 76 :
+ elseif type=76 :
border := mirror (ll--lr--ur--uly--cycle) ;
- elseif type= 77 :
+ elseif type=77 :
border := mirror (ll--lr--ury--ul--cycle) ;
- elseif type= 78 :
+ elseif type=78 :
border := mirror (lly--lr--ur--ul--cycle) ;
- elseif type= 79 :
+ elseif type=79 :
border := mirror (ll--lry--ur--ul--cycle) ;
else :
diff --git a/metapost/context/mp-spec.mp b/metapost/context/mp-spec.mp
index 918e73fb4..a8dfb96b6 100644
--- a/metapost/context/mp-spec.mp
+++ b/metapost/context/mp-spec.mp
@@ -11,8 +11,10 @@
%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
%C details.
-% (r,g,b) => cmyk: g=1, b=hash
-% => rest: g=n, b=whatever
+% (r,g,b) => cmyk : r=123 g= 1 b=hash
+% => transparent rgb : r=123 g= 2 b=hash
+% => transparent cmyk : r=123 g= 3 b=hash
+% => rest : r=123 g=n>10 b=whatever
%D This module is rather preliminary and subjected to
%D changes. Here we closely cooperates with the \METAPOST\
@@ -26,7 +28,7 @@ if known context_spec : endinput ; fi ;
boolean context_spec ; context_spec := true ;
numeric _special_counter_ ; _special_counter_ := 0 ;
-numeric _color_counter_ ; _color_counter_ := 0 ;
+numeric _color_counter_ ; _color_counter_ := 11 ; % < 10 reserved
numeric _special_signal_ ; _special_signal_ := 123 ;
%D When set to \type {true}, shading will be supported. Some
@@ -39,32 +41,49 @@ boolean _inline_specials_ ; _inline_specials_ := false ;
%D bookkeeping and collection of specials. At the cost of some
%D obscurity, we now have rather efficient resources.
-string _all_specials_ ; _all_specials_ := "" ;
+string _global_specials_ ; _global_specials_ := "" ;
+string _local_specials_ ; _local_specials_ := "" ;
-vardef add_special_signal =
- if (length _all_specials_>0) : % write the version number
+vardef add_special_signal = % write the version number
+ if (length _global_specials_>0) or (length _local_specials_ >0) :
special ("%%MetaPostSpecials: 1.0 " & decimal _special_signal_ ) ;
fi ;
enddef ;
vardef add_extra_specials =
- scantokens _all_specials_ ;
+ scantokens _global_specials_ ;
+ scantokens _local_specials_ ;
enddef ;
vardef reset_extra_specials =
- _all_specials_ := "" ;
+ % only local ones
+ _local_specials_ := "" ;
enddef ;
+boolean insidefigure ; insidefigure := false ;
+
+% todo: alleen als special gebruikt flush
+
+extra_beginfig :=
+ " insidefigure := true ; " &
+ " reset_extra_specials ; " &
+ extra_beginfig ;
+
extra_endfig :=
- " add_special_signal ; " &
- extra_endfig &
- " add_extra_specials ; " &
- " reset_extra_specials ; " ;
+ " add_special_signal ; " &
+ extra_endfig &
+ " add_extra_specials ; " &
+ " reset_extra_specials ; " &
+ " insidefigure := false ; " ;
+
+def _current_specials_ =
+ if insidefigure : _local_specials_ else : _global_specials_ fi
+enddef ;
def flush_special (expr typ, siz, dat) =
_special_counter_ := _special_counter_ + 1 ;
if _inline_specials_ :
- _all_specials_ := _all_specials_
+ _current_specials_ := _current_specials_
& "special "
& "(" & ditto
& dat & " "
@@ -74,7 +93,7 @@ def flush_special (expr typ, siz, dat) =
& " special"
& ditto & ");" ;
else :
- _all_specials_ := _all_specials_
+ _current_specials_ := _current_specials_
& "special "
& "(" & ditto
& "%%MetaPostSpecial: "
@@ -88,20 +107,20 @@ enddef ;
%D Shade allocation.
-vardef define_circular_shade (expr a, b, ra, rb, ca, cb) =
- flush_special(3, 17, "0 1 1" &
- dddecimal ca & ddecimal a & " " & decimal ra &
- dddecimal cb & ddecimal b & " " & decimal rb ) ;
- _special_counter_
-enddef ;
-
vardef define_linear_shade (expr a, b, ca, cb) =
- flush_special(2, 15, "0 1 1" &
+ flush_special(30, 15, "0 1 1" &
dddecimal ca & ddecimal a &
dddecimal cb & ddecimal b ) ;
_special_counter_
enddef ;
+vardef define_circular_shade (expr a, b, ra, rb, ca, cb) =
+ flush_special(31, 17, "0 1 1" &
+ dddecimal ca & ddecimal a & " " & decimal ra &
+ dddecimal cb & ddecimal b & " " & decimal rb ) ;
+ _special_counter_
+enddef ;
+
%D A few predefined shading macros.
boolean trace_shades ; trace_shades := false ;
@@ -121,6 +140,16 @@ def linear_shade (expr p, n, ca, cb) =
endgroup ;
enddef ;
+vardef predefined_linear_shade (expr p, n, ca, cb) =
+ save a, b, sh ; pair a, b ;
+ if (n=1) : a := llcorner p ; b := urcorner p ;
+ elseif (n=2) : a := llcorner p ; b := ulcorner p ;
+ elseif (n=3) : a := lrcorner p ; b := ulcorner p ;
+ else : a := llcorner p ; b := lrcorner p ;
+ fi ;
+ define_linear_shade (a,b,ca,cb)
+enddef ;
+
def circular_shade (expr p, n, ca, cb) =
begingroup ;
save ab, r ; pair ab ; numeric r ;
@@ -139,6 +168,19 @@ def circular_shade (expr p, n, ca, cb) =
endgroup ;
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) ;
+ 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 ;
+ define_circular_shade(ab,ab,0,r,ca,cb)
+enddef ;
+
%D Since a \type {fill p withshade s} syntax looks better
%D than some macro, we implement a new primary.
@@ -149,7 +191,7 @@ enddef ;
%D Figure inclusion.
-numeric cef ; cef := 0 ;
+%numeric cef ; cef := 0 ;
def externalfigure primary filename =
doexternalfigure (filename)
@@ -163,15 +205,15 @@ def doexternalfigure (expr filename) text transformation =
dddecimal (yypart t, xpart t, ypart t) & " " & filename) ;
addto p contour unitsquare scaled 0 ;
setbounds p to unitsquare transformed t ;
-% _color_counter_ := _color_counter_ + 1 ; cef := cef + 1 ;
-% draw p withcolor (_special_signal_/1000,_color_counter_/1000,cef/1000) ;
-draw p withcolor (_special_signal_/1000,cef/1000,_special_counter_/1000) ;
+ _color_counter_ := _color_counter_ + 1 ;
+ draw p withcolor (_special_signal_/1000,_color_counter_/1000,_special_counter_/1000) ;
+%draw p withcolor (_special_signal_/1000,cef/1000,_special_counter_/1000) ;
endgroup ;
enddef ;
%D Experimental:
-numeric currenthyperlink ; currenthyperlink := 0 ;
+%numeric currenthyperlink ; currenthyperlink := 0 ;
def hyperlink primary t = dohyperlink(t) enddef ;
def hyperpath primary t = dohyperpath(t) enddef ;
@@ -188,11 +230,11 @@ def dohyperpath (expr destination) expr somepath =
flush_special(20, 7,
ddecimal (xpart llcorner somepath, ypart llcorner somepath) & " " &
ddecimal (xpart urcorner somepath, ypart urcorner somepath) & " " & destination) ;
- currenthyperlink := currenthyperlink + 1 ;
-% _color_counter_ := _color_counter_ + 1 ;
+% currenthyperlink := currenthyperlink + 1 ;
+ _color_counter_ := _color_counter_ + 1 ;
fill boundingbox unitsquare scaled 0 withcolor
-% (_special_signal_/1000,_color_counter_/1000,currenthyperlink/1000) ;
- (_special_signal_/1000,currenthyperlink/1000,_special_counter_/1000) ;
+ (_special_signal_/1000,_color_counter_/1000,_special_counter_/1000) ;
+% (_special_signal_/1000,currenthyperlink/1000,_special_counter_/1000) ;
endgroup ;
enddef ;
@@ -241,24 +283,121 @@ enddef ;
resetcmykcolors ; boolean cmykcolors ; cmykcolors := false ; % true
+% vardef cmyk(expr c,m,y,k) =
+% if cmykcolors :
+% if not known cmykcolorhash[c][m][y][k] :
+% _cmyk_counter_ := _cmyk_counter_ + 1 ;
+% cmykcolorhash[c][m][y][k] := _cmyk_counter_ ;
+% flush_special(1, 7,
+% decimal _cmyk_counter_ & " " &
+% decimal c & " " &
+% decimal m & " " &
+% decimal y & " " &
+% decimal k) ;
+% fi
+% (_special_signal_/1000,1/1000,cmykcolorhash[c][m][y][k]/1000)
+% else :
+% (1-c-k,1-m-k,1-y-k)
+% fi
+% enddef ;
+
+string cmykcolorpattern[] ; % needed for transparancies
+
vardef cmyk(expr c,m,y,k) =
if cmykcolors :
- if not known cmykcolorhash[c][m][y][k] :
+ save ok ; boolean ok ;
+ if unknown cmykcolorhash[c][m][y][k] :
+ ok := false ; % not yet defined
+ elseif cmykcolorhash[c][m][y][k] = -1 :
+ ok := false ; % locally defined and undefined
+ else :
+ ok := true ; % globally already defined
+ fi ;
+ if not ok :
+ save s ; string s ; s := dddecimal (c,m,y) & " " & decimal k ;
_cmyk_counter_ := _cmyk_counter_ + 1 ;
+ cmykcolorpattern[_cmyk_counter_/1000] := s ;
cmykcolorhash[c][m][y][k] := _cmyk_counter_ ;
- flush_special(1, 7,
- decimal _cmyk_counter_ & " " &
- decimal c & " " &
- decimal m & " " &
- decimal y & " " &
- decimal k) ;
- fi
+ flush_special(1, 7, decimal _cmyk_counter_ & " " & s) ;
+ _local_specials_ := _local_specials_ &
+ " cmykcolorhash[" & decimal c & "][" & decimal m &
+ "][" & decimal y & "][" & decimal k & "] := -1 ; " ;
+ fi ;
(_special_signal_/1000,1/1000,cmykcolorhash[c][m][y][k]/1000)
else :
(1-c-k,1-m-k,1-y-k)
fi
enddef ;
+% newcolor truecyan, truemagenta, trueyellow ;
+%
+% truecyan = cmyk (1,0,0,0) ;
+% truemagenta = cmyk (0,1,0,0) ;
+% trueyellow = cmyk (0,0,1,0) ;
+
+%D Transparency
+
+normaltransparent := 1 ; multiplytransparent := 2 ;
+screentransparent := 3 ; overlaytransparent := 4 ;
+softlighttransparent := 5 ; hardlighttransparent := 6 ;
+colordodgetransparent := 7 ; colorburntransparent := 8 ;
+darkentransparent := 9 ; lightentransparent := 10 ;
+differencetransparent := 11 ; exclusiontransparent := 12 ;
+
+% nottransparent := 0 ;
+% compatibletransparent := 99 ;
+
+% fill fullcircle scaled 10cm withcolor transparant(.8,3,color) ;
+
+vardef transparent(expr n, t, c) =
+ save s, ss, nn, cc, is_cmyk, ok ;
+ string s, ss ; numeric nn ; color cc ; boolean is_cmyk, 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) ;
+ % build special string, fetch cmyk components
+ s := decimal nn & " " & decimal t & " " & if is_cmyk :
+ cmykcolorpattern[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_cmyk :
+ flush_special(3, 8, s) ;
+ else :
+ flush_special(2, 7, s) ;
+ fi ;
+ scantokens(ss) := _special_counter_ ;
+ _local_specials_ := _local_specials_ &
+ "scantokens(" & ditto & ss & ditto & ") := -1 ;" ;
+ fi ;
+ % go ahead
+ if is_cmyk :
+ (_special_signal_/1000,3/1000,scantokens(ss)/1000)
+ else :
+ (_special_signal_/1000,2/1000,scantokens(ss)/1000)
+ fi
+enddef ;
+
%D Basic position tracking:
def register (expr label, width, height, offset) =
diff --git a/metapost/context/mp-text.mp b/metapost/context/mp-text.mp
index c08bac5ff..cb6bb3895 100644
--- a/metapost/context/mp-text.mp
+++ b/metapost/context/mp-text.mp
@@ -28,23 +28,71 @@ fi ;
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)
+% else :
+% 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 :
- write "% figure " & decimal charcode & " : " &
- "texpictures[" & decimal noftexpictures & "] := btex " &
- txt & " etex ;" to jobname & ".mpt" ;
- if unknown texpictures[noftexpictures] :
- thelabel@#("unknown",origin)
+ if hobbiestextext : % the tex.mp method as fallback (see tex.mp)
+ write "btex " & txt & " etex" to "mptextmp.mp" ;
+ write EOF to "mptextmp.mp" ;
+ scantokens "input mptextmp"
else :
- thelabel@#(texpictures[noftexpictures],origin)
- fi
+ 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
+ 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 ;
+ ss := "textext" & ss & "(" & ditto & s & ditto & ")" ;
+ scantokens ss
+enddef ;
+
pair laboff.origin ; laboff.origin = (infinity,infinity) ;
pair laboff.raw ; laboff.raw = (infinity,infinity) ;
diff --git a/metapost/context/mp-tool.mp b/metapost/context/mp-tool.mp
index 59988d5f3..d259a240c 100644
--- a/metapost/context/mp-tool.mp
+++ b/metapost/context/mp-tool.mp
@@ -12,6 +12,7 @@
%C details.
% a cleanup is needed, like using image and alike
+% use a few more "newinternal"'s
%D This module is rather preliminary and subjected to
%D changes.
@@ -57,6 +58,8 @@ string semicolor ; semicolor := char 59 ;
% When somehow the first one gets no HiRes, then make sure
% that the format matches the mem sizes in the config file.
+% eerste " " er uit
+
vardef ddecimal primary p =
" " & decimal xpart p &
" " & decimal ypart p
@@ -185,10 +188,11 @@ def pop_boundingbox text p =
enddef;
vardef boundingbox primary p =
- llcorner p --
- lrcorner p --
- urcorner p --
- ulcorner p -- cycle
+ if (path p) or (picture p) :
+ llcorner p -- lrcorner p -- urcorner p -- ulcorner p
+ else :
+ origin
+ fi -- cycle
enddef;
vardef inner_boundingbox primary p =
@@ -219,18 +223,44 @@ enddef;
%D Some missing functions can be implemented rather
%D straightforward:
-def tand (expr x) = (sind(x)/cosd(x)) enddef ;
+numeric Pi ; Pi := 3.1415926 ;
+
def sqr (expr x) = (x*x) enddef ;
def log (expr x) = (if x=0: 0 else: mlog(x)/mlog(10) fi) enddef ;
def ln (expr x) = (if x=0: 0 else: mlog(x)/256 fi) enddef ;
def exp (expr x) = ((mexp 256)**x) enddef ;
-def pow (expr x) = (x**power) enddef ;
def inv (expr x) = (if x=0: 0 else: x**-1 fi) enddef ;
+
+def pow (expr x,p) = (x**p) enddef ;
+
def asin (expr x) = (x+(x**3)/6+3(x**5)/40) enddef ;
def acos (expr x) = (asin(-x)) enddef ;
def atan (expr x) = (x-(x**3)/3+(x**5)/5-(x**7)/7) enddef ;
+def tand (expr x) = (sind(x)/cosd(x)) enddef ;
+
+%D Here are Taco Hoekwater's alternatives:
+
+pi := 3.1415926 ; radian := 180/pi ; % 2pi*radian = 360 ;
+
+def tand (expr x) = (sind(x)/cosd(x)) enddef ;
+def cotd (expr x) = (cosd(x)/sind(x)) enddef ;
+
+def sin (expr x) = (sind(x*radian)) enddef ;
+def cos (expr x) = (cosd(x*radian)) enddef ;
+def tan (expr x) = (sin(x)/cos(x)) enddef ;
+def cot (expr x) = (cos(x)/sin(x)) enddef ;
+
+def asin (expr x) = angle((1+-+x,x)) enddef ;
+def acos (expr x) = angle((x,1+-+x)) enddef ;
-numeric Pi ; Pi := 3.14159 ;
+def invsin (expr x) = ((asin(x))/radian) enddef ;
+def invcos (expr x) = ((acos(x))/radian) enddef ;
+
+def acosh (expr x) = ln(x+(x+-+1)) enddef ;
+def asinh (expr x) = ln(x+(x++1)) enddef ;
+
+vardef sinh primary x = save xx ; xx = exp xx ; (xx-1/xx)/2 enddef ;
+vardef cosh primary x = save xx ; xx = exp xx ; (xx+1/xx)/2 enddef ;
%D We provide two macros for drawing stripes across a shape.
%D The first method (with the n suffix) uses another method,
@@ -376,17 +406,22 @@ enddef;
% TODO TODO TODO TODO, not yet ok
primarydef p xsized w =
- (p if bbwidth(p)>0 : scaled (w/bbwidth(p)) fi)
+ (p if (bbwidth (p)>0) and (w>0) : scaled (w/bbwidth (p)) fi)
enddef ;
primarydef p ysized h =
- (p if bbheight(p)>0 : scaled (h/bbheight(p)) fi)
+ (p if (bbheight(p)>0) and (h>0) : scaled (h/bbheight(p)) fi)
enddef ;
-primarydef p xysized wh =
- (p if (bbwidth(p)>0) and (bbheight(p)>0) :
- xscaled (xpart wh/bbwidth(p)) yscaled (ypart wh/bbheight(p))
- fi)
+primarydef p xysized s =
+ begingroup ;
+ save wh, w, h ; pair wh ; numeric w, h ;
+ wh := paired (s) ; w := bbwidth(p) ; h := bbheight(p) ;
+ (p if (w>0) and (h>0) :
+ if xpart wh > 0 : xscaled (xpart wh/w) fi
+ if ypart wh > 0 : yscaled (ypart wh/h) fi
+ fi)
+ endgroup
enddef ;
primarydef p sized wh =
@@ -447,10 +482,24 @@ path unitdiamond, fulldiamond ;
unitdiamond := (.5,0)--(1,.5)--(.5,1)--(0,.5)--cycle ;
fulldiamond := unitdiamond shifted - center unitdiamond ;
-%D shorter
+%D More robust:
+
+% let normalscaled = scaled ;
+% let normalxscaled = xscaled ;
+% let normalyscaled = yscaled ;
+%
+% def scaled expr s = normalscaled (s) enddef ;
+% def xscaled expr s = normalxscaled (s) enddef ;
+% def yscaled expr s = normalyscaled (s) enddef ;
+
+%D Shorter
primarydef p xyscaled q =
- p xscaled (xpart paired(q)) yscaled (ypart paired(q))
+ begingroup ; save qq ; pair qq ; qq = paired(q) ;
+ ( p
+ if xpart qq<>0 : xscaled (xpart qq) fi
+ if ypart qq<>0 : yscaled (ypart qq) fi )
+ endgroup
enddef ;
%D Experimenteel, zie folder-3.tex.
@@ -594,16 +643,9 @@ vardef paired (expr d) =
if pair d : d else : (d,d) fi
enddef ;
-%primarydef p enlarged d =
-% begingroup ; save dd ; pair dd ;
-% dd := if pair d : d else : (d,d) fi ;
-% (llcorner p shifted (-xpart dd,-ypart dd) --
-% lrcorner p shifted (+xpart dd,-ypart dd) --
-% urcorner p shifted (+xpart dd,+ypart dd) --
-% ulcorner p shifted (-xpart dd,+ypart dd) --
-% cycle)
-% endgroup
-%enddef;
+vardef tripled (expr d) =
+ if color d : d else : (d,d,d) fi
+enddef ;
primarydef p enlarged d =
(p llmoved d -- p lrmoved d -- p urmoved d -- p ulmoved d -- cycle)
@@ -642,25 +684,32 @@ primarydef p ulmoved d =
enddef ;
primarydef p leftenlarged d =
- (llcorner p shifted (-d,0) -- lrcorner p --
- urcorner p -- ulcorner p shifted (-d,0) -- cycle)
+ ((llcorner p) shifted (-d,0) -- lrcorner p --
+ urcorner p -- (ulcorner p) shifted (-d,0) -- cycle)
enddef ;
primarydef p rightenlarged d =
- (llcorner p -- lrcorner p shifted (d,0) --
- urcorner p shifted (d,0) -- ulcorner p -- cycle)
+ (llcorner p -- (lrcorner p) shifted (d,0) --
+ (urcorner p) shifted (d,0) -- ulcorner p -- cycle)
enddef ;
primarydef p topenlarged d =
(llcorner p -- lrcorner p --
- urcorner p shifted (0,-d) -- ulcorner p shifted (0,-d) -- cycle)
+ (urcorner p) shifted (0,d) -- (ulcorner p) shifted (0,d) -- cycle)
enddef ;
primarydef p bottomenlarged d =
- (llcorner p shifted (0,d) -- lrcorner p shifted (0,d) --
+ (llcorner p shifted (0,-d) -- lrcorner p shifted (0,-d) --
urcorner p -- ulcorner p -- cycle)
enddef ;
+%D Saves typing:
+
+vardef bottomboundary primary p = (llcorner p -- lrcorner p) enddef ;
+vardef rightboundary primary p = (lrcorner p -- urcorner p) enddef ;
+vardef topboundary primary p = (urcorner p -- ulcorner p) enddef ;
+vardef leftboundary primary p = (ulcorner p -- llcorner p) enddef ;
+
%D Nice too:
primarydef p superellipsed s =
@@ -709,7 +758,11 @@ primarydef p randomized s =
elseif pair p :
p randomshifted s
elseif color p :
- if pair s :
+ if color s :
+ (uniformdeviate redpart s * redpart p,
+ uniformdeviate greenpart s * greenpart p,
+ uniformdeviate bluepart s * bluepart p)
+ elseif pair s :
((xpart s + uniformdeviate (ypart s - xpart s)) * p)
else :
(uniformdeviate s * p)
@@ -719,6 +772,68 @@ primarydef p randomized s =
fi)
enddef ;
+%D Not perfect (alternative for interpath)
+
+vardef interpolated(expr s, p, q) =
+ save m ; m := max(length(p),length(q)) ;
+ (if path p :
+ for i=0 upto m-1 :
+ s[point (i /m) along p,
+ point (i /m) along q] .. controls
+ s[postcontrol (i /m) along p,
+ postcontrol (i /m) along q] and
+ s[precontrol ((i+1)/m) along p,
+ precontrol ((i+1)/m) along q] ..
+ endfor
+ if cycle p :
+ cycle
+ else :
+ s[point infinity of p,
+ point infinity of q]
+ fi
+ else :
+ a[p,q]
+ fi)
+enddef ;
+
+%D Interesting too:
+
+% primarydef p parallel s =
+% begingroup ; save q, b ; path q ; numeric b ;
+% b := xpart (lrcorner p - llcorner p) ;
+% q := p if b>0 : scaled ((b+2s)/b) fi ;
+% (q shifted (center p-center q))
+% endgroup
+% enddef ;
+
+%primarydef p parallel s =
+% begingroup ; save q, w,h ; path q ; numeric w, h ;
+% w := bbwidth(p) ; h := bbheight(p) ;
+% q := p if (w>0) and (h>0) :
+% xyscaled ((w+2*xpart paired(s))/w,(h+2*ypart paired(s))/h) fi ;
+% (q shifted (center p-center q))
+% endgroup
+%enddef ;
+
+vardef punked primary p =
+ (point 0 of p for i=1 upto length(p)-1 : -- point i of p endfor
+ if cycle p : -- cycle else : -- point length(p) of p fi)
+enddef ;
+
+vardef curved primary p =
+ (point 0 of p for i=1 upto length(p)-1 : .. point i of p endfor
+ if cycle p : .. cycle else : .. point length(p) of p fi)
+enddef ;
+
+primarydef p blownup s =
+ begingroup
+ save _p_ ; path _p_ ; _p_ := p xysized
+ (bbwidth (p)+2(xpart paired(s)),
+ bbheight(p)+2(ypart paired(s))) ;
+ (_p_ shifted (center p - center _p_))
+ endgroup
+enddef ;
+
%D Rather fundamental.
% vardef rightpath expr p =
@@ -774,13 +889,17 @@ def draworiginoptions (text t) = def _ori_opt_ = t enddef ; enddef ;
def drawboundoptions (text t) = def _bnd_opt_ = t enddef ; enddef ;
def drawpathoptions (text t) = def _pth_opt_ = t enddef ; enddef ;
-drawlineoptions (withpen pencircle scaled 1 withcolor .5white) ;
-drawpointoptions (withpen pencircle scaled 4 withcolor black) ;
-drawcontroloptions(withpen pencircle scaled 2.5 withcolor black) ;
-drawlabeloptions () ;
-draworiginoptions (withpen pencircle scaled 1 withcolor .5white) ;
-drawboundoptions (dashed evenly _ori_opt_) ;
-drawpathoptions (withpen pencircle scaled 5 withcolor .8white) ;
+def resetdrawoptions =
+ drawlineoptions (withpen pencircle scaled 1pt withcolor .5white) ;
+ drawpointoptions (withpen pencircle scaled 4pt withcolor black) ;
+ drawcontroloptions(withpen pencircle scaled 2.5pt withcolor black) ;
+ drawlabeloptions () ;
+ draworiginoptions (withpen pencircle scaled 1pt withcolor .5white) ;
+ drawboundoptions (dashed evenly _ori_opt_) ;
+ drawpathoptions (withpen pencircle scaled 5pt withcolor .8white) ;
+enddef ;
+
+resetdrawoptions ;
%D Path.
@@ -1062,10 +1181,17 @@ enddef ;
% this cuts of a piece from both ends
+% tertiarydef pat cutends len =
+% begingroup ; save tap ; path tap ;
+% tap := pat cutbefore (point len on pat) ;
+% (tap cutafter (point -len on tap))
+% endgroup
+% enddef ;
+
tertiarydef pat cutends len =
begingroup ; save tap ; path tap ;
- tap := pat cutbefore (point len on pat) ;
- (tap cutafter (point -len on tap))
+ tap := pat cutbefore (point (xpart paired(len)) on pat) ;
+ (tap cutafter (point -(ypart paired(len)) on tap))
endgroup
enddef ;
@@ -1105,7 +1231,7 @@ vardef thefreelabel (expr str, loc, ori) =
q := freesquare xyscaled (urcorner s - llcorner s) ;
l := point xpart (p intersectiontimes (ori--loc shifted (loc-ori))) of q ;
setbounds s to boundingbox s enlarged -freelabeloffset ; % new
- draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ;
+ %draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ;
(s shifted -l)
enddef ;
@@ -1215,9 +1341,9 @@ def pushcurrentpicture =
currentpicture := nullpicture ;
enddef ;
-def popcurrentpicture =
+def popcurrentpicture text t = % optional text
if currentpicturedepth > 0 :
- addto currentpicturestack[currentpicturedepth] also currentpicture ;
+ addto currentpicturestack[currentpicturedepth] also currentpicture t ;
currentpicture := currentpicturestack[currentpicturedepth] ;
currentpicturedepth := currentpicturedepth - 1 ;
fi ;
@@ -1321,13 +1447,13 @@ vardef colorcircle (expr size, red, green, blue) =
pushcurrentpicture ;
- fill r withcolor red ;
- fill g withcolor green ;
- fill b withcolor blue ;
+ fill r withcolor red ;
+ fill g withcolor green ;
+ fill b withcolor blue ;
fill c withcolor white-red ;
fill m withcolor white-green ;
fill y withcolor white-blue ;
- fill w withcolor white ;
+ fill w withcolor white ;
for i = r,g,b,c,m,y : draw i withcolor .5white ; endfor ;
@@ -1346,19 +1472,53 @@ enddef ;
% nice: currentpicture := inverted currentpicture ;
-vardef inverted expr p =
- save pp ; picture pp ; pp := nullpicture ;
- for i within p :
- addto pp
- 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 white-(redpart i, greenpart i, bluepart i) ;
- endfor ;
- pp
+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 ; )
+enddef ;
+
+vardef inverted primary p =
+ (p uncolored white)
+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 ;)
+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 ; )
enddef ;
% yes or no: "text" infont "cmr12" at 24pt ;
@@ -1386,7 +1546,8 @@ def condition primary b = if b : "true" else : "false" fi enddef ;
primarydef p stretched s =
begingroup
- save pp ; path pp ; pp := p scaled s ;
+% save pp ; path pp ; pp := p scaled s ;
+ save pp ; path pp ; pp := p xyscaled s ;
(pp shifted ((point 0 of p) - (point 0 of pp)))
endgroup
enddef ;
@@ -1401,10 +1562,15 @@ def yshifted expr dy = shifted(0,dy) enddef ;
% right: str = readfrom ("abc" & ".def" ) ;
% wrong: str = readfrom "abc" & ".def" ;
+% Every 62th read fails so we need to try again!
+
def readfile (expr name) =
if (readfrom (name) <> EOF) :
- scantokens("input " & name & " ")
+ scantokens("input " & name & " ") ;
+ elseif (readfrom (name) <> EOF) :
+ scantokens("input " & name & " ") ;
fi
+ closefrom (name) ;
enddef ;
% permits redefinition of end in macro
@@ -1413,17 +1579,28 @@ inner end ;
% real fun
+let normalwithcolor = withcolor ;
+
+def remapcolors =
+ def withcolor primary c = normalwithcolor remappedcolor(c) enddef ;
+enddef ;
+
+def normalcolors =
+ let withcolor = normalwithcolor ;
+enddef ;
+
def resetcolormap =
color color_map[][][] ;
+ normalcolors ;
enddef ;
resetcolormap ;
-%color_map_resolution := 1000 ;
+% color_map_resolution := 1000 ;
%
-%def r_color primary c = round(color_map_resolution*redpart c) enddef ;
-%def g_color primary c = round(color_map_resolution*greenpart c) enddef ;
-%def b_color primary c = round(color_map_resolution*bluepart c) enddef ;
+% def r_color primary c = round(color_map_resolution*redpart c) enddef ;
+% def g_color primary c = round(color_map_resolution*greenpart c) enddef ;
+% def b_color primary c = round(color_map_resolution*bluepart c) enddef ;
def r_color primary c = redpart c enddef ;
def g_color primary c = greenpart c enddef ;
@@ -1441,21 +1618,13 @@ def remappedcolor(expr c) =
fi
enddef ;
-let normalwithcolor = withcolor ;
-
-def remapcolors =
- def withcolor primary c = normalwithcolor remappedcolor(c) enddef ;
-enddef ;
-
-def normalcolors =
- let withcolor = normalwithcolor ;
-enddef ;
-
def refill suffix c = do_repath (1) (c) enddef ;
def redraw suffix c = do_repath (2) (c) enddef ;
def recolor suffix c = do_repath (0) (c) enddef ;
-def do_repath (expr mode) (suffix c) text t =
+color refillbackground ; refillbackground := (1,1,1) ;
+
+def do_repath (expr mode) (suffix c) text t = % can it be stroked and filled at the same time ?
begingroup ;
if mode=0 : save withcolor ; remapcolors ; fi ;
save _c_, _f_, _b_ ; picture _c_ ; color _f_ ; path _b_ ;
@@ -1469,12 +1638,12 @@ def do_repath (expr mode) (suffix c) text t =
elseif stroked i :
addto c doublepath pathpart i
dashed dashpart i withpen penpart i
- withcolor (redpart i, greenpart i, bluepart i)
+ withcolor _f_ % (redpart i, greenpart i, bluepart i)
if mode=2 : t fi ;
elseif filled i :
addto c contour pathpart i
- withcolor (redpart i, greenpart i, bluepart i)
- if mode=1 : t if _f_ = background : withcolor background fi fi ;
+ withcolor _f_
+ if (mode=1) and (_f_<>refillbackground) : t fi ;
fi ;
endfor ;
setbounds c to _b_ ;
@@ -1586,25 +1755,26 @@ vardef dostraightened(expr sign, p) =
pp := pp -- point i of p ;
fi ;
endfor ;
- save n ; numeric n ;
- n := length(pp) ;
+ save n, ok ; numeric n ; boolean ok ;
+ n := length(pp) ; ok := false ;
for i=0 upto n : % evt hier ook round
- if unitvector(point i of pp -
- point if i=0 : n else : i-1 fi of pp) <>
- sign * unitvector(point if i=n : 0 else : i+1 fi of pp -
- point i of pp) :
- point i of pp --
- fi
-%
-% to test:
-%
-% if round(unitvector(point i of pp)) <>
-% sign * round(unitvector(point if i=n : 0 else : i+1 fi of pp)) :
-% point i of pp --
-% fi
-%
+
+%% if unitvector(point i of pp -
+%% point if i=0 : n else : i-1 fi of pp) <>
+%% sign * unitvector(point if i=n : 0 else : i+1 fi of pp -
+%% point i of pp) :
+%% if ok : -- else : hide ( ok := true ; ) fi point i of pp
+%% fi
+
+ if unitvector(round(point i of pp -
+ point if i=0 : n else : i-1 fi of pp)) <>
+ sign * unitvector(round(point if i=n : 0 else : i+1 fi of pp -
+ point i of pp)) :
+ if ok : -- else : ok := true ; fi point i of pp
+ fi
+
endfor
- cycle
+ if ok and (cycle p) : -- cycle fi
else :
p
fi
@@ -1645,6 +1815,96 @@ vardef anchored@#(expr p, z) =
+ (1-labxf@#-labyf@#)*llcorner p))
enddef ;
+% epsed(1.2345)
+
+vardef epsed (expr e) =
+ e if e>0 : + eps elseif e<0 : - eps fi
+enddef ;
+
+% handy
+
+def withgray primary g =
+ withcolor (g,g,g)
+enddef ;
+
+% for metafun
+
+if unknown darkred : color darkred ; darkred := .625(1,0,0) fi ;
+if unknown darkyellow : color darkyellow ; darkyellow := .625(1,1,0) fi ;
+if unknown darkgray : color darkgray ; darkgray := .625(1,1,1) fi ;
+if unknown lightgray : color lightgray ; lightgray := .875(1,1,1) fi ;
+
+% an improeved plain mp macro
+
+vardef center primary p =
+ if pair p : p else : .5[llcorner p, urcorner p] fi
+enddef;
+
+% new, yet undocumented
+
+vardef rangepath (expr p, d, a) =
+ (if length p>0 :
+ (d*unitvector(direction 0 of p) rotated a)
+ shifted point 0 of p
+ -- p --
+ (d*unitvector(direction length(p) of p) rotated a)
+ shifted point length(p) of p
+ else :
+ p
+ fi)
+enddef ;
+
+% under construction
+
+vardef straightpath(expr a, b, method) =
+ if (method<1) or (method>6) :
+ (a--b)
+ elseif method = 1 :
+ (a --
+ if xpart a > xpart b :
+ if ypart a > ypart b :
+ (xpart b,ypart a) --
+ elseif ypart a < ypart b :
+ (xpart a,ypart b) --
+ fi
+ elseif xpart a < xpart b :
+ if ypart a > ypart b :
+ (xpart a,ypart b) --
+ elseif ypart a < ypart b :
+ (xpart b,ypart a) --
+ fi
+ fi
+ b)
+ elseif method = 3 :
+ (a --
+ if xpart a > xpart b :
+ (xpart b,ypart a) --
+ elseif xpart a < xpart b :
+ (xpart a,ypart b) --
+ fi
+ b)
+ elseif method = 5 :
+ (a --
+ if ypart a > ypart b :
+ (xpart b,ypart a) --
+ elseif ypart a < ypart b :
+ (xpart a,ypart b) --
+ fi
+ b)
+ else :
+ (reverse straightpath(b,a,method-1))
+ fi
+enddef ;
+
+% handy for myself
+
+def addbackground text t =
+ begingroup ; save p ; picture p ;
+ p := currentpicture ; currentpicture := nullpicture ;
+ fill boundingbox p t ; draw p ;
+ endgroup ;
+enddef ;
+
% done
endinput ;
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 17:21:31 +0000