From 736de6a312c37fbb8cea65cf0a86eda7dbbe0575 Mon Sep 17 00:00:00 2001 From: Hans Hagen Date: Fri, 11 Jan 2002 00:00:00 +0100 Subject: stable 2002.01.11 --- metapost/context/metafun.mp | 4 + metapost/context/mp-char.mp | 105 +++++----- metapost/context/mp-form.mp | 378 ++++++++++++++++++++++++++++++++++++ metapost/context/mp-func.mp | 59 ++++++ metapost/context/mp-grid.mp | 129 +++++++++++++ metapost/context/mp-grph.mp | 167 +++++++++------- metapost/context/mp-page.mp | 22 ++- metapost/context/mp-shap.mp | 22 +-- metapost/context/mp-spec.mp | 217 +++++++++++++++++---- metapost/context/mp-text.mp | 62 +++++- metapost/context/mp-tool.mp | 456 ++++++++++++++++++++++++++++++++++---------- 11 files changed, 1346 insertions(+), 275 deletions(-) create mode 100644 metapost/context/mp-form.mp create mode 100644 metapost/context/mp-func.mp create mode 100644 metapost/context/mp-grid.mp (limited to 'metapost') 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 ; -- cgit v1.2.3