From ac3c55a3216b5988f0e48ba9414ddb059f19a699 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 11 Jan 2006 22:58:36 +0000 Subject: trunk/Master/texmf-dist/metapost git-svn-id: svn://tug.org/texlive/trunk@104 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/metapost/base/TEX.mp | 9 + Master/texmf-dist/metapost/base/boxes.mp | 259 +++++++++ Master/texmf-dist/metapost/base/format.mp | 234 ++++++++ Master/texmf-dist/metapost/base/graph.mp | 842 ++++++++++++++++++++++++++++ Master/texmf-dist/metapost/base/marith.mp | 156 ++++++ Master/texmf-dist/metapost/base/mfplain.mp | 579 +++++++++++++++++++ Master/texmf-dist/metapost/base/mpost.mp | 2 + Master/texmf-dist/metapost/base/plain.mp | 552 ++++++++++++++++++ Master/texmf-dist/metapost/base/rboxes.mp | 38 ++ Master/texmf-dist/metapost/base/sarith.mp | 47 ++ Master/texmf-dist/metapost/base/string.mp | 31 + Master/texmf-dist/metapost/base/texnum.mp | 17 + Master/texmf-dist/metapost/base/troffnum.mp | 7 + 13 files changed, 2773 insertions(+) create mode 100644 Master/texmf-dist/metapost/base/TEX.mp create mode 100644 Master/texmf-dist/metapost/base/boxes.mp create mode 100644 Master/texmf-dist/metapost/base/format.mp create mode 100644 Master/texmf-dist/metapost/base/graph.mp create mode 100644 Master/texmf-dist/metapost/base/marith.mp create mode 100644 Master/texmf-dist/metapost/base/mfplain.mp create mode 100644 Master/texmf-dist/metapost/base/mpost.mp create mode 100644 Master/texmf-dist/metapost/base/plain.mp create mode 100644 Master/texmf-dist/metapost/base/rboxes.mp create mode 100644 Master/texmf-dist/metapost/base/sarith.mp create mode 100644 Master/texmf-dist/metapost/base/string.mp create mode 100644 Master/texmf-dist/metapost/base/texnum.mp create mode 100644 Master/texmf-dist/metapost/base/troffnum.mp (limited to 'Master/texmf-dist/metapost/base') diff --git a/Master/texmf-dist/metapost/base/TEX.mp b/Master/texmf-dist/metapost/base/TEX.mp new file mode 100644 index 00000000000..06a0b451f4f --- /dev/null +++ b/Master/texmf-dist/metapost/base/TEX.mp @@ -0,0 +1,9 @@ +% This file defines TEX to return the picture +% resulting from running the string through tex. It is slow, +% but more general than the standard btex..etex construction + +vardef TEX primary s = + write "btex "&s&" etex" to "mptextmp.mp"; + write EOF to "mptextmp.mp"; + scantokens "input mptextmp" +enddef; diff --git a/Master/texmf-dist/metapost/base/boxes.mp b/Master/texmf-dist/metapost/base/boxes.mp new file mode 100644 index 00000000000..4ba1a6d2a45 --- /dev/null +++ b/Master/texmf-dist/metapost/base/boxes.mp @@ -0,0 +1,259 @@ +% Macros for boxes + + +% Find the length of the prefix of string s for which cond is true for each +% character c of the prefix +vardef str_prefix(expr s)(text cond) = + save i_, c; string c; + i_ = 0; + forever: + c := substring (i_,i_+1) of s; + exitunless cond; + exitif incr i_=length s; + endfor + i_ +enddef; + +% Take a string returned by the str operator and return the same string +% with explicit numeric subscripts replaced by generic subscript symbols []. +vardef generisize(expr ss) = + save res, s, l; string res, s; + res = ""; % result so far + s = ss; % left to process + forever: exitif s=""; + l := str_prefix(s, (c<>"[") and ((c<"0") or (c>"9"))); + res := res & substring (0,l) of s; + s := substring (l,infinity) of s; + if s<>"": + res := res & "[]"; + l := if s>="[": 1 + str_prefix(s, c<>"]") + else: str_prefix(s, (c=".") or ("0"<=c) and (c<="9")) + fi; + s := substring(l,infinity) of s; + fi + endfor + res +enddef; + + +% Make sure the string _n_gen_ is generisize(_n_): +vardef set_n_gen_ = + if _n_ <> _n_cur_: + _n_cur_:=_n_; + _n_gen_:=generisize(_n_); + fi +enddef; + +string _n_, _n_cur_, _n_gen_; +_n_cur_ := "]"; % this won't match _n_ + + +% Given a type t and list of variable names vars, make sure that they are +% of type t and redeclare them as necessary. In the vars list _n represents +% scantokens _n_, a suffix that might contain numeric subscripts. +% This suffix needs to be replaced by scantokens _n_gen_ in order to get +% a variable that can be declared to be of type t. +vardef generic_declare(text t) text vars = + set_n_gen_; + forsuffixes v_=vars: + if forsuffixes _n=scantokens _n_: not t v_ endfor: + def _gdmac_ text _n = t v_ enddef; + expandafter _gdmac_ scantokens _n_gen_; + fi + endfor +enddef; + +% Here is another version that redeclares the vars even if they are already +% of the right type. +vardef generic_redeclare(text t) text vars = + set_n_gen_; + def _gdmac_ text _n = t vars enddef; + expandafter _gdmac_ scantokens _n_gen_; +enddef; + + + + + + + +% pp should be a string giving the name of a macro that finds the boundary path +% sp should be a string that names a macro for fixing the size and shape +% The suffix $ is the name of the box +% The text t gives the box contents: either empty, a picture, or a string to +% typeset +def beginbox_(expr pp,sp)(suffix $)(text t) = + _n_ := str $; + generic_declare(pair) _n.off, _n.c; + generic_declare(string) pproc_._n, sproc_._n; + generic_declare(picture) pic_._n; + pproc_$:=pp; sproc_$:=sp; + pic_$ = nullpicture; + for _p_=t: + pic_$:= + if picture _p_: _p_ + else: _p_ infont defaultfont scaled defaultscale + fi; + endfor + $c = $off + .5[llcorner pic_$, urcorner pic_$] +enddef; + + +% The suffix cl names a vardef macro that clears box-related variables +% The suffix $ is the name of the box being ended. +def endbox_(suffix cl, $) = + if known pic_.prevbox: _dojoin(prevbox,$); fi + def prevbox = $ enddef; + expandafter def expandafter clearboxes expandafter = + clearboxes cl($); + enddef +enddef; + + +% Text t gives equations for joining box a to box b. +def boxjoin(text t) = + def prevbox=_ enddef; + def _dojoin(suffix a,b) = t enddef; +enddef; + + +extra_beginfig := extra_beginfig + & "boxjoin();save pic_,sproc_,pproc_;def clearboxes=enddef;"; +extra_endfig := extra_endfig & "clearboxes"; + + +% Given a list of box names, give whatever default values are necessary +% in order to fix the size and shape of each box. +vardef fixsize(text t) = + forsuffixes $=t: scantokens sproc_$($); endfor +enddef; + + +% Given a list of box names, give default values for any unknown positioning +% offsets +vardef fixpos(text t) = + forsuffixes $=t: + if unknown xpart $.off: xpart $.off=0; fi + if unknown ypart $.off: ypart $.off=0; fi + endfor +enddef; + + +% Return the boundary path for the given box +vardef bpath suffix $ = + fixsize($); fixpos($); + scantokens pproc_$($) +enddef; + + +% Return the contents of the given box. First define a private version that +% the user can't accidently clobber. +vardef pic_mac_ suffix $ = + fixsize($); fixpos($); + pic_$ shifted $off +enddef; + +vardef pic suffix $ = pic_mac_ $ enddef; + + +def drawboxed(text t) = % Draw each box + fixsize(t); fixpos(t); + forsuffixes s=t: draw pic_mac_.s; draw bpath.s; endfor +enddef; + +def drawunboxed(text t) = % Draw contents of each box + fixsize(t); fixpos(t); + forsuffixes s=t: draw pic_mac_.s; endfor +enddef; + +def drawboxes(text t) = % Draw boundary path for each box + forsuffixes s=t: draw bpath.s; endfor +enddef; + + + + + +% Rectangular boxes + +newinternal defaultdx, defaultdy; +defaultdx := defaultdy := 3bp; + +vardef boxit@#(text tt) = + beginbox_("boxpath_","sizebox_",@#,tt); + generic_declare(pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w; + 0 = xpart (@#nw-@#sw) = ypart(@#se-@#sw); + 0 = xpart(@#ne-@#se) = ypart(@#ne-@#nw); + @#w = .5[@#nw,@#sw]; + @#s = .5[@#sw,@#se]; + @#e = .5[@#ne,@#se]; + @#n = .5[@#ne,@#nw]; + @#ne-@#c = @#c-@#sw = (@#dx,@#dy) + .5*(urcorner pic_@# - llcorner pic_@#); + endbox_(clearb_,@#); +enddef; + +def boxpath_(suffix $) = + $.sw -- $.se -- $.ne -- $.nw -- cycle +enddef; + +def sizebox_(suffix $) = + if unknown $.dx: $.dx=defaultdx; fi + if unknown $.dy: $.dy=defaultdy; fi +enddef; + +vardef clearb_(suffix $) = + _n_ := str $; + generic_redeclare(numeric) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w, + _n.c, _n.off, _n.dx, _n.dy; +enddef; + + + + + +% Circular and oval boxes + +newinternal circmargin; circmargin:=2bp; % default clearance for picture corner + +vardef circleit@#(text tt) = + beginbox_("thecirc_","sizecirc_",@#,tt); + generic_declare(pair) _n.n, _n.s, _n.e, _n.w; + @#e-@#c = @#c-@#w = (@#dx,0) + .5*(lrcorner pic_@#-llcorner pic_@#); + @#n-@#c = @#c-@#s = (0,@#dy) + .5*(ulcorner pic_@#-llcorner pic_@#); + endbox_(clearc_,@#); +enddef; + +def thecirc_(suffix $) = + $.e{up} ... $.n{left} ... $.w{down} ... $.s{right} ... cycle +enddef; + +vardef clearc_(suffix $) = + _n_ := str $; + generic_redeclare(numeric) _n.n, _n.s, _n.e, _n.w, _n.c, _n.off, _n.dx, _n.dy; +enddef; + +vardef sizecirc_(suffix $) = + save a_, b_; + (a_,b_) = .5*(urcorner pic_$ - llcorner pic_$); + if unknown $dx: + if unknown $dy: + if unknown($dy-$dx): a_+$dx=b_+$dy; fi + if a_+$dx=b_+$dy: a_+$dx = a_++b_ + circmargin; + else: $dx = + pathsel_(max(a_,b_+$dx-$dy), (a_+d_,0){up}...(0,b_+d_+$dy-$dx){left}); + fi + else: $dx = pathsel_(a_, (a_+d_,0){up}...(0,b_+$dy){left}); + fi + elseif unknown $dy: + $dy = pathsel_(b_, (a_+$dx,0){up}...(0,b_+d_){left}); + fi +enddef; + +vardef pathsel_(expr dhi)(text tt) = + save f_, p_; path p_; + p_ = origin..(a_,b_)+circmargin*unitvector(a_,b_); + vardef f_(expr d_) = + xpart((tt) intersectiontimes p_) >= 0 + enddef; + solve f_(0,dhi+1.5circmargin) +enddef; diff --git a/Master/texmf-dist/metapost/base/format.mp b/Master/texmf-dist/metapost/base/format.mp new file mode 100644 index 00000000000..6a636c62ad9 --- /dev/null +++ b/Master/texmf-dist/metapost/base/format.mp @@ -0,0 +1,234 @@ +% 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 + +% Other than the above-documented user interface, all externally visible names +% start with F and end with _. + + +if unknown Fmfont_: % If this file has not been read yet +begingroup interim warningcheck:=0; % Allow big numbers in token lists + +input string + + +%%%%%%%%%%%%%%%%%%%%%%% 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 peices side-by-side; decimal numbers use only m and/or s. +% To get exponenets 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) = + (decimal abs x infont Fmfont_ scaled Fmscale_) +enddef; + +vardef Fexp_(expr x) = + (decimal x infont Fefont_ scaled Fescale_ shifted (0,Feraise_)) +enddef; + +vardef Fline_up_(text t_) = + 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_ +enddef; + +vardef Fdec_o_(expr x) = + if x<0: Fline_up_(Fmneg_, Fmant_(x)) + else: Fmant_(x) + fi +enddef; + +vardef Fsci_o_(expr x, e) = + 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)) +enddef; + + +% Assume prologues=1 implies troff mode. TeX users who what prologues on +% should use some other positive value. The mpx file mechanism requires +% separate input files here. +if prologues=1: input troffnum +else: input texnum +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: + if unknown Mzero: scantokens "input marith"; fi + 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) = Fsci_o_(xpart z/1000, ypart z +3) 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) = + if s<>"": s infont defaultfont scaled defaultscale, fi +enddef; + + +% For each format letter, the table below tells how to round and typeset +% a quantity z in exponent form. +string fmt_[]; +fmt_[ASCII "e"] = "Formsci_(z Fprec_ p)"; % scientific, p significant figures +fmt_[ASCII "f"] = "Formdec_(z Fdigs_ p)"; % decimal, p digits right of the point +fmt_[ASCII "g"] = "Formgen_(z Fprec_ p)"; % decimal or scientific, p sig. figs. +fmt_[ASCII "G"] = "Formgen_(z Fdigs_ p)"; % decimal or scientific, p digits + + +% 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) = + if f="": nullpicture + else: + interim warningcheck:=0; + save k, l, s, p, z; + pair z; z=@#(x); + k = 1 + cspan(f, "%"<>); + l-k = cspan(substring(k,infinity)of f, isdigit); + p = if l>k: scantokens substring(k,l)of f else: 3 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 = "nullpicture"; + fi + Fline_up_( + Fset_item_(substring (0,k-1) of f) + scantokens s, + Fset_item_(substring (l+1,infinity) of f) + nullpicture) + fi +enddef; + +vardef format(expr f, x) = dofmt_.Feform_(f,x) enddef; +vardef Mformat(expr f, x) = dofmt_.Meform(f,x) enddef; + + +endgroup; % restore warningcheck to previous value +fi % end the if..fi that encloses this file diff --git a/Master/texmf-dist/metapost/base/graph.mp b/Master/texmf-dist/metapost/base/graph.mp new file mode 100644 index 00000000000..de3ee74c087 --- /dev/null +++ b/Master/texmf-dist/metapost/base/graph.mp @@ -0,0 +1,842 @@ +% Macros for drawing graphs + +% begingraph(width,height) begin a new graph +% setcoords(xtype,ytype) sets up a new coordinate system (log,-linear..) +% setrange(lo,hi) set coord ranges (numeric and string args OK) +% gdraw [with...] draw a line in current coord system +% gfill [with...] fill a region using current coord system +% gdrawarrow .., gdrawdblarrow.. like gdraw, but with 1 or 2 arrowheads +% Mreadpath() read path from file and return it in Mlog form +% augment(loc) append given coordinates to a polygonal path +% glabel(pic,loc) place label pic near graph coords or time loc +% gdotlabel(pic,loc) same with dot +% OUT loc value for labels relative to whole graph +% gdata(file,s,text) read coords from file; evaluate t w/ tokens s[] +% auto. default x or y tick locations (for interation) +% itick.(fmt,u) draw inward tick from given side at u w/ format +% otick.(fmt,u) draw outward tick at coord u; label format fmt +% grid.(fmt,u) draw grid line at u with given side labelled +% autogrid([itick|.. bot|..],..) iterate over auto.x, auto.y, drawing tick/grids +% frame.[bot|top..] draw frame (or one side of the frame) +% endgraph end of graph--the result is a picture + +% option `plot ' draws picture at each path knot, turns off pen +% Gtemplate. template paths for tick marks and grid lines +% Gmargin.low, Gmargin.high fractions determining margins when no setrange +% Glmarks[], Gumarks, Gemarks loop text strings used by auto. +% Gmarks, Gminlog numeric parameters used by auto. +% Gpaths tells how to interpret paths: log or linear +% Autoform is the format string used by autogrid + +% Other than the above-documented user interface, all externally visible names +% are of the form X_., Y_., or Z_., or they start +% with `G' and end with `_'. + + +if unknown Mzero: + begingroup interim % marith.mp starts with `warningcheck:=0' + input marith + endgroup; % restore warningcheck; we zero it when necessary +fi +if unknown mant_font: + input format +fi + + +vardef Gerr_(expr x,s) = + interim showstopping:=0; + show x; errmessage s; +enddef; + + + +%%%%%%%%%%%%%%%%%%%%%%%% Data structures, begingraph %%%%%%%%%%%%%%%%%%%%%%%% + +vardef Z_@# = (X_@#,Y_@#) enddef; % used in place of plain.mp's z convention + +def Gsuf_(suffix $) = % convert from x or y to X_ or Y_ + if str$="x": X_ else: Y_ fi +enddef; + + +def begingraph(expr w, h) = + begingroup + save X_, Y_, Gfin_, Gcur_, Gcbb_, Gneedgr_, Gneedfr_, Gdidsc_; + save Gdpic_, Gppic_, Ggl_, Garw_; + picture Gfin_, Gcur_, Gcbb_, Gdpic_, Gppic_, Ggl_[]; + boolean Gneedgr_, Gneedfr_, Gdidsc_; + Gfin_ = nullpicture; % the finished part of the graph + Gcur_ = nullpicture; % what has been drawn in current coords + Gcbb_ = nullpicture; % picture whose bbox is Gcur_'s w/ linewidths 0 + X_.ctyp = Y_.ctyp = linear; % coordinate system for each axis + Z_.gdim = (w,h); % dimensions of graph not counting axes etc. + X_.sc = Y_.sc = 0; % Mlog(the amount Gcur_ has been descaled by) + Gneedgr_ = true; % whether autogrid is needed + Gneedfr_ = true; % whether frame needs to be drawn + Gdidsc_ = false; % set when Glinsc_ rescales coordinates + Gdpic_ = nullpicture; % result of last gdraw or gfill + Garw_ = 0; % number of arrowheads for next gdraw +enddef; + +% Additional variables not explained above: +% Z_.low, Z_.high user-specified coordinate ranges in units used in Gcur_ +% Gppic_ a picture from the `plot' option known when plot allowed +% Gmll_, Gmhh_ pairs giving bounds used in auto +% Gme_, Gcma_ variables and macros used in auto +% Gc_ temporary macro used in auto +% Gbias_ an offset to Gmll_ and Gmhh_ to ease computing exponents +% Ggl_[] labels to place around the whole graph when it is done +% Some additional variables function as constants. Most can be modified by the +% user to alter the behavior of these macros. +% Not very modifiable: log, linear, Gboff_, Gfra_, Gfrb_, Gmarg_ +% Modifiable: Gtemplate.suffix, Glmarks[], Gumarks, Gemarks, Gmarks, +% Gminlog, Gpaths, Autoform + + +newinternal log, linear; % coordinate system codes +newinternal Gpaths; % path interpretation parameter +log:=1; linear:=2; +Gpaths := linear; + + + +%%%%%%%%%%%%%%%%%%%%%% Coordinates: setcoords, setrange %%%%%%%%%%%%%%%%%%%%%% + +% Graph-related usr input is `user graph coordinates' as specified by arguments +% to setcoords. +% `Internal graph coordinates' are used for Gcur_, Gcbb_, Z_.low, Z_.high. +% Their meaning depends on the appropriate component of Z_.ctyp: +% log means internal graph coords = Mlog(user graph coords) +% -log means internal graph coords = -Mlog(user graph coords) +% linear means internal graph coords = Mexp(Mlog(user graph coords) Mdiv ?sc) +% -linear means internal graph coords = -Mexp(Mlog(user graph coords) Mdiv ?sc) +% (In the last two lines, `?sc' means X_.sc or Y_.sc as appropriate.) + + +vardef Gsetp_ = % Set default Z_.low, Z_.high + forsuffixes $=low,high: + (if known X_$: whatever else: X_$ fi, if known Y_$: whatever else: Y_$ fi) + = Gmargin$[llcorner Gcbb_,urcorner Gcbb_] + Gmarg_$; + endfor +enddef; +pair Gmarg_.low, Gmarg_.high; +Gmarg_.high=-Gmarg_.low=(.00002,.00002); + + +% Set $, $$, $$$ so that shifting by $ then transforming by $$ and then $$$ +% maps the essential bounding box of Gcur_ into (0,0)..Z_.gdim. The +% `essential bounding box' is either what Z_.low and Z_.high imply or the +% result of ignoring pen widths in Gcur_. +vardef Gsetsc_(suffix $,$$,$$$) = + save p_; + Gsetp_; + pair p_, $; $=Gboff_-Z_.low; + p_ = (max(X_.high-X_.low,.9), max(Y_.high-Y_.low,.9)); + transform $$, $$$; + forsuffixes #=$$,$$$: xpart#=ypart#=xypart#=yxpart#=0; endfor + (Z_.high+Gboff_+$) transformed $$ = p_; + p_ transformed $$$ = Z_.gdim; +enddef; +Gmargin.low=-.07; % bbox fraction for default range start +Gmargin.high=1.07; % bbox fraction for default range stop +pair Gboff_; Gboff_=epsilon*(3,3); % allowance to avoid numerical trouble + + +def Gwithpc_(expr q) = + withpen penpart q withcolor (redpart q, greenpart q, bluepart q) +enddef; + + +% Add picture component q to picture @# and change part p to tp, where p is +% something from q that needs coordinate transformation. The type of p is pair +% or path. +% Pair o is the value of p that makes tp (0,0). This implements the trick +% whereby using 1 instead of 0 for th the width or height or the setbounds path +% for a label picture supresses shifting in x or y. +vardef Gpconv_@#(expr q, o)(text tp) = + save p; + if stroked q: + path p; p=pathpart q; + addto @# doublepath tp Gwithpc_(q) dashed dashpart q; + elseif filled q: + path p; p=pathpart q; + addto @# contour tp Gwithpc_(q); + else: + interim truecorners:=0; + pair p; p=llcorner q; + if urcorner q<>p: p:=p+Gcmul_(o-p,urcorner q-p); fi + addto @# also q shifted ((tp)-llcorner q); + fi +enddef; +def Gcmul_(expr a,b) = (xpart a*xpart b, ypart a*ypart b) enddef; + + +vardef Gclbnds_@# = numeric @#.low, @#.high; enddef; + + +% Finalize anything drawn in the present coordinate system and set up a new +% system as requested +vardef setcoords(expr tx, ty) = + interim warningcheck:=0; + if length Gcur_>0: + save s, S, T; + Gsetsc_(s, S, T); + for q within Gcur_: + Gpconv_.Gfin_(q, -s, p shifted s transformed S transformed T); + endfor + Gcur_ := Gcbb_ := nullpicture; + fi + Gclbnds_.X_; Gclbnds_.Y_; + X_.ctyp:=tx; Y_.ctyp:=ty; +enddef; + + +% Use scaling command cc to rescale everything in internal graph coords so that +% if Mlog(user graph coords) is u then the internal graph coord value becomes +% 10000/128. Assume u>=$sc+4Mten where $ is X_ or Y_, depending on whether cc +% is xscaled or yscaled. +vardef Glinsc_@#(expr u)(text cc) = + save v, P; + v = mexp(4Mten + (@#sc-u)); + picture P; P=nullpicture; + for q within Gcur_: Gpconv_.P(q, origin, p cc v cc 1/128); endfor + Gcur_ := P; + Gcbb_ := Gcbb_ cc v cc 1/128; + forsuffixes $=low, high: + if known @#.$: @#.$:=@#.$*v/128; fi + endfor + @#sc:= Mabs u -1115.72742; % @#sc:=Mabs u+Mlog(128)-4Mten + Gdidsc_ := true; +enddef; + + +% Convert x coordinate u from Mlog(user graph coords) to ctyp=linear internal +% graph coords. If the result would be uncomfortably large, use Glinsc_ to +% descale as needed. +vardef Gxcvlin_ primary u = + interim warningcheck:=0; + if unknown u: u + elseif u>X_.sc+4Mten: + Glinsc_.X_(u,xscaled); + 78.125 + else: Mexp(u Mdiv X_.sc) + fi +enddef; + +vardef Gycvlin_ primary u = % same as Gxcvlin_ but u is a y coordinate + interim warningcheck:=0; + if unknown u: u + elseif u>Y_.sc+4Mten: + Glinsc_.Y_(u,yscaled); + 78.125 + else: Mexp(u Mdiv Y_.sc) + fi +enddef; + + +% Set Z_.low and Z_.high to correspond to given range of user graph +% coordinates. The text argument should be a sequence of pairs and/or strings +% with 4 components in all. +vardef setrange(text t) = + interim warningcheck:=0; + save r_; r_=0; + string r_[]s; + for x_= + for p_=t: if pair p_: xpart p_, ypart fi p_, endfor: + r_[incr r_] if string x_: s fi = x_; + if r_>2: + Gsetr_ if r_=3: X_(Gxcvlin_) else: Y_(Gycvlin_) fi( + r_[r_-2] if unknown r_[r_-2]: s fi, x_); + fi + exitif r_=4; + endfor +enddef; + + +% @# is X_ or Y_; $ is Gxcvlin_ or Gycvlin_; l and h are numeric or string +% It would not be OK to set (@#low,@#high) to a pair expression because $ might +% try to rescale @#low when evaluating the right-hand side for @#high. +vardef Gsetr_@#(suffix $)(expr l, h) = + Gclbnds_@#; + if @#ctyp>0: + @#low = if abs @#ctyp<>log: $ fi Mlog_Str l; + @#high = if abs @#ctyp<>log: $ fi Mlog_Str h; + else: + -@#high = if abs @#ctyp<>log: $ fi Mlog_Str l; + -@#low = if abs @#ctyp<>log: $ fi Mlog_Str h; + fi +enddef; + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%% Converting path coordinates %%%%%%%%%%%%%%%%%%%%%%%%% + +% Find the result of scanning path p and using macros tx and ty to adjust the +% x and y parts of each coordinate pair. Boolean paramter c tells whether to +% force the result to be polygonal. +vardef Gscan_(expr p, c)(suffix tx, ty) = + if (str tx="") and (str ty=""): p + else: + save r_; path r_; + forever: + Gdidsc_ := false; + r_ := Gpp_(point 0 of p, tx, ty) + if path p: + for t=1 upto length p: + if c: -- + else: ..controls Gpp_(postcontrol(t-1) of p, tx, ty) + and Gpp_(precontrol t of p, tx, ty) .. + fi + Gpp_(point t of p, tx, ty) + endfor + if cycle p: &cycle fi + fi; + exitunless Gdidsc_; + endfor + if pair p: point 0 of fi r_ + fi +enddef; +vardef Gpp_(expr p)(suffix tx, ty) = (tx xpart p, ty ypart p) enddef; + + +% Convert path p from Mlog(user graph coords) to internal graph coords. +% Boolean flag f says whether to force the result to be polygonal. +vardef GMcvi_(expr f) primary p = + Gscan_(p, f, + if abs X_.ctyp=linear: Gxcvlin_ fi, + if abs Y_.ctyp=linear: Gycvlin_ fi) + if X_.ctyp<0: xscaled -1 fi + if Y_.ctyp<0: yscaled -1 fi +enddef; + + +% Convert path p from user graph coords to internal graph coords. +vardef Gucvi_ primary p = + if Gpaths=log: + GMcvi_((abs X_.ctyp<>log) or (abs Y_.ctyp<>log)) p + else: + interim warningcheck:=0; + save t, u; + t=Mexp(-X_.sc); u=Mexp(-Y_.sc); + Gscan_(p, (abs X_.ctyp<>linear) or (abs Y_.ctyp<>linear), + if abs X_.ctyp=log: Mlog fi, + if abs Y_.ctyp=log: Mlog fi) + transformed (identity + if abs X_.ctyp=linear: xscaled t fi + if abs Y_.ctyp=linear: yscaled u fi + if X_.ctyp<0: xscaled -1 fi + if Y_.ctyp<0: yscaled -1 fi) + fi +enddef; + + +% Convert label location t_ from user graph coords to internal graph coords. +% The label location should be a pair, or two numbers/strings. If t_ is empty +% or a single item of non-pair type, just return t_. Unknown coordinates +% produce unknown components in the result. +vardef Gtcvi_(text t_) = + save n_; n_=0; + interim warningcheck:=0; + if 0 for x_=t_: +1 if pair x_: +1 fi endfor <= 1: + t_ + else: + n_0 = n_1 = 0; + point 0 of GMcvi_(true) ( + for x_= + for y_=t_: if pair y_: xpart y_, ypart fi y_, endfor + 0, 0: + if known x_: Mlog_Str x_ + else: hide(n_[n_]:=whatever) Mzero + fi + exitif incr n_=2; + ,endfor) + (n_0,n_1) + fi +enddef; + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Reading data files %%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% Read a line from file f, extract whitespace-separated tokens ignoring any +% initial "%", and return true if at least one token is found. The tokens +% are stored in @#1, @#2, .. with "" in the last @#[] entry. +vardef Grdln_@#(expr f) = + save n_, s_; string s_; + s_ = readfrom f; + string @#[]; + if s_<>EOF: + @#1 := loptok s_; + n_ = if @#1="%": 0 else: 1 fi; + forever: + @#[incr n_] := loptok s_; + exitif @#[n_]=""; + endfor + @#1<>"" + else: false + fi +enddef; + + +% Execute c for each line of data read from file f, and stop at the first +% line with no data. Commands c can use line number i and tokens $1, $2, ... +def gdata(expr f)(suffix $)(text c) = + for i=1 upto infinity: + exitunless Grdln_$(f); + c + endfor +enddef; + + +% Read a path from file f and return it in Mlog form. The path is terminated +% by blank line or EOF. +vardef Mreadpath(expr f) = + interim warningcheck:=0; + save s; + gdata(f, s, if i>1:--fi + if s2="": (Mlog i, Mlog_str s1) + else: (Mlog_str s1, Mlog_str s2) fi) +enddef; + + +% Append coordinates t to polygonal path @#. The coordinates can be numerics, +% strings, or a single pair. +vardef augment@#(text t) = + interim warningcheck := 0; + if not path begingroup @# endgroup: + Gerr(begingroup @# endgroup, "Cannot augment--not a path"); + else: + def Gcma_= hide(def Gcma_=,enddef) enddef; + if known @#: @#:=@#-- else: @#= fi + (for p=t: + Gcma_ if string p: Mexp Mlog_str fi p + endfor); + fi +enddef; + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Drawing and filling %%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% Unknown pair components are set to 0 because glabel and gdotlabel understand +% unknown coordinates as `0 in absolute units'. +vardef Gupbb_(expr p) = + if known p: addto Gcbb_ doublepath p; + else: + save x,y; + z = llcorner Gcbb_; + if unknown xpart p: xpart p= else: x:= fi 0; + if unknown ypart p: ypart p= else: y:= fi 0; + addto Gcbb_ doublepath (p+z); + fi + Gcbb_ := image(fill llcorner Gcbb_..urcorner Gcbb_--cycle); +enddef; + + +% Initiate a gdraw or gfill command. This must be done before scanning the +% argument, because that could invoke the `if known Gppic_' test in a following +% plot option . +def Gaddto_ = Gdpic_:=Gppic_:=nullpicture; addto Gdpic_ enddef; + + +% Handle the part of a Gdraw command that uses path or data file p. +def Gdraw_ expr p = + if string p: GMcvi_(true) Mreadpath(p) + elseif path p or pair p: Gucvi_ p + else: Gerr_(p,"gdraw argument should be a data file or a path") + origin + fi + withpen currentpen Gwithlist_ _op_ +enddef; + + +% Handle the part of a Gdraw command that uses path or data file p. +def Gfill_ expr p = + if string p: GMcvi_(true) Mreadpath(p) --cycle + elseif cycle p: Gucvi_ p + else: Gerr_(p,"gfill argument should be a data file or a cyclic path") + origin..cycle + fi Gwithlist_ _op_ +enddef; + +def gdraw = Gaddto_ doublepath Gdraw_ enddef; +def gfill = Gaddto_ contour Gfill_ enddef; + + +% This is used in Gdraw_ and Gfill_ to allow postprocessing Gdpic_ +def Gwithlist_ text t_ = t_; Gpostdr_; enddef; + + +% Set Gppic_ so the postprocessing step will plot picture p at each path knot. +% Also select nullpen to supress stroking. +def plot expr p = + if known Gppic_: + withpen nullpen + hide (Gppic_:=image( + if bounded p: for q within p: Gdrw_ q endfor % Save memory + else: Gdrw_ p + fi Gsetb_ origin..cycle)) + fi +enddef; + +% This hides a semicolon that could prematurely end Gwithlist_'s text argument +def Gdrw_ primary p = addto currentpicture also p; enddef; +def Gsetb_ = setbounds currentpicture to enddef; + + +def gdrawarrow = Garw_:=1; gdraw enddef; +def gdrawdblarrow = Garw_:=2; gdraw enddef; + + +% Post-process the filled or stroked picture Gdpic_ as follows: (1) update +% the bounding box information; (2) transfer it to Gcur_ unless the pen has +% been set to nullpen to disable stroking; (3) plot Gppic at each knot. +vardef Gpostdr_ = + save p; + path p; p=pathpart Gdpic_; + Gupbb_(p); + if filled Gdpic_ or not Gisnull_(penpart Gdpic_): + addto Gcur_ also Gdpic_; + fi + if length Gppic_>0: + for i=0 upto length p if cycle p: -1 fi: + addto Gcur_ also Gppic_ shifted point i of p; + endfor + picture Gppic_; + fi + if Garw_>0: + Garwhd_(p, Gwithpc_(Gdpic_)); + if Garw_>1: Garwhd_(reverse p, Gwithpc_(Gdpic_)); fi + Garw_:=0; + fi +enddef; +vardef Gisnull_(expr p) = (urcorner p=origin) and (llcorner p=origin) enddef; + + +vardef Garwhd_(expr p)(text w) = % Draw arrowhead for path p, with list w + addto Gcur_ also + image(filldraw arrowhead( + Garhwext_(precontrol infinity of p, point infinity of p)) w; + Gsetb_ point infinity of p..cycle); +enddef; + +vardef Garhwext_(expr p, q) = + if p<>q: (q - 100pt*unitvector(q-p)) -- fi + q +enddef; + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Drawing labels %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% Argument c is a drawing command that needs an additonal argument p that gives +% a location in internal graph coords. Draw in Gcur_ enclosed in a setbounds +% path. Unknown components of p cause the setbounds path to have width or +% height 1 instead of 0. Then Gupbb_ sets these components to 0 and Gpconv_ +% supresses subsequent repositioning. +def Glab_(expr p)(suffix $)(text c) = + save sdim_; pair sdim_; + sdim_ := (if unknown xpart p: 1+ fi 0, if unknown ypart p: 1+ fi 0); + Gupbb_(p); + addto Gcur_ also + image(c(p); Gsetb_ p--p+sdim_--cycle) _op_ +enddef; + + +% Stash the result drawing command c in the Ggl_ table using with list w and +% an index based on angle laboff$. +vardef Gglab_(suffix $)(text c) text w = + Ggl_[1.5+angle laboff$ /90] = image(c(origin) w); +enddef; + + +def Glloc_ primary p = + if pair p: Glab_(p) + elseif numeric p: Glab_(point p of pathpart Gdpic_) + else: Gglab_ + fi +enddef; + + +% Place label p at user graph coords t using with list w. (t is a time, a pair +% or 2 numerics or strings). +vardef glabel@#(expr p)(text t) text w = + Glloc_ Gtcvi_(t) (@#,label@#(p)) w; enddef; + + +% Place label p at user graph coords t using with list w and draw a dot there. +% (t is a time, a pair, or 2 numerics or strings). +vardef gdotlabel@#(expr p)(text t) text w = + Glloc_ Gtcvi_(t) (@#,dotlabel@#(p)) w; enddef; + + +def OUT = enddef; % location text for outside labels + + + +%%%%%%%%%%%%%%%%%%%%%%%%%% Grid lines, ticks, etc. %%%%%%%%%%%%%%%%%%%%%%%%%% + +% Grid lines and tick marks are transformed versions of the templates below. +% In the template paths, (0,0) is on the edge of the frame and inward is to +% the right. +path Gtemplate.itick, Gtemplate.otick, Gtemplate.grid; +Gtemplate.itick = origin--(7bp,0); +Gtemplate.otick = (-7bp,0)--origin; +Gtemplate.grid = origin--(1,0); + +vardef itick@#(expr f,u) text w = Gtlab_(@#,@,false,f,u,w); enddef; + +vardef otick@#(expr f,u) text w = Gtlab_(@#,@,false,f,u,w); enddef; + +vardef grid@#(expr f,u) text w = Gtlab_(@#,@,true,f,u,w); enddef; + + +% Produce a tick or grid mark for label suffix $, Gtemplate suffix $$, +% coordinate value u, and with list w. Boolean c tells whether Gtemplate$$ +% needs scaling by X_.gdim or Y_.gdim, and f gives a format string or a label +% picture. +def Gtlab_(suffix $,$$)(expr c, f, u)(text w) = + Glab_(Gtcvi_(Ggpos_($,u)),,draw Ggpic_$($$,c,f,u,w) shifted) +enddef; + + +% Generate label positioning arguments appropriate for label suffix $ and +% coordinate u. +def Ggpos_(suffix $)(expr u) = + if xpart laboff.$=0: u,whatever else: whatever,u fi +enddef; + + +% Generate a picture of a grid line labeled with coordinate value u, picture +% or format string f, and with list w. Suffix @# is bot, top, lft, or rt, +% suffix $ identifies entries in the Gtemplate table, and boolean c tells +% whether to scale Gtemplate$. +vardef Ggpic_@#(suffix $)(expr c, f, u)(text w) = + if unknown u: Gerr_(u,"Label coordinate should be known"); nullpicture + else: + save p; path p; + interim warningcheck:=0; + Gneedgr_:=false; + p = Gtemplate$ zscaled -laboff@# + if c: Gxyscale fi + shifted (((.5 + laboff@# dotprod (.5,.5)) * laboff@#) Gxyscale); + image(draw p w; + label@#(if string f: format(f,u) else: f fi, point 0 of p)) + fi +enddef; +def Gxyscale = xscaled X_.gdim yscaled Y_.gdim enddef; + + +% Draw the frame or the part corresponding to label suffix @# using with list w. +vardef frame@# text w = + Gneedfr_:=false; + picture p_; + p_ = image(draw + if str@#<>"": subpath round(angle laboff@#*Gfra_+Gfrb_) of fi + unitsquare Gxyscale w); + Glab_((whatever,whatever),,draw p_ shifted); +enddef; +pair Gfra_; Gfra_=(1,1)/90; % unitsquare subpath is linear in label angle +pair Gfrb_; Gfrb_=(.75,2.25); + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%% Automatic grid selection %%%%%%%%%%%%%%%%%%%%%%%%%% + +string Glmarks[]; % marking options per decade for logarithmic scales +string Gumarks; % mark spacing options per decade for linear scales +string Gemarks; % exponent spacing options for logarithmic scales +newinternal Gmarks, Gminlog; +Gmarks := 4; % minimum number marks generated by auto.x or auto.y +Gminlog := 3.0; % revert to uniform marks when largest/smallest < this + +def Gfor(text t) = for i=t endfor enddef; % to shorten the mark templates below +Glmarks[1]="1,2,5"; +Glmarks[2]="1,1.5,2,3,4,5,7"; +Glmarks[3]="1Gfor(6upto10:,i/5)Gfor(5upto10:,i/2)Gfor(6upto9:,i)"; +Glmarks[4]="1Gfor(11upto20:,i/10)Gfor(11upto25:,i/5)Gfor(11upto19:,i/2)"; +Glmarks[5]="1Gfor(21upto40:,i/20)Gfor(21upto50:,i/10)Gfor(26upto49:,i/5)"; +Gumarks="10,5,2"; % start with 10 and go down; a final `,1' is appended +Gemarks="20,10,5,2,1"; + + +% Determine the X_ or Y_ bounds on the range to be covered by automatic grid +% marks. Suffix @# is X_ or Y_. The result is log or linear to specify the +% type of grid spacing to use. Bounds are returned in variables local to +% begingraph..endgraph: pairs Gmll_ and Gmhh_ are upper and lower bounds in +% `modified exponential form'. In modified exponential form, (x,y) means +% (x/1000)*10^y, where 1000<=abs x<10000. +vardef Gpick_@# = + interim warningcheck:=0; + save l, h; + Gsetp_; + if @#ctyp>0: (l,h) else: -(h,l) fi = (@#low, @#high); + if abs @#ctyp=log: + Gmll_ := Meform(Mabs l)+Gbias_; + Gmhh_ := Meform(Mabs h)+Gbias_; + if h-l >=mlog Gminlog: log else: linear fi + else: + Gmll_ := Meform(@#sc + Mlog l)+Gbias_; + Gmhh_ := Meform(@#sc + Mlog h)+Gbias_; + linear + fi +enddef; +pair Gbias_; Gbias_=(0,3); +pair Gmll_, Gmhh_; + + +% Scan Glmarks[k] and evaluate tokens t for each m where l<=m<=h. +def Gmsc_(expr k, l, h)(text t) = + for m=scantokens Glmarks[k]: + exitif m>h; + if m>=l: t fi + endfor +enddef; + + +% Scan Gmark[k] and evaluate tokens t for each m and e where m*10^e belongs +% between l and h (inclusive), where both l and h are in modified exponent form. +def Gmscan_(expr k, l, h)(text t) = + for e=ypart l upto ypart h: + Gmsc_(k, if e>ypart l: 1 else: xpart l/1000 fi, + if e= Gmarks; + endfor + k +enddef; + + +% Try to select an exponent spacing from Gemarks. If successful, set @# and +% return true +vardef Gempick_@# = + numeric @#; + for e=scantokens Gemarks: + @# = e; + exitif floor(ypart Gmhh_/e)-floor(Gey_(Gmll_)/e) >= Gmarks; + numeric @#; + endfor + known @# +enddef; + +vardef Gey_(expr p) = ypart p if xpart p=1000: -1 fi enddef; + + +% Compute the mark spacing d between xpart Gmll_ and xpart Gmhh_. +vardef Gipick_ = + interim warningcheck:=0; + save m, n, d; + m = Gmarks; + n = 1 for i=1 upto mlog(xpart Gmhh_-xpart Gmll_)/Mten - mlog m/(Mten-epsilon): + *10 endfor; + if n<=1000: + for x=scantokens Gumarks: + d = n*x; + exitif 0 Gigen_(d,+1)>=m; + numeric d; + endfor + fi + if known d: d else: n fi +enddef; + + +def Gigen_(expr d)(text t) = + for m = d*ceiling(xpart Gmll_/d) step d until xpart Gmhh_: + t + endfor +enddef; + + +% Evaluate tokens t for exponents e in multiples of d in the range determined +% by Gmll_ and Gmhh_. +def Gemgen_(expr d)(text t) = + for e = d*floor(Gey_(Gmll_)/d+1) + step d until d*floor(ypart Gmhh_/d): t + endfor +enddef; + + +% Adjust Gmll_ and Gmhh_ so their exponent parts match and they are in true +% exponent form ((x,y) means x*10^y). Return the new exponent. +vardef Gesame_ = + interim warningcheck := 0; + save e; + e+3 = if Gmll_=Gbias_: ypart Gmhh_ + elseif Gmhh_=Gbias_: ypart Gmll_ + else: max(ypart Gmll_, ypart Gmhh_) fi; + forsuffixes $=Gmll_, Gmhh_: + $ := (xpart $ for i=ypart $ upto e+2: /(10) endfor, e); + endfor + e +enddef; + + +% Assume e is an integer and either m=0 or 1<=abs(m)<10000. Find m*(10^e) +% and represent the result as a string if its absolute value would be at least +% 4096 or less than .1. It is OK to return 0 as a string or a numeric. +vardef Gpack_(expr m, e) = + if (e>3)or(e<-4): + decimal m & "e" & decimal e + elseif e>=0: + if abs m=.1: x else: decimal m & "e" & decimal e fi + fi +enddef; + + +def auto suffix $ = + hide(def Gcma_= hide(def Gcma_=,enddef) enddef) + if Gpick_.Gsuf_($)=log: + if Gempick_.Gme_: Gemgen_(Gme_, Gcma_ Gpack_(1,e)) + else: + Gmscan_(Gkpick_, Gmll_, Gmhh_, Gcma_ Gpack_(m,e)) + fi + else: + hide(Gme_:=Gesame_) + Gigen_(Gipick_, Gcma_ Gpack_(m,Gme_)) + fi +enddef; + + +string Autoform; Autoform = "%g"; + +vardef autogrid(suffix tx, ty) text w = + Gneedgr_:=false; + if str tx<>"": for x=auto.x: tx(Autoform,x) w; endfor fi + if str ty<>"": for y=auto.y: ty(Autoform,y) w; endfor fi +enddef; + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% endgraph %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +def endgraph = + if Gneedgr_: autogrid(otick.bot, otick.lft); fi + if Gneedfr_: frame; fi + setcoords(linear,linear); + interim truecorners:=1; + for b=bbox Gfin_: + setbounds Gfin_ to b; + for i=0 step .5 until 3.5: + if known Ggl_[i]: addto Gfin_ also Ggl_[i] shifted point i of b; fi + endfor + endfor + Gfin_ + endgroup +enddef; diff --git a/Master/texmf-dist/metapost/base/marith.mp b/Master/texmf-dist/metapost/base/marith.mp new file mode 100644 index 00000000000..3e49a700bfa --- /dev/null +++ b/Master/texmf-dist/metapost/base/marith.mp @@ -0,0 +1,156 @@ +% Macros for dealing with very large and very small numbers in `Mlog form'. + +% A number x in Mlog form represents mexp(x) if x is an even multiple of +% epsilon and -mexp(x) if x is an odd multiple of epsilon, where epsilon=1/65536 +% is the basic unit for MetaPost's fixpoint numbers. Such numbers can represent +% values large as 3.8877e+55 or as small as 1.604e-28. (Anything less than that +% is treated as zero.) + +% Mlog_str convert a string like "6.02e23" to Mlog form +% Mexp_str convert from Mlog form to a string like "6.02e23" +% Meform(q) find (x,y) such that q is the Mlog form of x*10^y +% Mlog convert a number to Mlog form +% Mexp convert from Mlog form into ordinary numeric form +% Mabs absolute value +% Mlog_Str convert to Mlog form; unknown results in unknown +% Madd add +% Msub subtract +% Mmul multiply +% Mdiv divide +% Mleq the boolean operator <= +% Mzero constant that represents zero +% Mten constant that represents 10.0 + +% All other externally visible names start with `M' and end with `_'. + + + +warningcheck := 0; % Need warningcheck:=0 anytime these macros are in use + +if unknown Mzero: % If we have not already seen this file + +newinternal Mzero; +Mzero := -16384; % Anything at least this small is treated as zero + + +input string.mp + + + +% Ideal value of mlog(10) is 589.4617838 or 38630967.46/65536. To get an even +% numerator, we round to 38630968/65536 or 589.4617920. +newinternal Mten; +Mten := 589.46179; + +% Convert x*10^y to Mlog form, assuming x is already in Mlog form. +primarydef x M_e_ y = (x+Mten*y) enddef; + +def Mgobble_ text t = enddef; +pair M_iv_; M_iv_=(0,4); + + +% String s is a number in scientific notatation with no leading spaces. +% Convert it to Mlog form. +vardef Mlog_str primary s = + save k, t, e, r; + string t; + if substring(0,1) of s="-": + r=-epsilon; t=substring (1,infinity) of s; + else: + r=0; t=s; + fi + let e = Mgobble_; + if begingroup scantokens substring M_iv_ of t endgroup >= 1000: + k = cspan(t,isdigit); + t := substring M_iv_ of t & "." & substring(4,k) of t & + substring (k if substring(k,k+1) of t=".": +1 fi, infinity) of t; + r := r + (k-4)*Mten; + fi + let e = M_e_; + r + Mlog scantokens t +enddef; + + +% Convert x from Mlog form into a pair whose xpart gives a mantissa and whose +% ypart gives a power of ten. The constant 1768.38985 is slightly more than +% 3Mten as is required to ensure that 3Mten-epsilon<=q+e*Mten<4Mten-epsilon. +% This forces the xpart of the result to be between 1000 and 10000. +vardef Meform(expr q) = + if q<=Mzero: (0,0) + else: + save e; e=floor((q-1768.38985)/Mten); + (Mexp(q-e*Mten), e) + fi +enddef; + +% Perform the inverse of Mlog_str, converting from Mlog form to a string. +vardef Mexp_str primary x = + save p; + pair p; p=Meform(x); + decimal xpart p + if ypart p<>0: & "e" & decimal ypart p fi +enddef; + + +vardef Mabs primary x = x*.5*2 enddef; + +% Convert a number to Mlog form +vardef Mlog primary x = + if x>0: Mabs mlog x + elseif x<0: epsilon + Mabs mlog(-x) + else: Mzero + fi +enddef; + + +% Convert a number from Mlog form +vardef Mexp primary x = + if x=Mabs x: mexp x + else: -mexp x + fi +enddef; + + +primarydef a Mmul b = + if (a<=Mzero) or (b<=Mzero): Mzero + else: (a+b) + fi +enddef; + + +primarydef a Mdiv b = + if a<=Mzero: Mzero + else: (a-b) + fi +enddef; + + +% 256ln(1579)=123556596.0003/65536=1885.3240356445 +secondarydef a Madd b = + if a>=b: (Mlog(1579 + Mexp(b Mmul (1885.32404-a))) + a-1885.32404) + else: b Madd a + fi +enddef; + + +secondarydef a Msub b = a Madd (b-epsilon) enddef; + + +tertiarydef a Mleq b = + (if a=Mabs a: + if b=Mabs b: a<=b else: false fi + elseif b=Mabs b: true else: b<=a fi + ) +enddef; + + + +vardef Mlog_Str primary x = + if unknown x: whatever + elseif string x: Mlog_str x + else: Mlog x + fi +enddef; + + +fi % end the if..fi that encloses this file diff --git a/Master/texmf-dist/metapost/base/mfplain.mp b/Master/texmf-dist/metapost/base/mfplain.mp new file mode 100644 index 00000000000..3ef191f0c34 --- /dev/null +++ b/Master/texmf-dist/metapost/base/mfplain.mp @@ -0,0 +1,579 @@ +% This is the plain MetaPost base that's look like what's described +% in The METAFONTbook. +string base_name, base_version; base_name="mfplain"; base_version="0.62"; + +message "Preloading the plain base, version "&base_version&": preliminaries,"; + +delimiters (); % this makes parentheses behave like parentheses +def upto = step 1 until enddef; % syntactic sugar +def downto = step -1 until enddef; +def exitunless expr c = exitif not c enddef; +let relax = \; % ignore the word `relax', as in TeX +let \\ = \; % double relaxation is like single +def ]] = ] ] enddef; % right brackets should be loners +def -- = {curl 1}..{curl 1} enddef; +def --- = .. tension infinity .. enddef; +def ... = .. tension atleast 1 .. enddef; + +newinternal smoothing, autorounding, turningcheck, granularity; +warningcheck:=1; +tracinglostchars:=1; +smoothing:=1; autorounding:=2; % These are ignored by MetaPost +turningcheck:=1; granularity:=1; + +def gobble primary g = enddef; +primarydef g gobbled gg = enddef; +def hide(text t) = exitif numeric begingroup t;endgroup; enddef; +def ??? = hide(interim showstopping:=1; showdependencies) enddef; +def stop expr s = message s; gobble readstring enddef; + +def interact = % sets up to make "show" commands stop + hide(showstopping:=1; tracingonline:=1) enddef; + +def loggingall = % puts tracing info into the log + tracingcommands:=3; tracingtitles:=1; tracingequations:=1; + tracingcapsules:=1; tracingspecs:=2; tracingchoices:=1; tracinglostchars:=1; + tracingstats:=1; tracingoutput:=1; tracingmacros:=1; tracingrestores:=1; + enddef; + +def tracingall = % turns on every form of tracing + tracingonline:=1; showstopping:=1; loggingall enddef; + +def tracingnone = % turns off every form of tracing + tracingcommands:=0; tracingtitles:=0; tracingequations:=0; + tracingcapsules:=0; tracingspecs:=0; tracingchoices:=0; tracinglostchars:=0; + tracingstats:=0; tracingoutput:=0; tracingmacros:=0; tracingrestores:=0; + enddef; + +message " basic constants and mathematical macros,"; + +% numeric constants +newinternal eps,epsilon,infinity,_; +eps := .00049; % this is a pretty small positive number +epsilon := 1/256/256; % but this is the smallest +infinity := 4095.99998; % and this is the largest +_ := -1; % internal constant to make macros unreadable but shorter + +newinternal mitered, rounded, beveled, butt, squared; +mitered:=0; rounded:=1; beveled:=2; % linejoin types +butt:=0; rounded:=1; squared:=2; % linecap types + + +% pair constants +pair right,left,up,down,origin; +origin=(0,0); up=-down=(0,1); right=-left=(1,0); + +% path constants +path quartercircle,halfcircle,fullcircle,unitsquare; +fullcircle = makepath pencircle; +halfcircle = subpath (0,4) of fullcircle; +quartercircle = subpath (0,2) of fullcircle; +unitsquare=(0,0)--(1,0)--(1,1)--(0,1)--cycle; + +% transform constants +transform identity; +for z=origin,right,up: z transformed identity = z; endfor + +% color constants +color black, white, red, green, blue; +black = (0,0,0); +white = (1,1,1); +red = (1,0,0); +green = (0,1,0); +blue = (0,0,1); + +% picture constants +picture blankpicture,unitpixel; +blankpicture=nullpicture; +unitpixel=nullpicture; addto unitpixel contour unitsquare; + +% string constants +string ditto; ditto = char 34; % ASCII double-quote mark + +% pen constants +def capsule_def(suffix s) primary u = def s = u enddef enddef; +pen pensquare,penrazor,penspeck; +pensquare = makepen(unitsquare shifted -(.5,.5)); +penrazor = makepen((-.5,0)--(.5,0)--cycle); +penspeck=pensquare scaled eps; + +% nullary operators +vardef whatever = save ?; ? enddef; + +% unary operators +let abs = length; + +vardef round primary u = u enddef; +vardef hround primary x = x enddef; +vardef vround primary y = y enddef; + +vardef ceiling primary x = -floor(-x) enddef; + +vardef byte primary s = + if string s: ASCII fi s enddef; + +vardef dir primary d = right rotated d enddef; + +vardef unitvector primary z = z/abs z enddef; + +vardef inverse primary T = + transform T_; T_ transformed T = identity; T_ enddef; + +vardef counterclockwise primary c = + if turningnumber c <= 0: reverse fi c enddef; + +vardef tensepath expr r = + for k=0 upto length r - 1: point k of r --- endfor + if cycle r: cycle else: point infinity of r fi enddef; + +% binary operators + +primarydef x mod y = (x-y*floor(x/y)) enddef; +primarydef x div y = floor(x/y) enddef; +primarydef w dotprod z = (xpart w * xpart z + ypart w * ypart z) enddef; + +primarydef x**y = if y=2: x*x else: takepower y of x fi enddef; +def takepower expr y of x = + if x>0: mexp(y*mlog x) + elseif (x=0) and (y>0): 0 + else: 1 + if y=floor y: + if y>=0: for n=1 upto y: *x endfor + else: for n=_ downto y: /x endfor + fi + else: hide(errmessage "Undefined power: " & decimal x&"**"&decimal y) + fi fi enddef; + +vardef direction expr t of p = + postcontrol t of p - precontrol t of p enddef; + +vardef directionpoint expr z of p = + a_:=directiontime z of p; + if a_<0: errmessage("The direction doesn't occur"); fi + point a_ of p enddef; + +secondarydef p intersectionpoint q = + begingroup save x_,y_; (x_,y_)=p intersectiontimes q; + if x_<0: errmessage("The paths don't intersect"); origin + else: .5[point x_ of p, point y_ of q] fi endgroup +enddef; + +tertiarydef p softjoin q = + begingroup c_:=fullcircle scaled 2join_radius shifted point 0 of q; + a_:=ypart(c_ intersectiontimes p); b_:=ypart(c_ intersectiontimes q); + if a_<0:point 0 of p{direction 0 of p} else: subpath(0,a_) of p fi + ... if b_<0:{direction infinity of q}point infinity of q + else: subpath(b_,infinity) of q fi endgroup enddef; +newinternal join_radius,a_,b_; path c_; + +% special operators +vardef incr suffix $ = $:=$+1; $ enddef; +vardef decr suffix $ = $:=$-1; $ enddef; + +def reflectedabout(expr w,z) = % reflects about the line w..z + transformed + begingroup transform T_; + w transformed T_ = w; z transformed T_ = z; + xxpart T_ = -yypart T_; xypart T_ = yxpart T_; % T_ is a reflection + T_ endgroup enddef; + +def rotatedaround(expr z, d) = % rotates d degrees around z + shifted -z rotated d shifted z enddef; +let rotatedabout = rotatedaround; % for roundabout people + +vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings + save u_; setu_ u; for uu = t: if uuu_: u_:=uu; fi endfor + u_ enddef; + +def setu_ primary u = + if pair u: pair u_ elseif string u: string u_ fi; + u_=u enddef; + +def flex(text t) = % t is a list of pairs + hide(n_:=0; for z=t: z_[incr n_]:=z; endfor + dz_:=z_[n_]-z_1) + z_1 for k=2 upto n_-1: ...z_[k]{dz_} endfor ...z_[n_] enddef; +newinternal n_; pair z_[],dz_; + +def superellipse(expr r,t,l,b,s)= + r{up}...(s[xpart t,xpart r],s[ypart r,ypart t]){t-r}... + t{left}...(s[xpart t,xpart l],s[ypart l,ypart t]){l-t}... + l{down}...(s[xpart b,xpart l],s[ypart l,ypart b]){b-l}... + b{right}...(s[xpart b,xpart r],s[ypart r,ypart b]){r-b}...cycle enddef; + +vardef interpath(expr a,p,q) = + for t=0 upto length p-1: a[point t of p, point t of q] + ..controls a[postcontrol t of p, postcontrol t of q] + and a[precontrol t+1 of p, precontrol t+1 of q] .. endfor + if cycle p: cycle + else: a[point infinity of p, point infinity of q] fi enddef; + +vardef solve@#(expr true_x,false_x)= % @#(true_x)=true, @#(false_x)=false + tx_:=true_x; fx_:=false_x; + forever: x_:=.5[tx_,fx_]; exitif abs(tx_-fx_)<=tolerance; + if @#(x_): tx_ else: fx_ fi :=x_; endfor + x_ enddef; % now x_ is near where @# changes from true to false +newinternal tolerance, tx_,fx_,x_; tolerance:=.1; + +message " macros for converting units,"; + +newinternal bpppix_, bp_per_pixel; % drawing is done in `pixel' units +bpppix_:=0.02; + +mm*bpppix_=2.83464; pt*bpppix_=0.99626; +dd*bpppix_=1.06601; bp*bpppix_=1; +cm*bpppix_=28.34645; pc*bpppix_=11.95517; +cc*bpppix_=12.79213; in*bpppix_=72; + +mm#=2.84528; pt#=1; dd#=1.07001; bp#=1.00375; +cm#=28.45276; pc#=12; cc#=12.84010; in#=72.27; + +newinternal hppp, vppp; +hppp:=pt; vppp:=pt; + +newinternal blacker, o_correction; % device-oriented corrections + +def define_pixels(text t) = + forsuffixes $=t: $:=$.#*pt; endfor enddef; +def define_blacker_pixels(text t) = + forsuffixes $=t: $:=$.#*pt+blacker; endfor enddef; +def define_corrected_pixels(text t) = + forsuffixes $=t: $:=$.#*pt*o_correction; endfor enddef; + +def define_whole_pixels = define_pixels enddef; +def define_whole_vertical_pixels = define_pixels enddef; +def define_good_x_pixels = define_pixels enddef; +def define_good_y_pixels = define_pixels enddef; +def define_whole_blacker_pixels = define_blacker_pixels enddef; +def define_whole_vertical_blacker_pixels = define_blacker_pixels enddef; +def define_horizontal_corrected_pixels = define_corrected_pixels enddef; + +def lowres_fix(text t) expr ratio = enddef; + +message " macros and tables for various modes of operation,"; + +transform currenttransform; +def t_ = transformed currenttransform enddef; +let o_=\; let _o_=\; + +def mode_setup = + if unknown mode: mode=proof; fi + numeric aspect_ratio; transform currenttransform; + scantokens if string mode:("input "&mode) else: mode_name[mode] fi; + if unknown mag: mag=1; fi + if unknown aspect_ratio: aspect_ratio=1; fi + bp_per_pixel:=bpppix_*mag; + scantokens extra_setup; % the user's special last-minute adjustments + if unknown currenttransform: currenttransform=identity; fi + clearit; + pickup pencircle scaled (.4pt+blacker); + enddef; +def smode = string mode; mode enddef; +string extra_setup, mode_name[]; +extra_setup=""; % usually there's nothing special to do + +vardef magstep primary m = mexp(46.67432m) enddef; + +def mode_def suffix $ = + $:=incr number_of_modes; + mode_name[$]:=str$ & "_"; + expandafter quote def scantokens mode_name[$] enddef; +newinternal number_of_modes; + + +newinternal proofing; % <0 to supress output; >1 to do labels +color proofcolor; % color for output when proofing>0 +proofcolor =.3[white,black]; +color background; +background = white; + +% proof mode: for initial design of characters +mode_def proof = + proofing:=2; % yes, we're making full proofs + fontmaking:=0; % no, we're not making a font + tracingtitles:=1; % yes, show titles online + blacker:=0; % no additional blackness + o_correction:=1; % no reduction in overshoot + if unknown mag: mag=36; else: mag:=36mag; fi + enddef; + +% smoke mode: for label-free proofs to mount on the wall +mode_def smoke = + proof_; % same as proof mode, except: + proofing:=1; % yes, we're making unlabeled proofs + proofcolor:=black; % with solid black pixels + let makebox=maketicks; % make the boxes less obtrusive + if unknown mag: mag=36; else: mag:=36mag; fi + enddef; + +% lowres mode: for certain devices that print 200 pixels per inch +mode_def lowres = + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles at all + blacker:=0; % no extra blackness with PostScript + o_correction:=1; % no reduction in overshoot + enddef; + +localfont:=lowres; % the mode most commonly used to make fonts + +% It is not likely that additional modes are needed, but if they are, +% additional mode_def commands should be in another input file that +% gets loaded after the PLAIN base. The auxiliary file should set +% base_version:=base_version&"/localname". + + +message " macros for drawing and filling,"; + +def pc_ = + hide(if proofing>0: def pc_=do_pc_ enddef; else: def pc_= enddef; fi) pc_ +enddef; +def do_pc_ = withcolor proofcolor enddef; + +linejoin:=rounded; % parameters that effect drawing +linecap:=rounded; +miterlimit:=10; + +pen currentpen; +picture currentpicture; + +def fill expr c = addto currentpicture contour c t_ pc_ enddef; +def draw expr p = + addto currentpicture + if picture p: + also p + else: + doublepath p t_ withpen currentpen + fi + pc_ +enddef; +def filldraw expr c = + addto currentpicture contour c t_ withpen currentpen + pc_ enddef; +def drawdot expr z = + addto currentpicture contour makepath currentpen shifted z + t_ pc_ enddef; + +def unfill expr c = fill c withcolor background enddef; +def undraw expr p = draw p withcolor background enddef; +def unfilldraw expr c = filldraw c withcolor background enddef; +def undrawdot expr z = drawdot z withcolor background enddef; +def erase text t = + def _e_ = withcolor background hide(def _e_=enddef;) enddef; + t _e_ +enddef; +def _e_= enddef; + +def cutdraw text t = + begingroup interim linecap:=butt; draw t _e_; endgroup enddef; + +def pickup secondary q = + if numeric q: numeric_pickup_ else: pen_pickup_ fi q enddef; +def numeric_pickup_ primary q = + if unknown pen_[q]: errmessage "Unknown pen"; clearpen + else: currentpen:=pen_[q]; + pen_lft:=pen_lft_[q]; + pen_rt:=pen_rt_[q]; + pen_top:=pen_top_[q]; + pen_bot:=pen_bot_[q]; + currentpen_path:=pen_path_[q] fi; enddef; +def pen_pickup_ primary q = + currentpen:=q; + pen_lft:=xpart penoffset down of currentpen; + pen_rt:=xpart penoffset up of currentpen; + pen_top:=ypart penoffset left of currentpen; + pen_bot:=ypart penoffset right of currentpen; + path currentpen_path; enddef; +newinternal pen_lft,pen_rt,pen_top,pen_bot,pen_count_; + +vardef savepen = pen_[incr pen_count_]=currentpen; + pen_lft_[pen_count_]=pen_lft; + pen_rt_[pen_count_]=pen_rt; + pen_top_[pen_count_]=pen_top; + pen_bot_[pen_count_]=pen_bot; + pen_path_[pen_count_]=currentpen_path; + pen_count_ enddef; + +def clearpen = currentpen:=nullpen; + pen_lft:=pen_rt:=pen_top:=pen_bot:=0; + path currentpen_path; + enddef; +def clear_pen_memory = + pen_count_:=0; + numeric pen_lft_[],pen_rt_[],pen_top_[],pen_bot_[]; + pen currentpen,pen_[]; + path currentpen_path, pen_path_[]; + enddef; + +vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef; +vardef rt primary x = x + if pair x: (pen_rt,0) else: pen_rt fi enddef; +vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef; +vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef; +vardef good.x primary x = x enddef; +vardef good.y primary y = y enddef; +vardef good.lft primary z = z enddef; +vardef good.rt primary z = z enddef; +vardef good.top primary z = z enddef; +vardef good.bot primary z = z enddef; + +vardef penpos@#(expr b,d) = + (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d; + x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef; + +def penstroke text t = + forsuffixes e = l,r: path_.e:=t; endfor + fill path_.l -- reverse path_.r -- cycle enddef; +path path_.l,path_.r; + +message " macros for proof labels and rules,"; + +string defaultfont; +newinternal defaultscale, labeloffset; +defaultfont = "cmr10"; +defaultscale := 1; +labeloffset := 3; + +vardef makelabel@#(expr s,z) = % puts string s near point z + picture p; + if known z: + p = s infont defaultfont scaled (defaultscale/bp_per_pixel); + draw p shifted (z t_ + labeloffset/bp_per_pixel*laboff@# - + (labxf@#*lrcorner p + labyf@#*ulcorner p + + (1-labxf@#-labyf@#)*llcorner p + ) + ) withcolor black; + interim linecap:=rounded; + draw z withpen pencircle scaled (3/bp_per_pixel) withcolor black; + fi +enddef; + +string lcode_; % just in case someone refers to this +pair laboff, laboff.lft, laboff.rt, laboff.top, laboff.bot; +laboff.lft=(-1,0); labxf.lft=1; labyf.lft=.5; +laboff.rt =(1,0); labxf.rt =0; labyf.rt =.5; +laboff.bot=(0,-1); labxf.bot=.5; labyf.bot=1; +laboff.top=(0,1); labxf.top=.5; labyf.top=0; +laboff=laboff.top; labxf=labxf.top; labyf=labyf.top; +% There could be fancy code to keep labels from overlapping! + +vardef labels@#(text t) = + if proofing>1: forsuffixes $=t: + makelabel@#(str$,z$); endfor + fi enddef; +vardef penlabels@#(text t) = + if proofing>1: forsuffixes $$=l,,r: forsuffixes $=t: + makelabel@#(str$.$$,z$.$$); endfor endfor + fi enddef; + +def range expr x = numtok[x] enddef; +def numtok suffix x=x enddef; +tertiarydef m thru n = + m for x=m+1 step 1 until n: , numtok[x] endfor enddef; + +def proofrule(expr w,z) = + begingroup interim linecap:=squared; + draw w..z withpen pencircle scaled (.4/bp_per_pixel) withcolor black; + endgroup +enddef; +def screenrule(expr w,z) = enddef; +pen rulepen; + +def makegrid(text xlist,ylist) = + xmin_ := min(xlist); xmax_ := max(xlist); + ymin_ := min(ylist); ymax_ := max(ylist); + for x=xlist: proofrule((x,ymin_), (x,ymax_)); endfor + for y=ylist: proofrule((xmin_,y), (xmax_,y)); endfor + enddef; + +vardef titlefont suffix $ = enddef; +vardef labelfont suffix $ = defaultfont:=str$ enddef; +vardef grayfont suffix $ = enddef; +vardef slantfont suffix $ = enddef; +def proofoffset primary z = enddef; +vardef proofrulethickness expr x = + rulepen := pencircle scaled x enddef; + +message " macros for character and font administration,"; + +def beginchar(expr c,w_sharp,h_sharp,d_sharp) = + begingroup + charcode:=if known c: byte c else: 0 fi; + charwd:=w_sharp; charht:=h_sharp; chardp:=d_sharp; + w:=charwd*pt; h:=charht*pt; d:=chardp*pt; + charic:=0; clearxy; clearit; clearpen; scantokens extra_beginchar; + enddef; + +def italcorr expr x_sharp = if x_sharp>0: charic:=x_sharp fi enddef; + +def change_width = enddef; + +def endchar = + scantokens extra_endchar; + if proofing>0: makebox(proofrule); fi + chardx:=w; % desired width of the character in pixels + shipit; + endgroup enddef; + +string extra_beginchar, extra_endchar; +extra_beginchar=extra_endchar=""; + +def makebox(text r) = + for y=0,h,-d: r((0,y),(w,y)); endfor % horizontals + for x=0,w: r((x,-d),(x,h)); endfor % verticals + if charic<>0: r((w+charic*pt,h),(w+charic*pt,.5h)); fi + enddef; + +def maketicks(text r) = + for y=0,h,-d: r((0,y),(10,y)); r((w-10,y),(w,y)); endfor + for x=0,w: r((x,10-d),(x,-d)); r((x,h-10),(x,h)); endfor + if charic<>0: r((w+charic*pt,h-10),(w+charic*pt,h)); fi + enddef; + +def font_size expr x = designsize:=x enddef; +def font_slant expr x = fontdimen 1: x enddef; +def font_normal_space expr x = fontdimen 2: x enddef; +def font_normal_stretch expr x = fontdimen 3: x enddef; +def font_normal_shrink expr x = fontdimen 4: x enddef; +def font_x_height expr x = fontdimen 5: x enddef; +def font_quad expr x = fontdimen 6: x enddef; +def font_extra_space expr x = fontdimen 7: x enddef; + +def font_identifier expr x = font_identifier_:=x enddef; +def font_coding_scheme expr x = font_coding_scheme_:=x enddef; +string font_identifier_, font_coding_scheme_; +font_identifier_=font_coding_scheme_="UNSPECIFIED"; + +message "and a few last-minute items."; + +vardef z@#=(x@#,y@#) enddef; + +def openit = enddef; +def showit = enddef; + +def clearxy = save x,y enddef; +def clearit = currentpicture:=nullpicture enddef; +def shipit = + if proofing>=0: + shipout currentpicture transformed + (identity shifted (xoffset,yoffset) scaled bp_per_pixel) + fi +enddef; +def cullit = enddef; +newinternal xoffset, yoffset; + +def screenchars = enddef; +def screenstrokes = enddef; +def imagerules = enddef; +def gfcorners = enddef; +def nodisplays = enddef; +def notransforms = let t_ = \ enddef; + +let bye = end; outer end,bye; + +clear_pen_memory; % initialize the `savepen' mechanism +mode_setup; % establish proof mode as the default +numeric mode,mag; % but leave mode and mag undefined diff --git a/Master/texmf-dist/metapost/base/mpost.mp b/Master/texmf-dist/metapost/base/mpost.mp new file mode 100644 index 00000000000..949e5bd0540 --- /dev/null +++ b/Master/texmf-dist/metapost/base/mpost.mp @@ -0,0 +1,2 @@ +\input plain +\dump diff --git a/Master/texmf-dist/metapost/base/plain.mp b/Master/texmf-dist/metapost/base/plain.mp new file mode 100644 index 00000000000..bc0db8a57c1 --- /dev/null +++ b/Master/texmf-dist/metapost/base/plain.mp @@ -0,0 +1,552 @@ +% This file gives the macros for plain MetaPost +% It contains all the features of plain METAFONT except those specific to +% font-making. (See The METAFONTbook by D.E. Knuth). +% There are also a number of macros for labeling figures, etc. +string base_name, base_version; base_name="plain"; base_version="0.64"; + +message "Preloading the plain mem file, version "&base_version; + +delimiters (); % this makes parentheses behave like parentheses +def upto = step 1 until enddef; % syntactic sugar +def downto = step -1 until enddef; +def exitunless expr c = exitif not c enddef; +let relax = \; % ignore the word `relax', as in TeX +let \\ = \; % double relaxation is like single +def ]] = ] ] enddef; % right brackets should be loners +def -- = {curl 1}..{curl 1} enddef; +def --- = .. tension infinity .. enddef; +def ... = .. tension atleast 1 .. enddef; + +def gobble primary g = enddef; +primarydef g gobbled gg = enddef; +def hide(text t) = exitif numeric begingroup t;endgroup; enddef; +def ??? = hide(interim showstopping:=1; showdependencies) enddef; +def stop expr s = message s; gobble readstring enddef; + +warningcheck:=1; +tracinglostchars:=1; + +def interact = % sets up to make "show" commands stop + hide(showstopping:=1; tracingonline:=1) enddef; + +def loggingall = % puts tracing info into the log + tracingcommands:=3; tracingtitles:=1; tracingequations:=1; + tracingcapsules:=1; tracingspecs:=2; tracingchoices:=1; tracinglostchars:=1; + tracingstats:=1; tracingoutput:=1; tracingmacros:=1; tracingrestores:=1; + enddef; + +def tracingall = % turns on every form of tracing + tracingonline:=1; showstopping:=1; loggingall enddef; + +def tracingnone = % turns off every form of tracing + tracingcommands:=0; tracingtitles:=0; tracingequations:=0; + tracingcapsules:=0; tracingspecs:=0; tracingchoices:=0; tracinglostchars:=0; + tracingstats:=0; tracingoutput:=0; tracingmacros:=0; tracingrestores:=0; + enddef; + + + +%% dash patterns + +vardef dashpattern(text t) = + save on, off, w; + let on=_on_; + let off=_off_; + w = 0; + nullpicture t +enddef; + +tertiarydef p _on_ d = + begingroup save pic; + picture pic; pic=p; + addto pic doublepath (w,w)..(w+d,w); + w := w+d; + pic shifted (0,d) + endgroup +enddef; + +tertiarydef p _off_ d = + begingroup w:=w+d; + p shifted (0,d) + endgroup +enddef; + + + +%% basic constants and mathematical macros + +% numeric constants +newinternal eps,epsilon,infinity,_; +eps := .00049; % this is a pretty small positive number +epsilon := 1/256/256; % but this is the smallest +infinity := 4095.99998; % and this is the largest +_ := -1; % internal constant to make macros unreadable but shorter + +newinternal mitered, rounded, beveled, butt, squared; +mitered:=0; rounded:=1; beveled:=2; % linejoin types +butt:=0; rounded:=1; squared:=2; % linecap types + + +% pair constants +pair right,left,up,down,origin; +origin=(0,0); up=-down=(0,1); right=-left=(1,0); + +% path constants +path quartercircle,halfcircle,fullcircle,unitsquare; +fullcircle = makepath pencircle; +halfcircle = subpath (0,4) of fullcircle; +quartercircle = subpath (0,2) of fullcircle; +unitsquare=(0,0)--(1,0)--(1,1)--(0,1)--cycle; + +% transform constants +transform identity; +for z=origin,right,up: z transformed identity = z; endfor + +% color constants +color black, white, red, green, blue, background; +black = (0,0,0); +white = (1,1,1); +red = (1,0,0); +green = (0,1,0); +blue = (0,0,1); +background = white; % The user can reset this + +% picture constants +picture blankpicture,evenly,withdots; +blankpicture=nullpicture; % `display blankpicture...' +evenly=dashpattern(on 3 off 3); % `dashed evenly' +withdots=dashpattern(off 2.5 on 0 off 2.5); % `dashed withdots' + +% string constants +string ditto, EOF; +ditto = char 34; % ASCII double-quote mark +EOF = char 0; % end-of-file for readfrom and write..to + +% pen constants +pen pensquare,penrazor,penspeck; +pensquare = makepen(unitsquare shifted -(.5,.5)); +penrazor = makepen((-.5,0)--(.5,0)--cycle); +penspeck=pensquare scaled eps; + +% nullary operators +vardef whatever = save ?; ? enddef; + +% unary operators +let abs = length; + +vardef round primary u = + if numeric u: floor(u+.5) + elseif pair u: (round xpart u, round ypart u) + else: u fi enddef; + +vardef ceiling primary x = -floor(-x) enddef; + +vardef byte primary s = + if string s: ASCII fi s enddef; + +vardef dir primary d = right rotated d enddef; + +vardef unitvector primary z = z/abs z enddef; + +vardef inverse primary T = + transform T_; T_ transformed T = identity; T_ enddef; + +vardef counterclockwise primary c = + if turningnumber c <= 0: reverse fi c enddef; + +vardef tensepath expr r = + for k=0 upto length r - 1: point k of r --- endfor + if cycle r: cycle else: point infinity of r fi enddef; + +vardef center primary p = .5[llcorner p, urcorner p] enddef; + + + +% binary operators + +primarydef x mod y = (x-y*floor(x/y)) enddef; +primarydef x div y = floor(x/y) enddef; +primarydef w dotprod z = (xpart w * xpart z + ypart w * ypart z) enddef; + +primarydef x**y = if y=2: x*x else: takepower y of x fi enddef; +def takepower expr y of x = + if x>0: mexp(y*mlog x) + elseif (x=0) and (y>0): 0 + else: 1 + if y=floor y: + if y>=0: for n=1 upto y: *x endfor + else: for n=_ downto y: /x endfor + fi + else: hide(errmessage "Undefined power: " & decimal x&"**"&decimal y) + fi fi enddef; + +vardef direction expr t of p = + postcontrol t of p - precontrol t of p enddef; + +vardef directionpoint expr z of p = + a_:=directiontime z of p; + if a_<0: errmessage("The direction doesn't occur"); fi + point a_ of p enddef; + +secondarydef p intersectionpoint q = + begingroup save x_,y_; (x_,y_)=p intersectiontimes q; + if x_<0: errmessage("The paths don't intersect"); origin + else: .5[point x_ of p, point y_ of q] fi endgroup +enddef; + +tertiarydef p softjoin q = + begingroup c_:=fullcircle scaled 2join_radius shifted point 0 of q; + a_:=ypart(c_ intersectiontimes p); b_:=ypart(c_ intersectiontimes q); + if a_<0:point 0 of p{direction 0 of p} else: subpath(0,a_) of p fi + ... if b_<0:{direction infinity of q}point infinity of q + else: subpath(b_,infinity) of q fi endgroup enddef; +newinternal join_radius,a_,b_; path c_; + + +path cuttings; % what got cut off + +tertiarydef a cutbefore b = % tries to cut as little as possible + begingroup save t; + (t, whatever) = a intersectiontimes b; + if t<0: + cuttings:=point 0 of a; + a + else: cuttings:= subpath (0,t) of a; + subpath (t,length a) of a + fi + endgroup +enddef; + +tertiarydef a cutafter b = + reverse (reverse a cutbefore b) + hide(cuttings:=reverse cuttings) +enddef; + + + +% special operators +vardef incr suffix $ = $:=$+1; $ enddef; +vardef decr suffix $ = $:=$-1; $ enddef; + +def reflectedabout(expr w,z) = % reflects about the line w..z + transformed + begingroup transform T_; + w transformed T_ = w; z transformed T_ = z; + xxpart T_ = -yypart T_; xypart T_ = yxpart T_; % T_ is a reflection + T_ endgroup enddef; + +def rotatedaround(expr z, d) = % rotates d degrees around z + shifted -z rotated d shifted z enddef; +let rotatedabout = rotatedaround; % for roundabout people + +vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings + save u_; setu_ u; for uu = t: if uuu_: u_:=uu; fi endfor + u_ enddef; + +def setu_ primary u = + if pair u: pair u_ elseif string u: string u_ fi; + u_=u enddef; + +def flex(text t) = % t is a list of pairs + hide(n_:=0; for z=t: z_[incr n_]:=z; endfor + dz_:=z_[n_]-z_1) + z_1 for k=2 upto n_-1: ...z_[k]{dz_} endfor ...z_[n_] enddef; +newinternal n_; pair z_[],dz_; + +def superellipse(expr r,t,l,b,s)= + r{up}...(s[xpart t,xpart r],s[ypart r,ypart t]){t-r}... + t{left}...(s[xpart t,xpart l],s[ypart l,ypart t]){l-t}... + l{down}...(s[xpart b,xpart l],s[ypart l,ypart b]){b-l}... + b{right}...(s[xpart b,xpart r],s[ypart r,ypart b]){r-b}...cycle enddef; + +vardef interpath(expr a,p,q) = + for t=0 upto length p-1: a[point t of p, point t of q] + ..controls a[postcontrol t of p, postcontrol t of q] + and a[precontrol t+1 of p, precontrol t+1 of q] .. endfor + if cycle p: cycle + else: a[point infinity of p, point infinity of q] fi enddef; + +vardef solve@#(expr true_x,false_x)= % @#(true_x)=true, @#(false_x)=false + tx_:=true_x; fx_:=false_x; + forever: x_:=.5[tx_,fx_]; exitif abs(tx_-fx_)<=tolerance; + if @#(x_): tx_ else: fx_ fi :=x_; endfor + x_ enddef; % now x_ is near where @# changes from true to false +newinternal tolerance, tx_,fx_,x_; tolerance:=.01; + +vardef buildcycle(text ll) = + save ta_, tb_, k_, i_, pp_; path pp_[]; + k_=0; + for q=ll: pp_[incr k_]=q; endfor + i_=k_; + for i=1 upto k_: + (ta_[i], length pp_[i_]-tb_[i_]) = + pp_[i] intersectiontimes reverse pp_[i_]; + if ta_[i]<0: + errmessage("Paths "& decimal i &" and "& decimal i_ &" don't intersect"); + fi + i_ := i; + endfor + for i=1 upto k_: subpath (ta_[i],tb_[i]) of pp_[i] .. endfor + cycle +enddef; + + + +%% units of measure + +mm=2.83464; pt=0.99626; dd=1.06601; bp:=1; +cm=28.34645; pc=11.95517; cc=12.79213; in:=72; + +vardef magstep primary m = mexp(46.67432m) enddef; + + + +%% macros for drawing and filling + +def drawoptions(text t) = + def _op_ = t enddef +enddef; + +linejoin:=rounded; % parameters that effect drawing +linecap:=rounded; +miterlimit:=10; + +drawoptions(); + +pen currentpen; +picture currentpicture; + +def fill expr c = addto currentpicture contour c _op_ enddef; +def draw expr p = + addto currentpicture + if picture p: + also p + else: + doublepath p withpen currentpen + fi + _op_ +enddef; +def filldraw expr c = + addto currentpicture contour c withpen currentpen + _op_ enddef; +def drawdot expr z = + addto currentpicture contour makepath currentpen shifted z + _op_ enddef; + +def unfill expr c = fill c withcolor background enddef; +def undraw expr p = draw p withcolor background enddef; +def unfilldraw expr c = filldraw c withcolor background enddef; +def undrawdot expr z = drawdot z withcolor background enddef; +def erase text t = + def _e_ = withcolor background hide(def _e_=enddef;) enddef; + t _e_ +enddef; +def _e_= enddef; + +def cutdraw text t = + begingroup interim linecap:=butt; draw t _e_; endgroup enddef; + +vardef image(text t) = + save currentpicture; + picture currentpicture; + currentpicture := nullpicture; + t; + currentpicture +enddef; + +def pickup secondary q = + if numeric q: numeric_pickup_ else: pen_pickup_ fi q enddef; +def numeric_pickup_ primary q = + if unknown pen_[q]: errmessage "Unknown pen"; clearpen + else: currentpen:=pen_[q]; + pen_lft:=pen_lft_[q]; + pen_rt:=pen_rt_[q]; + pen_top:=pen_top_[q]; + pen_bot:=pen_bot_[q]; + currentpen_path:=pen_path_[q] fi; enddef; +def pen_pickup_ primary q = + currentpen:=q; + pen_lft:=xpart penoffset down of currentpen; + pen_rt:=xpart penoffset up of currentpen; + pen_top:=ypart penoffset left of currentpen; + pen_bot:=ypart penoffset right of currentpen; + path currentpen_path; enddef; +newinternal pen_lft,pen_rt,pen_top,pen_bot,pen_count_; + +vardef savepen = pen_[incr pen_count_]=currentpen; + pen_lft_[pen_count_]=pen_lft; + pen_rt_[pen_count_]=pen_rt; + pen_top_[pen_count_]=pen_top; + pen_bot_[pen_count_]=pen_bot; + pen_path_[pen_count_]=currentpen_path; + pen_count_ enddef; + +def clearpen = currentpen:=nullpen; + pen_lft:=pen_rt:=pen_top:=pen_bot:=0; + path currentpen_path; + enddef; +def clear_pen_memory = + pen_count_:=0; + numeric pen_lft_[],pen_rt_[],pen_top_[],pen_bot_[]; + pen currentpen,pen_[]; + path currentpen_path, pen_path_[]; + enddef; + +vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef; +vardef rt primary x = x + if pair x: (pen_rt,0) else: pen_rt fi enddef; +vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef; +vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef; + +vardef penpos@#(expr b,d) = + (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d; + x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef; + +def penstroke text t = + forsuffixes e = l,r: path_.e:=t; endfor + fill path_.l -- reverse path_.r -- cycle enddef; +path path_.l,path_.r; + + + +%% High level drawing commands + +newinternal ahlength, ahangle; +ahlength := 4; % default arrowhead length 4bp +ahangle := 45; % default head angle 45 degrees + +vardef arrowhead expr p = + save q,e; path q; pair e; + e = point length p of p; + q = gobble(p shifted -e cutafter makepath(pencircle scaled 2ahlength)) + cuttings; + (q rotated .5ahangle & reverse q rotated -.5ahangle -- cycle) shifted e +enddef; + +path _apth; +def drawarrow expr p = _apth:=p; _finarr enddef; +def drawdblarrow expr p = _apth:=p; _findarr enddef; + +def _finarr text t = + draw _apth t; + filldraw arrowhead _apth t +enddef; + +def _findarr text t = + draw _apth t; + filldraw arrowhead _apth withpen currentpen t; + filldraw arrowhead reverse _apth withpen currentpen t +enddef; + + + +%% macros for labels + +newinternal bboxmargin; bboxmargin:=2bp; + +vardef bbox primary p = + llcorner p-(bboxmargin,bboxmargin) -- lrcorner p+(bboxmargin,-bboxmargin) + -- urcorner p+(bboxmargin,bboxmargin) -- ulcorner p+(-bboxmargin,bboxmargin) + -- cycle +enddef; + +string defaultfont; +newinternal defaultscale, labeloffset; +defaultfont = "cmr10"; +defaultscale := 1; +labeloffset := 3bp; + +vardef thelabel@#(expr s,z) = % Position s near z + save p; picture p; + if picture s: p=s + else: p = s infont defaultfont scaled defaultscale + fi; + p shifted (z + labeloffset*laboff@# - + (labxf@#*lrcorner p + labyf@#*ulcorner p + + (1-labxf@#-labyf@#)*llcorner p + ) + ) +enddef; + +def label = draw thelabel enddef; +newinternal dotlabeldiam; dotlabeldiam:=3bp; +vardef dotlabel@#(expr s,z) = + label@#(s,z); + interim linecap:=rounded; + draw z withpen pencircle scaled dotlabeldiam; +enddef; +def makelabel = dotlabel enddef; + +pair laboff, laboff.lft, laboff.rt, laboff.top, laboff.bot; +pair laboff.ulft, laboff.llft, laboff.urt, laboff.lrt; +laboff =(0,0); labxf =.5; labyf =.5; +laboff.lft=(-1,0); labxf.lft=1; labyf.lft=.5; +laboff.rt =(1,0); labxf.rt =0; labyf.rt =.5; +laboff.bot=(0,-1); labxf.bot=.5; labyf.bot=1; +laboff.top=(0,1); labxf.top=.5; labyf.top=0; +laboff.ulft=(-.7,.7);labxf.ulft=1; labyf.ulft=0; +laboff.urt=(.7,.7); labxf.urt=0; labyf.urt=0; +laboff.llft=-(.7,.7);labxf.llft=1; labyf.llft=1; +laboff.lrt=(.7,-.7); labxf.lrt=0; labyf.lrt=1; + +vardef labels@#(text t) = + forsuffixes $=t: + label@#(str$,z$); endfor + enddef; +vardef dotlabels@#(text t) = + forsuffixes $=t: + dotlabel@#(str$,z$); endfor + enddef; +vardef penlabels@#(text t) = + forsuffixes $$=l,,r: forsuffixes $=t: + makelabel@#(str$.$$,z$.$$); endfor endfor + enddef; + + +def range expr x = numtok[x] enddef; +def numtok suffix x=x enddef; +tertiarydef m thru n = + m for x=m+1 step 1 until n: , numtok[x] endfor enddef; + + + +%% Overall adminstration + +string extra_beginfig, extra_endfig; +extra_beginfig = extra_endfig = ""; + +def beginfig(expr c) = + begingroup + charcode:=c; + clearxy; clearit; clearpen; + pickup defaultpen; + drawoptions(); + scantokens extra_beginfig; +enddef; + +def endfig = + scantokens extra_endfig; + shipit; + endgroup +enddef; + + +%% last-minute items + +vardef z@#=(x@#,y@#) enddef; + +def clearxy = save x,y enddef; +def clearit = currentpicture:=nullpicture enddef; +def shipit = shipout currentpicture enddef; + +let bye = end; outer end,bye; + +clear_pen_memory; % initialize the `savepen' mechanism +clearit; + +newinternal defaultpen; +pickup pencircle scaled .5bp; % set default line width +defaultpen := savepen; diff --git a/Master/texmf-dist/metapost/base/rboxes.mp b/Master/texmf-dist/metapost/base/rboxes.mp new file mode 100644 index 00000000000..b083ba30579 --- /dev/null +++ b/Master/texmf-dist/metapost/base/rboxes.mp @@ -0,0 +1,38 @@ +% This macro package is exactly like boxes.mp except that it defines +% an additional macro rboxit() that produces +% rectangular boxes with rounded corners. + +\input boxes + + + + +% Rectangular boxes with rounded corners + +newinternal rbox_radius; +rbox_radius := 8bp; + +vardef rboxit@#(text tt) = + beginbox_("rboxpath_","sizebox_",@#,tt); + generic_declare(pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w; + 0 = xpart (@#nw-@#sw) = ypart(@#se-@#sw); + 0 = xpart(@#ne-@#se) = ypart(@#ne-@#nw); + @#w = .5[@#nw,@#sw]; + @#s = .5[@#sw,@#se]; + @#e = .5[@#ne,@#se]; + @#n = .5[@#ne,@#nw]; + @#ne-@#c = @#c-@#sw = (@#dx,@#dy) + .5*(urcorner pic_@# - llcorner pic_@#); + endbox_(clearb_,@#); +enddef; + +def rboxpath_(suffix $) = + save _r; + _r = min(rbox_radius, .5*ypart($.n-$.s), .5*xpart($.e-$.w)); + $.sw+(_r,0) {right}..{right} $.se-(_r,0) + ..$.se+(0,_r) {up}..{up} $.ne-(0,_r) + ..$.ne-(_r,0) {left}..{left} $.nw+(_r,0) + ..$.nw-(0,_r) {down}..{down} $.sw+(0,_r) .. cycle +enddef; + + +% sizebox_ and clearb_ are defined in boxes.mp diff --git a/Master/texmf-dist/metapost/base/sarith.mp b/Master/texmf-dist/metapost/base/sarith.mp new file mode 100644 index 00000000000..26f99c0fa61 --- /dev/null +++ b/Master/texmf-dist/metapost/base/sarith.mp @@ -0,0 +1,47 @@ +% Macros for arithmetic on strings that represent big numbers +% All the macros below except ordinary numeric values as well + +% Scvnum % convert to an ordinary numeric +% Sabs % absolute value +% Sadd % add +% Ssub % subtract +% Smul % multiply +% Sdiv % divide +% Sleq % compare <= +% Sneq % numeric compare <> + +% All other externally visible names start with `S' and end with `_' + + +if unknown Mzero: + begingroup interim % marith.mp starts with `warningcheck:=0' + input marith + endgroup; % restore warningcheck; we zero it when necessary +fi + + +vardef Sunop_(expr x)(text o) = + interim warningcheck:=0; + o if numeric x: decimal fi x +enddef; + + +vardef Sbinop_@#(expr a, b)(text o) = + interim warningcheck:=0; + @# (Mlog_Str a o Mlog_Str b) +enddef; + + +def Ssbinop_ = Sbinop_.Mexp_str enddef; + + +vardef Sabs primary x = Sunop_(x, Mexp_str Mabs Mlog_str) enddef; +vardef Scvnum primary x = Sunop_(x, Mexp Mlog_str) enddef; +% The inverse of Scvnum is the `decimal' primitive. + +primarydef a Smul b = Ssbinop_(a,b,Mmul) enddef; +primarydef a Sdiv b = Ssbinop_(a,b,Mdiv) enddef; +secondarydef a Sadd b = Ssbinop_(a,b,Madd) enddef; +secondarydef a Ssub b = Ssbinop_(a,b,Msub) enddef; +tertiarydef a Sleq b = Sbinop_(a,b,Mleq) enddef; +tertiarydef a Sneq b = Sbinop_(a,b,<>) enddef; diff --git a/Master/texmf-dist/metapost/base/string.mp b/Master/texmf-dist/metapost/base/string.mp new file mode 100644 index 00000000000..2cf5a7ff4dd --- /dev/null +++ b/Master/texmf-dist/metapost/base/string.mp @@ -0,0 +1,31 @@ +% String manipulation routines for MetaPost +% It is harmless to input this file more than once. + + +vardef isdigit primary d = + ("0"<=d)and(d<="9") enddef; + + +% Number of initial characters of string s where `c ' is true +vardef cspan(expr s)(text c) = + 0 + for i=1 upto length s: + exitunless c substring (i-1,i) of s; + + 1 + endfor +enddef; + + +% String s is composed of items separated by white space. Lop off the first +% item and the surrounding white space and return just the item. +vardef loptok suffix s = + save t, k; + k = cspan(s," ">=); + if k>0: s:=substring(k,infinity) of s; fi + k := cspan(s," "<); + string t; + t = substring (0,k) of s; + s := substring (k,infinity) of s; + s := substring (cspan(s," ">=),infinity) of s; + t +enddef; diff --git a/Master/texmf-dist/metapost/base/texnum.mp b/Master/texmf-dist/metapost/base/texnum.mp new file mode 100644 index 00000000000..afb311c3e4f --- /dev/null +++ b/Master/texmf-dist/metapost/base/texnum.mp @@ -0,0 +1,17 @@ +% Default init_numbers for use with TeX +% Don't input this directly--format.mp uses this file + +verbatimtex + \ifx\documentstyle\undefined \else + \ifx\blackandwhite\undefined + \documentstyle{article} + \else \documentstyle{slides} + \fi + \begin{document} + \fi +etex + +init_numbers(btex$-$etex, btex$1$etex, btex${\times}10$etex, + btex${}^-$etex, btex${}^2$etex); + +Fe_base := btex $10$ etex; diff --git a/Master/texmf-dist/metapost/base/troffnum.mp b/Master/texmf-dist/metapost/base/troffnum.mp new file mode 100644 index 00000000000..28d6f0fe452 --- /dev/null +++ b/Master/texmf-dist/metapost/base/troffnum.mp @@ -0,0 +1,7 @@ +% Default init_numbers for use with troff +% Don't input this directly--format.mp uses this file + +init_numbers(btex$-$etex, btex$1$etex, btex$ times 10$etex, + btex$"" sup -$etex, btex$"" sup 2$etex); + +Fe_base := btex $10$ etex; -- cgit v1.2.3