diff options
102 files changed, 48807 insertions, 0 deletions
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 <string_primary> 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 <file or path> [with...] draw a line in current coord system +% gfill <file or path> [with...] fill a region using current coord system +% gdrawarrow .., gdrawdblarrow.. like gdraw, but with 1 or 2 arrowheads +% Mreadpath(<filename>) read path from file and return it in Mlog form +% augment<path name>(loc) append given coordinates to a polygonal path +% glabel<suffix>(pic,loc) place label pic near graph coords or time loc +% gdotlabel<suffix>(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.<x or y> default x or y tick locations (for interation) +% itick.<bot|top|..>(fmt,u) draw inward tick from given side at u w/ format +% otick.<bot|top|..>(fmt,u) draw outward tick at coord u; label format fmt +% grid.<bot|top|..>(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 <picture>' draws picture at each path knot, turns off pen +% Gtemplate.<tickcmd> 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.<x or y> +% Gmarks, Gminlog numeric parameters used by auto.<x or y> +% 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_.<suffix>, Y_.<suffix>, or Z_.<suffix>, 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<x or y> +% Gme_, Gcma_ variables and macros used in auto<x or y> +% Gc_ temporary macro used in auto<x or y> +% 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<ypart h: 10 else: xpart h/1000 fi, t) + endfor +enddef; + + +% Select a k for which Gmscan_(k,...) gives enough marks. +vardef Gkpick_ = + save k; + k = 0; + forever: + exitif unknown Glmarks[k+1]; + exitif 0 Gmscan_(incr k, Gmll_, Gmhh_, +1) >= 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<infinity/Ten_to[e]: + m*Ten_to[e] + else: decimal m & "e" & decimal e + fi + else: + save x; x=m/Ten_to[-e]; + if abs x>=.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 <string> convert a string like "6.02e23" to Mlog form +% Mexp_str <M_numeric> 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 <numeric> convert a number to Mlog form +% Mexp <M_numeric> convert from Mlog form into ordinary numeric form +% Mabs <M_numeric> absolute value +% Mlog_Str <string or numeric> convert to Mlog form; unknown results in unknown +% <M_numeric> Madd <M_numeric> add +% <M_numeric> Msub <M_numeric> subtract +% <M_numeric> Mmul <M_numeric> multiply +% <M_numeric> Mdiv <M_numeric> divide +% <M_numeric> Mleq <M_numeric> 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 uu<u_: u_:=uu; fi endfor + u_ enddef; + +vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings + save u_; setu_ u; for uu = t: if uu>u_: 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 uu<u_: u_:=uu; fi endfor + u_ enddef; + +vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings + save u_; setu_ u; for uu = t: if uu>u_: 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<box name>(<string or picture>) 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 <number> % convert to an ordinary numeric +% Sabs <number> % absolute value +% <number> Sadd <number> % add +% <number> Ssub <number> % subtract +% <number> Smul <number> % multiply +% <number> Sdiv <number> % divide +% <number> Sleq <number> % compare <= +% <number> Sneq <number> % 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 <character>' 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; diff --git a/Master/texmf-dist/metapost/config/mfmp.ini b/Master/texmf-dist/metapost/config/mfmp.ini new file mode 100644 index 00000000000..b7d5669406c --- /dev/null +++ b/Master/texmf-dist/metapost/config/mfmp.ini @@ -0,0 +1,4 @@ +% Thomas Esser, 1998. public domain. +\input mfplain +\dump +\endinput diff --git a/Master/texmf-dist/metapost/config/mpost.ini b/Master/texmf-dist/metapost/config/mpost.ini new file mode 100644 index 00000000000..18cd78cb56d --- /dev/null +++ b/Master/texmf-dist/metapost/config/mpost.ini @@ -0,0 +1,4 @@ +% Thomas Esser, 1998. public domain. +\input plain +\dump +\endinput diff --git a/Master/texmf-dist/metapost/context/base/metafun.mp b/Master/texmf-dist/metapost/context/base/metafun.mp new file mode 100644 index 00000000000..5071013c5f8 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/metafun.mp @@ -0,0 +1,63 @@ +%D \module +%D [ file=metafun.mp, +%D version=2000.07.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=format generation file, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. + +%D When generating many graphics at runtime, it can save run +%D time to use a format file. We could have named this file +%D \type {context}, but this is error prone, because it forces +%D to use the progname \type {mpost} or \type {context} +%D explicitly, depending on the needs. When using the format, +%D a mismatch in the memory specification of \type {mpost} or +%D \type {context} (the \TEX\ one) could lead to lost strings +%D (and as a result in buggy boundingbox and special +%D handling). By using the name \type {metatex} we make sure +%D that we use (unless overloaded) the settings of \type +%D {mpost}. + +if unknown ahangle : + input plain.mp ; % John Hobby's file +else : + let dump = relax ; +fi ; + +input mp-tool.mp ; +input mp-spec.mp ; +input mp-core.mp ; +input mp-page.mp ; +input mp-text.mp ; +input mp-shap.mp ; +input mp-butt.mp ; +input mp-char.mp ; +input mp-step.mp ; +input mp-grph.mp ; +input mp-figs.mp ; + +% mp-form.mp ; +input mp-grid.mp ; +input mp-func.mp ; + +string metafunversion ; + +metafunversion = "metafun" & " " & + decimal year & "-" & + decimal month & "-" & + decimal day & " " & + decimal (time div 60) & ":" & + decimal (time-(time div 60)*60) ; + +let normalend = end ; + +def end = + ; message "" ; message metafunversion ; message "" ; normalend ; +enddef ; + +dump ; endinput . diff --git a/Master/texmf-dist/metapost/context/base/mp-back.mp b/Master/texmf-dist/metapost/context/base/mp-back.mp new file mode 100644 index 00000000000..99e88554b62 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-back.mp @@ -0,0 +1,206 @@ +%D \module +%D [ file=mp-back.mp, +%D version=2000.05.31, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=backgrounds, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_back : endinput ; fi ; + +boolean context_back ; context_back := true ; + +def some_hash ( expr hash_width , + hash_height , + hash_linewidth , + hash_linecolor , + hash_angle , + hash_gap ) = + + stripe_gap := hash_gap ; + stripe_angle := hash_angle ; + drawoptions (withpen pencircle scaled hash_linewidth + withcolor hash_linecolor) ; + path p ; p := unitsquare xscaled hash_width yscaled hash_height ; + stripe_path_a () (draw) p ; % next we move it all to quadrant 1 + currentpicture := currentpicture shifted urcorner currentpicture ; + +enddef ; + +def some_double_back (expr back_type , + back_width , + back_height , + back_delta , + back_linewidth , + back_linecolor , + back_fillcolor , + back_topcolor , + back_bottomcolor , + back_leftcolor , + back_rightcolor ) = + + numeric ww ; ww := back_width ; + numeric hh ; hh := back_height ; + numeric dd ; dd := back_delta ; + + color back_nillcolor ; back_nillcolor := back_topcolor ; + + path p ; p := fullsquare xscaled ww yscaled hh ; + path q ; q := fullsquare xscaled (ww-2dd) yscaled (hh-2dd) ; + path r ; r := llcorner p -- + lrcorner p shifted (-3dd,0) .. controls lrcorner p .. + lrcorner p shifted (0, 3dd) -- + urcorner p shifted (0,-3dd) .. controls urcorner p .. + urcorner p shifted (-3dd,0) -- + ulcorner p -- cycle ; + path s ; s := r xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; + path t ; t := llcorner p -- + lrcorner p -- + urcorner p shifted (0,-3dd) .. controls urcorner p .. + urcorner p shifted (-3dd,0) -- + ulcorner p shifted ( 3dd,0) .. controls ulcorner p .. + ulcorner p shifted (0,-3dd) -- + llcorner p -- cycle ; + path u ; u := t xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; + path v ; v := llcorner p shifted ( 3dd,0) -- + lrcorner p shifted (-3dd,0) .. controls lrcorner p .. + lrcorner p shifted (0, 3dd) -- + urcorner p shifted (0,-3dd) .. controls urcorner p .. + urcorner p shifted (-3dd,0) -- + ulcorner p shifted ( 3dd,0) .. controls ulcorner p .. + ulcorner p shifted (0,-3dd) .. + llcorner p shifted (0, 3dd) .. controls llcorner p .. cycle ; % {down} .. cycle ; + path w ; w := t xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; + path a ; a := llcorner p -- ulcorner p -- + ulcorner q -- llcorner q -- cycle ; + path b ; b := llcorner p -- lrcorner p -- + lrcorner q -- llcorner q -- cycle ; + path c ; c := lrcorner p -- urcorner p -- + urcorner q -- lrcorner q -- cycle ; + path d ; d := ulcorner p -- urcorner p -- + urcorner q -- ulcorner q -- cycle ; + path e ; e := llcorner p -- lrcorner p -- + urcorner p -- urcorner q -- + lrcorner q -- llcorner q -- cycle ; + path f ; f := llcorner p -- ulcorner p -- + urcorner p -- urcorner q -- + ulcorner q -- llcorner q -- cycle ; + + linecap := butt ; pickup pencircle scaled back_linewidth ; + + if back_type=1 : + + fill p withcolor back_fillcolor ; + fill a withcolor back_leftcolor ; + fill b withcolor back_bottomcolor ; + fill c withcolor back_rightcolor ; + fill d withcolor back_topcolor ; + draw a withcolor back_linecolor ; + draw d withcolor back_linecolor ; + draw b withcolor back_linecolor ; + draw c withcolor back_linecolor ; + + elseif back_type=2 : + + fill p withcolor back_fillcolor ; + fill e withcolor back_bottomcolor ; + fill f withcolor back_topcolor ; + draw e withcolor back_linecolor ; + draw f withcolor back_linecolor ; + + elseif back_type=3 : + + fill v withcolor back_nillcolor ; + fill w withcolor back_fillcolor ; + draw v withcolor back_linecolor ; + draw w withcolor back_linecolor ; + + elseif back_type=4 : + + fill t withcolor back_nillcolor ; + fill u withcolor back_fillcolor ; + draw t withcolor back_linecolor ; + draw u withcolor back_linecolor ; + + elseif back_type=5 : + + t := t rotatedaround(center t,180) ; + u := u rotatedaround(center u,180) ; + + fill t withcolor back_nillcolor ; + fill u withcolor back_fillcolor ; + draw t withcolor back_linecolor ; + draw u withcolor back_linecolor ; + + elseif back_type=6 : + + r := r rotatedaround(center r,180) ; + s := s rotatedaround(center s,180) ; + + fill r withcolor back_nillcolor ; + fill s withcolor back_fillcolor ; + draw r withcolor back_linecolor ; + draw s withcolor back_linecolor ; + + elseif back_type=7 : + + fill r withcolor back_nillcolor ; + fill s withcolor back_fillcolor ; + draw r withcolor back_linecolor ; + draw s withcolor back_linecolor ; + +fi ; + +enddef ; + +endinput ; + +beginfig (1) ; + +some_double_back (1, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, .6white, .7white, .6white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (2, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, .6white, white, white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (3, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, white, white, white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (4, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, white, white, white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (5, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, white, white, white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (6, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, white, white, white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (7, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, white, white, white) + +currentpicture := currentpicture shifted (0,-3cm) ; + +some_double_back (8, 4.5cm, 1.5cm, .25cm, 1mm, + .5white, .8white, .7white, white, white, white) + +endfig ; + +end . diff --git a/Master/texmf-dist/metapost/context/base/mp-butt.mp b/Master/texmf-dist/metapost/context/base/mp-butt.mp new file mode 100644 index 00000000000..cf580211e59 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-butt.mp @@ -0,0 +1,75 @@ +%D \module +%D [ file=mp-butt.mp, +%D version=2000.05.31, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=buttons, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_butt : endinput ; fi ; + +boolean context_butt ; context_butt := true ; + +def some_button (expr button_type , + button_size , + button_linecolor , + button_fillcolor ) = + + numeric button_linewidth ; button_linewidth := button_size/10 ; + + drawoptions (withpen pencircle scaled button_linewidth + withcolor button_linecolor) ; + + path p ; p := unitsquare scaled button_size ; + numeric d ; d := button_size ; + numeric l ; l := button_linewidth ; + + fill p withcolor button_fillcolor ; draw p ; + + if button_type=101 : + draw (d-2l,2l)--(2l,.5d)--(d-2l,d-2l)--cycle ; + elseif button_type=102 : + draw (2l,2l)--(d-2l,.5d)--(2l,d-2l)--cycle ; + elseif button_type=103 : + for i=2l step 2l until d-2l : + draw (2l,i)--(2l ,i) ; + draw (4l,i)--(d-2l,i) ; + endfor ; + elseif button_type=104 : + for i=2l step 2l until d-2l : + draw (2l ,i)--(d/2-l,i) ; + draw (d/2+l,i)--(d-2l ,i) ; + endfor ; + elseif button_type=105 : + fill fullcircle scaled (.2d) shifted (.5d,.7d) ; + fill fullcircle xscaled (.6d) yscaled d shifted (.5d,0) ; + clip currentpicture to p ; + draw p ; + elseif button_type=106 : + draw (2l,2l)--(d-2l,d-2l) ; + draw (d-2l,2l)--(2l,d-2l) ; + elseif button_type=107 : + p := (3l,d-2l)--(d-3l,d-2l)--(.5d,4l)--cycle ; + fill p ; draw p ; + draw (.5d,2l) ; + elseif button_type=108 : + draw (.5d,2l)--(d-2l,d-2l)--(2l,d-2l)--cycle ; + elseif button_type=109 : + draw (.5d,d-2l)--(d-2l,2l)--(2l,2l)--cycle ; + elseif button_type=110 : + button_linewidth := button_linewidth/2 ; + draw p enlarged (-2l,-l) ; + for i=2l step l until d-2l : + draw (3l,i)--(d-3l,i) ; + endfor ; + fi ; + +enddef ; + +endinput ; diff --git a/Master/texmf-dist/metapost/context/base/mp-char.mp b/Master/texmf-dist/metapost/context/base/mp-char.mp new file mode 100644 index 00000000000..cd774d50962 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-char.mp @@ -0,0 +1,997 @@ +% to be cleaned up, namespace needed ! ! ! ! ! + +%D \module +%D [ file=mp-char.mp, +%D version=1998.10.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=charts, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if unknown context_shap : input mp-shap ; fi ; +if known context_char : endinput ; fi ; + +boolean context_char ; context_char := true ; + +% kan naar elders + +current_position := 0 ; + +def save_text_position (expr p) = % beware: clip shift needed + current_position := current_position + 1 ; + savedata + "\MPposition{" & decimal current_position & "}{" + & decimal xpart p & "}{" + & decimal ypart p & "}" ; +enddef ; + +%D settings + +grid_width := 60pt ; grid_height := 40pt ; +shape_width := 45pt ; shape_height := 30pt ; + +chart_offset := 2pt ; + +color chart_background_color ; chart_background_color := white ; + +%D test mode + +boolean show_mid_points ; show_mid_points := false ; +boolean show_con_points ; show_con_points := false ; +boolean show_all_points ; show_all_points := false ; + +%D shapes + +color shape_line_color, shape_fill_color ; + +shape_line_width := 2pt ; +shape_line_color := .5white ; +shape_fill_color := .9white ; + +shape_node := 0 ; +shape_action := 24 ; +shape_procedure := 5 ; +shape_product := 12 ; +shape_decision := 14 ; +shape_archive := 19 ; +shape_loop := 35 ; +shape_wait := 6 ; +shape_subprocedure := 20 ; shape_sub_procedure := 20 ; +shape_singledocument := 32 ; shape_single_document := 32 ; +shape_multidocument := 33 ; shape_multi_document := 33 ; +shape_right := 66 ; +shape_left := 67 ; +shape_up := 68 ; +shape_down := 69 ; + +% vardef some_shape_path (expr type) == imported from mp-shap + +def show_shapes (expr n) = + + begin_chart(n,8,10) ; + show_con_points := true ; + for i=0 upto 7 : + for j=0 upto 9 : + new_shape(i+1,j+1,i*10+j); + endfor ; + endfor ; + end_chart ; + +enddef ; + +%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 ; + +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 ; + max_x := maxx ; + max_y := maxy ; + dsp_x := 0 ; + dsp_y := 0 ; + for x=1 upto max_x : + for y=1 upto max_y : + xyfree [x][y] := true ; + xyfill [x][y] := shape_fill_color ; + xydraw [x][y] := shape_line_color ; + xyline [x][y] := shape_line_width ; + endfor ; + endfor ; + endgroup ; +enddef ; + +def scaled_to_grid = + xscaled grid_width yscaled grid_height +enddef ; + +def xy_offset (expr x, y) = + (x+.5,y+.5) +enddef ; + +def draw_shape (expr x, yy, p, sx, sy) = + begingroup ; + save y ; + y := y_pos(yy) ; + xypath [x][y] := (p xscaled sx yscaled sy) shifted xy_offset(x,y) ; + xyfree [x][y] := false ; + xysx [x][y] := sx ; + xysy [x][y] := sy ; + xyfill [x][y] := shape_fill_color ; + xydraw [x][y] := shape_line_color ; + xyline [x][y] := shape_line_width ; + xypeep [x][y] := peepshape ; + endgroup ; +enddef ; + +vardef i_point (expr x, y, p, t) = + begingroup ; + save q, ok ; + pair q ; + boolean ok ; + q := xypath[x][y] intersection_point ((p) shifted xy_offset(x,y)) ; + ok := true ; +% if xpart q < -.5 : ok := false ; q := (-.45,ypart q) fi ; +% if xpart q > .5 : ok := false ; q := ( .45,ypart q) fi ; +% if ypart q < -.5 : ok := false ; q := (xpart q,-.45) fi ; +% if ypart q > .5 : ok := false ; q := (xpart q, .45) fi ; + if not ok : + message (t & " of shape (" & decimal x & "," & decimal y & ") limited") ; + fi ; + q + endgroup +enddef ; + +vardef trimmed (expr x, y, z, t) = + if touchshape and t : xyline[x][y]/z else : epsilon fi +enddef ; + +zfactor := 1/3 ; + +vardef xy_bottom (expr x, y, z, t) = + i_point (x, y, ((0,0)--(0,-2)) shifted (zfactor*z*xysx[x][y],0), "bottom") + shifted(0,-trimmed(x,y,grid_height,t)) +enddef ; + +vardef xy_top (expr x, y, z, t) = + i_point (x, y, ((0,0)--(0,2)) shifted (zfactor*z*xysx[x][y],0), "top") + shifted(0,trimmed(x,y,grid_height,t)) +enddef ; + +vardef xy_left (expr x, y, z, t) = + i_point (x, y, ((0,0)--(-2,0)) shifted (0,zfactor*z*xysy[x][y]), "left") + shifted(-trimmed(x,y,grid_width,t),0) +enddef ; + +vardef xy_right (expr x, y, z, t) = + i_point (x, y, ((0,0)--(2,0)) shifted (0,zfactor*z*xysy[x][y]), "right") + shifted(trimmed(x,y,grid_width,t),0) +enddef ; + +def flush_shapes = + for x=1 upto max_x : + for y=1 upto max_y : + flush_shape (x, y) ; + endfor ; + endfor ; +enddef ; + +def draw_connection_point (expr x, y, z) = + pickup pencircle scaled if (z=0): 2 fi xyline[x][y] ; + drawdot xy_bottom(x,y,z,false) scaled_to_grid withcolor (1,0,0) ; + drawdot xy_top (x,y,z,false) scaled_to_grid withcolor (0,1,0) ; + drawdot xy_left (x,y,z,false) scaled_to_grid withcolor (0,0,1) ; + drawdot xy_right (x,y,z,false) scaled_to_grid withcolor (1,1,0) ; +enddef ; + +def flush_shape (expr x, yy) = + begingroup ; + save y ; + y := y_pos(yy) ; + if not xyfree[x][y] : + pickup pencircle scaled xyline[x][y] ; + if xypeep[x][y] : + fill (xypath[x][y] peepholed (unitsquare shifted (x,y))) + scaled_to_grid withpen pencircle scaled 0 + withcolor chart_background_color ; + else : + fill xypath[x][y] scaled_to_grid withcolor xyfill[x][y] ; + fi ; + draw xypath[x][y] scaled_to_grid withcolor xydraw[x][y] ; + if show_con_points or show_all_points : + draw_connection_point (x, y, 0) ; + fi ; + if show_all_points : + for i=-1 upto 1 : + draw_connection_point (x, y, i) ; + endfor ; + fi ; + fi ; + endgroup ; +enddef ; + +vardef points_initialized (expr xfrom, yfrom, xto, yto, n) = + if not xyfree[xfrom][yfrom] and not xyfree[xto][yto] : + xypoint := n ; true + else : + xypoint := 0 ; false + fi +enddef ; + +def collapse_points = % this is now an mp-tool macro + % remove redundant points + n := 1 ; + for i=2 upto xypoint: + if not (xypoints[i]=xypoints[n]) : + n := n + 1 ; + xypoints[n] := xypoints[i] + fi ; + endfor ; + xypoint := n ; + % make straight lines + if xypoints[2]=xypoints[xypoint-1] : + xypoints[3] := xypoints[xypoint] ; + xypoint := 3 ; + fi ; +enddef ; + +vardef smooth_connection (expr a,b) = + sx := connection_smooth_size/grid_width ; + sy := connection_smooth_size/grid_height ; + if ypart a = ypart b : + a shifted (if xpart a >= xpart b : - fi sx,0) +% a shifted (sx*xpart unitvector(b-a),0) + else : + a shifted (0,if ypart a >= ypart b : - fi sy) +% a shifted (0,sy*ypart unitvector(b-a)) + fi +enddef ; + +vardef trim_points = + begingroup + save p, a, b, d, i ; path p ; pair d ; + p := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ; + if touchshape : + a := shape_line_width/grid_width ; + b := shape_line_width/grid_height ; + else : + a := epsilon ; + b := epsilon ; + fi ; + d := direction infinity of p ; + xypoints[xypoint] := xypoints[xypoint] shifted + if xpart d < 0 : (+a,0) ; + elseif xpart d > 0 : (-a,0) ; + elseif ypart d < 0 : (0,+b) ; + elseif ypart d > 0 : (0,-b) ; + else : origin ; + fi ; + d := direction 0 of p ; + xypoints[1] := xypoints[1] shifted + if xpart d < 0 : (-a,0) ; + elseif xpart d > 0 : (+a,0) ; + elseif ypart d < 0 : (0,-b) ; + elseif ypart d > 0 : (0,+b) ; + else : origin ; + fi ; + endgroup +enddef ; + +vardef trim_points = enddef ; + +vardef connection_path = + if reverse_connection : reverse fi (xypoints[1]-- + for i=2 upto xypoint-1 : + if smooth : + smooth_connection(xypoints[i],xypoints[i-1]) .. + controls xypoints[i] and xypoints[i] .. + smooth_connection(xypoints[i],xypoints[i+1]) -- + else : + xypoints[i]-- + fi + endfor + xypoints[xypoint]) +enddef ; + +% vardef connection_path = +% sx := connection_smooth_size/grid_width ; +% sy := connection_smooth_size/grid_height ; +% if reverse_connection : reverse fi +% (for i=1 upto xypoint-1 : xypoints[i] -- endfor xypoints[xypoint]) +% if smooth : cornered max(sx,sy) fi +% enddef ; +% +% primarydef p cornered c = +% if cycle p : +% ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- +% for i=1 upto length(p) : +% (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- +% (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) .. +% controls point i of p .. +% endfor cycle) +% else : +% ((point 0 of p) -- +% for i=1 upto length(p)-1 : +% (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- +% (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) .. +% controls point i of p .. +% endfor +% (point length(p) of p)) +% fi +% enddef ; + +def draw_connection = + if xypoint>0 : + collapse_points ; + trim_points ; + cpath := cpath + 1 ; + cpaths[cpath] := connection_path scaled_to_grid ; + cline[cpath] := connection_line_width ; + ccolor[cpath] := connection_line_color ; + carrow[cpath] := arrowtip ; + cdash[cpath] := dashline ; + ccross[cpath] := showcrossing ; + else : + message("no connection defined") ; + fi ; + reverse_connection := false ; +enddef ; + +def flush_connections = + pair ip ; + boolean crossing ; + ahlength := connection_arrow_size ; + dash_pattern := dashpattern(on connection_dash_size off connection_dash_size ) ; + for i=1 upto cpath : + if ccross[i] : + crossing := false ; + for j=1 upto i : + %if not ((point infinity of cpaths[i] = point infinity of cpaths[j]) or + % (point 0 of cpaths[i] = point 0 of cpaths[j])) : + if not (point infinity of cpaths[i] = point infinity of cpaths[j]) : + ip := cpaths[i] intersection_point cpaths[j] ; + if intersection_found : crossing := true fi ; + fi ; + endfor ; + if crossing : + pickup pencircle scaled 2cline[i] ; + %draw cpaths[i] withcolor chart_background_color ; + path cp ; cp := cpaths[i] ; + cp := cp cutbefore point .05 length cp of cp ; + cp := cp cutafter point .95 length cp of cp ; + draw cp withcolor chart_background_color ; + fi ; + fi ; + pickup pencircle scaled cline[i] ; + if carrow[i] : + if cdash[i] : + drawarrow cpaths[i] withcolor ccolor[i] dashed dash_pattern ; + else : + drawarrow cpaths[i] withcolor ccolor[i] ; + fi ; + else : + if cdash[i] : + draw cpaths[i] withcolor ccolor[i] dashed dash_pattern ; + else : + draw cpaths[i] withcolor ccolor[i] ; + fi ; + fi ; + draw_midpoint (i) ; + endfor ; +enddef ; + +def draw_midpoint (expr n) = + begingroup + save p ; + pair p ; + p := point .5*length(cpaths[n]) of cpaths[n]; + pickup pencircle scaled 2cline[n] ; + save_text_position (p) ; + if show_mid_points : + drawdot p withcolor .7white ; + fi ; + endgroup ; +enddef ; + +boolean reverse_connection ; reverse_connection := false ; + +vardef up_on_grid (expr n) = + (xpart xypoints[n],(ypart xypoints[n]+1) div 1) +enddef ; + +vardef down_on_grid (expr n) = + (xpart xypoints[n],(ypart xypoints[n]) div 1) +enddef ; + +vardef left_on_grid (expr n) = + ((xpart xypoints[n]) div 1, ypart xypoints[n]) +enddef ; + +vardef right_on_grid (expr n) = + ((xpart xypoints[n]+1) div 1, ypart xypoints[n]) +enddef ; + +vardef x_on_grid (expr n, xfrom, xto, zfrom) = + if (xfrom=xto) and not (zfrom=0) : + if (zfrom=1) : right_on_grid(2) else : left_on_grid(2) fi + elseif xpart xypoints[1] < xpart xypoints[6] : + right_on_grid(n) + else : + left_on_grid(n) + fi +enddef ; + +vardef y_on_grid (expr n, yfrom, yto, zfrom) = + if (yfrom=yto) and not (zfrom=0) : + if (zfrom=1) : up_on_grid(2) else : down_on_grid(2) fi + elseif ypart xypoints[1] < ypart xypoints[6] : + up_on_grid(n) + else : + down_on_grid(n) + fi +enddef ; + +vardef xy_on_grid (expr n, m) = + (xpart xypoints[n], ypart xypoints[m]) +enddef ; + +vardef down_to_grid (expr a,b) = + (xpart xypoints[a], + ypart xypoints[if ypart xypoints[a]<ypart xypoints[b]:a else:b fi]) +enddef ; + +vardef up_to_grid (expr a,b) = + (xpart xypoints[a], + ypart xypoints[if ypart xypoints[a]>ypart xypoints[b]:a else:b fi]) +enddef ; + +vardef left_to_grid (expr a,b) = + (xpart xypoints[if xpart xypoints[a]<xpart xypoints[b]:a else:b fi], + ypart xypoints[a]) +enddef ; + +vardef right_to_grid (expr a,b) = + (xpart xypoints[if xpart xypoints[a]>xpart xypoints[b]:a else:b fi], + ypart xypoints[a]) +enddef ; + +% vardef boundingboxfraction(expr p, f) = +% ((boundingbox p) enlarged (-f*bbwidth(p),-f*bbheight(p))) +% enddef ; + +vardef valid_connection (expr xfrom, yfrom, xto, yto) = + begingroup ; + save ok, vc, pp ; + boolean ok ; + % check for slanted lines + ok := true ; + for i=1 upto xypoint-1 : + if not ((xpart xypoints[i]=xpart xypoints[i+1]) or + (ypart xypoints[i]=ypart xypoints[i+1])) : ok := false ; + fi ; + endfor ; + if not ok : + %message("slanted"); + false + elseif forcevalid : + %message("force"); + true + elseif (xfrom=xto) and (yfrom=yto) : + %message("self"); + false + else : + % check for crossing shapes + pair vc ; + path pp ; + + pair xyfirst, xylast ; + xyfirst := xypoints[1] ; + xylast := xypoints[xypoint] ; + trim_points ; + pp := for i=1 upto xypoint-1 : xypoints[i]-- endfor xypoints[xypoint] ; + xypoints[1] := xyfirst ; + xypoints[xypoint] := xylast ; + + for i=1 upto max_x : + for j=1 upto max_y : % was bug: xfrom,yto + if not ( ( (i,j)=(xfrom,yfrom) ) or ( (i,j)=(xto,yto) ) ) : + if not xyfree[i][j] : + vc := pp intersection_point xypath[i][j] ; + if intersection_found : ok := false fi ; + fi ; + fi ; + endfor ; + endfor ; + %if not ok: message("crossing") ; fi ; + ok + fi + endgroup +enddef ; + +def connect_top_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,6) : + xypoints[1] := xy_top(xfrom,yfrom,zfrom,true) ; + xypoints[6] := xy_bottom(xto,yto,zto,true) ; + xypoints[2] := up_on_grid(1) ; + xypoints[5] := down_on_grid(6) ; + xypoints[3] := up_to_grid(2,5) ; + xypoints[4] := up_to_grid(2,5) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := x_on_grid(2,xfrom,xto,zfrom) ; + xypoints[4] := xy_on_grid(3,5) ; + fi ; + %%%% begin experiment + xypoints[3] := xypoints[3] shifted (dsp_x,0) ; + xypoints[4] := xypoints[4] shifted (dsp_x,0) ; + if dsp_y>0 : + xypoints[2] := xypoints[2] shifted (0,dsp_y) ; + xypoints[3] := xypoints[3] shifted (0,dsp_y) ; + elseif dsp_y<0 : + xypoints[4] := xypoints[4] shifted (0,dsp_y) ; + xypoints[5] := xypoints[5] shifted (0,dsp_y) ; + fi + %%%% end experiment + draw_connection ; + fi ; +enddef ; + +def connect_left_right (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,6) : + xypoints[1] := xy_left(xfrom,yfrom,zfrom,true) ; + xypoints[6] := xy_right(xto,yto,zto,true) ; + xypoints[2] := left_on_grid(1) ; + xypoints[5] := right_on_grid(6) ; + xypoints[3] := left_to_grid(2,5) ; + xypoints[4] := left_to_grid(2,5) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := y_on_grid(2,yfrom,yto,zfrom) ; + xypoints[4] := xy_on_grid(5,3) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_left_top (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,5) : + xypoints[1] := xy_left(xfrom,yfrom,zfrom,true) ; + xypoints[5] := xy_top(xto,yto,zto,true) ; + xypoints[2] := left_on_grid(1) ; + xypoints[4] := up_on_grid(5) ; + xypoints[3] := left_to_grid(2,5) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := xy_on_grid(2,4) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_left_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,5) : + xypoints[1] := xy_left(xfrom,yfrom,zfrom,true) ; + xypoints[5] := xy_bottom(xto,yto,zto,true) ; + xypoints[2] := left_on_grid(1) ; + xypoints[4] := down_on_grid(5) ; + xypoints[3] := left_to_grid(2,5) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := xy_on_grid(2,4) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_right_top (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,5) : + xypoints[1] := xy_right(xfrom,yfrom,zfrom,true) ; + xypoints[5] := xy_top(xto,yto,zto,true) ; + xypoints[2] := right_on_grid(1) ; + xypoints[4] := up_on_grid(5) ; + xypoints[3] := right_to_grid(2,5) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := xy_on_grid(2,4) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_right_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,5) : + xypoints[1] := xy_right(xfrom,yfrom,zfrom,true) ; + xypoints[5] := xy_bottom(xto,yto,zto,true) ; + xypoints[2] := right_on_grid(1) ; + xypoints[4] := down_on_grid(5) ; + xypoints[3] := right_to_grid(2,5) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := xy_on_grid(2,4) ; + fi ; + %%%% begin experiment + xypoints[2] := xypoints[2] shifted (dsp_x,0) ; + xypoints[3] := xypoints[3] shifted (dsp_x,0) ; + if dsp_y>0 : + xypoints[3] := xypoints[3] shifted (0,-dsp_y) ; + xypoints[4] := xypoints[4] shifted (0,-dsp_y) ; + elseif dsp_y<0 : + xypoints[3] := xypoints[3] shifted (0,dsp_y) ; + xypoints[4] := xypoints[4] shifted (0,dsp_y) ; + fi + %%%% end experiment + draw_connection ; + fi ; +enddef ; + +def connect_left_left (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,6) : + xypoints[1] := xy_left(xfrom,yfrom,zfrom,true) ; + xypoints[6] := xy_left(xto,yto,zto,true) ; + xypoints[2] := left_on_grid(1) ; + xypoints[5] := left_on_grid(6) ; + xypoints[3] := left_to_grid(2,5) ; + xypoints[4] := left_to_grid(5,2) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := y_on_grid(2,yfrom,yto,zfrom) ; + xypoints[4] := xy_on_grid(5,3) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_right_right (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,6) : + xypoints[1] := xy_right(xfrom,yfrom,zfrom,true) ; + xypoints[6] := xy_right(xto,yto,zto,true) ; + xypoints[2] := right_on_grid(1) ; + xypoints[5] := right_on_grid(6) ; + xypoints[3] := right_to_grid(2,5) ; + xypoints[4] := right_to_grid(5,2) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := y_on_grid(2,yfrom,yto,zfrom) ; + xypoints[4] := xy_on_grid(5,3) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_top_top (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,6) : + xypoints[1] := xy_top(xfrom,yfrom,zfrom,true) ; + xypoints[6] := xy_top(xto,yto,zto,true) ; + xypoints[2] := up_on_grid(1) ; + xypoints[5] := up_on_grid(6) ; + xypoints[3] := up_to_grid(2,5) ; + xypoints[4] := up_to_grid(5,2) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := x_on_grid(2,xfrom,xto,zfrom) ; + xypoints[4] := xy_on_grid(3,5) ; + fi ; + draw_connection ; + fi ; +enddef ; + +def connect_bottom_bottom (expr xfrom,yyfrom,zfrom) (expr xto,yyto,zto) = + yfrom := y_pos(yyfrom) ; yto := y_pos(yyto) ; + if points_initialized(xfrom,yfrom,xto,yto,6) : + xypoints[1] := xy_bottom(xfrom,yfrom,zfrom,true) ; + xypoints[6] := xy_bottom(xto,yto,zto,true) ; + xypoints[2] := down_on_grid(1) ; + xypoints[5] := down_on_grid(6) ; + xypoints[3] := down_to_grid(2,5) ; + xypoints[4] := down_to_grid(5,2) ; + if not valid_connection(xfrom,yfrom,xto,yto) : + xypoints[3] := x_on_grid(2,xfrom,xto,zfrom) ; + xypoints[4] := xy_on_grid(3,5) ; + fi ; + %%%% begin experiment + xypoints[3] := xypoints[3] shifted (dsp_x,0) ; + xypoints[4] := xypoints[4] shifted (dsp_x,0) ; + if dsp_y<0 : + xypoints[2] := xypoints[2] shifted (0,-dsp_y) ; + xypoints[3] := xypoints[3] shifted (0,-dsp_y) ; + elseif dsp_y>0 : + xypoints[4] := xypoints[4] shifted (0,dsp_y) ; + xypoints[5] := xypoints[5] shifted (0,dsp_y) ; + fi + %%%% end experiment + draw_connection ; + fi ; +enddef ; + +def connect_bottom_top (expr xfrom,yfrom,zfrom) (expr xto,yto,zto) = + reverse_connection := true ; + connect_top_bottom (xto,yto,zto) (xfrom,yfrom,zfrom) ; +enddef ; + +def connect_right_left (expr xfrom,yfrom,zfrom) (expr xto,yto,zto) = + reverse_connection := true ; + connect_left_right (xto,yto,zto) (xfrom,yfrom,zfrom) ; +enddef ; + +def connect_top_left (expr xfrom,yfrom,zfrom) (expr xto,yto,zto) = + reverse_connection := true ; + connect_left_top (xto,yto,zto) (xfrom,yfrom,zfrom) ; +enddef ; + +def connect_bottom_left (expr xfrom,yfrom,zfrom) (expr xto,yto,zto) = + reverse_connection := true ; + connect_left_bottom (xto,yto,zto) (xfrom,yfrom,zfrom) ; +enddef ; + +def connect_top_right (expr xfrom,yfrom,zfrom) (expr xto,yto,zto) = + reverse_connection := true ; + connect_right_top (xto,yto,zto) (xfrom,yfrom,zfrom) ; +enddef ; + +def connect_bottom_right (expr xfrom,yfrom,zfrom) (expr xto,yto,zto) = + reverse_connection := true ; + connect_right_bottom (xto,yto,zto) (xfrom,yfrom,zfrom) ; +enddef ; + +def draw_test_shape (expr x, y) = + draw_shape(x,y,fullcircle, .7, .7) ; +enddef ; + +def draw_test_shapes = + for i=1 upto max_x : + for j=1 upto max_y : + draw_test_shape(i,j) ; + endfor ; + endfor ; +enddef; + +def draw_test_area = + pickup pencircle scaled .5shape_line_width ; + draw (unitsquare xscaled max_x yscaled max_y shifted (1,1)) + scaled_to_grid withcolor blue ; +enddef ; + +def show_connection (expr n, m) = + + begin_chart(100+n,6,6) ; + + draw_test_area ; + + smooth := true ; + arrowtip := true ; + dashline := true ; + + draw_test_shape(2,2) ; draw_test_shape(4,5) ; + draw_test_shape(3,3) ; draw_test_shape(5,1) ; + draw_test_shape(2,5) ; draw_test_shape(1,3) ; + draw_test_shape(6,2) ; draw_test_shape(4,6) ; + + if (m=1) : + connect_top_bottom (2,2,0) (4,5,0) ; + connect_top_bottom (3,3,0) (5,1,0) ; + connect_top_bottom (2,5,0) (1,3,0) ; + connect_top_bottom (6,2,0) (4,6,0) ; + elseif (m=2) : + connect_top_top (2,2,0) (4,5,0) ; + connect_top_top (3,3,0) (5,1,0) ; + connect_top_top (2,5,0) (1,3,0) ; + connect_top_top (6,2,0) (4,6,0) ; + elseif (m=3) : + connect_bottom_bottom (2,2,0) (4,5,0) ; + connect_bottom_bottom (3,3,0) (5,1,0) ; + connect_bottom_bottom (2,5,0) (1,3,0) ; + connect_bottom_bottom (6,2,0) (4,6,0) ; + elseif (m=4) : + connect_left_right (2,2,0) (4,5,0) ; + connect_left_right (3,3,0) (5,1,0) ; + connect_left_right (2,5,0) (1,3,0) ; + connect_left_right (6,2,0) (4,6,0) ; + elseif (m=5) : + connect_left_left (2,2,0) (4,5,0) ; + connect_left_left (3,3,0) (5,1,0) ; + connect_left_left (2,5,0) (1,3,0) ; + connect_left_left (6,2,0) (4,6,0) ; + elseif (m=6) : + connect_right_right (2,2,0) (4,5,0) ; + connect_right_right (3,3,0) (5,1,0) ; + connect_right_right (2,5,0) (1,3,0) ; + connect_right_right (6,2,0) (4,6,0) ; + elseif (m=7) : + connect_left_top (2,2,0) (4,5,0) ; + connect_left_top (3,3,0) (5,1,0) ; + connect_left_top (2,5,0) (1,3,0) ; + connect_left_top (6,2,0) (4,6,0) ; + elseif (m=8) : + connect_left_bottom (2,2,0) (4,5,0) ; + connect_left_bottom (3,3,0) (5,1,0) ; + connect_left_bottom (2,5,0) (1,3,0) ; + connect_left_bottom (6,2,0) (4,6,0) ; + elseif (m=9) : + connect_right_top (2,2,0) (4,5,0) ; + connect_right_top (3,3,0) (5,1,0) ; + connect_right_top (2,5,0) (1,3,0) ; + connect_right_top (6,2,0) (4,6,0) ; + else : + connect_right_bottom (2,2,0) (4,5,0) ; + connect_right_bottom (3,3,0) (5,1,0) ; + connect_right_bottom (2,5,0) (1,3,0) ; + connect_right_bottom (6,2,0) (4,6,0) ; + fi ; + + end_chart ; + +enddef ; + +def show_connections = + for f=1 upto 10 : + show_connection(f,f) ; + endfor ; +enddef ; + +%D charts + +def clip_chart (expr minx, miny, maxx, maxy) = + cmin_x := minx ; + cmax_x := maxx ; + cmin_y := miny ; + cmax_y := 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 ; + initialize_grid (maxx, maxy) ; + bboxmargin := 0 ; + cmin_x := 1 ; + cmax_x := maxx ; + cmin_y := 1 ; + cmax_y := maxy ; +enddef ; + +def end_chart = + flush_shapes ; + flush_connections ; + cmin_x := cmin_x ; + cmax_x := cmin_x+cmax_x ; + cmin_y := cmin_y-1 ; + cmax_y := cmin_y+cmax_y ; + if reverse_y : + cmin_y := y_pos(cmin_y) ; + cmax_y := y_pos(cmax_y) ; + fi ; + path p ; + p := (((cmin_x,cmin_y)--(cmax_x,cmin_y)-- + (cmax_x,cmax_y)--(cmin_x,cmax_y)--cycle)) + scaled_to_grid ; + %draw p withcolor red ; + p := p enlarged chart_offset ; + clip currentpicture to p ; + setbounds currentpicture to p ; + savedata + "\MPclippath{" & + decimal xpart llcorner p & "}{" & + decimal ypart llcorner p & "}{" & + decimal xpart urcorner p & "}{" & + decimal ypart urcorner p & "}" ; + savedata + "\MPareapath{" & + decimal (xpart llcorner p + 2chart_offset) & "}{" & + decimal (ypart llcorner p + 2chart_offset) & "}{" & + decimal (xpart urcorner p - 2chart_offset) & "}{" & + decimal (ypart urcorner p - 2chart_offset) & "}" ; + currentpicture := currentpicture scaled chart_scale ; + if chart_figure>0: endfig ; fi ; +enddef ; + +def new_shape (expr x, y, n) = + if known n : + if (x>0) and (x<=max_x) and (y>0) and (y<=max_y) : + sx := shape_width/grid_width ; + sy := shape_height/grid_height ; + draw_shape(x,y,some_shape_path(n), sx, sy) ; + else : + message ("shape outside grid ignored") ; + fi ; + else + message ("shape not known" ) ; + fi ; +enddef ; + +def begin_sub_chart = + begingroup ; + save shape_line_width , connection_line_width ; + save shape_line_color, shape_fill_color, connection_line_color ; + color shape_line_color, shape_fill_color, connection_line_color ; + save smooth, arrowtip, dashline, peepshape ; + boolean smooth, arrowtip, dashline, peepshape ; +enddef ; + +def end_sub_chart = + endgroup ; +enddef ; + +%D done + +endinput ; + +%D testing + +show_shapes(100) ; + +end + +%D more testing + +show_connections ; + +begin_chart (1,4,5) ; + %clip_chart(1,1,1,2) ; + new_shape (1,1,31) ; + new_shape (1,2,3) ; + new_shape (4,4,5) ; + connect_top_left (1,1,0) (4,4,0) ; + connect_bottom_top (1,2,0) (4,4,0) ; + connect_left_right (1,2,0) (1,1,0) ; +end_chart ; + +end diff --git a/Master/texmf-dist/metapost/context/base/mp-core.mp b/Master/texmf-dist/metapost/context/base/mp-core.mp new file mode 100644 index 00000000000..eb038163e35 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-core.mp @@ -0,0 +1,1352 @@ +%D \module +%D [ file=mp-core.mp, +%D version=2000.something, % 1999.08.12, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=core interfacing, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_core : endinput ; fi ; + +boolean context_core ; context_core := true ; + +pair lxy[], rxy[], cxy[], llxy[], lrxy[], ulxy[], urxy[] ; +path pxy[] ; +numeric hxy[], wxy[], dxy[], nxy[] ; + +def box_found (expr n,x,y,w,h,d) = + not ((x=0) and (y=0) and (w=0) and (h=0) and (d=0)) +enddef ; + +def initialize_box_pos (expr pos,n,x,y,w,h,d) = + pair lxy, rxy, cxy, llxy, lrxy, ulxy, urxy ; + path pxy ; numeric hxy, wxy, dxy, nxy; + lxy := (x,y) ; + llxy := (x,y-d) ; + lrxy := (x+w,y-d) ; + urxy := (x+w,y+h) ; + ulxy := (x,y+h) ; + wxy := w ; + hxy := h ; + dxy := d ; + rxy := lxy shifted (wxy,0) ; + pxy := llxy--lrxy--urxy--ulxy--cycle ; + cxy := center pxy ; + nxy := n ; + freeze_box(pos) ; +enddef ; + +def freeze_box (expr pos) = + lxy[pos] := lxy ; + llxy[pos] := llxy ; + lrxy[pos] := lrxy ; + urxy[pos] := urxy ; + ulxy[pos] := ulxy ; + wxy[pos] := wxy ; + hxy[pos] := hxy ; + dxy[pos] := dxy ; + rxy[pos] := rxy ; + pxy[pos] := pxy ; + cxy[pos] := cxy ; + nxy[pos] := nxy ; +enddef ; + +def initialize_box (expr n,x,y,w,h,d) = + + numeric bpos ; bpos := 0 ; initialize_box_pos(bpos,n,x,y,w,h,d) ; + +enddef ; + +def initialize_area (expr fn,fx,fy,fw,fh,fd, + tn,tx,ty,tw,th,td) = + + numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; + numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; + + do_initialize_area (fpos, tpos) ; + +enddef ; + +def do_initialize_area (expr fpos, tpos) = + lxy := lxy[fpos] ; + llxy := (xpart llxy[fpos], ypart llxy[tpos]) ; + lrxy := lrxy[tpos] ; + urxy := (xpart urxy[tpos], ypart urxy[fpos]) ; + ulxy := ulxy[fpos] ; + wxy := xpart lrxy - xpart llxy ; + hxy := hxy[fpos] ; + dxy := dxy[tpos] ; + rxy := lxy shifted (wxy,0) ; + pxy := llxy--lrxy--urxy--ulxy--cycle ; + cxy := center pxy ; +enddef ; + +def set_par_line_height (expr ph, pd) = + par_strut_height := + if ph>0 : ph elseif StrutHeight>0 : StrutHeight else : 8pt fi ; + par_strut_depth := + if pd>0 : pd elseif StrutDepth >0 : StrutDepth else : 3pt fi ; + par_line_height := + par_strut_height + par_strut_depth ; +enddef ; + +def initialize_par (expr fn,fx,fy,fw,fh,fd, + tn,tx,ty,tw,th,td, + mn,mx,my,mw,mh,md, + pn,px,py,pw,ph,pd, + rw,rl,rr,rh,ra,ri) = + + numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; + numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; + numeric mpos ; mpos := 3 ; initialize_box_pos(mpos,mn,mx,my,mw,mh,md) ; + numeric ppos ; ppos := 4 ; initialize_box_pos(ppos,pn,px,py,pw,ph,pd) ; + + numeric par_strut_height, par_strut_depth, par_line_height ; + + set_par_line_height (ph, pd) ; + + do_initialize_area (fpos, tpos) ; + do_initialize_par (fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) ; + +enddef ; + +def initialize_area_par (expr fn,fx,fy,fw,fh,fd, + tn,tx,ty,tw,th,td, + wn,wx,wy,ww,wh,wd) = + + numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; + numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; + numeric wpos ; wpos := 3 ; initialize_box_pos(wpos,wn,wx,wy,ww,wh,wd) ; + + numeric par_strut_height, par_strut_depth, par_line_height ; + + set_par_line_height (wh, wd) ; + + numeric ffpos ; ffpos := 4 ; initialize_box_pos(ffpos,wn,wx,fy,0,wh,wd) ; + numeric ttpos ; ttpos := 5 ; initialize_box_pos(ttpos,wn,wx+ww,ty,0,wh,wd) ; + + do_initialize_area (ffpos, ttpos) ; + + numeric mpos ; mpos := 6 ; freeze_box(mpos) ; + +% do_initialize_area (fpos, tpos) ; + do_initialize_par (fpos, tpos, mpos, ffpos, 0,0,0,0,0,0) ; + +enddef ; + +def do_initialize_par (expr fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) = + + pair lref, rref, pref, lhref, rhref ; + + % clip the page area to the left and right skips + + llxy[mpos] := llxy[mpos] shifted (+rl,0) ; + lrxy[mpos] := lrxy[mpos] shifted (-rr,0) ; + urxy[mpos] := urxy[mpos] shifted (-rr,0) ; + ulxy[mpos] := ulxy[mpos] shifted (+rl,0) ; + + % fixate the leftskip, rightskip and hanging indentation + + lref := (xpart llxy[mpos],ypart ulxy[ppos]) ; lhref := lref shifted (rh,0) ; + rref := (xpart lrxy[mpos],ypart urxy[ppos]) ; rhref := rref shifted (rh,0) ; + + pref := lxy[ppos] ; + + if nxy[tpos] > nxy[fpos] : + if nxy[fpos] = nxy[mpos] : + % first of multiple pages + llxy[tpos] := llxy[mpos] ; + lrxy[tpos] := lrxy[mpos] ; + urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; + ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; + boxgriddirection := down ; + elseif nxy[tpos] = nxy[mpos] : + % last of multiple pages + llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; + lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; + urxy[fpos] := urxy[mpos] ; + ulxy[fpos] := ulxy[mpos] ; + boxgriddirection := up ; + else : + % middle of multiple pages + llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; + lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; + urxy[fpos] := urxy[mpos] ; + ulxy[fpos] := ulxy[mpos] ; + llxy[tpos] := llxy[mpos] ; + lrxy[tpos] := lrxy[mpos] ; + urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; + ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; + boxgriddirection := up ; + fi ; + else : + % just one page + boxgriddirection := up ; + fi ; + + path txy, bxy, pxy, mxy ; + + txy := originpath ; % top + bxy := originpath ; % bottom + pxy := originpath ; % composed + + boolean lefthang, righthang, somehang ; + + % we only hang on the first of a multiple page background + + if nxy[mpos] > nxy[fpos] : + lefthang := righthang := somehang := false ; + else : + lefthang := (rh>0) ; righthang := (rh<0) ; somehang := false ; + fi ; + + if lefthang : + mxy := boundingbox (lref -- lref shifted (rh,ra*par_line_height)) ; + elseif righthang : + mxy := boundingbox (rref -- rref shifted (rh,ra*par_line_height)) ; + else : + mxy := originpath ; + fi ; + + if round(ypart llxy[fpos]) = round(ypart llxy[tpos]) : + + % We have a one-liner. Watch how er use the bottom pos for + % determining the height. + + llxy[fpos] := (xpart llxy[fpos], ypart llxy[tpos]) ; + ulxy[fpos] := (xpart ulxy[fpos], ypart ulxy[tpos]) ; + + else : + + % We have a multi-liner. For convenience we now correct the + % begin and end points for indentation. + + if lefthang and (round(ypart llxy[tpos]) >= round(ypart lrcorner mxy)) : + llxy[tpos] := (xpart lhref, ypart llxy[tpos]) ; + ulxy[tpos] := (xpart lhref, ypart ulxy[tpos]) ; + else : + llxy[tpos] := (xpart lref, ypart llxy[tpos]) ; + ulxy[tpos] := (xpart lref, ypart ulxy[tpos]) ; + fi ; + + if righthang and (round(ypart lrxy[fpos]) >= round(ypart llcorner mxy)) : + lrxy[fpos] := (xpart rhref, ypart lrxy[fpos]) ; + urxy[fpos] := (xpart rhref, ypart urxy[fpos]) ; + else : + lrxy[fpos] := (xpart rref, ypart lrxy[fpos]) ; + urxy[fpos] := (xpart rref, ypart urxy[fpos]) ; + fi ; + + fi ; + + somehang := (ypart ulxy[fpos]>ypart llcorner mxy) and + (ypart llxy[tpos]<ypart llcorner mxy) ; + + if round(ypart llxy[fpos]) = round(ypart llxy[tpos]) : + + % A (short) one-liner goes into the top box. + + txy := llxy[fpos] -- lrxy[tpos] -- urxy[tpos] -- ulxy[fpos] -- cycle ; + + elseif (round(ypart llxy[fpos]) = round(ypart ulxy[tpos])) and + (round(xpart lrxy[tpos]) < round(xpart llxy[fpos])) : + + % We have a sentence that spans two lines but with only end + % of line and begin of line segments. We need to take care of + % indentation. + + txy := llxy[fpos] -- lrxy[fpos] -- urxy[fpos] -- ulxy[fpos] -- cycle ; + bxy := llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- ulxy[tpos] -- cycle ; + + elseif (round(ypart llxy[fpos]) = round(ypart ulxy[tpos])) : + + % We have a sentence that spans two lines but with overlap. + + pxy := llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- lrxy[fpos] -- + urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- ulxy[tpos] -- cycle ; + + elseif lefthang and somehang : + + % We have a sentence that spans more than two lines with + % left hanging indentation. + + pxy := llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- + (xpart urxy[fpos],ypart urxy[tpos]) -- + urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- + if round(ypart urxy[tpos]) < round(ypart llcorner mxy) : + (xpart lrcorner mxy,ypart llxy[fpos]) -- + lrcorner mxy -- + (xpart llxy[tpos],ypart llcorner mxy) -- + else : + (xpart llxy[tpos],ypart llxy[fpos]) -- + fi + cycle ; + + elseif righthang and somehang : + + % We have a sentence that spans more than two lines with + % right hanging indentation. + + pxy := llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- + if round(ypart urxy[tpos]) < round(ypart llcorner mxy) : + (xpart lrcorner mxy,ypart urxy[tpos]) -- + lrcorner mxy -- llcorner mxy -- + else : + (xpart urxy[fpos],ypart urxy[tpos]) -- + fi + urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- + (xpart llxy[tpos],ypart llxy[fpos]) -- + cycle ; + + else : + + % We have a sentence that spans more than two lines with + % no hanging indentation. + + pxy := llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- + (xpart urxy[fpos],ypart urxy[tpos]) -- + urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- + (xpart llxy[tpos],ypart llxy[fpos]) -- cycle ; + + fi ; + + pxy := simplified pxy ; + pxy := unspiked pxy ; + +enddef ; + +TopSkip := 0 ; % will move +StrutHeight := 0 ; % will move + +pair last_multi_par_shift ; last_multi_par_shift := origin ; + +def relocate_multipars (expr xy) = + last_multi_par_shift := xy ; + for i=1 upto nofmultipars : + multipars[i] := multipars[i] shifted last_multi_par_shift ; + endfor ; +enddef ; + +boolean compensate_multi_par_topskip ; +boolean span_multi_column_pars ; +boolean auto_multi_par_hsize ; +boolean enable_multi_par_fallback ; + +compensate_multi_par_topskip := true ; +span_multi_column_pars := false ; +auto_multi_par_hsize := false ; % true ; +enable_multi_par_fallback := true ; + +vardef multi_par_at_top (expr i) = + (round (ypart ulcorner multipars[i]) = round (ypart ulcorner + (TextAreas[multirefs[i]] shifted last_multi_par_shift))) +enddef ; + +numeric nofmultipars ; nofmultipars := 0 ; + +boolean obey_multi_par_hang ; obey_multi_par_hang := true ; +boolean obey_multi_par_more ; obey_multi_par_more := true ; +boolean snap_multi_par_tops ; snap_multi_par_tops := true ; +boolean local_multi_par_area ; local_multi_par_area := false ; +boolean ignore_multi_par_page ; ignore_multi_par_page := false ; + +boolean one_piece_multi_par ; one_piece_multi_par := false ; + +def simplify_multi_pars = % boundingbox ipv shape als optie + for i := 1 upto nofmultipars : + multipars[i] := boundingbox multipars[i] ; + endfor ; +enddef ; + +def save_multipar (expr i, l, p) = + nofmultipars := nofmultipars + 1 ; + multirefs[nofmultipars] := i ; + multilocs[nofmultipars] := l ; + multipars[nofmultipars] := unspiked (simplified p) ; +enddef ; + +def prepare_multi_pars (expr fn,fx,fy,fw,fh,fd, + tn,tx,ty,tw,th,td, + wn,wx,wy,ww,wh,wd, + pn,px,py,pw,ph,pd, + rw,rl,rr,rh,ra,ri) = + + if span_multi_column_pars : + begingroup ; + save TextAreas ; path TextAreas[] ; + save NOfTextAreas ; numeric NOfTextAreas ; + for i=1 upto NOfTextColumns : + TextAreas[i] := TextColumns[i] ; + endfor ; + NOfTextAreas := NOfTextColumns ; + fi ; + + last_multi_par_shift := origin ; + + numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; + numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; + numeric wpos ; wpos := 3 ; initialize_box_pos(wpos,wn,wx,wy,ww,wh,wd) ; + numeric ppos ; ppos := 4 ; initialize_box_pos(ppos,pn,px,py,pw,ph,pd) ; + + if local_multi_par_area : + RealPageNumber := fn ; + NOfTextAreas := 1 ; + NOfSavedTextAreas := 0 ; + TextAreas[1] := TextAreas[0] ; + TextColumns[1] := TextColumns[0] ; + nxy[fpos] := nxy[tpos] := nxy[wpos] := nxy[ppos] := RealPageNumber ; + % draw TextColumns[1] withcolor green ; + % draw TextAreas[1] withcolor green ; + elseif ignore_multi_par_page : + RealPageNumber := fn ; + nxy[fpos] := nxy[tpos] := nxy[wpos] := nxy[ppos] := RealPageNumber ; + fi ; + + numeric par_strut_height, par_strut_depth, par_line_height ; + + set_par_line_height (ph, pd) ; + + numeric par_hang_indent, par_hang_after, par_indent, par_left_skip ; + + par_hang_indent := rh ; + par_hang_after := ra ; + par_indent := ri ; + par_left_skip := rl ; + + pair par_start_pos ; + +% par_start_pos := llxy[fpos] if par_indent<0: shifted (-par_indent,0) fi ; + + par_start_pos := llxy[fpos] + if par_indent <0: shifted (-par_indent, 0) fi + if par_left_skip<0: shifted (-par_left_skip,0) fi ; + + if wxy[wpos]>0 : + left_skip := rl + xpart llxy[wpos] - xpart llxy[ppos] ; + right_skip := rw - left_skip - ww ; + else : + left_skip := rl ; + right_skip := rr ; + fi ; + + path multipar, multipars[] ; + numeric multiref, multirefs[] ; + numeric multiloc, multilocs[] ; % 1=begin 2=between 3=end + + numeric multi_par_pages ; multi_par_pages := nxy[tpos]-nxy[fpos]+1 ; + + ii := 0 ; nn := NOfTextAreas+1 ; nofmultipars := 0 ; + + vardef snapped_multi_pos (expr p) = + if snap_multi_par_tops : + if abs(ypart p - ypart ulcorner multipar) < par_line_height : + (xpart p,ypart ulcorner multipar) + else : + p + fi + else : + p + fi + enddef ; + + % def set_multipar (expr i) = + % ((TextAreas[i] leftenlarged -left_skip) rightenlarged -right_skip) + % enddef ; + + vardef set_multipar (expr i) = + ( (TextAreas[i] leftenlarged -left_skip) rightenlarged (-right_skip + if auto_multi_par_hsize : + rw - bbwidth(TextAreas[i]) fi) ) + enddef ; + + vardef top_multi_par(expr p) = + (round(estimated_par_lines(bbheight(p)*par_line_height))=round(bbheight(p))) + enddef ; + + vardef multi_par_tsc(expr p) = + if top_multi_par(p) : TopSkipCorrection else : 0 fi + enddef ; + + vardef estimated_par_lines (expr h) = + round(h/par_line_height) + enddef ; + + vardef estimated_multi_par_height (expr n, t) = + if round(par_line_height)=0 : + 0 + else : + save ok, h ; boolean ok ; + numeric h ; h := 0 ; + ok := false ; + if (nxy[fpos]=RealPageNumber-1) : + for i := 1 upto NOfSavedTextAreas : + if (InsideSavedTextArea(i,par_start_pos)) : + ok := true ; + h := h + estimated_par_lines(ypart ulxy[fpos] - + ypart llcorner SavedTextAreas[i]) ; + elseif ok : + h := h + estimated_par_lines(bbheight(SavedTextAreas[i])) ; + fi ; + endfor ; + fi ; + if ok : + for i := 1 upto n-1 : + h := h + estimated_par_lines(bbheight(TextAreas[i])) ; + endfor ; + else : + % already: ok := false ; + for i := 1 upto n-1 : + if (InsideTextArea(i,par_start_pos)) : + ok := true ; + h := h + estimated_par_lines(ypart ulxy[fpos] - ypart llcorner TextAreas[i]) ; + elseif ok : + h := h + estimated_par_lines(bbheight(TextAreas[i])) ; + fi ; + endfor ; + fi ; + h + fi + enddef ; + + vardef left_top_hang (expr same_area) = + +par_hang_after := ra + estimated_par_lines(py-fy) ; + + if (par_hang_indent>0) and (par_hang_after<0) and obey_multi_par_hang : + pair _ul_ ; _ul_ := (xpart ulcorner multipar, ypart snapped_multi_pos(ulxy[fpos])); + pair _pa_ ; _pa_ := _ul_ shifted (0,par_hang_after*par_line_height) ; +% _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; + _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llcorner multipar)) ; + if same_area : +% _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])) ; + _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llxy[tpos])) ; + fi ; + if obey_multi_par_more and (round(par_line_height)>0) : + par_hang_after := min(0,round(par_hang_after + + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; + fi ; + (xpart _ul_ + par_hang_indent, ypart lrxy[fpos]) -- + (xpart _ul_ + par_hang_indent, ypart _pa_) -- + (xpart ulcorner multipar, ypart _pa_) + else : + (xpart ulcorner multipar, ypart lrxy[fpos]) + fi + enddef ; + + vardef right_top_hang (expr same_area) = + +% par_hang_after := ra - estimated_par_lines(py-fy) ; +par_hang_after := ra + estimated_par_lines(py-fy) ; + + if (par_hang_indent<0) and (par_hang_after<0) and obey_multi_par_hang : + pair _ur_ ; _ur_ := (xpart urcorner multipar, ypart snapped_multi_pos(urxy[fpos])) ; + pair _pa_ ; _pa_ := _ur_ shifted (0,par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llcorner multipar)) ; + if same_area : + _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart snapped_multi_pos(ulxy[tpos]))) ; + fi ; + if obey_multi_par_more and (round(par_line_height)>0) : + par_hang_after := min(0,round(par_hang_after + + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; + fi ; + (xpart urcorner multipar, ypart _pa_) -- + (xpart _ur_ + par_hang_indent, ypart _pa_) -- + (xpart _ur_ + par_hang_indent, ypart snapped_multi_pos(urxy[fpos])) + else : + (xpart urcorner multipar, ypart snapped_multi_pos(urxy[fpos])) + fi + enddef ; + + vardef x_left_top_hang (expr i, t) = + par_hang_after := min(0,ra + estimated_multi_par_height(i,t)) ; + if (par_hang_indent>0) and (par_hang_after<0) : + pair _ul_ ; _ul_ := ulcorner multipar ; + pair _pa_ ; _pa_ := _ul_ shifted (0,par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; + +if t : + _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])); +fi ; +if abs(ypart _pa_-ypart llxy[tpos])<par_line_height : + _pa_ := (xpart _pa_,ypart llxy[tpos]); +fi ; +if abs(ypart _pa_-ypart llcorner multipar)<par_line_height : + _pa_ := (xpart _pa_,ypart llcorner multipar); +fi ; + + (xpart _ul_, ypart _pa_) -- + (xpart _ul_ + par_hang_indent, ypart _pa_) -- + (xpart _ul_ + par_hang_indent, ypart _ul_) + else : + ulcorner multipar + fi + enddef ; + +% here + + vardef x_right_top_hang (expr i, t) = + par_hang_after := min(0,ra + estimated_multi_par_height(i,t)) ; + if (par_hang_indent<0) and (par_hang_after<0) : + pair _ur_ ; _ur_ := urcorner multipar ; + pair _pa_ ; _pa_ := _ur_ shifted (0,par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart lrcorner multipar)) ; +if t : + _pa_ := (xpart _pa_,max(ypart _pa_,ypart snapped_multi_pos(urxy[tpos]))) ; +fi ; + +%todo +% +%if abs(ypart _pa_-ypart llxy[tpos])<par_line_height : +% _pa_ := (xpart _pa_,ypart llxy[tpos]); +%fi ; +%if abs(ypart _pa_-ypart llcorner multipar)<par_line_height : +% _pa_ := (xpart _pa_,ypart llcorner multipar); +%fi ; + + (xpart _ur_ + par_hang_indent, ypart _ur_) -- + (xpart _ur_ + par_hang_indent, ypart _pa_) -- + (xpart _ur_, ypart _pa_) + else : + urcorner multipar + fi + enddef ; + + vardef left_bottom_hang (expr same_area) = + pair _ll_, _sa_, _pa_ ; + _sa_ := if same_area : llxy[tpos] else : lrcorner multipar fi ; + if (par_hang_indent>0) and (par_hang_after>0) and obey_multi_par_hang : + _ll_ := (xpart ulcorner multipar, ypart snapped_multi_pos(ulxy[fpos])) ; + _pa_ := _ll_ shifted (0,-par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; + if same_area : + _pa_ := (xpart _pa_,max(ypart _pa_,ypart _sa_)) ; + fi ; + if obey_multi_par_more and (round(par_line_height)>0) : + par_hang_after := max(0,round(par_hang_after - + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; + fi ; + _pa_ -- + (xpart _pa_ + par_hang_indent,ypart _pa_) -- + (xpart _pa_ + par_hang_indent,ypart _sa_) + else : + (xpart llcorner multipar, ypart _sa_) + fi + enddef ; + + vardef right_bottom_hang (expr same_area) = + pair _lr_, _sa_, _pa_ ; + _sa_ := if same_area : snapped_multi_pos(ulxy[tpos]) else : lrcorner multipar fi ; + if (par_hang_indent<0) and (par_hang_after>0) and obey_multi_par_hang : + _lr_ := (xpart urcorner multipar, ypart snapped_multi_pos(urxy[fpos])) ; + _pa_ := _lr_ shifted (0,-par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart lrcorner multipar)) ; + if same_area : + _pa_ := (xpart _pa_,max(ypart _pa_,ypart snapped_multi_pos(ulxy[tpos]))) ; + fi ; + if obey_multi_par_more and (round(par_line_height)>0) : + par_hang_after := max(0,round(par_hang_after - + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; + fi ; + (xpart _pa_ + par_hang_indent,ypart _sa_) -- + (xpart _pa_ + par_hang_indent,ypart _pa_) -- + _pa_ + else : + (xpart lrcorner multipar, ypart _sa_) + fi + enddef ; + + vardef x_left_bottom_hang (expr i, t) = + pair _ll_, _sa_, _pa_ ; + _sa_ := if t : llxy[tpos] else : llcorner multipar fi ; + if (par_hang_indent>0) and (ra>0) : + par_hang_after := max(0,ra - estimated_multi_par_height(i,t)) ; + _ll_ := ulcorner multipar ; + _pa_ := _ll_ shifted (0,-par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart _sa_)) ; + % we need to compensate for topskip enlarged areas + if abs(ypart _pa_ - ypart _sa_) > par_line_height : + (xpart _pa_ + par_hang_indent,ypart _sa_) -- + (xpart _pa_ + par_hang_indent,ypart _pa_) -- + fi + _pa_ + else : + (xpart llcorner multipar, ypart _sa_) + fi + enddef ; + + vardef x_right_bottom_hang (expr i, t) = + pair _lr_, _sa_, _pa_ ; + _sa_ := if t : snapped_multi_pos(ulxy[tpos]) else : llcorner multipar fi ; + if (par_hang_indent<0) and (ra>0) : + par_hang_after := max(0,ra - estimated_multi_par_height(i, t)) ; + _lr_ := urcorner multipar ; + _pa_ := _lr_ shifted (0,-par_hang_after*par_line_height) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart lrcorner multipar)) ; + _pa_ := (xpart _pa_,max(ypart _pa_,ypart _sa_)) ; + % we need to compensate for topskip enlarged areas + _pa_ + if abs(ypart _pa_ - ypart _sa_) > par_line_height : + -- (xpart _pa_ + par_hang_indent,ypart _pa_) + -- (xpart _pa_ + par_hang_indent,ypart _sa_) + fi + else : + (xpart lrcorner multipar, ypart _sa_) + fi + enddef ; + + def test_multipar = +% multipar := +% llcorner multipar -- +% urcorner multipar -- +% lrcorner multipar -- +% ulcorner multipar -- +% cycle ; + multipar := boundingbox multipar ; + enddef ; + + % first loop + + if enable_multi_par_fallback and + (nxy[fpos]=RealPageNumber) and + (nxy[tpos]=RealPageNumber) and not + (InsideSomeTextArea(lxy[fpos]) and + InsideSomeTextArea(rxy[tpos])) : + + % fallback + + multipar := + + llxy[fpos] -- + lrxy[tpos] -- + urxy[tpos] -- + ulxy[fpos] -- cycle ; + + save_multipar (1,1,multipar) ; + + else : + + % normal + + for i=1 upto NOfTextAreas : + + TopSkipCorrection := 0 ; + + multipar := set_multipar(i) ; + + % watch how we compensate for negative indentation + + if (nxy[fpos]=RealPageNumber) and (InsideTextArea(i,par_start_pos)) : + + + % first one in chain + + ii := i ; + + if (nxy[tpos]=RealPageNumber) and (InsideTextArea(i,llxy[tpos])) : + + % in same area + + nn := i ; + + if compensate_multi_par_topskip and (round(LineHeight-ph-pd)=0) : + + TopSkipCorrection := TopSkip - StrutHeight ; + + if round(ypart ulxy[fpos] + TopSkipCorrection) = + round(ypart ulcorner TextAreas[i]) : + ulxy[fpos] := ulxy[fpos] shifted (0,TopSkipCorrection) ; + urxy[fpos] := urxy[fpos] shifted (0,TopSkipCorrection) ; + else : + TopSkipCorrection := 0 ; + fi ; + + fi ; + + if ypart llxy[fpos] = ypart llxy[tpos] : + + multipar := + llxy[fpos] -- + lrxy[tpos] -- + %urxy[tpos] -- + snapped_multi_pos(urxy[tpos]) -- + %ulxy[fpos] -- + snapped_multi_pos(ulxy[fpos]) -- + cycle ; + + save_multipar (i,1,multipar) ; + + elseif (ypart llxy[fpos] = ypart ulxy[tpos]) and + (xpart llxy[tpos] < xpart llxy[fpos]) : + + % two loners + + multipar := if obey_multi_par_hang : + + right_bottom_hang(true) -- + right_top_hang(true) -- + snapped_multi_pos(urxy[fpos]) -- + lrxy[fpos] -- + + else : + + llxy[fpos] -- + (xpart urcorner multipar, ypart llxy[fpos]) -- + (xpart urcorner multipar, ypart ulxy[fpos]) -- + snapped_multi_pos(ulxy[fpos]) -- + + fi cycle ; + + save_multipar (i,1,multipar) ; + + multipar := set_multipar(i) ; + + multipar := if obey_multi_par_hang : + + left_bottom_hang(true) -- + llxy[tpos] -- + snapped_multi_pos(ulxy[tpos]) -- + left_top_hang(true) -- + + else : + + (xpart llcorner multipar, ypart llxy[tpos]) -- + llxy[tpos] -- + snapped_multi_pos(ulxy[tpos]) -- + (xpart llcorner multipar, ypart ulxy[tpos]) -- + + fi cycle ; + + save_multipar (i,1,multipar) ; + + else : + + multipar := if obey_multi_par_hang : + + left_bottom_hang(true) -- + llxy[tpos] -- + %ulxy[tpos] -- + snapped_multi_pos(ulxy[tpos]) -- + right_bottom_hang(true) -- + right_top_hang(true) -- + %urxy[fpos] -- + snapped_multi_pos(urxy[fpos]) -- + lrxy[fpos] -- + left_top_hang(true) -- + + else : + + (xpart llcorner multipar, ypart llxy[tpos]) -- + llxy[tpos] -- + %ulxy[tpos] -- + snapped_multi_pos(ulxy[tpos]) -- + (xpart lrcorner multipar, ypart ulxy[tpos]) -- + (xpart urcorner multipar, ypart urxy[fpos]) -- + %urxy[fpos] -- + snapped_multi_pos(urxy[fpos]) -- + lrxy[fpos] -- + (xpart ulcorner multipar, ypart lrxy[fpos]) -- + + fi cycle ; + + save_multipar (i,1,multipar) ; + + fi ; + + else : + + multipar := if obey_multi_par_hang : + + left_bottom_hang(false) -- + right_bottom_hang(false) -- + right_top_hang(false) -- + %urxy[fpos] -- + snapped_multi_pos(urxy[fpos]) -- + lrxy[fpos] -- + left_top_hang(false) -- + + else : + + llcorner multipar -- + lrcorner multipar -- + (xpart urcorner multipar, ypart urxy[fpos]) -- + %urxy[fpos] -- + snapped_multi_pos(urxy[fpos]) -- + lrxy[fpos] -- + (xpart ulcorner multipar, ypart lrxy[fpos]) -- + + fi cycle ; + + save_multipar (i,1,multipar) ; + + fi ; + + elseif (nxy[tpos]=RealPageNumber) and (InsideTextArea(i,llxy[tpos])) : + + % last one in chain + + nn := i ; + + if obey_multi_par_hang and obey_multi_par_more : + + multipar := + x_left_top_hang(i,true) -- + x_right_top_hang(i,true) -- + x_right_bottom_hang(i,true) -- +% ulxy[tpos] -- +snapped_multi_pos(ulxy[tpos]) -- + llxy[tpos] -- + x_left_bottom_hang(i,true) -- + cycle ; + + else : + + multipar := + ulcorner multipar -- + urcorner multipar -- + (xpart lrcorner multipar, ypart urxy[tpos]) -- +% ulxy[tpos] -- +snapped_multi_pos(ulxy[tpos]) -- + llxy[tpos] -- + (xpart llcorner multipar, ypart llxy[tpos]) -- + cycle ; + + fi ; + + save_multipar (i,3,multipar) ; + + else : + + % handled later + + fi ; + + endfor ; + + % second loop + + for i=ii+1 upto nn-1 : + + % rest of chain / todo : hang + +%if (nxy[fpos]<=RealPageNumber) and (nxy[tpos]>=RealPageNumber) : + + multipar := set_multipar(i) ; + + if obey_multi_par_hang and obey_multi_par_more : + + multipar := + x_left_top_hang(i,false) -- + x_right_top_hang(i,false) -- + x_right_bottom_hang(i,false) -- + x_left_bottom_hang(i,false) -- + cycle ; + + fi ; + + save_multipar(i,2,multipar) ; + +%fi ; + + endfor ; + + % end of normal/fallback + +fi ; + + if span_multi_column_pars : + endgroup ; + fi ; + + % quick hack for gb: + + one_piece_multi_par := (nofmultipars=1) and (pn=tn) ; + +enddef ; + +color boxgridcolor ; boxgridcolor := .8red ; +color boxlinecolor ; boxlinecolor := .8blue ; +color boxfillcolor ; boxfillcolor := .8white ; +numeric boxgridtype ; boxgridtype := 0 ; +numeric boxlinetype ; boxlinetype := 1 ; +numeric boxfilltype ; boxfilltype := 1 ; +pair boxgriddirection ; boxgriddirection := up ; +numeric boxgridwidth ; boxgridwidth := 1pt ; +numeric boxlinewidth ; boxlinewidth := 1pt ; +numeric boxlineradius ; boxlineradius := 0pt ; +numeric boxfilloffset ; boxfilloffset := 0pt ; +numeric boxgriddistance ; boxgriddistance := .5cm ; + +def draw_box = + draw pxy withcolor boxlinecolor withpen pencircle scaled boxlinewidth ; + draw lxy -- rxy withcolor boxlinecolor withpen pencircle scaled boxgridwidth ; +enddef ; + +def draw_par = % 1 2 3 11 12 + do_draw_par(pxy) ; do_draw_par(txy) ; do_draw_par(bxy) ; + for i = pxy, txy, bxy : + if boxgridtype= 1 : + boxgriddirection := origin ; + draw baseline_grid (i,boxgriddirection,true ) withcolor boxgridcolor ; + elseif boxgridtype= 2 : + boxgriddirection := origin ; + draw baseline_grid (i,boxgriddirection,false) withcolor boxgridcolor ; + elseif boxgridtype= 3 : + boxgriddirection := origin ; + draw baseline_grid (i,boxgriddirection,true ) withcolor boxgridcolor ; + draw baseline_grid (i,boxgriddirection,true ) + shifted (0,ExHeight) withcolor boxgridcolor ; + elseif boxgridtype=11 : + draw graphic_grid(i,boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; + elseif boxgridtype=12 : + draw graphic_grid(i,boxgriddistance,boxgriddistance,0,0) ; + fi ; + endfor ; +enddef ; + +def do_show_par (expr p, r, c) = + if length(p) > 2 : for i=0 upto length(p) : + draw fullcircle scaled r shifted point i of p + withpen pencircle scaled .5pt withcolor c ; + endfor ; fi ; + draw p withpen pencircle scaled .5pt withcolor c ; +enddef ; + +def show_par = + if length(mxy) > 2 : + draw mxy dashed evenly + withpen pencircle scaled .5pt withcolor .5white ; + fi ; + do_show_par(txy, 4pt, .5green) ; + do_show_par(bxy, 6pt, .5blue ) ; + do_show_par(pxy, 8pt, .5red ) ; + draw pref withpen pencircle scaled 2pt ; +enddef ; + +def sort_multi_pars = + if nofmultipars>1 : + begingroup ; save _p_, _n_ ; path _p_ ; numeric _n_ ; + for i := 1 upto nofmultipars : + if multilocs[i] = 3 : + _p_ := multipars[nofmultipars] ; + multipars[nofmultipars] := multipars[i] ; + multipars[i] := _p_ ; + _n_ := multirefs[nofmultipars] ; + multirefs[nofmultipars] := multirefs[i] ; + multirefs[i] := _n_ ; + _n_ := multilocs[nofmultipars] ; + multilocs[nofmultipars] := multilocs[i] ; + multilocs[i] := _n_ ; + fi ; + endfor ; + endgroup ; + fi ; +enddef ; + +% This collapses successive areas (possibly interrupted by +% floats. First we need to sort the areas, since they are +% normally in de order start, end, inbetween. + +def collapse_multi_pars = + if nofmultipars>1 : + begingroup ; save _nofmultipars_ ; numeric _nofmultipars_ ; + _nofmultipars_ := 1 ; + sort_multi_pars ; % block not in order: 1, 3, 2.... + for i:=1 upto nofmultipars-1 : + if (round(xpart(llcorner multipars[i]-llcorner multipars[i+1]))=0) and + (round(xpart(lrcorner multipars[i]-lrcorner multipars[i+1]))=0) : +multilocs[_nofmultipars_] := multilocs[i+1] ; +multirefs[_nofmultipars_] := multirefs[i+1] ; + multipars[_nofmultipars_] := + ulcorner multipars[_nofmultipars_] -- + urcorner multipars[_nofmultipars_] -- + lrcorner multipars[i+1] -- + llcorner multipars[i+1] -- cycle ; + else : + _nofmultipars_ := _nofmultipars_ + 1 ; + multipars[_nofmultipars_] := multipars[i+1] ; + multilocs[_nofmultipars_] := multilocs[i+1] ; + multirefs[_nofmultipars_] := multirefs[i+1] ; + fi ; + endfor ; + nofmultipars := _nofmultipars_ ; + endgroup ; + fi ; +enddef ; + +def draw_multi_pars = + for i=1 upto nofmultipars : + do_draw_par(multipars[i]) ; + if boxgridtype= 1 : + draw baseline_grid (multipars[i],up,true ) withcolor boxgridcolor ; + elseif boxgridtype= 2 : + draw baseline_grid (multipars[i],up,false) withcolor boxgridcolor ; + elseif boxgridtype= 3 : + draw baseline_grid (multipars[i],up,true ) withcolor boxgridcolor ; + draw baseline_grid (multipars[i],up,true ) + shifted (0,ExHeight) withcolor boxgridcolor ; + elseif boxgridtype=11 : + draw graphic_grid(multipars[i],boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; + elseif boxgridtype=12 : + draw graphic_grid(multipars[i],boxgriddistance,boxgriddistance,0,0) ; + fi ; + endfor ; +enddef ; + +def show_multi_pars = + for i=1 upto nofmultipars : + do_show_par(multipars[i], 6pt, .5blue) ; + endfor ; +enddef ; + +vardef do_draw_par (expr p) = + if (length p>2) and (bbwidth(p)>1) and (bbheight(p)>1) : + save pp ; path pp ; + if (boxlineradius>0) and (boxlinetype=2) : + pp := p cornered boxlineradius ; + else : + pp := p ; + fi ; + if boxfilltype>0 : + if boxfilloffset>0 : + % temporary hack + begingroup ; interim linejoin := mitered ; + filldraw pp withcolor boxfillcolor withpen pencircle scaled (2*boxfilloffset) ; + endgroup ; + else : + fill pp withcolor boxfillcolor ; + fi ; + fi ; + if boxlinetype>0 : + draw pp withcolor boxlinecolor withpen pencircle scaled boxlinewidth ; + fi ; + fi ; +enddef ; + +vardef baseline_grid (expr pxy, pdir, at_baseline) = + if (par_line_height>0) and (bbheight(pxy)>1) and (bbwidth(pxy)>1) and (boxgridwidth>0) : + save i, grid ; picture grid ; pair start ; + def _do_ (expr start) = + draw start -- start shifted (bbwidth(pxy),0) + withpen pencircle scaled boxgridwidth + withcolor boxgridcolor ; + enddef ; + grid := image + ( %fails with inlinespace + % + if pdir=up : + for i = if at_baseline : par_strut_depth else : 0 fi + step par_line_height + until max(bbheight(pxy),par_line_height) : + _do_ (llcorner pxy shifted (0,+i)) ; + endfor ; + else : + for i = if at_baseline : par_strut_height else : 0 fi + step par_line_height + until bbheight(pxy) : + _do_ (ulcorner pxy shifted (0,-i)) ; + endfor ; + fi ; + ) ; + clip grid to pxy ; + grid + else : + nullpicture + fi +enddef ; + +vardef graphic_grid (expr pxy, dx, dy, x, y) = + if (bbheight(pxy)>dy) and (bbwidth(pxy)>dx) and (boxgridwidth>0) : + save grid ; picture grid ; + grid := image + ( for i = xpart llcorner pxy step dx until xpart lrcorner pxy : + draw (i,ypart llcorner pxy) -- (i,ypart ulcorner pxy) + withpen pencircle scaled boxgridwidth ; + endfor ; + for i = ypart llcorner pxy step dy until ypart ulcorner pxy : + draw (xpart llcorner pxy,i) -- (xpart lrcorner pxy,i) + withpen pencircle scaled boxgridwidth ; + endfor ) shifted (x,y) ; + clip grid to pxy ; + grid + else : + nullpicture + fi +enddef ; + +def anchor_box (expr n,x,y,w,h,d) = + currentpicture := currentpicture shifted (-x,-y) ; +enddef ; + +let draw_area = draw_box ; +let anchor_area = anchor_box ; +let anchor_par = anchor_box ; + +% new and experimental and yet undocumented + +numeric sync_n[], sync_p[][], sync_w[][], sync_h[][], sync_d[][], sync_t[][] ; +pair sync_xy[][] ; color sync_c[][] ; + +def ResetSyncTasks = + path SyncPaths[] ; numeric SyncTasks[], NOfSyncPaths, CurrentSyncClass ; + NOfSyncPaths := CurrentSyncClass := 0 ; + if unknown SyncLeftOffset : numeric SyncLeftOffset ; SyncLeftOffset := 0 ; fi ; + if unknown SyncWidth : numeric SyncWidth ; SyncWidth := 0 ; fi ; + if unknown SyncThreshold : numeric SyncThreshold ; SyncThreshold := LineHeight ; fi ; + if unknown SyncColor : color SyncColor ; SyncColor := .5white ; fi ; + if (SyncLeftOffset = 0) and (SyncWidth = 0) : + SyncWidth := if known TextWidth : TextWidth else : -1cm fi ; + fi ; +enddef ; + +ResetSyncTasks ; + +vardef SyncBox(expr n, i, leftoffset, width, topoffset, bottomoffset) = + save o ; pair o ; o := (xpart llcorner PlainTextArea,ypart sync_xy[n][i]) ; + o shifted (leftoffset,sync_h[n][i]+topoffset) -- + o shifted (width+leftoffset,sync_h[n][i]+topoffset) -- + o shifted (width+leftoffset,bottomoffset) -- + o shifted (leftoffset,bottomoffset) -- cycle +enddef ; + +def SetSyncColor(expr n, i, c) = + sync_c[n][i] := c ; +enddef ; + +def SetSyncThreshold(expr n, i, th) = + sync_th[n][i] := th ; +enddef ; + +vardef TheSyncColor(expr n, i) = + if known sync_c[n][i] : sync_c[n][i] else : SyncColor fi +enddef ; + +vardef TheSyncThreshold(expr n, i) = + if known sync_th[n][i] : sync_th[n][i] else : SyncThreshold fi +enddef ; + +vardef PrepareSyncTasks(expr n, collapse, extendtop, prestartnext) = + ResetSyncTasks ; + if known sync_n[n] : + CurrentSyncClass := n ; + save ok, l, d ; boolean ok ; ok := false ; NOfSyncPaths := l := 0 ; + for i=1 upto sync_n[n] : + if RealPageNumber > sync_p[n][i] : + l := i ; + elseif RealPageNumber = sync_p[n][i] : + NOfSyncPaths := NOfSyncPaths + 1 ; + if not ok : + if i>1 : +% not yet correct when two of the same follow each other + if sync_t[n][i-1] = sync_t[n][i] : + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + else : + SyncPaths[NOfSyncPaths] := SyncBox(n, i-1, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i-1 ; + NOfSyncPaths := NOfSyncPaths + 1 ; + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + fi ; + else : + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + fi ; + else : + SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := i ; + fi ; + ok := true ; + fi ; + endfor ; + if (NOfSyncPaths = 0) and (l > 0) : + NOfSyncPaths := 1 ; + SyncPaths[NOfSyncPaths] := SyncBox(n, l, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; + SyncTasks[NOfSyncPaths] := l ; + fi ; + if NOfSyncPaths > 0 : + for i = 1 upto NOfSyncPaths-1 : + SyncPaths[i] := topboundary SyncPaths[i] -- reverse topboundary SyncPaths[i+1] -- cycle ; + endfor ; + if unknown SyncThresholdMethod : + numeric SyncThresholdMethod ; SyncThresholdMethod := 2 ; + fi ; + if extendtop : + if SyncThresholdMethod = 1 : + if NOfSyncPaths>1 : + d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[2]]) ; + if (SyncTasks[2]>1) and (d > 0pt) and (d <= TheSyncThreshold(n,sync_t[n][SyncTasks[2]])) and (sync_p[n][SyncTasks[2]] = RealPageNumber) : + SyncPaths[2] := SyncPaths[2] topenlarged PaperHeight ; + fi ; + fi ; + else : + for i = 1 upto NOfSyncPaths : + d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[i]]) ; + if (d > 0) and (d <= TheSyncThreshold(n,sync_t[n][SyncTasks[i]])) and (sync_p[n][SyncTasks[i]] = RealPageNumber) : + SyncPaths[i] := SyncPaths[i] topenlarged PaperHeight ; + fi ; + endfor ; + fi ; + fi ; + if prestartnext : + if NOfSyncPaths>1 : + if SyncTasks[NOfSyncPaths] < sync_n[n] : % there is a next one + d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[NOfSyncPaths]+1]) ; + if (d > 0) and (d <= TheSyncThreshold(n, sync_t[n][SyncTasks[i]])) and (sync_p[n][SyncTasks[NOfSyncPaths]+1] = RealPageNumber+1) : + SyncPaths[NOfSyncPaths+1] := + (xpart ulcorner SyncPaths[NOfSyncPaths],ypart llcorner PlainTextArea) -- + (xpart urcorner SyncPaths[NOfSyncPaths],ypart llcorner PlainTextArea) -- + lrcorner SyncPaths[NOfSyncPaths] -- + llcorner SyncPaths[NOfSyncPaths] -- cycle ; + SyncTasks[NOfSyncPaths+1] := SyncTasks[NOfSyncPaths]+1 ; + NOfSyncPaths := NOfSyncPaths + 1 ; + fi ; + fi ; + fi ; + else : + if NOfSyncPaths>1 : + d := ypart (sync_xy[n][SyncTasks[NOfSyncPaths]] - llcorner PlainTextArea) ; + if (d < TheSyncThreshold(n, SyncTasks[NOfSyncPaths])) : + NOfSyncPaths := NOfSyncPaths - 1 ; + SyncPaths[NOfSyncPaths] := SyncPaths[NOfSyncPaths] bottomenlarged PaperHeight ; + fi ; + fi ; + fi ; + if (NOfSyncPaths>1) and collapse : + save j ; numeric j ; j := 1 ; + for i = 2 upto NOfSyncPaths : + if sync_t[n][SyncTasks[i]] = sync_t[n][SyncTasks[j]] : + SyncPaths[j] := boundingbox image (draw SyncPaths[i] ; draw SyncPaths[j] ; ) ; + SyncTasks[j] := SyncTasks[i] ; + else : + j := j + 1 ; + SyncPaths[j] := SyncPaths[i] ; + SyncTasks[j] := SyncTasks[i] ; + fi ; + endfor ; + NOfSyncPaths := j ; + fi ; + fi ; + fi ; +enddef ; + +def SyncTask(expr n) = + if known SyncTasks[n] : SyncTasks[n] else : 0 fi +enddef ; + +def FlushSyncTasks = + for i = 1 upto NOfSyncPaths : + ProcessSyncTask(SyncPaths[i], TheSyncColor(CurrentSyncClass,sync_t[CurrentSyncClass][SyncTasks[i]])) ; + endfor ; +enddef ; + +def ProcessSyncTask(expr p, c) = + fill p withcolor c ; +enddef ; + +endinput ;
\ No newline at end of file diff --git a/Master/texmf-dist/metapost/context/base/mp-figs.mp b/Master/texmf-dist/metapost/context/base/mp-figs.mp new file mode 100644 index 00000000000..aa6bc0399fb --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-figs.mp @@ -0,0 +1,50 @@ +%D \module +%D [ file=mp-tool.mp, +%D version=2003.01.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=figures, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_figs : endinput ; fi ; + +boolean context_figs ; context_figs := true ; + +% todo: check defined + +def registerfigure(expr name,width,height) = + begingroup ; + save s ; string s ; s := cleanstring(name) ; + scantokens( s & "_width := " & decimal(width)) ; + scantokens( s & "_height := " & decimal(width)) ; + endgroup ; +enddef ; + +vardef figuresize(expr name) = + save s ; string s ; s := cleanstring(name) ; + save p ; pair p ; + scantokens( "p := " & "(" & s & "_width" & "," & s & "_height" & ")" ) ; + p +enddef ; + +vardef figurewidth(expr name) = + xpart figuresize(name) +enddef ; + +vardef figureheight(expr name) = + ypart figuresize(name) +enddef ; + +def figuredimensions = figuresize enddef ; % for old times sake + +def naturalfigure(expr name) = + externalfigure name xyscaled(figuresize(name)) +enddef ; + +endinput diff --git a/Master/texmf-dist/metapost/context/base/mp-fobg.mp b/Master/texmf-dist/metapost/context/base/mp-fobg.mp new file mode 100644 index 00000000000..712efe751aa --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-fobg.mp @@ -0,0 +1,88 @@ +%D \module +%D [ file=mp-fobg.mp, +%D version=2004.03.12, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=Formatting Objects, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_fobg : endinput ; fi ; + +boolean context_fobg ; context_fobg := true ; + +FoNone := 0 ; FoHidden := 1 ; FoDotted := 2 ; FoDashed := 3 ; FoSolid := 4 ; +FoDouble := 5 ; FoGroove := 6 ; FoRidge := 7 ; FoInset := 8 ; FoOutset := 9 ; +FoAll := 0 ; FoTop := 1 ; FoBottom := 2 ; FoLeft := 3 ; FoRight := 4 ; +FoMedium := .5pt ; FoThin := FoMedium/2 ; FoThick := FoMedium*2 ; + +color FoBackgroundColor, FoNoColor, FoLineColor[] ; FoNoColor := (-1,-1,-1) ; +numeric FoLineWidth[], FoLineStyle[] ; +boolean FoFrame, FoBackground, FoSplit ; + +FoFrame := FoBackground := FoSplit := false ; +FoBackgroundColor := white ; +FoDashFactor := .5 ; +FoDotFactor := .375 ; + +for i = FoAll upto FoRight : + FoLineColor[i] := black ; + FoLineWidth[i] := .5pt ; + FoLineStyle[i] := FoNone ; +endfor ; + +def DrawFoFrame(expr n, p) = + drawoptions(withcolor FoLineColor[n] withpen pencircle scaled FoLineWidth[n]) ; + if FoLineStyle[n] = FoNone : + % nothing + elseif FoLineStyle[n] = FoHidden : + % nothing + elseif FoLineStyle[n] = FoDotted : + draw p dashed (withdots scaled (FoDotFactor*FoLineWidth[n])) ; + elseif FoLineStyle[n] = FoDashed : + draw p dashed (evenly scaled (FoDashFactor*FoLineWidth[n])) ; + elseif FoLineStyle[n] = FoSolid : + draw p ; + elseif FoLineStyle[n] = FoDouble : + draw p enlarged FoLineWidth[n] ; draw p enlarged -FoLineWidth[n] ; + elseif FoLineStyle[n] = FoGroove : + draw p ; + draw p withpen pencircle scaled .5FoLineWidth[n] withcolor (inverted FoLineColor[n] softened .5) ; + elseif FoLineStyle[n] = FoRidge : + draw p withcolor (inverted FoLineColor[n] softened .5) ; + draw p withpen pencircle scaled .5FoLineWidth[n] ; + elseif FoLineStyle[n] = FoInset : + draw p ; draw p inset 2.5FoLineWidth[n] ; + elseif FoLineStyle[n] = FoOutset : + draw p ; draw p outset 2.5FoLineWidth[n] ; + fi ; +enddef ; + +primarydef p outset d = + ((lrcorner p -- urcorner p -- ulcorner p -- llcorner p -- cycle) + shifted (d*(-1,1)) cutbefore topboundary p) cutafter leftboundary p +enddef ; + +primarydef p inset d = + ((ulcorner p -- llcorner p -- lrcorner p -- urcorner p -- cycle) + shifted (d*(1,-1)) cutbefore bottomboundary p) cutafter rightboundary p +enddef ; + +vardef equalpaths(expr p, q) = + if length(p) = length(q) : + save ok ; boolean ok ; ok := true ; + for i = 0 upto length(p)-1 : + ok := ok and (round(point i of p) = round(point i of q)) ; + endfor ; + ok + else : + false + fi +enddef ; + +endinput ; diff --git a/Master/texmf-dist/metapost/context/base/mp-form.mp b/Master/texmf-dist/metapost/context/base/mp-form.mp new file mode 100644 index 00000000000..bad87651c17 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-form.mp @@ -0,0 +1,397 @@ +% 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 + +boolean mant_font ; mant_font := true ; % signals graph not to load form + +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 + if fmt_metapost : + Fe_base := Fline_up_("1" infont Fmfont_ scaled Fmscale_, Femarker_) ; + % else : + % sFe_base := Fline_up_("1", sFemarker_) ; + fi ; + 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 isfmtseparator primary c = %%% added by HH %%% + ((c <> fmt_separator) and (c <> "%")) +enddef ; + +def initialize_form_numbers = + initialize_numbers ; % in context: do_initialize_numbers ; +enddef ; + +vardef dofmt_@#(expr f, x) = %%% adapted by HH %%% + initialize_form_numbers ; + if f = "" : + if fmt_metapost : nullpicture else : "" fi + else : + interim warningcheck := 0 ; + save k, l, s, p, z ; + pair z ; z = @#(x) ; + % the next adaption is okay + % k = 1 + cspan(f, fmt_separator <> ) ; + % but best is to support both % and fmt_separator + k = 1 + cspan(f, isfmtseparator) ; + % + 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/Master/texmf-dist/metapost/context/base/mp-func.mp b/Master/texmf-dist/metapost/context/base/mp-func.mp new file mode 100644 index 00000000000..d8646ef3bdd --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/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/Master/texmf-dist/metapost/context/base/mp-grid.mp b/Master/texmf-dist/metapost/context/base/mp-grid.mp new file mode 100644 index 00000000000..f6e84348915 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-grid.mp @@ -0,0 +1,145 @@ +%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 ; + +numeric grid_eps ; grid_eps = eps ; + +def hlingrid (expr Min, Max, Step, Length, Width) text t = + image ( for i=Min step Step until Max+grid_eps : + 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+grid_eps : + 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)+grid_eps : + 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)+grid_eps : + 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+grid_eps : + 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+grid_eps : + 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)+grid_eps : + 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)+grid_eps : + draw textext@#(do_format(Format,i)) shifted (Length*log(i),0) t ; + endfor ; ) +enddef ; + +vardef hlinlabel@#(expr Min, Max, Step, Length) text t = + image ( + for i=Min step Step until Max+grid_eps : + draw thelabel@#(decimal i,(0,i*(Length/Max))) t ; + endfor ; ) +enddef ; + +vardef vlinlabel@#(expr Min, Max, Step, Length) text t = + image ( + for i=Min step Step until Max+grid_eps : + draw thelabel@#(decimal i,(i*(Length/Max),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/Master/texmf-dist/metapost/context/base/mp-grph.mp b/Master/texmf-dist/metapost/context/base/mp-grph.mp new file mode 100644 index 00000000000..18c43c57b53 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-grph.mp @@ -0,0 +1,295 @@ +%D \module +%D [ file=mp-grph.mp, +%D version=2000.12.14, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=graphic text support, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +%D Under construction. + +if unknown context_tool : input mp-tool ; fi ; +if known context_grph : endinput ; fi ; + +boolean context_grph ; context_grph := true ; + +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 ; + resetfig ; % resets currentpicture +enddef ; + +numeric currentgraphictext ; currentgraphictext := 0 ; +string graphictextformat ; graphictextformat := "plain" ; +string graphictextstring ; graphictextstring := "" ; +string graphictextfile ; graphictextfile := "dummy.mpo" ; + +def savegraphictext (expr str) = + graphictextfile := jobname & ".mpo" ; + if (graphictextstring<>"") : + write graphictextstring to graphictextfile ; + graphictextstring := "" ; + fi ; + write str to graphictextfile ; + let erasegraphictextfile = relax ; +enddef ; + +def erasegraphictextfile = + graphictextfile := jobname & ".mpo" ; + write EOF to graphictextfile ; + let erasegraphictextfile = relax ; +enddef ; + +extra_beginfig := extra_beginfig & " erasegraphictextfile ;" ; + +def begingraphictextfig (expr n) = + foundpicture := n ; scratchpicture := nullpicture ; +enddef ; + +def endgraphictextfig = + if foundpicture = currentgraphictext : + expandafter endinput + else : + scratchpicture := nullpicture ; + fi ; +enddef ; + +def loadfigure primary filename = + doloadfigure (filename) +enddef ; + +def doloadfigure (expr filename) text figureattributes = + begingroup ; + save figurenumber, figurepicture, number, fixedplace ; + numeric figurenumber ; figurenumber := 0 ; + boolean figureshift ; figureshift := true ; + picture figurepicture ; figurepicture := currentpicture ; + def number primary n = hide(figurenumber := n) enddef ; + def fixedplace = hide(figureshift := false) enddef ; + protectgraphicmacros ; + % defaults + interim linecap := rounded ; + interim linejoin := rounded ; + interim miterlimit := 10 ; + % + currentpicture := nullpicture ; + draw fullcircle figureattributes ; % expand number + currentpicture := nullpicture ; + def beginfig (expr n) = + currentpicture := nullpicture ; + if (figurenumber=n) or (figurenumber=0) : + let endfig = endinput ; + fi ; + enddef ; + let endfig = relax ; + readfile(filename) ; + if figureshift : + currentpicture := currentpicture shifted -llcorner currentpicture ; + fi ; + addto figurepicture also currentpicture figureattributes ; + currentpicture := figurepicture ; + endgroup ; +enddef ; + +def graphictext primary t = + dographictext(t) +enddef ; + +def dographictext (expr t) = + begingroup ; + save figurepicture ; picture figurepicture ; + figurepicture := currentpicture ; currentpicture := nullpicture ; + if graphictextformat<>"" : + graphictextstring := + "% format=" & graphictextformat & CRLF & graphictextstring ; + graphictextformat := "" ; + fi ; + currentgraphictext := currentgraphictext + 1 ; + savegraphictext ("\startTEXpage[scale=10000]" & t & "\stopTEXpage") ; + dofinishgraphictext +enddef ; + +def redographictext primary t = + regraphictext(t) +enddef ; + +def regraphictext (expr t) = + begingroup ; + save figurepicture ; picture figurepicture ; + figurepicture := currentpicture ; currentpicture := nullpicture ; + save currentgraphictext ; numeric currentgraphictext ; + currentgraphictext := t ; + dofinishgraphictext +enddef ; + +%D Believe it or not, but it took me half a day to uncover +%D the following neccessity: +%D +%D \starttypen +%D save withfillcolor, withdrawcolor ; +%D \stoptypen +%D +%D When we have more than one graphictext, these will be +%D defined after the first graphic. For some obscure reason, +%D this means that in the next graphic they will be called, but +%D afterwards the data and boolean are not set. Don't ask me +%D why. + +def dofinishgraphictext text x_op_x = + protectgraphicmacros ; % resets currentpicture + 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 ; + save withfillcolor, withdrawcolor ; % quite important + numeric foundpicture ; picture scratchpicture ; string str ; + def draw expr p = + % 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 withshade primary c = + hide(def s_op_s = normalwithshade c enddef ; s_color := true ) + enddef ; + def withfillcolor primary c = + hide(def f_op_f = withcolor c enddef ; f_color := true ) + enddef ; + def withdrawcolor primary c = + hide(def d_op_d = withcolor c enddef ; d_color := true ) + 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 ; + scratchpicture := nullpicture ; + 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 ; + currentpicture := figurepicture ; + 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 : + addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ; + fi ; + endfor ; + fi ; + 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 ; + endfor ; + fi ; + if d_color and reverse_fill : + for i within scratchpicture : + if filled i : + addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ; + fi ; + endfor ; + fi ; + if s_color : + for i within scratchpicture : + if filled i : + addto currentpicture contour pathpart i _op_ x_op_x s_op_s ; + fi ; + endfor ; + else : + for i within scratchpicture : + if stroked i : + addto currentpicture doublepath pathpart i _op_ x_op_x d_op_d ; + fi ; + endfor ; + fi ; + endgroup ; +enddef ; + +def resetgraphictextdirective = + graphictextstring := "" ; +enddef ; + +def graphictextdirective text t = + graphictextstring := graphictextstring & t & CRLF ; +enddef ; + +endinput + +% example + +input mp-grph ; + + graphictextformat := "context" ; +% graphictextformat := "plain" ; +% graphictextformat := "latex" ; graphictextdirective "\documentclass[]{article}" ; + +beginfig (1) ; + graphictext + "\vbox{\hsize10cm \input tufte }" + scaled 8 + withdrawcolor blue + withfillcolor red + withpen pencircle scaled 2pt ; +endfig ; + +beginfig(1) ; + loadfigure "gracht.mp" rotated 20 ; + loadfigure "koe.mp" number 1 scaled 2 ; +endfig ; + +end diff --git a/Master/texmf-dist/metapost/context/base/mp-page.mp b/Master/texmf-dist/metapost/context/base/mp-page.mp new file mode 100644 index 00000000000..e3750b55b75 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-page.mp @@ -0,0 +1,447 @@ +%D \module +%D [ file=mp-page.mp, +%D version=1999.03.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=page enhancements, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. + +%D This module is rather preliminary and subjected to +%D changes. + +if unknown context_tool : input mp-tool ; fi ; +if known context_page : endinput ; fi ; + +boolean context_page ; context_page := true ; + +if unknown PageStateAvailable : + boolean PageStateAvailable ; PageStateAvailable := false ; +fi ; + +if unknown OnRightPage : + boolean OnRightPage ; OnRightPage := true ; +fi ; + +if unknown OnOddPage : + boolean OnOddPage ; OnOddPage := true ; +fi ; + +if unknown InPageBody : + boolean InPageBody ; InPageBody := false ; +fi ; + +def SaveTextAreas = + path SavedTextAreas [] ; + path SavedTextColumns[] ; + numeric NOfSavedTextAreas ; + numeric NOfSavedTextColumns ; + for i=1 upto NOfTextAreas : + SavedTextAreas[i] := TextAreas[i] ; + endfor ; + for i=1 upto NOfTextColumns : + SavedTextColumns[i] := TextColumns[i] ; + endfor ; + NOfSavedTextAreas := NOfTextAreas ; + NOfSavedTextColumns := NOfTextColumns ; +enddef ; + +def ResetTextAreas = + path TextAreas[], TextColumns[] ; + numeric NOfTextAreas ; NOfTextAreas := 0 ; + numeric NOfTextColumns ; NOfTextColumns := 0 ; + numeric nofmultipars ; nofmultipars := 0 ; + TextAreas[0] := TextColumns[0] := origin -- cycle ; +enddef ; + +ResetTextAreas ; SaveTextAreas ; ; + +def RegisterTextArea (expr x, y, w, h, d) = + begingroup ; save p ; path p ; + p := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; + if NOfTextAreas>0 : + % if needed, concatenate areas + if (round(llcorner TextAreas[NOfTextAreas]) = round(ulcorner p)) and + (round(lrcorner TextAreas[NOfTextAreas]) = round(urcorner p)) : + p := ulcorner TextAreas[NOfTextAreas] -- + urcorner TextAreas[NOfTextAreas] -- + lrcorner p -- + llcorner p -- + cycle ; + else : + NOfTextAreas := NOfTextAreas + 1 ; + fi ; + else : + NOfTextAreas := NOfTextAreas + 1 ; + fi ; + TextAreas[NOfTextAreas] := p ; + if NOfTextColumns>0 : + if (round(xpart llcorner TextColumns[NOfTextColumns]) = round(xpart ulcorner p)) and + (round(xpart lrcorner TextColumns[NOfTextColumns]) = round(xpart urcorner p)) : + p := ulcorner TextColumns[NOfTextColumns] -- + urcorner TextColumns[NOfTextColumns] -- + lrcorner p -- + llcorner p -- + cycle ; + else : + NOfTextColumns := NOfTextColumns + 1 ; + fi ; + else : + NOfTextColumns := NOfTextColumns + 1 ; + fi ; + TextColumns[NOfTextColumns] := p ; + endgroup ; +enddef ; + +%D We store a local area in slot zero. + +def RegisterLocalTextArea (expr x, y, w, h, d) = + TextAreas[0] := TextColumns[0] := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; +enddef ; + +def ResetLocalTextArea = + TextAreas[0] := TextColumns[0] := origin -- cycle ; +enddef ; + +ResetLocalTextArea ; + +vardef InsideTextArea (expr _i_, _xy_) = + ( (round(xpart _xy_) >= round(xpart llcorner TextAreas[_i_])) and + (round(xpart _xy_) <= round(xpart lrcorner TextAreas[_i_])) and + (round(ypart _xy_) >= round(ypart llcorner TextAreas[_i_])) and + (round(ypart _xy_) <= round(ypart urcorner TextAreas[_i_])) ) +enddef ; + +vardef InsideSavedTextArea (expr _i_, _xy_) = + ( (round(xpart _xy_) >= round(xpart llcorner SavedTextAreas[_i_])) and + (round(xpart _xy_) <= round(xpart lrcorner SavedTextAreas[_i_])) and + (round(ypart _xy_) >= round(ypart llcorner SavedTextAreas[_i_])) and + (round(ypart _xy_) <= round(ypart urcorner SavedTextAreas[_i_])) ) +enddef ; + +vardef InsideSomeTextArea(expr _xy_) = + save ok ; boolean ok ; ok := false ; + for i := 1 upto NOfTextAreas : + if InsideTextArea(i,_xy_) : ok := true ; fi ; + exitif ok ; + endfor ; + ok +enddef ; + +vardef InsideSomeSavedTextArea(expr _xy_) = + save ok ; boolean ok ; ok := false ; + for i := 1 upto NOfSavedTextAreas : + if InsideSavedTextArea(i,_xy_) : ok := true ; fi ; + exitif ok ; + endfor ; + ok +enddef ; + +vardef TextAreaX (expr x) = + numeric _TextAreaX_ ; _TextAreaX_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) : + _TextAreaX_ := xpart llcorner TextAreas[i] ; + fi ; + endfor ; + _TextAreaX_ +enddef ; + +vardef TextAreaY (expr y) = + numeric _TextAreaY_ ; _TextAreaY_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(y) >= round(ypart llcorner TextAreas[NOfTextAreas])) and + (round(y) <= round(ypart ulcorner TextAreas[NOfTextAreas])) : + _TextAreaY_ := ypart llcorner TextAreas[NOfTextAreas] ; + fi ; + endfor ; + _TextAreaY_ +enddef ; + +vardef TextAreaXY (expr x, y) = + pair _TextAreaXY_ ; _TextAreaXY_ := origin ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) and + (round(y) >= round(ypart llcorner TextAreas[i])) and + (round(y) <= round(ypart ulcorner TextAreas[i])) : + _TextAreaXY_ := llconer TextAreas[i] ; + fi ; + endfor ; + _TextAreaXY_ +enddef ; + +vardef TextAreaW (expr x) = + numeric _TextAreaW_ ; _TextAreaW_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) : + _TextAreaW_ := bbwidth(TextAreas[i]) ; + fi ; + endfor ; + _TextAreaW_ +enddef ; + +vardef TextAreaH (expr y) = + numeric _TextAreaH_ ; _TextAreaH_ := 0 ; + for i := 1 upto NOfTextAreas : + if (round(y) >= round(ypart llcorner TextAreas[i])) and + (round(y) <= round(ypart ulcorner TextAreas[i])) : + _TextAreaH_ := bbheight(TextAreas[i]) ; + fi ; + endfor ; + _TextAreaH_ +enddef ; + +vardef TextAreaWH (expr x, y) = + pair _TextAreaWH_ ; _TextAreaWH_ := origin ; + for i := 1 upto NOfTextAreas : + if (round(x) >= round(xpart llcorner TextAreas[i])) and + (round(x) <= round(xpart lrcorner TextAreas[i])) and + (round(y) >= round(ypart llcorner TextAreas[i])) and + (round(y) <= round(ypart ulcorner TextAreas[i])) : + _TextAreaWH_ := (bbwidth(TextAreas[i]),bbheight(TextAreas[i])) ; + fi ; + endfor ; + _TextAreaWH_ +enddef ; + +PageNumber := 0 ; +PaperHeight := 845.04684pt ; +PaperWidth := 597.50787pt ; +PrintPaperHeight := 845.04684pt ; +PrintPaperWidth := 597.50787pt ; +TopSpace := 71.12546pt ; +BottomSpace := 0.0pt ; +BackSpace := 71.13275pt ; +CutSpace := 0.0pt ; +MakeupHeight := 711.3191pt ; +MakeupWidth := 426.78743pt ; +TopHeight := 0.0pt ; +TopDistance := 0.0pt ; +HeaderHeight := 56.90294pt ; +HeaderDistance := 0.0pt ; +TextHeight := 597.51323pt ; +FooterDistance := 0.0pt ; +FooterHeight := 56.90294pt ; +BottomDistance := 0.0pt ; +BottomHeight := 0.0pt ; +LeftEdgeWidth := 0.0pt ; +LeftEdgeDistance := 0.0pt ; +LeftMarginWidth := 75.58197pt ; +LeftMarginDistance := 11.99829pt ; +TextWidth := 426.78743pt ; +RightMarginDistance := 11.99829pt ; +RightMarginWidth := 75.58197pt ; +RightEdgeDistance := 0.0pt ; +RightEdgeWidth := 0.0pt ; + +PageOffset := 0.0pt ; +PageDepth := 0.0pt ; + +LayoutColumns := 0 ; +LayoutColumnDistance:= 0.0pt ; +LayoutColumnWidth := 0.0pt ; + +LeftEdge := -4 ; Top := -40 ; +LeftEdgeSeparator := -3 ; TopSeparator := -30 ; +LeftMargin := -2 ; Header := -20 ; +LeftMarginSeparator := -1 ; HeaderSeparator := -10 ; +Text := 0 ; Text := 0 ; +RightMarginSeparator := +1 ; FooterSeparator := +10 ; +RightMargin := +2 ; Footer := +20 ; +RightEdgeSeparator := +3 ; BottomSeparator := +30 ; +RightEdge := +4 ; Bottom := +40 ; + +Margin := LeftMargin ; % obsolete +Edge := LeftEdge ; % obsolete +InnerMargin := RightMargin ; % obsolete +InnerEdge := RightEdge ; % obsolete +OuterMargin := LeftMargin ; % obsolete +OuterEdge := LeftEdge ; % obsolete + +InnerMarginWidth := 0pt ; +OuterMarginWidth := 0pt ; +InnerMarginDistance := 0pt ; +OuterMarginDistance := 0pt ; + +InnerEdgeWidth := 0pt ; +OuterEdgeWidth := 0pt ; +InnerEdgeDistance := 0pt ; +OuterEdgeDistance := 0pt ; + +path Area [][] ; pair Location [][] ; path Field [][] ; path Page ; +numeric HorPos ; numeric Hstep [] ; numeric Hsize [] ; +numeric VerPos ; numeric Vstep [] ; numeric Vsize [] ; + +for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + Area[HorPos][VerPos] := origin--cycle ; + Area[VerPos][HorPos] := Area[HorPos][VerPos] ; + Location[HorPos][VerPos] := origin ; + Location[VerPos][HorPos] := Location[HorPos][VerPos] ; + Field[HorPos][VerPos] := origin--cycle ; + Field[VerPos][HorPos] := Field[HorPos][VerPos] ; + endfor ; +endfor ; + +% def LoadPageState = +% scantokens "input mp-state.tmp" ; +% enddef ; + +def SwapPageState = + if not OnRightPage : + BackSpace := PaperWidth-MakeupWidth-BackSpace ; + CutSpace := PaperWidth-MakeupWidth-CutSpace ; + i := LeftMarginWidth ; + LeftMarginWidth := RightMarginWidth ; + RightMarginWidth := i ; + i := LeftMarginDistance ; + LeftMarginDistance := RightMarginDistance ; + RightMarginDistance := i ; + i := LeftEdgeWidth ; + LeftEdgeWidth := RightEdgeWidth ; + RightEdgeWidth := i ; + i := LeftEdgeDistance ; + LeftEdgeDistance := RightEdgeDistance ; + RightEdgeDistance := i ; + +% these are now available as ..Width and ..Distance + + Margin := LeftMargin ; + Edge := LeftEdge ; + InnerMargin := RightMargin ; + InnerEdge := RightEdge ; + OuterMargin := LeftMargin ; + OuterEdge := LeftEdge ; + else : + Margin := RightMargin ; + Edge := RightEdge ; + InnerMargin := LeftMargin ; + InnerEdge := LeftEdge ; + OuterMargin := RightMargin ; + OuterEdge := RightEdge ; + fi ; +enddef ; + +def SetPageAreas = + + numeric Vsize[], Hsize[], Vstep[], Hstep[] ; + + Vsize[Top] = TopHeight ; + Vsize[TopSeparator] = TopDistance ; + Vsize[Header] = HeaderHeight ; + Vsize[HeaderSeparator] = HeaderDistance ; + Vsize[Text] = TextHeight ; + Vsize[FooterSeparator] = FooterDistance ; + Vsize[Footer] = FooterHeight ; + Vsize[BottomSeparator] = BottomDistance ; + Vsize[Bottom] = BottomHeight ; + + Vstep[Top] = Vstep[TopSeparator] +Vsize[TopSeparator] ; + Vstep[TopSeparator] = PaperHeight-TopSpace ; + Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; + Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; + Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; + Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; + Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; + Vstep[BottomSeparator] = Vstep[Footer] -Vsize[BottomSeparator] ; + Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; + + Hsize[LeftEdge] = LeftEdgeWidth ; + Hsize[LeftEdgeSeparator] = LeftEdgeDistance ; + Hsize[LeftMargin] = LeftMarginWidth ; + Hsize[LeftMarginSeparator] = LeftMarginDistance ; + Hsize[Text] = MakeupWidth ; + Hsize[RightMarginSeparator] = RightMarginDistance ; + Hsize[RightMargin] = RightMarginWidth ; + Hsize[RightEdgeSeparator] = RightEdgeDistance ; + Hsize[RightEdge] = RightEdgeWidth ; + + Hstep[LeftEdge] = Hstep[LeftEdgeSeparator] -Hsize[LeftEdge] ; + Hstep[LeftEdgeSeparator] = Hstep[LeftMargin] -Hsize[LeftEdgeSeparator] ; + Hstep[LeftMargin] = Hstep[LeftMarginSeparator] -Hsize[LeftMargin] ; + Hstep[LeftMarginSeparator] = Hstep[Text] -Hsize[LeftMarginSeparator] ; + Hstep[Text] = BackSpace ; + Hstep[RightMarginSeparator] = Hstep[Text] +Hsize[Text] ; + Hstep[RightMargin] = Hstep[RightMarginSeparator]+Hsize[RightMarginSeparator] ; + Hstep[RightEdgeSeparator] = Hstep[RightMargin] +Hsize[RightMargin] ; + Hstep[RightEdge] = Hstep[RightEdgeSeparator] +Hsize[RightEdgeSeparator] ; + + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; + Area[VerPos][HorPos] := Area[HorPos][VerPos] ; + Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; + Location[VerPos][HorPos] := Location[HorPos][VerPos] ; + Field[HorPos][VerPos] := Area[HorPos][VerPos] shifted Location[HorPos][VerPos] ; + Field[VerPos][HorPos] := Field[HorPos][VerPos] ; + endfor ; + endfor ; + + Page := unitsquare xscaled PaperWidth yscaled PaperHeight ; + +enddef ; + +def BoundPageAreas = + + % pickup pencircle scaled 0pt ; + + bboxmargin := 0 ; setbounds currentpicture to Page ; + +enddef ; + +def StartPage = + + if PageStateAvailable : + LoadPageState ; + SwapPageState ; + fi ; + + SetPageAreas ; + BoundPageAreas ; + +enddef ; + +def StopPage = + + BoundPageAreas ; + +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 ; +def lrEnlarged (expr p,d) = (lrcorner p shifted (+d,-d)) enddef ; +def urEnlarged (expr p,d) = (urcorner p shifted (+d,+d)) enddef ; +def ulEnlarged (expr p,d) = (ulcorner p shifted (-d,+d)) enddef ; + +def Enlarged (expr p, d) = + (llEnlarged (p,d) -- + lrEnlarged (p,d) -- + urEnlarged (p,d) -- + ulEnlarged (p,d) -- cycle) +enddef ; + +endinput ;
\ No newline at end of file diff --git a/Master/texmf-dist/metapost/context/base/mp-shap.mp b/Master/texmf-dist/metapost/context/base/mp-shap.mp new file mode 100644 index 00000000000..0f5fe431d99 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-shap.mp @@ -0,0 +1,307 @@ +%D \module +%D [ file=mp-shap.mp, +%D version=2000.05.31, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=shapes, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_shap : endinput ; fi ; + +boolean context_shap ; context_shap := true ; + +vardef some_shape_path (expr type) = + + begingroup ; + + save border, xradius, yradius, + normal, mirror, rotate, + lc, rc, tc, bc, ll, lr, ur, ul, + llx, lrx, urx, ulx, lly, lry, ury, uly ; + + path border ; + + xradius := .15 ; xxradius := .10 ; + yradius := .15 ; yyradius := .10 ; + + pair ll ; ll := llcorner (unitsquare shifted (-.5,-.5)) ; + pair lr ; lr := lrcorner (unitsquare shifted (-.5,-.5)) ; + pair ur ; ur := urcorner (unitsquare shifted (-.5,-.5)) ; + pair ul ; ul := ulcorner (unitsquare shifted (-.5,-.5)) ; + + pair llx ; llx := ll shifted (xradius,0) ; + pair lly ; lly := ll shifted (0,yradius) ; + + pair lrx ; lrx := lr shifted (-xradius,0) ; + pair lry ; lry := lr shifted (0,yradius) ; + + pair urx ; urx := ur shifted (-xradius,0) ; + pair ury ; ury := ur shifted (0,-yradius) ; + + pair ulx ; ulx := ul shifted (xradius,0) ; + pair uly ; uly := ul shifted (0,-yradius) ; + + pair llxx ; llxx := ll shifted (xxradius,0) ; + pair llyy ; llyy := ll shifted (0,yyradius) ; + + pair lrxx ; lrxx := lr shifted (-xxradius,0) ; + pair lryy ; lryy := lr shifted (0,yyradius) ; + + pair urxx ; urxx := ur shifted (-xxradius,0) ; + pair uryy ; uryy := ur shifted (0,-yyradius) ; + + pair ulxx ; ulxx := ul shifted (xxradius,0) ; + pair ulyy ; ulyy := ul shifted (0,-yyradius) ; + + pair lc ; lc := ll shifted (0,.5) ; + pair rc ; rc := lr shifted (0,.5) ; + pair tc ; tc := ul shifted (.5,0) ; + pair bc ; bc := ll shifted (.5,0) ; + + def mirror (expr p) = + p rotatedaround(origin,180) + enddef ; + + def normal (expr p ) = + p + enddef ; + + def rotate (expr p) = + p rotated 45 + enddef ; + + if type= 0 : + border := normal (origin--cycle) ; + + elseif type= 5 : + border := normal (llx--lrx{right}...rc...{left}urx--ulx{left}...lc...{right}cycle) ; + elseif type= 6 : + border := normal (ll--lrx{right}...rc...{left}urx--ul--cycle) ; + elseif type= 7 : + border := mirror (ll--lrx{right}...rc...{left}urx--ul--cycle) ; + elseif type= 8 : + border := normal (lr--ury{up}...tc...{down}uly--ll--cycle) ; + elseif type= 9 : + border := mirror (lr--ury{up}...tc...{down}uly--ll--cycle) ; + elseif type=10 : + border := normal (ll--lr--ur--ul--ll--ur--ul--ll--cycle) ; + elseif type=11 : + border := normal (ll--lr--ur--ul--ll--lr--ul--ll--cycle) ; + elseif type=12 : + border := normal (ll--lrx--ur--ulx--cycle) ; + elseif type=13 : + border := normal (llx--lr--urx--ul--cycle) ; + elseif type=14 : + border := normal (lly--bc--lry--ury--tc--uly--cycle) ; + elseif type=15 : + border := normal (llx--lrx--rc--urx--ulx--lc--cycle) ; + elseif type=16 : + border := normal (ll--lrx--rc--urx--ul--cycle) ; + elseif type=17 : + border := mirror (ll--lrx--rc--urx--ul--cycle) ; + elseif type=18 : + border := normal (lr--ury--tc--uly--ll--cycle) ; + elseif type=19 : + border := mirror (lr--ury--tc--uly--ll--cycle) ; + elseif type=20 : + border := normal (ll--lr--ur--ul--ll--llxx--ulxx--ul--ll-- + lr--ur--urxx--lrxx--cycle) ; + elseif type=21 : + border := normal (ul--ll--lr--ur--ul--ulyy--uryy--ur--ul-- + ll--lr--lryy--llyy--cycle) ; + elseif type=22 : + border := normal (ll--lrx--lry--ur--ulx--uly--cycle) ; + elseif type=23 : + border := normal (llx--lr--ury--urx--ul--lly--cycle) ; + elseif type=24 : + border := normal (ll--lr--ur--ul--cycle) ; + elseif type=25 : + border := normal (llx--lrx--lry--ury--urx--ulx--uly--lly--cycle) ; + elseif type=26 : + border := normal (ll--lrx--lry--ur--ul--cycle) ; + elseif type=27 : + border := mirror (ll--lr--ury--urx--ul--cycle) ; + elseif type=28 : + border := normal (ll--lr--ury--urx--ul--cycle) ; + elseif type=29 : + border := mirror (ll--lrx--lry--ur--ul--cycle) ; + elseif type=30 : + border := rotate (bc{right}...{up}rc...tc{left}...{down}lc...{right}bc & + bc--tc & tc{left}..{down}lc & lc--rc & + rc{up}..tc{left}...{down}lc...{right}bc & cycle) ; + elseif type=31 : + border := normal (bc{right}...{up}rc...tc{left}...{down}lc...{right}bc & + bc--tc & tc{left}..{down}lc & lc--rc & + rc{up}..tc{left}...{down}lc...{right}bc & cycle) ; + elseif type=32 : + border := normal (ll{right}...{right}lry--ur--ul--ll--cycle) ; + elseif type=33 : + border := normal (ll{right}...{right}lry--ur--ul--ll--cycle + --ul--ulx--ulx shifted(0,yyradius) + --ur shifted(yyradius,yyradius) + --lry shifted(yyradius,yyradius) + --lry shifted(0,yyradius) + --ur--ul--cycle ) ; + elseif type=34 : + border := normal (uly..tc..ury & + ury..tc shifted (0,-2yradius)..uly & + uly--lly & + lly..bc..lry & + lry--ury & + ury..tc shifted (0,-2yradius)..uly & cycle ) ; + elseif type=35 : + border := normal (bc{right}...rc{up}...tc{left}...lc{down}...cycle) ; + elseif type=36 : + border := normal (ul--tc{right}..rc{down}..{left}bc--ll & + ll..(xpart llx, ypart lc)..ul & cycle) ; + elseif type=37 : + border := mirror (ul--tc{right}..rc{down}..{left}bc--ll & + ll..(xpart llx, ypart lc)..ul & cycle) ; + elseif type=38 : + border := normal (ll--lc{up}..tc{right}..{down}rc--lr & + lr..(xpart bc, ypart lly)..ll & cycle) ; + elseif type=39 : + border := mirror (ll--lc{up}..tc{right}..{down}rc--lr & + lr..(xpart bc, ypart lly)..ll & cycle) ; + elseif type=40 : + border := normal (ll--lr--ur--ul--ll--ur--ul--ll--lr--ul--ll--cycle) ; + elseif type=41 : + border := normal (ll--lr--ur--ul--ll--lr--rc--lc--ll--bc--tc--ul--ll & cycle) ; + elseif type=42 : + border := normal (ll--lr--origin shifted (+epsilon,0)-- + ur--ul--origin shifted (-epsilon,0)--cycle) ; + elseif type=43 : + border := normal (ll--ul--origin shifted (0,+epsilon)-- + ur--lr--origin shifted (0,-epsilon)--cycle) ; + elseif type=45 : + border := normal (bc--rc--tc--lc--cycle) ; + elseif type=46 : + border := normal (ll--ul--rc--cycle) ; + elseif type=47 : + border := mirror (ll--ul--rc--cycle) ; + elseif type=48 : + border := mirror (ul--ur--bc--cycle) ; + elseif type=49 : + border := normal (ul--ur--bc--cycle) ; + + elseif type=56 : + border := normal (ll--lry--ury--ul--cycle) ; + elseif type=57 : + border := mirror (ll--lry--ury--ul--cycle) ; + elseif type=58 : + border := normal (ll--ulx--urx--lr--cycle) ; + elseif type=59 : + border := mirror (ll--ulx--urx--lr--cycle) ; + + elseif type=61 : + border := normal (fullcircle scaled (1.5*yradius) xscaled (grid_height/grid_width)) ; + elseif type=62 : + border := normal (fullcircle scaled (2.0*yradius) xscaled (grid_height/grid_width)) ; + + elseif type=66 : + border := normal (rc--origin shifted ( epsilon,0) --cycle & + rc--origin --cycle ) ; + elseif type=67 : + border := normal (lc--origin shifted (-epsilon,0) --cycle & + lc--origin --cycle ) ; + elseif type=68 : + border := normal (tc--origin shifted (0, epsilon) --cycle & + tc--origin --cycle ) ; + elseif type=69 : + border := normal (bc--origin shifted (0,-epsilon) --cycle & + bc--origin --cycle ) ; + + elseif type=75 : + border := mirror (lly--lry--ury--uly--cycle) ; + elseif type=76 : + border := mirror (ll--lr--ur--uly--cycle) ; + elseif type=77 : + border := mirror (ll--lr--ury--ul--cycle) ; + elseif type=78 : + border := mirror (lly--lr--ur--ul--cycle) ; + elseif type=79 : + border := mirror (ll--lry--ur--ul--cycle) ; + + else : + border := normal (origin--cycle) ; + %border := normal (ll--lr--ur--ul--cycle) ; + fi ; + + border + + endgroup + +enddef; + +def some_shape ( expr shape_type , + shape_width , + shape_height , + shape_linewidth , + shape_linecolor , + shape_fillcolor ) = + + path p ; p := + some_shape_path (shape_type) + xscaled shape_width + yscaled shape_height ; + + pickup pencircle scaled shape_linewidth ; + + fill p withcolor shape_fillcolor ; + draw p withcolor shape_linecolor ; + +enddef ; + +vardef drawshape (expr t, p, lw, lc, fc) = + save pp ; + if t>1 : % normal shape + path pp ; + pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) shifted center p ; + fill pp withcolor fc ; + draw pp withpen pencircle scaled lw withcolor lc ; + elseif t=1 : % background only + path pp ; + pp := fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ; + fill pp withcolor fc ; + else : % dimensions only + picture pp ; pp := nullpicture ; + setbounds pp to fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ; + draw pp ; + fi ; +enddef ; + +vardef drawline (expr t, p, lw, lc) = + if (t>0) and (length(p)>1) : + saveoptions ; + drawoptions(withpen pencircle scaled lw withcolor lc) ; + draw p ; + if t = 1 : + draw arrowheadonpath(p,1) ; + elseif t = 2 : + draw arrowheadonpath(reverse p,1) ; + elseif t = 3 : + for $ = p,reverse p : draw arrowheadonpath($,1) ; endfor ; + elseif t = 11 : + draw arrowheadonpath(p,1/2) ; + elseif t = 12 : + draw arrowheadonpath(reverse p,1/2) ; + elseif t = 13 : + for $=p,reverse p : draw arrowheadonpath($,1) ; endfor ; + for $=p,reverse p : draw arrowheadonpath($,3/4) ; endfor ; + elseif t = 21 : + for $=1/5,1/2,4/5 : draw arrowheadonpath(p,$) ; endfor ; + elseif t = 22 : + for $=1/5,1/2,4/5 : draw arrowheadonpath(reverse p,$) ; endfor ; + elseif t = 23 : + for $=p,reverse p : draw arrowheadonpath($,1/4) ; endfor ; + fi ; + fi ; +enddef ; + +endinput ; diff --git a/Master/texmf-dist/metapost/context/base/mp-spec.mp b/Master/texmf-dist/metapost/context/base/mp-spec.mp new file mode 100644 index 00000000000..9fe3c724fdc --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-spec.mp @@ -0,0 +1,775 @@ +%D \module +%D [ file=mp-spec.mp, +%D version=1999.6.26, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=special extensions, +%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. + +% Spot colors are not handled by mptopdf ! + +% (r,g,b) => cmyk : r=123 g= 1 b=hash +% => spot : r=123 g= 2 b=hash +% => transparent rgb : r=123 g= 3 b=hash +% => transparent cmyk : r=123 g= 4 b=hash +% => transparent spot : r=123 g= 5 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\ +%D to \PDF\ converter module built in \CONTEXT\ and provides +%D for instance shading. More information can be found in +%D type {supp-mpe.tex}. + +if unknown context_tool : input mp-tool ; fi ; +if known context_spec : endinput ; fi ; + +boolean context_spec ; context_spec := true ; + +numeric _special_counter_ ; _special_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 +%D day I will also write an additional directive. + +boolean _inline_specials_ ; _inline_specials_ := false ; + +%D Because we want to output only those specials that are +%D actually used in a figure, we need a bit complicated +%D bookkeeping and collection of specials. At the cost of some +%D obscurity, we now have rather efficient resources. + +string _global_specials_ ; _global_specials_ := "" ; +string _local_specials_ ; _local_specials_ := "" ; + +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 _global_specials_ ; + scantokens _local_specials_ ; +enddef ; + +vardef reset_extra_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 ; " & + " insidefigure := false ; " ; + +def set_extra_special (expr s) = + if insidefigure : + _local_specials_ := _local_specials_ & s ; + else : + _global_specials_ := _global_specials_ & s ; + fi +enddef ; + +def flush_special (expr typ, siz, dat) = + _special_counter_ := _special_counter_ + 1 ; + if _inline_specials_ : + set_extra_special + ( "special " + & "(" & ditto + & dat & " " + & decimal _special_counter_ & " " + & decimal typ & " " + & decimal siz + & " special" + & ditto & ");" ) ; + else : + set_extra_special + ( "special " + & "(" & ditto + & "%%MetaPostSpecial: " + & decimal siz & " " + & dat & " " + & decimal _special_counter_ & " " + & decimal typ + & ditto & ");" ) ; + fi ; +enddef ; + +%D The next hack is needed in case you use a version of +%D \METAPOST\ that does not provide you the means to configure +%D the buffer size. Patrick Gundlach suggested to use arrays +%D in this case. + +boolean bufferhack ; bufferhack := false ; % true ; + +if bufferhack : + + string _global_specials_[] ; numeric _nof_global_specials_ ; + string _local_specials_[] ; numeric _nof_local_specials_ ; + + _nof_global_specials_ := _nof_local_specials_ := 0 ; + + vardef add_special_signal = % write the version number + if (_nof_global_specials_>0) or (_nof_local_specials_>0) : + special ("%%MetaPostSpecials: 1.0 " & decimal _special_signal_ ) ; + fi ; + enddef ; + + vardef add_extra_specials = + for i=1 upto _nof_global_specials_ : + scantokens _global_specials_[i] ; + endfor; + for i=1 upto _nof_local_specials_ : + scantokens _local_specials_[i] ; + endfor; + enddef ; + + vardef reset_extra_specials = + string _local_specials_[] ; _nof_local_specials_ := 0 ; + enddef ; + + def set_extra_special (expr s) = + if insidefigure : + _local_specials_[incr(_nof_local_specials_)] := s ; + else : + _global_specials_[incr(_nof_global_specials_)] := s ; + fi + enddef ; + +fi ; + +%D So far for this hack. + +%D Shade allocation. + +newinternal shadefactor ; shadefactor := 1 ; + +pair shadeoffset ; shadeoffset := origin ; + +vardef define_linear_shade (expr a, b, ca, cb) = + flush_special(30, 15, "0 1 " & decimal shadefactor & " " & + dddecimal ca & " " & ddecimal (a shifted shadeoffset) & " " & + dddecimal cb & " " & ddecimal (b shifted shadeoffset) ) ; + _special_counter_ +enddef ; + +vardef define_circular_shade (expr a, b, ra, rb, ca, cb) = + flush_special(31, 17, "0 1 " & decimal shadefactor & " " & + dddecimal ca & " " & ddecimal (a shifted shadeoffset) & " " & decimal ra & " " & + dddecimal cb & " " & ddecimal (b shifted shadeoffset) & " " & decimal rb ) ; + _special_counter_ +enddef ; + +%D A few predefined shading macros. + +boolean trace_shades ; trace_shades := false ; + +% 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 ; + +def set_linear_vector (suffix a,b)(expr p,n) = + if (n=1) : a := llcorner p ; + b := urcorner p ; + elseif (n=2) : a := lrcorner p ; + b := ulcorner p ; + elseif (n=3) : a := urcorner p ; + b := llcorner p ; + elseif (n=4) : a := ulcorner p ; + b := lrcorner p ; + elseif (n=5) : a := .5[ulcorner p,llcorner p] ; + b := .5[urcorner p,lrcorner p] ; + elseif (n=6) : a := .5[llcorner p,lrcorner p] ; + b := .5[ulcorner p,urcorner p] ; + elseif (n=7) : a := .5[lrcorner p,urcorner p] ; + b := .5[llcorner p,ulcorner p] ; + elseif (n=8) : a := .5[urcorner p,ulcorner p] ; + b := .5[lrcorner p,llcorner p] ; + else : a := .5[ulcorner p,llcorner p] ; + b := .5[urcorner p,lrcorner p] ; + fi ; +enddef ; + +def linear_shade (expr p, n, ca, cb) = + begingroup ; + save a, b, sh ; pair a, b ; + set_linear_vector(a,b)(p,n) ; + fill p withshade define_linear_shade (a,b,ca,cb) ; + if trace_shades : + drawarrow a -- b withpen pencircle scaled 1pt ; + fi ; + endgroup ; +enddef ; + +vardef predefined_linear_shade (expr p, n, ca, cb) = + save a, b, sh ; pair a, b ; + set_linear_vector(a,b)(p,n) ; + set_shade_vector(a,b)(p,n) ; + define_linear_shade (a,b,ca,cb) +enddef ; + +def set_circular_vector (suffix ab, r)(expr p,n) = + if (n=1) : ab := llcorner p ; + elseif (n=2) : ab := lrcorner p ; + elseif (n=3) : ab := urcorner p ; + elseif (n=4) : ab := ulcorner p ; + else : ab := center p ; r := .5r ; + fi ; +enddef ; + +def circular_shade (expr p, n, ca, cb) = + begingroup ; + save ab, r ; pair ab ; numeric r ; + r := (xpart lrcorner p - xpart llcorner p) ++ + (ypart urcorner p - ypart lrcorner p) ; + set_circular_vector(ab,r)(p,n) ; + fill p withshade define_circular_shade(ab,ab,0,r,ca,cb) ; + if trace_shades : + drawarrow ab -- ab shifted (0,r) withpen pencircle scaled 1pt ; + fi ; + 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) ; + set_circular_vector(ab,r)(p,n) ; + define_circular_shade(ab,ab,0,r,ca,cb) +enddef ; + +%D Since a \type {fill p withshade s} syntax looks better +%D than some macro, we implement a new primary. + +primarydef p withshade sc = % == p withcolor shadecolor(sh) + hide (_color_counter_ := _color_counter_ + 1) + p withcolor (_special_signal_/1000,_color_counter_/1000,sc/1000) +enddef ; + +vardef shadecolor(expr sc) = + hide (_color_counter_ := _color_counter_ + 1) + (_special_signal_/1000,_color_counter_/1000,sc/1000) +enddef ; + +%D Figure inclusion. + +%numeric cef ; cef := 0 ; + +def externalfigure primary filename = + doexternalfigure (filename) +enddef ; + +def doexternalfigure (expr filename) text transformation = + begingroup ; save p, t ; picture p ; transform t ; + p := nullpicture ; t := identity transformation ; + flush_special(10, 9, + dddecimal (xxpart t, yxpart t, xypart t) & " " & + 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 ; + 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 ; + +def hyperlink primary t = dohyperlink(t) enddef ; +def hyperpath primary t = dohyperpath(t) enddef ; + +def dohyperlink (expr destination) text transformation = + begingroup ; save somepath ; path somepath ; + somepath := fullsquare transformation ; + dohyperpath(destination) somepath ; + endgroup ; +enddef ; + +def dohyperpath (expr destination) expr somepath = + begingroup ; + 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 ; + fill boundingbox unitsquare scaled 0 withcolor + (_special_signal_/1000,_color_counter_/1000,_special_counter_/1000) ; +% (_special_signal_/1000,currenthyperlink/1000,_special_counter_/1000) ; + endgroup ; +enddef ; + +% \setupinteraction[state=start] +% \setupcolors [state=start] +% +% Hello There! \blank +% +% \startMPcode +% pickup pencircle scaled 5 ; +% draw fullcircle scaled 4cm withcolor red ; +% hyperpath "nextpage" boundingbox currentpicture ; +% draw origin withcolor blue ; +% \stopMPcode +% +% \blank Does it work or not? +% +% \startMPcode +% pickup pencircle scaled 5 ; +% draw fullcircle scaled 4cm withcolor red ; +% hyperpath "nextpage" fullcircle scaled 4cm ; +% draw origin withcolor blue ; +% draw fullcircle scaled 4cm shifted (1cm,1cm); +% \stopMPcode +% +% \blank Does it work or not? \page Hello There! \blank +% +% \startMPcode +% pickup pencircle scaled 5 ; +% draw fullcircle scaled 2cm shifted (-2cm,-1cm) ; +% draw fullcircle scaled 3cm shifted (2cm,1cm) withcolor red ; +% draw fullcircle scaled 1cm ; +% hyperlink "previouspage" scaled 3cm shifted (2cm,1cm) ; +% draw origin withcolor blue ; +% \stopMPcode +% +% \blank Does it work or not? + +_cmyk_counter_ := 0 ; + +extra_endfig := " resetcmykcolors ; " & extra_endfig ; + +def resetcmykcolors = + numeric cmykcolorhash[][][][] ; +enddef ; + +resetcmykcolors ; boolean cmykcolors ; cmykcolors := false ; % true + +string cmykcolorpattern[] ; % needed for transparancies + +vardef cmyk(expr c,m,y,k) = + if cmykcolors : + 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_ & " " & 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 Spot colors + +_spotcolor_counter_ := 0 ; +_spotcolor_number_ := 0 ; + +extra_endfig := " resetspotcolors ; " & extra_endfig ; + +def resetspotcolors = + numeric spotcolorhash[][] ; +enddef ; + +resetspotcolors ; boolean spotcolors ; spotcolors := false ; % true + +string spotcolorpattern[] ; % needed for transparancies + +% vardef spotcolor(expr p, s) = +% if spotcolors : +% save ok, pc_tag ; boolean ok ; string pc_tag ; +% pc_tag := "_pct_"&p ; +% if not unstringed(pc_tag) : +% _spotcolor_number_ := _spotcolor_number_ + 1 ; +% setunstringed(pc_tag,_spotcolor_number_) ; +% fi ; +% pp := getunstringed(pc_tag) ; +% if unknown spotcolorhash[pp][s] : +% ok := false ; % not yet defined +% elseif spotcolorhash[pp][s] = -1 : +% ok := false ; % locally defined and undefined +% else : +% ok := true ; % globally already defined +% fi ; +% if not ok : +% save ss ; string ss ; ss := p & " " & decimal s ; +% _spotcolor_counter_ := _spotcolor_counter_ + 1 ; +% spotcolorpattern[_spotcolor_counter_/1000] := ss ; +% spotcolorhash[pp][s] := _spotcolor_counter_ ; +% flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ; +% _local_specials_ := _local_specials_ & +% "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ; +% fi ; +% (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000) +% else : +% (1-s,1-s,1-s) +% fi +% enddef ; + +% vardef spotcolor(expr p, s) = +% if spotcolors : +% save ok, pc_tag ; boolean ok ; string pc_tag ; +% pc_tag := "_pct_"&p ; +% if not unstringed(pc_tag) : +% _spotcolor_number_ := _spotcolor_number_ + 1 ; +% setunstringed(pc_tag,_spotcolor_number_) ; +% fi ; +% pp := getunstringed(pc_tag) ; +% if unknown spotcolorhash[pp][s] : +% ok := false ; % not yet defined +% elseif spotcolorhash[pp][s] = -1 : +% ok := false ; % locally defined and undefined +% else : +% ok := true ; % globally already defined +% fi ; +% if not ok : +% save ss ; string ss ; ss := p & " " & decimal s ; +% _spotcolor_counter_ := _spotcolor_counter_ + 1 ; +% spotcolorpattern[_spotcolor_counter_/1000] := ss ; +% spotcolorhash[pp][s] := _spotcolor_counter_ ; +% flush_special(2, 5, decimal _spotcolor_counter_ & " " & ss) ; +% _local_specials_ := _local_specials_ & +% "spotcolorhash["&decimal pp&"]["&decimal s&"]:=-1;" ; +% fi ; +% (_special_signal_/1000,2/1000,spotcolorhash[pp][s]/1000) +% else : +% (1-s,1-s,1-s) +% fi +% enddef ; + +vardef spotcolor(expr p, s) = + multitonecolor(p, 1, "", decimal s) +enddef ; + +vardef multitonecolor(expr n, f, d, p) = % name fractions names factors + if spotcolors : + save ok, pc_tag ; boolean ok ; string pc_tag ; + pc_tag := "_pct_" & n ; + if not unstringed(pc_tag) : + _spotcolor_number_ := _spotcolor_number_ + 1 ; + setunstringed(pc_tag,_spotcolor_number_) ; + fi ; + pp := getunstringed(pc_tag) ; + pc_tag := "_pct_"& decimal f & "_" & if d = "" : n else : d fi & "_" & p ; % check for d empty + if not unstringed(pc_tag) : + _spotcolor_number_ := _spotcolor_number_ + 1 ; + setunstringed(pc_tag,_spotcolor_number_) ; + fi ; + ps := getunstringed(pc_tag) ; + if unknown spotcolorhash[pp][ps] : + ok := false ; % not yet defined + elseif spotcolorhash[pp][ps] = -1 : + ok := false ; % locally defined and undefined + else : + ok := true ; % globally already defined + fi ; + if not ok : + save ss ; string ss ; ss := n & " " & decimal f & " " & if d = "" : n else : d fi & " " & p ; + _spotcolor_counter_ := _spotcolor_counter_ + 1 ; + spotcolorpattern[_spotcolor_counter_/1000] := ss ; + spotcolorhash[pp][ps] := _spotcolor_counter_ ; + flush_special(2, 7, decimal _spotcolor_counter_ & " " & ss) ; + _local_specials_ := _local_specials_ & + "spotcolorhash["&decimal pp&"]["&decimal ps&"]:=-1;" ; + fi ; + (_special_signal_/1000,2/1000,spotcolorhash[pp][ps]/1000) + else : + .5white + fi +enddef ; + +%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, is_spot, ok ; +% string s, ss ; numeric nn ; color cc ; boolean is_cmyk, is_spot, ok ; +% % transparancy type +% if string n : +% if expandafter known scantokens(n&"transparent") : +% nn := scantokens(n&"transparent") ; +% else : +% nn := 0 ; +% fi +% else : % nn := min(n,13) +% nn := if n<13 : n else : nn := 0 fi ; +% fi ; +% % we need to expand the color (can be cmyk(..) or predefined) +% cc := c ; % expand color +% % check for cmyk special +% is_cmyk := (redpart cc = _special_signal_/1000) +% and (greenpart cc = 1/1000) ; +% is_spot := (redpart cc = _special_signal_/1000) +% and (greenpart cc = 2/1000) ; +% % build special string, fetch cmyk components +% s := decimal nn & " " & decimal t & " " & +% if is_cmyk : cmykcolorpattern[bluepart cc] +% elseif is_spot : spotcolorpattern[bluepart cc] +% else : dddecimal cc fi ; +% % check if this one is already used +% ss := "tr_" & s ; +% % efficiency hack +% if expandafter unknown scantokens(ss) : +% ok := false ; % not yet defined +% elseif scantokens(ss) < 0 : +% ok := false ; % locally defined and undefined +% else : +% ok := true ; % globally already defined +% fi ; +% if not ok : +% if is_spot : +% flush_special(5, 6, s) ; +% elseif is_cmyk : +% flush_special(4, 8, s) ; +% else : +% flush_special(3, 7, s) ; +% fi ; +% scantokens(ss) := _special_counter_ ; +% _local_specials_ := _local_specials_ & +% "scantokens(" & ditto & ss & ditto & ") := -1 ;" ; +% fi ; +% % go ahead +% if is_spot : +% (_special_signal_/1000,5/1000,scantokens(ss)/1000) +% elseif is_cmyk : +% (_special_signal_/1000,4/1000,scantokens(ss)/1000) +% else : +% (_special_signal_/1000,3/1000,scantokens(ss)/1000) +% fi +% enddef ; + +vardef transparent(expr n, t, c) = + save s, ss, nn, cc, is_cmyk, is_spot, ok ; + string s, ss ; numeric nn ; color cc ; boolean is_cmyk, is_spot, ok ; + % transparancy type + if string n : + if expandafter known scantokens(n&"transparent") : + nn := scantokens(n&"transparent") ; + else : + nn := 0 ; + fi + else : % nn := min(n,13) + nn := if n<13 : n else : nn := 0 fi ; + fi ; + % we need to expand the color (can be cmyk(..) or predefined) + cc := c ; % expand color + % check for cmyk special + is_cmyk := (redpart cc = _special_signal_/1000) + and (greenpart cc = 1/1000) ; + is_spot := (redpart cc = _special_signal_/1000) + and (greenpart cc = 2/1000) ; + % build special string, fetch cmyk components + s := decimal nn & " " & decimal t & " " & + if is_cmyk : cmykcolorpattern[bluepart cc] + elseif is_spot : spotcolorpattern[bluepart cc] + else : dddecimal cc fi ; + % check if this one is already used + ss := cleanstring("tr_" & s) ; + % we now have rather unique names, i.e. a color spec of .234 becomes + % tr..._234.... and metapost gives a number overflow (parse error) + % for variables like tr_12345678 which may result from many decimal + % positions (imo mp bug) + ss := asciistring(ss) ; + % efficiency hack + if expandafter unknown scantokens(ss) : + ok := false ; % not yet defined + elseif scantokens(ss) < 0 : + ok := false ; % locally defined and undefined + else : + ok := true ; % globally already defined + fi ; + if not ok : + if is_spot : + flush_special(5, 8, s) ; + elseif is_cmyk : + flush_special(4, 8, s) ; + else : + flush_special(3, 7, s) ; + fi ; + scantokens(ss) := _special_counter_ ; + _local_specials_ := _local_specials_ & + "scantokens(" & ditto & ss & ditto & ") := -1 ;" ; + fi ; + % go ahead + if is_spot : + (_special_signal_/1000,5/1000,scantokens(ss)/1000) + elseif is_cmyk : + (_special_signal_/1000,4/1000,scantokens(ss)/1000) + else : + (_special_signal_/1000,3/1000,scantokens(ss)/1000) + fi +enddef ; + +%D This function returns true of false, dependent on transparency. + +vardef is_transparent(text t) = + begingroup ; save transparent ; save _c_, _b_ ; + vardef transparent(expr nn, tt, cc) = _b_ := true ; cc enddef ; + boolean _b_ ; _b_ := false ; + color _c_ ; _c_ := t ; _b_ + endgroup +enddef ; + +%D This function returns the not transparent color. + +vardef not_transparent(text t) = + begingroup ; save transparent ; + vardef transparent(expr nn, tt, cc) = cc enddef ; + t endgroup +enddef ; + +%D Basic position tracking: + +def register (expr label, width, height, offset) = + begingroup ; + flush_special(50, 7, + ddecimal offset & " " & + decimal width & " " & + decimal height & " " & label) ; + endgroup ; +enddef ; + +%D We cannot scale cmyk colors directly since this spoils +%D the trigger signal (such colors are no real colors). + +vardef scaledcmyk(expr c,m,y,k,sf) = + cmyk(sf*c,sf*m,sf*y,sf*k) +enddef ; + +vardef scaledcmykasrgb(expr c,m,y,k,sf) = + (sf*(1-c-k,1-m-k,1-y-k)) +enddef ; + +vardef scaledrgbascmyk(expr c,m,y,k,sf) = + scaledcmyk(1-c,1-m,1-y,0,sf) +enddef ; + +vardef scaledrgb(expr r,g,b,sf) = + (sf*(r,g,b)) +enddef ; + +vardef scaledgray(expr s,sf) = + (sf*(s,s,s)) +enddef ; + +% spotcolor is already scaled + +endinput ; + +% just an exercise (due to a question by Chof on the context mailing list); scaling of +% 'special' colors is not possible and the next solution is incomplete (spot colors, +% transparency, etc); watch the the tricky chained macro construction + +% vardef normalgray(expr s ) = (s,s,s) enddef ; +% vardef normalrgb (expr r,g,b ) = (r,g,b) enddef ; +% vardef normalcmyk(expr c,m,y,k) = if cmykcolors : save ok ; boolean ok ; if unknown cmykcolorhash[c][m][y][k] : ok := false ; elseif cmykcolorhash[c][m][y][k] = -1 : ok := false ; else : ok := true ; 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_ & " " & 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 ; + +% vardef gray(expr s) = normalgray(s ) enddef ; +% vardef rgb (expr r,g,b) = normalrgb (r,g,b ) enddef ; +% vardef cmyk(expr c,m,y,k) = normalcmyk(c,m,y,k) enddef ; + +% numeric _scaled_color_t_ ; +% color _scaled_color_c_ ; + +% def withscaledcolor = +% hide ( +% _scaled_color_t_ := 0 ; % direct +% def gray(expr s) = +% hide ( +% _gray_s_ := s ; +% _scaled_color_t_ := 1; % gray +% ) +% 0 +% enddef ; +% def rgb (expr r,g,b) = +% hide ( +% _rgb_r_ := r ; _rgb_g_ := g ; _rgb_b_ := b ; +% _scaled_color_t_ := 2 ; % rgb +% ) +% 0 +% enddef ; +% def cmyk (expr c,m,y,k) = +% hide ( +% _cmyk_c_ := c ; _cmyk_m_ := m ; _cmyk_y_ := y ; _cmyk_k_ := k ; +% _scaled_color_t_ := 3 ; % cmyk +% ) +% 0 +% enddef ; ) +% dowithscaledcolor +% enddef ; + +% def dowithscaledcolor expr t = +% hide ( +% if color t : _scaled_color_c_ := t fi ; +% vardef gray(expr s) = normalgray(s) enddef ; +% vardef rgb (expr r,g,b) = normalrgb (r,g,b) enddef ; +% vardef cmyk(expr c,m,y,k) = normalcmyk(c,m,y,k) enddef ; +% ) +% enddef ; + +% def by expr s = +% if _scaled_color_t_ = 0 : +% withcolor s*_scaled_color_c_ +% elseif _scaled_color_t_ = 1 : +% withcolor gray(s*_gray_s_) +% elseif _scaled_color_t_ = 2 : +% withcolor rgb (s*_rgb_r_, s*_rgb_g_, s*_rgb_b_) +% elseif _scaled_color_t_ = 3 : +% withcolor cmyk(s*_cmyk_c_, s*_cmyk_m_, s*_cmyk_y_, s*_cmyk_k_) +% fi +% enddef ; + +% fill fullcircle scaled 10cm withscaledcolor cmyk(0,0,1,0) by .5 ; +% fill fullcircle scaled 8cm withscaledcolor rgb (0,0,1) by .5 ; +% fill fullcircle scaled 6cm withscaledcolor gray(1) by .5 ; +% fill fullcircle scaled 4cm withscaledcolor (0,1,0) by .5 ; diff --git a/Master/texmf-dist/metapost/context/base/mp-step.mp b/Master/texmf-dist/metapost/context/base/mp-step.mp new file mode 100644 index 00000000000..d602f701430 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-step.mp @@ -0,0 +1,320 @@ +%D \module +%D [ file=mp-step.mp, +%D version=2001.05.22, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=steps, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if unknown context_tool : input mp-tool ; fi ; +if known context_step : endinput ; fi ; + +boolean context_step ; context_step := true ; + +%D In the associated \TEX\ module \type {m-steps}, we describe +%D three methods. The first method uses a different kind of +%D code than the other two. The method we decided to use, +%D is based on positional information (paths) provided by +%D \CONTEXT. + +def initialize_step_variables = + save line_method, line_h_offset, line_v_offset ; + numeric line_method ; line_method := 1 ; + numeric line_h_offset ; line_h_offset := 3pt ; + numeric line_v_offset ; line_v_offset := 3pt ; +enddef ; + +def begin_step_chart = + initialize_step_variables ; + save steps, texts, t, b, tb, nofcells ; + picture cells[][], texts[][][], lines[][][] ; + numeric t, b ; t := 1 ; b := 2 ; + numeric nofcells ; nofcells := 0 ; +enddef ; + +def analyze_step_chart = + numeric n[], l[][], r[][] ; pair p[] ; + n[t] := n[b] := 0 ; numeric tb ; + for i=1 upto nofcells : for nn = t, b : + if bbwidth(cells[nn][i])>0 : n[nn] := n[nn] + 1 ; fi ; + l[t][i] := r[t][i] := l[b][i] := r[b][i] := 0 ; + endfor ; endfor ; + % count left and right points + for i=1 upto nofcells-1 : for j=i upto nofcells-1 : for nn = t, b : + if bbwidth(texts[nn][i][j])>0 : + l[nn][i] := l[nn][i] + 1 ; + r[nn][j+1] := r[nn][j+1] + 1 ; + fi ; + endfor ; endfor ; endfor ; + % calculate left and right points + vardef do (expr nn, mm, ii, ss) = + if (l[nn][ii] + r[nn][ii]) > 1 : ss else : .5 fi + [ ulcorner cells[mm][ii], urcorner cells[mm][ii] ] + enddef ; + % combined rows + tb := if n[t]>0 : t else : b fi ; +enddef ; + +vardef get_step_chart_top_line (expr i, j) = + if bbwidth(cells[tb][i])>0 : + if bbwidth(texts[t][i][j])>0 : + if bbwidth(cells[tb][j+1])>0 : + p[1] := top do(t, tb, i, .6) ; + p[3] := top do(t, tb, j+1, .4) ; + p[2] := .5[p[1],p[3]] ; + if line_method = 1 : + p[2] := p[2] shifted (0, ypart + (llcorner texts[t][i][j] - ulcorner cells[tb][j+1])) ; + elseif line_method = 2 : + p[2] := center texts[t][i][j] ; + else : + % nothing + fi ; + p[1] := p[1] shifted (0,+line_v_offset) ; + p[2] := p[2] shifted (0,-line_v_offset) ; + p[3] := p[3] shifted (0,+line_v_offset) ; + (p[1] {up} ... p[2] ... {down} p[3]) + else : + origin + fi + else : + origin + fi + else : + origin + fi +enddef ; + +vardef get_step_chart_bot_line (expr i, j) = + if bbwidth(cells[b][i])>0 : + if bbwidth(texts[b][i][j])>0 : + if bbwidth(cells[b][j+1])>0 : + p[1] := (bot do(b, b, i, .6)) shifted (0,-bbheight(cells[b][i])) ; + p[3] := (bot do(b, b, j+1, .4)) shifted (0,-bbheight(cells[b][j+1])) ; + p[2] := .5[p[1],p[3]] ; + if line_method = 1 : + p[2] := p[2] shifted (0, -ypart + (llcorner cells[b][j+1] - ulcorner texts[b][i][j])) ; + elseif line_method = 2 : + p[2] := center texts[b][i][j] ; + fi ; + p[1] := p[1] shifted (0,-line_v_offset) ; + p[2] := p[2] shifted (0,+line_v_offset) ; + p[3] := p[3] shifted (0,-line_v_offset) ; + (p[1] {down} ... p[2] ... {up} p[3]) + else : + origin + fi + else : + origin + fi + else : + origin + fi +enddef ; + +def end_step_chart = + for i=1 upto nofcells : for nn = t, b : + if bbwidth(cells[nn][i]) >0 : draw cells[nn][i] ; fi ; + endfor ; endfor ; + for i=1 upto nofcells : for j=i upto nofcells : for nn = t, b : + if known lines[nn][i][j] : + if bbwidth(lines[nn][i][j])>0 : draw lines[nn][i][j] ; fi ; + fi ; + endfor ; endfor ; endfor ; + for i=1 upto nofcells : for j=i upto nofcells : for nn = t, b : + if bbwidth(texts[nn][i][j])>0 : draw texts[nn][i][j] ; fi ; + endfor ; endfor ; endfor ; +enddef ; + +%D Step tables. + +def begin_step_table = + initialize_step_variables ; + picture cells[], texts[], lines[] ; + numeric nofcells ; nofcells := 0 ; +enddef ; + +def end_step_table = + for i=1 upto nofcells : if known cells[i] : if bbwidth(cells[i])>0 : + draw cells[i] ; + fi ; fi ; endfor ; + for i=1 upto nofcells : if known lines[i] : if bbwidth(lines[i])>0 : + draw lines[i] ; + fi ; fi ; endfor ; + for i=1 upto nofcells : if known texts[i] : if bbwidth(texts[i])>0 : + draw texts[i] ; + fi ; fi ; endfor ; +enddef ; + +vardef get_step_table_line (expr i) = + pair prev, self, next ; + if known texts[i] : + self := lft .5[llcorner texts[i], ulcorner texts[i] ] ; + prev := rt if known texts[i-1] : .3 else : .5 fi [lrcorner cells[i] , urcorner cells[i] ] ; + next := rt if known texts[i+1] : .7 else : .5 fi [lrcorner cells[i+1], urcorner cells[i+1]] ; + self := self shifted (-line_h_offset,0) ; + prev := prev shifted (+line_h_offset,0) ; + next := next shifted (+line_h_offset,0) ; + prev {right} ... self ... {left} next + else : + origin + fi +enddef ; + +endinput + +%D The older method let \METAPOST\ do the typesetting. The +%D macros needed for that are included here for educational +%D purposes. +%D +%D \starttypen +%D def initialize_step_variables = +%D save line_color, line_width, arrow_alternative, +%D text_fill_color, text_line_color, text_line_width, text_offset, +%D cell_fill_color, cell_line_color, cell_line_width, cell_offset, +%D line_h_offset, line_v_offset ; +%D color line_color ; line_color := .4white ; +%D numeric line_width ; line_width := 1.5pt ; +%D color text_fill_color ; text_fill_color := white ; +%D color text_line_color ; text_line_color := red ; +%D numeric text_line_width ; text_line_width := 1pt ; +%D numeric text_offset ; text_offset := 2pt ; +%D color cell_fill_color ; cell_fill_color := white ; +%D color cell_line_color ; cell_line_color := blue ; +%D numeric cell_line_width ; cell_line_width := 1pt ; +%D numeric cell_offset ; cell_offset := 2pt ; +%D numeric line_alternative ; line_alternative := 1 ; +%D numeric line_h_offset ; line_h_offset := 3pt ; +%D numeric line_v_offset ; line_v_offset := 3pt ; +%D enddef ; +%D +%D def begin_step_chart = +%D begingroup ; +%D initialize_step_variables ; +%D save steps, texts, t, b ; +%D picture cells[][] ; numeric nofcells ; nofcells := 0 ; +%D picture texts[][][] ; numeric noftexts ; noftexts := 0 ; +%D numeric t, b ; t := 1 ; b := 2 ; +%D enddef ; +%D \stoptypen +%D +%D We use a couple of macros to store the content. In the +%D second (third) alternative we will directly fill the +%D cells. +%D +%D \starttypen +%D def set_step_chart_cells (expr one, two) = +%D nofcells := nofcells + 1 ; noftexts := 0 ; +%D cells[t][nofcells] := textext.rt(one) ; +%D cells[b][nofcells] := textext.rt(two) ; +%D enddef ; +%D +%D def set_step_chart_texts (expr one, two) = +%D noftexts := noftexts + 1 ; +%D texts[t][nofcells][noftexts] := textext.rt(one) ; +%D texts[b][nofcells][noftexts] := textext.rt(two) ; +%D enddef ; +%D \stoptypen +%D +%D If you compare the building macro with the later +%D alternative, you will notice that here we explicitly +%D have to calculate the distances and positions. +%D +%D \starttypen +%D def end_step_chart = +%D numeric dx ; dx := 0 ; path p ; +%D numeric n[] ; n[t] := n[b] := 0 ; +%D numeric stepsvdistance[] ; +%D vardef bbwidth (expr p) = (xpart (lrcorner p - llcorner p)) enddef ; +%D vardef bbheight (expr p) = (ypart (urcorner p - lrcorner p)) enddef ; +%D stepsvdistance[t] := stepsvdistance[b] := 0 ; +%D for i=1 upto nofcells : +%D % find largest bbox +%D p := boundingbox steps +%D [if bbwidth(cells[t][i])>bbwidth(cells[b][i]): t else: b fi][i] ; +%D % assign largest bbox +%D for nn = t, b : +%D if bbwidth(cells[nn][i])>0 : +%D setbounds cells[nn][i] to p enlarged cell_offset ; +%D n[nn] := n[nn] + 1 ; +%D fi ; +%D endfor ; +%D % determine height +%D if n[t]>0 : +%D stepsvdistance[t] := bbheight(cells[t][1]) + intertextdistance ; +%D fi ; +%D % add to row +%D for nn = t, b : +%D cells[nn][i] := cells[nn][i] shifted (dx,stepsvdistance[nn]) ; +%D if bbwidth(cells[nn][i])>0 : +%D dowithpath (boundingbox cells[nn][i], +%D cell_line_width, cell_line_color, cell_background_color) ; +%D fi ; +%D endfor ; +%D % calculate position +%D dx := dx + interstepdistance + bbwidth(cells[b][i]) ; +%D endfor ; +%D boolean stacked ; stacked := false ; +%D numeric l[][], r[][], l[][], r[][] ; +%D pair pa, pb, pc ; path p[] ; +%D for i=1 upto nofcells : +%D l[t][i] := r[t][i] := l[b][i] := r[b][i] := 0 ; +%D endfor ; +%D % count left and right points +%D for i=1 upto nofcells : for j=1 upto nofcells : for nn = t, b : +%D if known texts[nn][i][j] : if bbwidth(texts[nn][i][j])>0 : +%D l[nn][i] := l[nn][i] + 1 ; +%D r[nn][j+i] := r[nn][j+i] + 1 ; +%D stacked := (stacked or (j>1)) ; +%D setbounds texts[nn][i][j] to boundingbox texts[nn][i][j] enlarged cell_offset ; +%D fi fi ; +%D endfor ; endfor ; endfor ; +%D % calculate left and right points +%D vardef do (expr nn, mm, ii, ss) = +%D if (l[nn][ii] > 0) and (r[nn][ii] > 0) : ss else : .5 fi +%D [ ulcorner cells[mm][ii],urcorner cells[mm][ii] ] +%D enddef ; +%D % draw arrow from left to right point +%D def dodo (expr nn, ii, jj, dd) = +%D drawarrow p[nn] +%D withpen pencircle scaled arrow_line_width +%D withcolor arrow_line_color ; +%D transform tr ; tr := identity +%D shifted point .5 along p[nn] +%D shifted -center texts[nn][ii][jj] +%D if not stacked : shifted (0,dd) fi ; +%D dowithpath ((boundingbox texts[nn][ii][jj]) transformed tr, +%D text_line_width, text_line_color, text_fill_color) ; +%D enddef ; +%D % draw top and bottom text boxes +%D for i=1 upto nofcells : for j=1 upto nofcells : +%D pickup pencircle scaled arrow_line_width ; +%D if known texts[t][i][j] : if bbwidth(texts[t][i][j]) > 0 : +%D pa := top do(t, if n[t]>0 : t else : b fi, i, .6) ; +%D pb := top do(t, if n[t]>0 : t else : b fi, j+i, .4) ; +%D pc := .5[pa,pb] shifted (0,+step_arrow_depth) ; +%D p[t] := pa {up} .. if not stacked : pc .. fi {down} pb ; +%D dodo(t, i, j, +intertextdistance) ; +%D fi fi ; +%D if known texts[b][i][j] : if bbwidth(texts[b][i][j]) > 0 : +%D pa := (bot do(b, b, i, .6)) shifted (0,-bbheight(cells[b][i])) ; +%D pb := (bot do(b, b, j+i, .4)) shifted (0,-bbheight(cells[b][j+i])) ; +%D pc := .5[pa,pb] shifted (0,-step_arrow_depth) ; +%D p[b] := pa {down} .. if not stacked : pc .. fi {up} pb ; +%D dodo(b, i, j, -intertextdistance) ; +%D fi fi ; +%D endfor ; endfor ; +%D endgroup ; +%D enddef ; +%D \stoptypen +%D +%D If you compare both methods, you will notice that the +%D first method is the cleanest, but not the most efficient +%D (since it needs \TEX\ runs within \METAPOST\ runs within +%D \TEX\ runs). diff --git a/Master/texmf-dist/metapost/context/base/mp-symb.mp b/Master/texmf-dist/metapost/context/base/mp-symb.mp new file mode 100644 index 00000000000..a84c84e828d --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-symb.mp @@ -0,0 +1,351 @@ +%D \module +%D [ file=mp-symb.mp, +%D version=very old, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=navigation symbol macros, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. + +%D Instead of these symbols, you can use the \type {contnav} +%D font by Taco Hoekwater that is derived form this file. + +u := 3; +h := 5u; +wt := 5u; +wb := .25wt; +o := .1u; +pw := .5u; + +drawoptions (withpen pencircle scaled pw); + +path lefttriangle, righttriangle, sublefttriangle, subrighttriangle; + +pair s ; s = (2wb,0) ; + +x1t = x2t = 0; +x3t = wt; +y3t = .5h; +z1t-z2t = (z3t-z2t) rotated 60; + +z4t = (z2t--z3t) intersectionpoint ((z1t--z2t) shifted s) ; +z5t = (z3t--z1t) intersectionpoint ((z1t--z2t) shifted s) ; + +righttriangle = z1t--z2t--z3t--cycle; +lefttriangle = righttriangle rotatedaround((0,.5h), 180) shifted (wt,0); + +subrighttriangle = z4t--((z2t--z3t--z1t) shifted s)--z5t ; +sublefttriangle = subrighttriangle rotatedaround((0,.5h), 180) shifted (wt,0); + +path sidebar; + +x1b = x4b = 0; +x2b = x3b = wb; +y1b = y2b = y1t; +y3b = y4b = y2t; + +sidebar = z1b--z2b--z3b--z4b--cycle; + +path midbar, onebar, twobar; + +hh = abs(y1t-y2t); + +%midbar := unitsquare scaled 2hh/3; +midbar := unitsquare scaled hh; +onebar := unitsquare xscaled (hh/3) yscaled hh; +twobar := onebar; + +def prepareglyph = + drawoptions (withpen pencircle scaled .5u); +enddef; + +def finishglyph = + set_outer_boundingbox currentpicture; + bboxmargin := o; + setbounds currentpicture to bbox currentpicture; +% draw boundingbox currentpicture withcolor red withpen pencircle scaled 1; +enddef; + +beginfig (1); + prepareglyph; + fill lefttriangle; + draw lefttriangle; % draw gets the bbox right, filldraw doesn't + finishglyph; +endfig; + +beginfig (2); + prepareglyph; + fill righttriangle; + draw righttriangle; + finishglyph; +endfig; + +beginfig (3); + prepareglyph; + fill sidebar; + draw sidebar; + fill lefttriangle shifted (.5s); + draw lefttriangle shifted (.5s); + finishglyph; +endfig; + +beginfig (4); + prepareglyph; + fill righttriangle; + draw righttriangle; + fill sidebar shifted (wt,0); + draw sidebar shifted (wt,0); + finishglyph; +endfig; + +beginfig (5); + prepareglyph; + fill lefttriangle; + draw lefttriangle; + fill lefttriangle shifted s; + draw lefttriangle shifted s; + finishglyph; +endfig; + +beginfig (6); + prepareglyph; + fill righttriangle; + draw righttriangle; + fill righttriangle shifted s; + draw righttriangle shifted s; + finishglyph; +endfig; + +beginfig (7); + prepareglyph; + fill midbar; + draw midbar; + finishglyph; +endfig; + +beginfig (8); + prepareglyph; + fill onebar; + draw onebar; + finishglyph; +endfig; + +beginfig (9); + prepareglyph; + fill twobar; + draw twobar; + fill twobar shifted (pw+hh/2,0); + draw twobar shifted (pw+hh/2,0); + finishglyph; +endfig; + +beginfig(101); + prepareglyph; + draw lefttriangle; + finishglyph; +endfig; + +beginfig(102); + prepareglyph; + draw righttriangle; + finishglyph; +endfig; + +beginfig(103); + prepareglyph; + draw sidebar; + draw lefttriangle shifted (.5s); + finishglyph; +endfig; + +beginfig(104); + prepareglyph; + draw righttriangle; + draw sidebar shifted (wt,0); + finishglyph; +endfig; + +beginfig(105); + prepareglyph; + draw lefttriangle; + draw lefttriangle shifted s; + finishglyph; +endfig; + +beginfig(106); + prepareglyph; + draw righttriangle; + draw righttriangle shifted s; + finishglyph; +endfig; + +beginfig(107); + prepareglyph; + draw midbar; + finishglyph; +endfig; + +beginfig(108); + prepareglyph; + draw onebar; + finishglyph; +endfig; + +beginfig(109); + prepareglyph; + draw twobar; + draw twobar shifted (pw+hh/2,0); + finishglyph; +endfig; + +beginfig(201); + prepareglyph; + draw lefttriangle; + finishglyph; +endfig; + +beginfig(202); + prepareglyph; + draw righttriangle; + finishglyph; +endfig; + +beginfig(203); + prepareglyph; + draw sidebar; + draw lefttriangle shifted (.5s); + finishglyph; +endfig; + +beginfig(204); + prepareglyph; + draw righttriangle; + draw sidebar shifted (wt,0); + finishglyph; +endfig; + +beginfig(205); + prepareglyph; + draw sublefttriangle shifted s; + draw lefttriangle shifted s; + finishglyph; +endfig; + +beginfig(206); + prepareglyph; + draw subrighttriangle; + draw righttriangle; + finishglyph; +endfig; + +beginfig(207); + prepareglyph; + draw midbar; + finishglyph; +endfig; + +beginfig(208); + prepareglyph; + draw onebar; + finishglyph; +endfig; + +beginfig(209); + prepareglyph; + draw twobar; + draw twobar shifted (pw+hh/2,0); + finishglyph; +endfig; + + +beginfig(999); + +picture collection [] ; + +prepareglyph ; +draw lefttriangle ; +finishglyph ; +collection[201] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw righttriangle ; +finishglyph ; +collection[202] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw sidebar ; +draw lefttriangle shifted (.5s) ; +finishglyph ; +collection[203] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw righttriangle ; +draw sidebar shifted (wt,0) ; +finishglyph ; +collection[204] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw sublefttriangle shifted s ; +draw lefttriangle shifted s ; +finishglyph ; +collection[205] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw subrighttriangle ; +draw righttriangle ; +finishglyph ; +collection[206] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw midbar ; +finishglyph ; +collection[207] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw onebar ; +finishglyph ; +collection[208] := currentpicture ; +currentpicture := nullpicture ; + +prepareglyph ; +draw twobar ; +draw twobar shifted (pw+hh/2,0) ; +finishglyph ; +collection[209] := currentpicture ; +currentpicture := nullpicture ; + +for i=201 upto 209 : + collection[i] := collection[i] shifted - center collection[i] ; +endfor ; + +addto currentpicture also collection[205] shifted ( 0, 0) + withcolor (.3,.4,.5) ; +addto currentpicture also collection[202] shifted ( 0,1.5h) + withcolor (.5,.6,.7) ; +addto currentpicture also collection[201] shifted (1.5h, 0) + withcolor (.6,.7,.8) ; +addto currentpicture also collection[206] shifted (1.5h,1.5h) + withcolor (.4,.5,.6) ; + +collection[210] := currentpicture ; +currentpicture := nullpicture ; + +bboxmargin := .25u; + +fill bbox collection[210] withcolor .95(1,1,0); +addto currentpicture also collection[210] ; + +endfig ; + +end diff --git a/Master/texmf-dist/metapost/context/base/mp-text.mp b/Master/texmf-dist/metapost/context/base/mp-text.mp new file mode 100644 index 00000000000..2e061df0996 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-text.mp @@ -0,0 +1,267 @@ +%D \module +%D [ file=mp-text.mp, +%D version=2000.07.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=text support, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +%D Under construction. + +if unknown context_tool : input mp-tool ; fi ; +if known context_text : endinput ; fi ; + +boolean context_text ; context_text := true ; + +if unknown noftexpictures : + numeric noftexpictures ; noftexpictures := 0 ; +fi ; + +if unknown texpictures[1] : + picture texpictures[] ; +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 ; +% string textextstring ; textextstring := "" ; + +% def resettextextdirective = +% textextstring := "" ; +% enddef ; + +% def textextdirective text t = +% textextstring := textextstring & t ; +% enddef ; + +vardef textext@#(expr txt) = + save _s_ ; string _s_ ; + interim labeloffset := textextoffset ; + noftexpictures := noftexpictures + 1 ; + if string txt : +% if textextstring <> "" : +% _s_ := "verbatimtex " & textextstring & " etex ;" ; +% else : +% _s_ := "" ; +% fi ; + if hobbiestextext : % the tex.mp method as fallback (see tex.mp) +% write _s_ to "mptextmp.mp" ; + write _s_ & "btex " & txt & " etex" to "mptextmp.mp" ; + write EOF to "mptextmp.mp" ; + scantokens "input mptextmp" + else : +% write "% setup : " & _s_ to jobname & ".mpt" ; + write "% figure " & decimal charcode & " : " & + "texpictures[" & decimal noftexpictures & "] := btex " & + txt & " etex ;" to jobname & ".mpt" ; + if unknown texpictures[noftexpictures] : + thelabel@#("unknown",origin) + else : + thelabel@#(texpictures[noftexpictures],origin) + 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) ; + +vardef thelabel@#(expr s, z) = + save p ; picture p ; + p = s if not picture s : infont defaultfont scaled defaultscale fi ; + if laboff@#<>laboff.origin : + (p shifted (z + labeloffset*laboff@# - (labxf@#*lrcorner p + + labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p))) + else : + (p shifted z) + fi +enddef; + +def build_parshape (expr p, offset_or_path, dx, dy, + baselineskip, strutheight, strutdepth, topskip) = + + if unknown trace_parshape : + boolean trace_parshape ; trace_parshape := false ; + fi ; + + begingroup ; + + save q, l, r, line, tt, bb, + n, hsize, vsize, vvsize, voffset, hoffset, width, indent, + ll, lll, rr, rrr, cp, cq, t, b ; + + path q, l, r, line, tt, bb ; + numeric n, hsize, vsize, vvsize, voffset, hoffset, width[], indent[] ; + pair ll, lll, rr, rrr, cp, cq, t, b ; + + n := 0 ; cp := center p ; + + if path offset_or_path : + q := offset_or_path ; cq := center q ; + voffset := dy ; + hoffset := dx ; + else : + q := p ; cq := center q ; + hoffset := offset_or_path + dx ; + voffset := offset_or_path + dy ; + fi ; + + hsize := xpart lrcorner q - xpart llcorner q ; + vsize := ypart urcorner q - ypart lrcorner q ; + + q := p shifted - cp ; + + startsavingdata ; + + savedata "\global\parvoffset " & decimal voffset&"bp " ; + savedata "\global\parhoffset " & decimal hoffset&"bp " ; + savedata "\global\parwidth " & decimal hsize&"bp " ; + savedata "\global\parheight " & decimal vsize&"bp " ; + + if not path offset_or_path : + q := q xscaled ((hsize-2hoffset)/hsize) + yscaled ((vsize-2voffset)/vsize) ; + fi ; + + hsize := xpart lrcorner q - xpart llcorner q ; + vsize := ypart urcorner q - ypart lrcorner q ; + + t := (ulcorner q -- urcorner q) intersection_point q ; + b := (llcorner q -- lrcorner q) intersection_point q ; + + if xpart directionpoint t of q < 0 : + q := reverse q ; + fi ; + + l := q cutbefore t ; + l := l if xpart point 0 of q < 0 : & q fi cutafter b ; + + r := q cutbefore b ; + r := r if xpart point 0 of q > 0 : & q fi cutafter t ; + +% tt := (ulcorner q -- urcorner q) shifted (0,-topskip) ; +% bb := (llcorner q -- lrcorner q) shifted (0,strutdepth) ; +% +% l := l cutbefore (l intersection_point tt) ; +% l := l cutafter (l intersection_point bb) ; +% r := r cutbefore (r intersection_point bb) ; +% r := r cutafter (r intersection_point tt) ; + + if trace_parshape : + drawarrow p withpen pencircle scaled 2pt withcolor red ; + drawarrow l shifted cp withpen pencircle scaled 1pt withcolor green ; + drawarrow r shifted cp withpen pencircle scaled 1pt withcolor blue ; + fi ; + + vardef found_point (expr lin, pat, sig) = + pair a, b ; + a := pat intersection_point (lin shifted (0,strutheight)) ; + if intersection_found : + a := a shifted (0,-strutheight) ; + else : + a := pat intersection_point lin ; + fi ; + b := pat intersection_point (lin shifted (0,-strutdepth)) ; + if intersection_found : + if sig : + if xpart b > xpart a : a := b shifted (0,strutdepth) fi ; + else : + if xpart b < xpart a : a := b shifted (0,strutdepth) fi ; + fi ; + fi ; + a + enddef ; + + if (strutheight+strutdepth<baselineskip) : + vvsize := vsize ; + else : + vvsize := (vsize div baselineskip) * baselineskip ; + fi ; + + for i=topskip step baselineskip until vvsize : + + line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ; + + ll := found_point(line,l,true ) ; + rr := found_point(line,r,false) ; + + if trace_parshape : + fill (ll--rr--rr shifted (0,strutheight)--ll + shifted (0,strutheight)--cycle) shifted cp withcolor .5white ; + fill (ll--rr--rr shifted (0,-strutdepth)--ll + shifted (0,-strutdepth)--cycle) shifted cp withcolor .7white ; + draw ll shifted cp withpen pencircle scaled 2pt ; + draw rr shifted cp withpen pencircle scaled 2pt ; + draw (ll--rr) shifted cp withpen pencircle scaled .5pt ; + fi ; + + n := n + 1 ; + indent[n] := abs(xpart ll - xpart llcorner q) ; + width[n] := abs(xpart rr - xpart ll) ; + + if (i=strutheight) and (width[n]<baselineskip) : + n := n - 1 ; + savedata "\global\chardef\parfirst=1 " ; + fi ; + + endfor ; + + savedata "\global\parlines " & decimal n ; + savedata "\global\partoks{ " ; + for i=1 upto n: + savedata decimal indent[i]&"bp " & decimal width[i]&"bp " ; + endfor ; + savedata "}" ; + + stopsavingdata ; + + endgroup ; + +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mp-tool.mp b/Master/texmf-dist/metapost/context/base/mp-tool.mp new file mode 100644 index 00000000000..925b9ca4449 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-tool.mp @@ -0,0 +1,2366 @@ +%D \module +%D [ file=mp-tool.mp, +%D version=1998.02.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=auxiliary macros, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. + +% 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. + +if known context_tool : endinput ; fi ; + +boolean context_tool ; context_tool := true ; + +%D New, version number testing: +%D +%D \starttyping +%D fill fullcircle scaled 2cm withcolor if mpversiongt("0.6") : red else : green fi ; +%D fill fullcircle scaled 1cm withcolor if mpversionlt(0.6) : blue else : white fi ; +%D \stoptyping + +if not known mpversion : string mpversion ; mpversion := "0.641" ; fi ; + +% vardef mpversiongt(expr s) = +% scantokens (mpversion & " > " & if numeric s : decimal s else : s fi) +% enddef ; +% vardef mpversionlt(expr s) = +% scantokens (mpversion & " < " & if numeric s : decimal s else : s fi) +% enddef ; +% vardef mpversioneq(expr s) = +% scantokens (mpversion & " = " & if numeric s : decimal s else : s fi) +% enddef ; + +%D More interesting: +%D +%D \starttyping +%D fill fullcircle scaled 4cm withcolor if mpversiongt("0.6") : red else : green fi ; +%D fill fullcircle scaled 2cm withcolor if mpversionlt(0.6) : blue else : white fi ; +%D fill fullcircle scaled 1cm withcolor if mpversioncmp(0.6,">=") : yellow else : black fi ; +%D \stoptyping + +vardef mpversioncmp(expr s, c) = + scantokens (mpversion & c & if numeric s : decimal s else : s fi) +enddef ; + +vardef mpversionlt (expr s) = mpversioncmp(s, "<") enddef ; +vardef mpversioneq (expr s) = mpversioncmp(s, "=") enddef ; +vardef mpversiongt (expr s) = mpversioncmp(s, ">") enddef ; + +%D We always want \EPS\ conforming output, so we say: + +prologues := 2 ; % 1 = troff, 2 = tex +warningcheck := 0 ; + +%D Namespace handling: + +% let exclamationmark = ! ; +% let questionmark = ? ; +% +% def unprotect = +% let ! = relax ; +% let ? = relax ; +% enddef ; +% +% def protect = +% let ! = exclamationmark ; +% let ? = questionmark ; +% enddef ; +% +% unprotect ; +% +% mp!some!module = 10 ; show mp!some!module ; show somemodule ; +% +% protect ; + +%D A semicolor to be used in specials: ? ? ? + +string semicolor ; semicolor := char 59 ; + +%D By including this module, \METAPOST\ automatically writes a +%D high resolution boundingbox to the \POSTSCRIPT\ file. This +%D hack is due to John Hobby himself. + +% 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 + +string space ; space = char 32 ; + +vardef ddecimal primary p = + decimal xpart p & " " & decimal ypart p +enddef ; + +extra_endfig := extra_endfig + & "special " + & "(" + & ditto + & "%%HiResBoundingBox: " + & ditto + & "&ddecimal llcorner currentpicture" + & "&space" + & "&ddecimal urcorner currentpicture" + & ");"; + +%D Also handy (when we flush colors): + +vardef dddecimal primary c = + decimal redpart c & " " & decimal greenpart c & " " & decimal bluepart c +enddef ; + +%D We have standardized data file names: + +if not known _data_prefix_ : + + string _data_prefix_ ; _data_prefix_ = "mpd-" ; + string _data_suffix_ ; _data_suffix_ = ".tmp" ; + +fi ; + +def data_file = + _data_prefix_ & decimal charcode & _data_suffix_ +enddef ; + +%D Because \METAPOST\ has a hard coded limit of 4~datafiles, +%D we need some trickery when we have multiple files. + +if unknown collapse_data : + boolean collapse_data ; collapse_data := false ; +fi ; + +boolean savingdata ; savingdata := false ; + +def savedata expr txt = + if collapse_data : + write if savingdata : txt else : + "\MPdata{" & decimal charcode & "}{" & txt & "}" + fi + & "%" to jobname & _data_suffix_ ; + else : + write txt to data_file ; + fi ; +enddef ; + +def startsavingdata = + savingdata := true ; + if collapse_data : + write + "\MPdata{" & decimal charcode & "}{%" + to + jobname & _data_suffix_ ; + fi ; +enddef ; + +def stopsavingdata = + savingdata := false ; + if collapse_data : + write "}%" to jobname & _data_suffix_ ; + fi ; +enddef ; + +%D Instead of a keystroke eating save and allocation +%D sequence, you can use the \citeer {new} alternatives to +%D save and allocate in one command. + +def newcolor text v = forsuffixes i=v : save i ; color i ; endfor ; enddef ; +def newnumeric text v = forsuffixes i=v : save i ; numeric i ; endfor ; enddef ; +def newboolean text v = forsuffixes i=v : save i ; boolean i ; endfor ; enddef ; +def newtransform text v = forsuffixes i=v : save i ; transform i ; endfor ; enddef ; +def newpath text v = forsuffixes i=v : save i ; path i ; endfor ; enddef ; +def newpicture text v = forsuffixes i=v : save i ; picture i ; endfor ; enddef ; +def newstring text v = forsuffixes i=v : save i ; string i ; endfor ; enddef ; + +%D Sometimes we don't want parts of the graphics add to the +%D bounding box. One way of doing this is to save the bounding +%D box, draw the graphics that may not count, and restore the +%D bounding box. +%D +%D \starttypen +%D push_boundingbox currentpicture; +%D pop_boundingbox currentpicture; +%D \stoptypen +%D +%D The bounding box can be called with: +%D +%D \starttypen +%D boundingbox currentpicture +%D inner_boundingbox currentpicture +%D outer_boundingbox currentpicture +%D \stoptypen +%D +%D Especially the latter one can be of use when we include +%D the graphic in a document that is clipped to the bounding +%D box. In such occasions one can use: +%D +%D \starttypen +%D set_outer_boundingbox currentpicture; +%D \stoptypen +%D +%D Its counterpart is: +%D +%D \starttypen +%D set_inner_boundingbox p +%D \stoptypen + +path pushed_boundingbox; + +def push_boundingbox text p = + pushed_boundingbox := boundingbox p; +enddef; + +def pop_boundingbox text p = + setbounds p to pushed_boundingbox; +enddef; + +vardef boundingbox primary p = + if (path p) or (picture p) : + llcorner p -- lrcorner p -- urcorner p -- ulcorner p + else : + origin + fi -- cycle +enddef; + +vardef inner_boundingbox primary p = + top rt llcorner p -- + top lft lrcorner p -- + bot lft urcorner p -- + bot rt ulcorner p -- cycle +enddef; + +vardef outer_boundingbox primary p = + bot lft llcorner p -- + bot rt lrcorner p -- + top rt urcorner p -- + top lft ulcorner p -- cycle +enddef; + +def innerboundingbox = inner_boundingbox enddef ; +def outerboundingbox = outer_boundingbox enddef ; + +vardef set_inner_boundingbox text q = + setbounds q to inner_boundingbox q; +enddef; + +vardef set_outer_boundingbox text q = + setbounds q to outer_boundingbox q; +enddef; + +%D Some missing functions can be implemented rather +%D straightforward: + +numeric Pi ; Pi := 3.1415926 ; + +vardef sqr primary x = (x*x) enddef ; +vardef log primary x = (if x=0: 0 else: mlog(x)/mlog(10) fi) enddef ; +vardef ln primary x = (if x=0: 0 else: mlog(x)/256 fi) enddef ; +vardef exp primary x = ((mexp 256)**x) enddef ; +vardef inv primary x = (if x=0: 0 else: x**-1 fi) enddef ; + +vardef pow (expr x,p) = (x**p) enddef ; + +vardef asin primary x = (x+(x**3)/6+3(x**5)/40) enddef ; +vardef acos primary x = (asin(-x)) enddef ; +vardef atan primary x = (x-(x**3)/3+(x**5)/5-(x**7)/7) enddef ; +vardef tand primary x = (sind(x)/cosd(x)) enddef ; + +%D Here are Taco Hoekwater's alternatives (but +%D vardef'd and primaried). + +pi := 3.1415926 ; radian := 180/pi ; % 2pi*radian = 360 ; + +vardef tand primary x = (sind(x)/cosd(x)) enddef ; +vardef cotd primary x = (cosd(x)/sind(x)) enddef ; + +vardef sin primary x = (sind(x*radian)) enddef ; +vardef cos primary x = (cosd(x*radian)) enddef ; +vardef tan primary x = (sin(x)/cos(x)) enddef ; +vardef cot primary x = (cos(x)/sin(x)) enddef ; + +vardef asin primary x = angle((1+-+x,x)) enddef ; +vardef acos primary x = angle((x,1+-+x)) enddef ; + +vardef invsin primary x = ((asin(x))/radian) enddef ; +vardef invcos primary x = ((acos(x))/radian) enddef ; + +vardef acosh primary x = ln(x+(x+-+1)) enddef ; +vardef asinh primary x = ln(x+(x++1)) enddef ; + +vardef sinh primary x = save xx ; xx = exp x ; (xx-1/xx)/2 enddef ; +vardef cosh primary x = save xx ; xx = exp x ; (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, +%D slower in calculation, but more efficient when drawn. The +%D first macro divides the sides into n equal parts. The +%D first argument specifies the way the lines are drawn, while +%D the second argument identifier the way the shape is to be +%D drawn. +%D +%D \starttypen +%D stripe_path_n +%D (dashed evenly withcolor blue) +%D (filldraw) +%D fullcircle xscaled 100 yscaled 40 shifted (50,50) withpen pencircle scaled 4; +%D \stoptypen +%D +%D The a (or angle) alternative supports arbitrary angles and +%D is therefore more versatile. +%D +%D \starttypen +%D stripe_path_a +%D (withpen pencircle scaled 2 withcolor red) +%D (draw) +%D fullcircle xscaled 100 yscaled 40 withcolor blue; +%D \stoptypen +%D +%D The first alternative obeys: + +stripe_n := 10; +stripe_slot := 3; + +%D When no pen dimensions are passed, the slot determines +%D the spacing. +%D +%D The angle alternative is influenced by: + +stripe_gap := 5; +stripe_angle := 45; + +def stripe_path_n (text s_spec) (text s_draw) expr s_path = + do_stripe_path_n (s_spec) (s_draw) (s_path) +enddef; + +def do_stripe_path_n (text s_spec) (text s_draw) (expr s_path) text s_text = + begingroup + save curpic, newpic, bb, pp, ww; + picture curpic, newpic; + path bb, pp; + pp := s_path; + curpic := currentpicture; + currentpicture := nullpicture; + s_draw pp s_text; + bb := boundingbox currentpicture; + newpic := currentpicture; + currentpicture := nullpicture; + ww := min(ypart urcorner newpic - ypart llcorner newpic, + xpart urcorner newpic - xpart llcorner newpic); + ww := ww/(stripe_slot*stripe_n); + for i=1/stripe_n step 1/stripe_n until 1: + draw point (1+i) of bb -- point (3-i) of bb + withpen pencircle scaled ww s_spec ; + endfor; + for i=0 step 1/stripe_n until 1: + draw point (3+i) of bb -- point (1-i) of bb + withpen pencircle scaled ww s_spec; + endfor; + clip currentpicture to pp; + addto newpic also currentpicture; + currentpicture := curpic; + addto currentpicture also newpic; + endgroup +enddef; + +def stripe_path_a (text s_spec) (text s_draw) expr s_path = + do_stripe_path_a (s_spec) (s_draw) (s_path) +enddef; + +def do_stripe_path_a (text s_spec) (text s_draw) (expr s_path) text s_text = + begingroup + save curpic, newpic, pp; picture curpic, newpic; path pp ; + pp := s_path ; + curpic := currentpicture; + currentpicture := nullpicture; + s_draw pp s_text ; + def do_stripe_rotation (expr p) = + (currentpicture rotatedaround(center p,stripe_angle)) + enddef ; + s_max := max + (xpart llcorner do_stripe_rotation(currentpicture), + xpart urcorner do_stripe_rotation(currentpicture), + ypart llcorner do_stripe_rotation(currentpicture), + ypart urcorner do_stripe_rotation(currentpicture)); + newpic := currentpicture; + currentpicture := nullpicture; + for i=-s_max-.5stripe_gap step stripe_gap until s_max: + draw (-s_max,i)--(s_max,i) s_spec; + endfor; + currentpicture := do_stripe_rotation(newpic); + clip currentpicture to pp ; + addto newpic also currentpicture; + currentpicture := curpic; + addto currentpicture also newpic; + endgroup +enddef; + +%D A few normalizing macros: +%D +%D \starttypen +%D xscale_currentpicture ( width ) +%D yscale_currentpicture ( height ) +%D xyscale_currentpicture ( width, height ) +%D scale_currentpicture ( width, height ) +%D \stoptypen + +% def xscale_currentpicture(expr the_width) = +% natural_width := xpart urcorner currentpicture - xpart llcorner currentpicture; +% currentpicture := currentpicture scaled (the_width/natural_width) ; +% enddef; +% +% def yscale_currentpicture(expr the_height ) = +% natural_height := ypart urcorner currentpicture - ypart llcorner currentpicture; +% currentpicture := currentpicture scaled (the_height/natural_height) ; +% enddef; +% +% def xyscale_currentpicture(expr the_width, the_height) = +% natural_width := xpart urcorner currentpicture - xpart llcorner currentpicture; +% natural_height := ypart urcorner currentpicture - ypart llcorner currentpicture; +% currentpicture := currentpicture +% xscaled (the_width/natural_width) +% yscaled (the_height/natural_height) ; +% enddef; +% +% def scale_currentpicture(expr the_width, the_height) = +% xscale_currentpicture(the_width) ; +% yscale_currentpicture(the_height) ; +% enddef; + +% nog eens uitbreiden zodat path en pic worden afgehandeld. + +% natural_width := xpart urcorner currentpicture - xpart llcorner currentpicture; +% currentpicture := currentpicture scaled (the_width/natural_width) ; + +% TODO TODO TODO TODO, not yet ok + +primarydef p xsized w = + (p if (bbwidth (p)>0) and (w>0) : scaled (w/bbwidth (p)) fi) +enddef ; + +primarydef p ysized h = + (p if (bbheight(p)>0) and (h>0) : scaled (h/bbheight(p)) fi) +enddef ; + +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 = + (p xysized wh) +enddef ; + +def xscale_currentpicture(expr w) = + currentpicture := currentpicture xsized w ; +enddef; + +def yscale_currentpicture(expr h) = + currentpicture := currentpicture ysized h ; +enddef; + +def xyscale_currentpicture(expr w, h) = + currentpicture := currentpicture xysized (w,h) ; +enddef; + +def scale_currentpicture(expr w, h) = + currentpicture := currentpicture xsized w ; + currentpicture := currentpicture ysized h ; +enddef; + +%D A full circle is centered at the origin, while a unitsquare +%D is located in the first quadrant. Now guess what kind of +%D path fullsquare and unitcircle do return. + +path fullsquare, unitcircle ; + +fullsquare := unitsquare shifted - center unitsquare ; +unitcircle := fullcircle shifted urcorner fullcircle ; + +%D Some more paths: + +path urcircle, ulcircle, llcircle, lrcircle ; + +urcircle := origin--(+.5,0)&(+.5,0){up} ..(0,+.5)&(0,+.5)--cycle ; +ulcircle := origin--(0,+.5)&(0,+.5){left} ..(-.5,0)&(-.5,0)--cycle ; +llcircle := origin--(-.5,0)&(-.5,0){down} ..(0,-.5)&(0,-.5)--cycle ; +lrcircle := origin--(0,-.5)&(0,-.5){right}..(+.5,0)&(+.5,0)--cycle ; + +path tcircle, bcircle, lcircle, rcircle ; + +tcircle = origin--(+.5,0)&(+.5,0){up} ..(0,+.5)..{down} (-.5,0)--cycle ; +bcircle = origin--(-.5,0)&(-.5,0){down} ..(0,-.5)..{up} (+.5,0)--cycle ; +lcircle = origin--(0,+.5)&(0,+.5){left} ..(-.5,0)..{right}(0,-.5)--cycle ; +rcircle = origin--(0,-.5)&(0,-.5){right}..(+.5,0)..{left} (0,+.5)--cycle ; + +path urtriangle, ultriangle, lltriangle, lrtriangle ; + +urtriangle := origin--(+.5,0)--(0,+.5)--cycle ; +ultriangle := origin--(0,+.5)--(-.5,0)--cycle ; +lltriangle := origin--(-.5,0)--(0,-.5)--cycle ; +lrtriangle := origin--(0,-.5)--(+.5,0)--cycle ; + +path unitdiamond, fulldiamond ; + +unitdiamond := (.5,0)--(1,.5)--(.5,1)--(0,.5)--cycle ; +fulldiamond := unitdiamond shifted - center unitdiamond ; + +%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 = + 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. + +def set_grid(expr w, h, nx, ny) = + boolean grid[][] ; boolean grid_full ; + grid_w := w ; + grid_h := h ; + grid_nx := nx ; + grid_ny := ny ; + grid_x := round(w/grid_nx) ; % +.5) ; + grid_y := round(h/grid_ny) ; % +.5) ; + grid_left := (1+grid_x)*(1+grid_y) ; + grid_full := false ; + for i=0 upto grid_x: + for j=0 upto grid_y: + grid[i][j] := false ; + endfor ; + endfor ; +enddef ; + +vardef new_on_grid(expr _dx_, _dy_) = + dx := _dx_ ; + dy := _dy_ ; + ddx := min(round(dx/grid_nx),grid_x) ; % +.5),grid_x) ; + ddy := min(round(dy/grid_ny),grid_y) ; % +.5),grid_y) ; + if not grid_full and not grid[ddx][ddy]: + grid[ddx][ddy] := true ; + grid_left := grid_left-1 ; + grid_full := (grid_left=0) ; + true + else: + false + fi +enddef ; + +%D usage: \type{innerpath peepholed outerpath}. +%D +%D beginfig(1); +%D def fullsquare = (unitsquare shifted -center unitsquare) enddef ; +%D fill (fullsquare scaled 200) withcolor red ; +%D path p ; p := (fullcircle scaled 100) ; bboxmargin := 0 ; +%D fill p peepholed bbox p ; +%D endfig; + +secondarydef p peepholed q = + begingroup ; + save start ; pair start ; start := point 0 of p ; + if xpart start >= xpart center p : + if ypart start >= ypart center p : + urcorner q -- ulcorner q -- llcorner q -- lrcorner q -- + reverse p -- lrcorner q -- cycle + else : + lrcorner q -- urcorner q -- ulcorner q -- llcorner q -- + reverse p -- llcorner q -- cycle + fi + else : + if ypart start > ypart center p : + ulcorner q -- llcorner q -- lrcorner q -- urcorner q -- + reverse p -- urcorner q -- cycle + else : + llcorner q -- lrcorner q -- urcorner q -- ulcorner q -- + reverse p -- ulcorner q -- cycle + fi + fi + endgroup +enddef ; + +boolean intersection_found ; + +secondarydef p intersection_point q = + begingroup + save x_, y_ ; + (x_,y_) = p intersectiontimes q ; + if x_<0 : + intersection_found := false ; + center p % origin + else : + intersection_found := true ; + .5[point x_ of p, point y_ of q] + fi + endgroup +enddef ; + +%D New, undocumented, experimental: + +vardef tensecircle (expr width, height, offset) = + ((-width/2,-height/2) ... (0,-height/2-offset) ... + (+width/2,-height/2) ... (+width/2+offset,0) ... + (+width/2,+height/2) ... (0,+height/2+offset) ... + (-width/2,+height/2) ... (-width/2-offset,0) ... cycle) +enddef ; + +%vardef tensecircle (expr width, height, offset) = +% ((-width/2,-height/2)..(0,-height/2-offset)..(+width/2,-height/2) & +% (+width/2,-height/2)..(+width/2+offset,0)..(+width/2,+height/2) & +% (+width/2,+height/2)..(0,+height/2+offset)..(-width/2,+height/2) & +% (-width/2,+height/2)..(-width/2-offset,0)..(-width/2,-height/2)..cycle) +%enddef ; + +vardef roundedsquare (expr width, height, offset) = + ((offset,0)--(width-offset,0){right} .. + (width,offset)--(width,height-offset){up} .. + (width-offset,height)--(offset,height){left} .. + (0,height-offset)--(0,offset){down} .. cycle) +enddef ; + +%D Some colors. + +color cyan ; cyan = (0,1,1) ; +color magenta ; magenta = (1,0,1) ; +color yellow ; yellow = (1,1,0) ; + +%D Well, this is the dangerous and naive version: + +def drawfill text t = + fill t ; + draw t ; +enddef; + +%D This two step approach saves the path first, since it can +%D be a function. Attributes must not be randomized. + +def drawfill expr c = + path _c_ ; _c_ := c ; + do_drawfill +enddef ; + +def do_drawfill text t = + draw _c_ t ; + fill _c_ t ; +enddef; + +def undrawfill expr c = + drawfill c withcolor background +enddef ; + +%D Moved from mp-char.mp + +vardef paired (expr d) = + if pair d : d else : (d,d) fi +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) +enddef; + +primarydef p llenlarged d = + (p llmoved d -- lrcorner p -- urcorner p -- ulcorner p -- cycle) +enddef ; + +primarydef p lrenlarged d = + (llcorner p -- p lrmoved d -- urcorner p -- ulcorner p -- cycle) +enddef ; + +primarydef p urenlarged d = + (llcorner p -- lrcorner p -- p urmoved d -- ulcorner p -- cycle) +enddef ; + +primarydef p ulenlarged d = + (llcorner p -- lrcorner p -- urcorner p -- p ulmoved d -- cycle) +enddef ; + +primarydef p llmoved d = + ((llcorner p) shifted (-xpart paired(d),-ypart paired(d))) +enddef ; + +primarydef p lrmoved d = + ((lrcorner p) shifted (+xpart paired(d),-ypart paired(d))) +enddef ; + +primarydef p urmoved d = + ((urcorner p) shifted (+xpart paired(d),+ypart paired(d))) +enddef ; + +primarydef p ulmoved d = + ((ulcorner p) shifted (-xpart paired(d),+ypart paired(d))) +enddef ; + +primarydef p leftenlarged d = + ((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) +enddef ; + +primarydef p topenlarged d = + (llcorner p -- lrcorner p -- + (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) -- + urcorner p -- ulcorner p -- cycle) +enddef ; + +%D Handy for testing/debugging: + +primarydef p crossed d = + (center p shifted (-d, 0) -- llcorner p -- + center p shifted ( 0,-d) -- lrcorner p -- + center p shifted (+d, 0) -- urcorner p -- + center p shifted ( 0,+d) -- 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 ; + +vardef bottomboundary primary p = + if pair p : p else : (llcorner p -- lrcorner p) fi +enddef ; + +vardef rightboundary primary p = + if pair p : p else : (lrcorner p -- urcorner p) fi +enddef ; + +vardef topboundary primary p = + if pair p : p else : (urcorner p -- ulcorner p) fi +enddef ; + +vardef leftboundary primary p = + if pair p : p else : (ulcorner p -- llcorner p) fi +enddef ; + +%D Nice too: + +primarydef p superellipsed s = + superellipse + (.5[lrcorner p,urcorner p], + .5[urcorner p,ulcorner p], + .5[ulcorner p,llcorner p], + .5[llcorner p,lrcorner p], + s) +enddef ; + +primarydef p squeezed s = + ((llcorner p .. .5[llcorner p,lrcorner p] shifted ( 0, ypart paired(s)) .. lrcorner p) & + (lrcorner p .. .5[lrcorner p,urcorner p] shifted (-xpart paired(s), 0) .. urcorner p) & + (urcorner p .. .5[urcorner p,ulcorner p] shifted ( 0,-ypart paired(s)) .. ulcorner p) & + (ulcorner p .. .5[ulcorner p,llcorner p] shifted ( xpart paired(s), 0) .. llcorner p) & cycle) +enddef ; + +primarydef p randomshifted s = + begingroup ; save ss ; pair ss ; ss := paired(s) ; + p shifted (-.5xpart ss + uniformdeviate xpart ss, + -.5ypart ss + uniformdeviate ypart ss) + endgroup +enddef ; + +%primarydef p randomized s = +% for i=0 upto length(p)-1 : +% ((point i of p) randomshifted s) .. controls +% ((postcontrol i of p) randomshifted s) and +% ((precontrol (i+1) of p) randomshifted s) .. +% endfor cycle +%enddef ; + +primarydef p randomized s = + (if path p : + for i=0 upto length(p)-1 : + ((point i of p) randomshifted s) .. controls + ((postcontrol i of p) randomshifted s) and + ((precontrol (i+1) of p) randomshifted s) .. + endfor + if cycle p : + cycle + else : + ((point length(p) of p) randomshifted s) + fi + elseif pair p : + p randomshifted s + elseif color p : + 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) + fi + else : + p + uniformdeviate 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 = +% save q, t, b ; path q ; pair t, b ; +% t := (ulcorner p -- urcorner p) intersection_point p ; +% b := (llcorner p -- lrcorner p) intersection_point p ; +% if xpart directionpoint t of p < 0 : p := reverse p ; fi ; +% q := p cutbefore b ; +% q := q if xpart point 0 of p > 0 : & p fi cutafter t ; +% q +% enddef ; +% +% vardef leftpath expr p = +% save q, t, b ; path q ; pair t, b ; +% t := (ulcorner p -- urcorner p) intersection_point p ; +% b := (llcorner p -- lrcorner p) intersection_point p ; +% if xpart directionpoint t of p < 0 : p := reverse p ; fi ; +% q := p cutbefore t ; +% q := q if xpart point 0 of p > 0 : & p fi cutafter b ; +% q +% enddef ; + +def leftrightpath(expr p, l) = + save q, t, b ; path q ; pair t, b ; + t := (ulcorner p -- urcorner p) intersection_point p ; + b := (llcorner p -- lrcorner p) intersection_point p ; + if xpart directionpoint t of p < 0 : p := reverse p ; fi ; + q := p cutbefore if l: t else: b fi ; + q := q if xpart point 0 of p > 0 : & + p fi cutafter if l: b else: t fi ; + q +enddef ; + +vardef leftpath expr p = leftrightpath(p,true ) enddef ; +vardef rightpath expr p = leftrightpath(p,false) enddef ; + +%D Drawoptions + +def saveoptions = + save _op_ ; def _op_ = enddef ; +enddef ; + +%D Tracing. + +let normaldraw = draw ; +let normalfill = fill ; + +def drawlineoptions (text t) = def _lin_opt_ = t enddef ; enddef ; +def drawpointoptions (text t) = def _pnt_opt_ = t enddef ; enddef ; +def drawcontroloptions(text t) = def _ctr_opt_ = t enddef ; enddef ; +def drawlabeloptions (text t) = def _lab_opt_ = t enddef ; enddef ; +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 ; + +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. + +def drawpath expr p = + normaldraw p _pth_opt_ +enddef ; + +%D Arrow. + +vardef drawarrowpath expr p = + save autoarrows ; boolean autoarrows ; autoarrows := true ; + drawarrow p _pth_opt_ +enddef ; + +%def drawarrowpath expr p = +% begingroup ; +% save autoarrows ; boolean autoarrows ; autoarrows := true ; +% save arrowpath ; path arrowpath ; arrowpath := p ; +% _drawarrowpath_ +%enddef ; +% +%def _drawarrowpath_ text t = +% drawarrow arrowpath _pth_opt_ t ; +% endgroup ; +%enddef ; + +def midarrowhead expr p = + arrowhead p cutafter + (point length(p cutafter point .5 along p)+ahlength on p) +enddef ; + +vardef arrowheadonpath (expr p, s) = + save autoarrows ; boolean autoarrows ; autoarrows := true ; + arrowhead p if s<1 : cutafter (point (s*arclength(p)+.5ahlength) on p) fi +enddef ; + +%D Points. + +def drawpoint expr c = + if string c : + string _c_ ; _c_ := "(" & c & ")" ; + dotlabel.urt(_c_, scantokens _c_) ; + drawdot scantokens _c_ + else : + dotlabel.urt("(" & decimal xpart c & "," & decimal ypart c & ")", c) ; + drawdot c + fi _pnt_opt_ +enddef ; + +%D PathPoints. + +def drawpoints expr c = path _c_ ; _c_ := c ; do_drawpoints enddef ; +def drawcontrolpoints expr c = path _c_ ; _c_ := c ; do_drawcontrolpoints enddef ; +def drawcontrollines expr c = path _c_ ; _c_ := c ; do_drawcontrollines enddef ; +def drawpointlabels expr c = path _c_ ; _c_ := c ; do_drawpointlabels enddef ; + +def do_drawpoints text t = + for _i_=0 upto length(_c_) : + normaldraw point _i_ of _c_ _pnt_opt_ t ; + endfor ; +enddef; + +def do_drawcontrolpoints text t = + for _i_=0 upto length(_c_) : + normaldraw precontrol _i_ of _c_ _ctr_opt_ t ; + normaldraw postcontrol _i_ of _c_ _ctr_opt_ t ; + endfor ; +enddef; + +def do_drawcontrollines text t = + for _i_=0 upto length(_c_) : + normaldraw point _i_ of _c_ -- precontrol _i_ of _c_ _lin_opt_ t ; + normaldraw point _i_ of _c_ -- postcontrol _i_ of _c_ _lin_opt_ t ; + endfor ; +enddef; + +boolean swappointlabels ; swappointlabels := false ; + +def do_drawpointlabels text t = + for _i_=0 upto length(_c_) : + pair _u_ ; _u_ := unitvector(direction _i_ of _c_) + rotated if swappointlabels : - fi 90 ; + pair _p_ ; _p_ := (point _i_ of _c_) ; + _u_ := 12 * defaultscale * _u_ ; + normaldraw thelabel ( decimal _i_, + _p_ shifted if cycle _c_ and (_i_=0) : - fi _u_ ) _lab_opt_ t ; + endfor ; +enddef; + +%D Bounding box. + +def drawboundingbox expr p = + normaldraw boundingbox p _bnd_opt_ +enddef ; + +%D Origin. + +numeric originlength ; originlength := .5cm ; + +def draworigin text t = + normaldraw (origin shifted (0, originlength) -- + origin shifted (0,-originlength)) _ori_opt_ t ; + normaldraw (origin shifted ( originlength,0) -- + origin shifted (-originlength,0)) _ori_opt_ t ; +enddef; + +%D Axis. + +numeric tickstep ; tickstep := 5mm ; +numeric ticklength ; ticklength := 2mm ; + +def drawxticks expr c = path _c_ ; _c_ := c ; do_drawxticks enddef ; +def drawyticks expr c = path _c_ ; _c_ := c ; do_drawyticks enddef ; +def drawticks expr c = path _c_ ; _c_ := c ; do_drawticks enddef ; + +% Adding eps prevents disappearance due to rounding errors. + +def do_drawxticks text t = + for i=0 step -tickstep until xpart llcorner _c_ - eps : + if (i<=xpart lrcorner _c_) : + normaldraw (i,-ticklength)--(i,ticklength) _ori_opt_ t ; + fi ; + endfor ; + for i=0 step tickstep until xpart lrcorner _c_ + eps : + if (i>=xpart llcorner _c_) : + normaldraw (i,-ticklength)--(i,ticklength) _ori_opt_ t ; + fi ; + endfor ; + normaldraw (llcorner _c_ -- ulcorner _c_) + shifted (-xpart llcorner _c_,0) _ori_opt_ t ; +enddef ; + +def do_drawyticks text t = + for i=0 step -tickstep until ypart llcorner _c_ - eps : + if (i<=ypart ulcorner _c_) : + normaldraw (-ticklength,i)--(ticklength,i) _ori_opt_ t ; + fi ; + endfor ; + for i=0 step tickstep until ypart ulcorner _c_ + eps : + if (i>=ypart llcorner _c_) : + normaldraw (-ticklength,i)--(ticklength,i) _ori_opt_ t ; + fi ; + endfor ; + normaldraw (llcorner _c_ -- lrcorner _c_) + shifted (0,-ypart llcorner _c_) _ori_opt_ t ; +enddef ; + +def do_drawticks text t = + drawxticks _c_ t ; + drawyticks _c_ t ; +enddef ; + +%D All of it except axis. + +def drawwholepath expr p = + draworigin ; + drawpath p ; + drawcontrollines p ; + drawcontrolpoints p ; + drawpoints p ; + drawboundingbox p ; + drawpointlabels p ; +enddef ; + +%D Tracing. + +def visualizeddraw expr c = + if picture c : normaldraw c else : path _c_ ; _c_ := c ; do_visualizeddraw fi +enddef ; + +def visualizedfill expr c = + if picture c : normalfill c else : path _c_ ; _c_ := c ; do_visualizedfill fi +enddef ; + +def do_visualizeddraw text t = + draworigin ; + drawpath _c_ t ; + drawcontrollines _c_ ; + drawcontrolpoints _c_ ; + drawpoints _c_ ; + drawboundingbox _c_ ; + drawpointlabels _c_ ; +enddef ; + +def do_visualizedfill text t = + if cycle _c_ : normalfill _c_ t fi ; + draworigin ; + drawcontrollines _c_ ; + drawcontrolpoints _c_ ; + drawpoints _c_ ; + drawboundingbox _c_ ; + drawpointlabels _c_ ; +enddef ; + +def visualizepaths = + let fill = visualizedfill ; + let draw = visualizeddraw ; +enddef ; + +def naturalizepaths = + let fill = normalfill ; + let draw = normaldraw ; +enddef ; + +extra_endfig := extra_endfig & " naturalizepaths ; " ; + +%D Normally, arrowheads don't scale well. So we provide a +%D hack. + +boolean autoarrows ; autoarrows := false ; +numeric ahfactor ; ahfactor := 2.5 ; + +def set_ahlength (text t) = + ahlength := (ahfactor*pen_size(_op_ t)) ; % _op_ added +enddef ; + +vardef pen_size (text t) = + save p ; picture p ; p := nullpicture ; + addto p doublepath (top origin -- bot origin) t ; + (ypart urcorner p - ypart lrcorner p) +enddef ; + +%D The next two macros are adapted versions of plain +%D \METAPOST\ definitions. + +def _finarr text t = + if autoarrows : set_ahlength (t) fi ; + draw _apth t ; + filldraw arrowhead _apth t ; +enddef; + +def _findarr text t = + if autoarrows : set_ahlength (t) fi ; + draw _apth t ; + fill arrowhead _apth withpen currentpen t ; + fill arrowhead reverse _apth withpen currentpen t ; +enddef ; + +%D Handy too ...... + +vardef pointarrow (expr pat, loc, len, off) = + save l, r, s, t ; path l, r ; numeric s ; pair t ; + t := if pair loc : loc else : point loc along pat fi ; +% draw t withpen pencircle scaled 10 withcolor .5white ; + s := len/2 - off ; if s<=0 : s := 0 elseif s>len : s := len fi ; + r := pat cutbefore t ; + r := (r cutafter point (arctime s of r) of r) ; + s := len/2 + off ; if s<=0 : s := 0 elseif s>len : s := len fi ; + l := reverse (pat cutafter t) ; + l := (reverse (l cutafter point (arctime s of l) of l)) ; + (l..r) +enddef ; + +def rightarrow (expr pat,tim,len) = pointarrow(pat,tim,len,-len) enddef ; +def leftarrow (expr pat,tim,len) = pointarrow(pat,tim,len,+len) enddef ; +def centerarrow (expr pat,tim,len) = pointarrow(pat,tim,len, 0) enddef ; + +%D The \type {along} and \type {on} operators can be used +%D as follows: +%D +%D \starttypen +%D drawdot point .5 along somepath ; +%D drawdot point 3cm on somepath ; +%D \stoptypen +%D +%D The number denotes a percentage (fraction). + +primarydef pct along pat = % also negative + (arctime (pct * (arclength pat)) of pat) of pat +enddef ; + +% primarydef len on pat = +% (arctime len of pat) of pat +% enddef ; + +primarydef len on pat = + (arctime if len>0 : len else : (arclength(pat)+len) fi of pat) of pat +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 (xpart paired(len)) on pat) ; + (tap cutafter (point -(ypart paired(len)) on tap)) + endgroup +enddef ; + +%D To be documented. + +path freesquare ; + +freesquare := ((-1,0)--(-1,-1)--(0,-1)--(+1,-1)-- + (+1,0)--(+1,+1)--(0,+1)--(-1,+1)--cycle) scaled .5 ; + +numeric freelabeloffset ; freelabeloffset := 3pt ; +numeric freedotlabelsize ; freedotlabelsize := 3pt ; + +vardef thefreelabel (expr str, loc, ori) = + save s, p, q, l ; picture s ; path p, q ; pair l ; + interim labeloffset := freelabeloffset ; + s := if string str : thelabel(str,loc) else : str shifted -center str shifted loc fi ; + setbounds s to boundingbox s enlarged freelabeloffset ; + p := fullcircle scaled (2*length(loc-ori)) shifted ori ; + q := freesquare xyscaled (urcorner s - llcorner s) ; +% l := point (xpart (p intersectiontimes (ori--loc))) of q ; + l := point xpart (p intersectiontimes + (ori--((1+eps)*arclength(ori--loc)*unitvector(loc-ori)))) of q ; + setbounds s to boundingbox s enlarged -freelabeloffset ; % new + %draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ; + (s shifted -l) +enddef ; + +% better? + +vardef thefreelabel (expr str, loc, ori) = + save s, p, q, l ; picture s ; path p, q ; pair l ; + interim labeloffset := freelabeloffset ; + s := if string str : thelabel(str,loc) else : str shifted -center str shifted loc fi ; + setbounds s to boundingbox s enlarged freelabeloffset ; + p := fullcircle scaled (2*length(loc-ori)) shifted 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 ; + (s shifted -l) +enddef ; + +vardef freelabel (expr str, loc, ori) = + draw thefreelabel(str,loc,ori) ; +enddef ; + +vardef freedotlabel (expr str, loc, ori) = + interim linecap:=rounded ; + draw loc withpen pencircle scaled freedotlabelsize ; + draw thefreelabel(str,loc,ori) ; +enddef ; + +%D \starttypen +%D drawarrow anglebetween(line_a,line_b,somelabel) ; +%D \stoptypen + +% angleoffset ; angleoffset := 0pt ; +numeric anglelength ; anglelength := 20pt ; +numeric anglemethod ; anglemethod := 1 ; + +% vardef anglebetween (expr a, b, str) = % path path string +% save pointa, pointb, common, middle, offset ; +% pair pointa, pointb, common, middle, offset ; +% save curve ; path curve ; +% save where ; numeric where ; +% if round point 0 of a = round point 0 of b : +% common := point 0 of a ; +% else : +% common := a intersectionpoint b ; +% fi ; +% pointa := point anglelength on a ; +% pointb := point anglelength on b ; +% where := turningnumber (common--pointa--pointb--cycle) ; +% middle := ((common--pointa) rotatedaround (pointa,-where*90)) +% intersectionpoint +% ((common--pointb) rotatedaround (pointb, where*90)) ; +% if anglemethod = 0 : +% curve := pointa{unitvector(middle-pointa)}.. pointb; +% middle := point .5 along curve ; +% curve := common ; +% elseif anglemethod = 1 : +% curve := pointa{unitvector(middle-pointa)}.. pointb; +% middle := point .5 along curve ; +% elseif anglemethod = 2 : +% middle := common rotatedaround(.5[pointa,pointb],180) ; +% curve := pointa--middle--pointb ; +% elseif anglemethod = 3 : +% curve := pointa--middle--pointb ; +% elseif anglemethod = 4 : +% curve := pointa..controls middle..pointb ; +% middle := point .5 along curve ; +% fi ; +% draw thefreelabel(str, middle, common) withcolor black ; +% curve +% enddef ; + +vardef anglebetween (expr a, b, str) = % path path string + save pointa, pointb, common, middle, offset ; + pair pointa, pointb, common, middle, offset ; + save curve ; path curve ; + save where ; numeric where ; + if round point 0 of a = round point 0 of b : + common := point 0 of a ; + else : + common := a intersectionpoint b ; + fi ; + pointa := point anglelength on a ; + pointb := point anglelength on b ; + where := turningnumber (common--pointa--pointb--cycle) ; + middle := (reverse(common--pointa) rotatedaround (pointa,-where*90)) + intersection_point + (reverse(common--pointb) rotatedaround (pointb, where*90)) ; + if not intersection_found : + middle := point .5 along + ((reverse(common--pointa) rotatedaround (pointa,-where*90)) -- + ( (common--pointb) rotatedaround (pointb, where*90))) ; + fi ; + if anglemethod = 0 : + curve := pointa{unitvector(middle-pointa)}.. pointb; + middle := point .5 along curve ; + curve := common ; + elseif anglemethod = 1 : + curve := pointa{unitvector(middle-pointa)}.. pointb; + middle := point .5 along curve ; + elseif anglemethod = 2 : + middle := common rotatedaround(.5[pointa,pointb],180) ; + curve := pointa--middle--pointb ; + elseif anglemethod = 3 : + curve := pointa--middle--pointb ; + elseif anglemethod = 4 : + curve := pointa..controls middle..pointb ; + middle := point .5 along curve ; + fi ; + draw thefreelabel(str, middle, common) ; % withcolor black ; + curve +enddef ; + +% Stack + +picture currentpicturestack[] ; +numeric currentpicturedepth ; currentpicturedepth := 0 ; + +def pushcurrentpicture = + currentpicturedepth := currentpicturedepth + 1 ; + currentpicturestack[currentpicturedepth] := currentpicture ; + currentpicture := nullpicture ; +enddef ; + +def popcurrentpicture text t = % optional text + if currentpicturedepth > 0 : + addto currentpicturestack[currentpicturedepth] also currentpicture t ; + currentpicture := currentpicturestack[currentpicturedepth] ; + currentpicturedepth := currentpicturedepth - 1 ; + fi ; +enddef ; + +%D colorcircle(size, red, green, blue) ; + +% vardef colorcircle (expr size, red, green, blue) = +% save r, g, b, rr, gg, bb, cc, mm, yy ; save radius ; +% path r, g, b, rr, bb, gg, cc, mm, yy ; numeric radius ; +% +% radius := 5cm ; pickup pencircle scaled (radius/25) ; +% +% r := g := b := fullcircle scaled radius shifted (0,radius/4) ; +% +% r := r rotatedaround (origin, 15) ; +% g := g rotatedaround (origin,135) ; +% b := b rotatedaround (origin,255) ; +% +% r := r rotatedaround(center r,-90) ; +% g := g rotatedaround(center g, 90) ; +% +% gg := buildcycle(buildcycle(reverse r,b),g) ; +% cc := buildcycle(buildcycle(b,reverse g),r) ; +% +% rr := gg rotatedaround(origin,120) ; +% bb := gg rotatedaround(origin,240) ; +% +% yy := cc rotatedaround(origin,120) ; +% mm := cc rotatedaround(origin,240) ; +% +% pushcurrentpicture ; +% +% fill fullcircle scaled radius withcolor white ; +% +% fill rr withcolor red ; fill cc withcolor white-red ; +% fill gg withcolor green ; fill mm withcolor white-green ; +% fill bb withcolor blue ; fill yy withcolor white-blue ; +% +% for i = rr,gg,bb,cc,mm,yy : draw i withcolor .5white ; endfor ; +% +% currentpicture := currentpicture xsized size ; +% +% popcurrentpicture ; +% enddef ; + +% vardef colorcircle (expr size, red, green, blue) = +% save r, g, b, rr, gg, bb, cc, mm, yy ; save radius ; +% path r, g, b, rr, bb, gg, cc, mm, yy ; numeric radius ; +% +% radius := 5cm ; pickup pencircle scaled (radius/25) ; +% +% transform t ; t := identity rotatedaround(origin,120) ; +% +% r := fullcircle scaled radius +% shifted (0,radius/4) rotatedaround(origin,15) ; +% +% g := r transformed t ; b := g transformed t ; +% +% r := r rotatedaround(center r,-90) ; +% g := g rotatedaround(center g, 90) ; +% +% gg := buildcycle(buildcycle(reverse r,b),g) ; +% cc := buildcycle(buildcycle(b,reverse g),r) ; +% +% rr := gg transformed t ; bb := rr transformed t ; +% yy := cc transformed t ; mm := yy transformed t ; +% +% pushcurrentpicture ; +% +% fill fullcircle scaled radius withcolor white ; +% +% fill rr withcolor red ; fill cc withcolor white-red ; +% fill gg withcolor green ; fill mm withcolor white-green ; +% fill bb withcolor blue ; fill yy withcolor white-blue ; +% +% for i = rr,gg,bb,cc,mm,yy : draw i withcolor .5white ; endfor ; +% +% currentpicture := currentpicture xsized size ; +% +% popcurrentpicture ; +% enddef ; + +vardef colorcircle (expr size, red, green, blue) = + save r, g, b, c, m, y, w ; save radius ; + path r, g, b, c, m, y, w ; numeric radius ; + + radius := 5cm ; pickup pencircle scaled (radius/25) ; + + transform t ; t := identity rotatedaround(origin,120) ; + + r := fullcircle rotated 90 scaled radius + shifted (0,radius/4) rotatedaround(origin,135) ; + + b := r transformed t ; g := b transformed t ; + + c := buildcycle(subpath(1,7) of g,subpath(1,7) of b) ; + y := c transformed t ; m := y transformed t ; + + w := buildcycle(subpath(3,5) of r, subpath(3,5) of g,subpath(3,5) of b) ; + + pushcurrentpicture ; + + 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 ; + + for i = r,g,b,c,m,y : draw i withcolor .5white ; endfor ; + + currentpicture := currentpicture xsized size ; + + popcurrentpicture ; +enddef ; + +% penpoint (i,2) of somepath -> inner / outer point + +vardef penpoint expr pnt of p = + save n, d ; numeric n, d ; + (n,d) = if pair pnt : pnt else : (pnt,1) fi ; + (point n of p shifted ((penoffset direction n of p of currentpen) scaled d)) +enddef ; + +% nice: currentpicture := inverted currentpicture ; + +primarydef p uncolored c = + if color p : + c - p + else : + image + (for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : contour else : doublepath fi pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor c-(redpart i, greenpart i, bluepart i) ; + endfor ; ) + fi +enddef ; + +vardef inverted primary p = + (p uncolored white) +enddef ; + +% primarydef p softened c = +% if color p : +% tripled(c) * p +% else : +% image +% (save cc ; color cc ; cc := tripled(c) ; +% for i within p : +% addto currentpicture +% if stroked i or filled i : +% if filled i : contour else : doublepath fi pathpart i +% dashed dashpart i withpen penpart i +% else : +% also i +% fi +% withcolor (redpart cc * redpart i, +% greenpart cc * greenpart i, +% bluepart cc * bluepart i) ; +% endfor ;) +% fi +% enddef ; + +primarydef p softened c = + begingroup + save cc ; color cc ; cc := tripled(c) ; + if color p : + (redpart cc * redpart p, + greenpart cc * greenpart p, + bluepart cc * bluepart p) + else : + image + (for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : contour else : doublepath fi pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor (redpart cc * redpart i, + greenpart cc * greenpart i, + bluepart cc * bluepart i) ; + endfor ;) + fi + endgroup +enddef ; + +vardef grayed primary p = + if color p : + tripled(.30redpart p+.59greenpart p+.11bluepart p) + else : + image + (for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : contour else : doublepath fi pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor tripled(.30redpart i+.59greenpart i+.11bluepart i) ; + endfor ; ) + fi +enddef ; + +% yes or no: "text" infont "cmr12" at 24pt ; + +% let normalinfont = infont ; +% +% numeric lastfontsize ; lastfontsize = fontsize defaultfont ; +% +% def infont primary name = % no vardef, no expr +% hide(lastfontsize := fontsize name) % no ; +% normalinfont name +% enddef ; +% +% def scaledat expr size = +% scaled (size/lastfontsize) +% enddef ; +% +% let at = scaledat ; + +% like decimal + +def condition primary b = if b : "true" else : "false" fi enddef ; + +% undocumented + +primarydef p stretched s = + begingroup +% 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 ; + +% yes or no, untested -) + +def xshifted expr dx = shifted(dx,0) enddef ; +def yshifted expr dy = shifted(0,dy) enddef ; + +% also handy + +% 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 & ";") ; +% elseif (readfrom (name) <> EOF) : +% scantokens("input " & name & ";") ; +% fi ; +% closefrom (name) ; +% enddef ; +% +% this sometimes fails on the elseif, so : +% + +def readfile (expr name) = + begingroup ; save ok ; boolean ok ; + if (readfrom (name) <> EOF) : + ok := false ; + elseif (readfrom (name) <> EOF) : + ok := false ; + else : + ok := true ; + fi ; + if not ok : + scantokens("input " & name & " ") ; + fi ; + closefrom (name) ; + endgroup ; +enddef ; + +% permits redefinition of end in macro + +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 ; +% +% 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 ; +def b_color primary c = bluepart c enddef ; + +def remapcolor(expr old, new) = + color_map[r_color old][g_color old][b_color old] := new ; +enddef ; + +def remappedcolor(expr c) = + if known color_map[r_color c][g_color c][b_color c] : + color_map[r_color c][g_color c][b_color c] + else : + c + fi +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 ; +% +% 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_, _cc_, _f_, _b_ ; picture _c_, _cc_ ; color _f_ ; path _b_ ; +% _c_ := c ; _b_ := boundingbox c ; c := nullpicture ; +% for i within _c_ : +% _f_ := (redpart i, greenpart i, bluepart i) ; +% if bounded i : +% setbounds c to pathpart i ; +% elseif clipped i : +% clip c to pathpart i ; +% elseif stroked i : +% addto c doublepath pathpart i +% dashed dashpart i withpen penpart i +% withcolor _f_ % (redpart i, greenpart i, bluepart i) +% if mode=2 : t fi ; +% elseif filled i : +% addto c contour pathpart i +% withcolor _f_ +% if (mode=1) and (_f_<>refillbackground) : t fi ; +% else : +% addto c also i ; +% fi ; +% endfor ; +% setbounds c to _b_ ; +% endgroup ; +% enddef ; + +% Thanks to Jens-Uwe Morawski for pointing out that we need +% to treat bounded and clipped components as local pictures. + +def recolor suffix p = p := repathed (0,p) enddef ; +def refill suffix p = p := repathed (1,p) enddef ; +def redraw suffix p = p := repathed (2,p) enddef ; +def retext suffix p = p := repathed (3,p) enddef ; +def untext suffix p = p := repathed (4,p) enddef ; + +% primarydef p recolored t = repathed(0,p) t enddef ; +% primarydef p refilled t = repathed(1,p) t enddef ; +% primarydef p redrawn t = repathed(2,p) t enddef ; +% primarydef p retexted t = repathed(3,p) t enddef ; +% primarydef p untexted t = repathed(4,p) t enddef ; + +color refillbackground ; refillbackground := (1,1,1) ; + +% vardef repathed (expr mode, p) text t = +% begingroup ; +% if mode=0 : save withcolor ; remapcolors ; fi ; +% save _p_, _pp_, _f_, _b_, _t_ ; +% picture _p_, _pp_ ; color _f_ ; path _b_ ; transform _t_ ; +% _b_ := boundingbox p ; _p_ := nullpicture ; +% for i within p : +% _f_ := (redpart i, greenpart i, bluepart i) ; +% if bounded i : +% _pp_ := repathed(mode,i) t ; +% setbounds _pp_ to pathpart i ; +% addto _p_ also _pp_ ; +% elseif clipped i : +% _pp_ := repathed(mode,i) t ; +% clip _pp_ to pathpart i ; +% addto _p_ also _pp_ ; +% elseif stroked i : +% addto _p_ doublepath pathpart i +% dashed dashpart i withpen penpart i +% withcolor _f_ % (redpart i, greenpart i, bluepart i) +% if mode=2 : t fi ; +% elseif filled i : +% addto _p_ contour pathpart i +% withcolor _f_ +% if (mode=1) and (_f_<>refillbackground) : t fi ; +% elseif textual i : % textpart i <> "" : +% if mode <> 4 : +% % transform _t_ ; +% % (xpart _t_, xxpart _t_, xypart _t_) = (xpart i, xxpart i, xypart i) ; +% % (ypart _t_, yypart _t_, yxpart _t_) = (ypart i, yypart i, yxpart i) ; +% % addto _p_ also +% % textpart i infont fontpart i % todo : other font +% % transformed _t_ +% % withpen penpart i +% % withcolor _f_ +% % if mode=3 : t fi ; +% addto _p_ also i if mode=3 : t fi ; +% fi ; +% else : +% addto _p_ also i ; +% fi ; +% endfor ; +% setbounds _p_ to _b_ ; +% _p_ +% endgroup +% enddef ; + +def restroke suffix p = p := repathed (21,p) enddef ; % keep attributes +def reprocess suffix p = p := repathed (22,p) enddef ; % no attributes + +% also 11 and 12 + +vardef repathed (expr mode, p) text t = + begingroup ; + if mode=0 : save withcolor ; remapcolors ; fi ; + save _p_, _pp_, _ppp_, _f_, _b_, _t_ ; + picture _p_, _pp_, _ppp_ ; color _f_ ; path _b_ ; transform _t_ ; + _b_ := boundingbox p ; _p_ := nullpicture ; + for i within p : + _f_ := (redpart i, greenpart i, bluepart i) ; + if bounded i : + _pp_ := repathed(mode,i) t ; + setbounds _pp_ to pathpart i ; + addto _p_ also _pp_ ; + elseif clipped i : + _pp_ := repathed(mode,i) t ; + clip _pp_ to pathpart i ; + addto _p_ also _pp_ ; + elseif stroked i : + if mode=21 : + _ppp_ := i ; % indirectness is needed + addto _p_ also image(scantokens(t & " pathpart _ppp_") + dashed dashpart i withpen penpart i + withcolor _f_ ; ) ; + elseif mode=22 : + _ppp_ := i ; % indirectness is needed + addto _p_ also image(scantokens(t & " pathpart _ppp_")) ; + else : + addto _p_ doublepath pathpart i + dashed dashpart i withpen penpart i + withcolor _f_ % (redpart i, greenpart i, bluepart i) + if mode=2 : t fi ; + fi ; + elseif filled i : + if mode=11 : + _ppp_ := i ; % indirectness is needed + addto _p_ also image(scantokens(t & " pathpart _ppp_") + withcolor _f_ ; ) ; + elseif mode=12 : + _ppp_ := i ; % indirectness is needed + addto _p_ also image(scantokens(t & " pathpart _ppp_")) ; + else : + addto _p_ contour pathpart i + withcolor _f_ + if (mode=1) and (_f_<>refillbackground) : t fi ; + fi ; + elseif textual i : % textpart i <> "" : + if mode <> 4 : + % transform _t_ ; + % (xpart _t_, xxpart _t_, xypart _t_) = (xpart i, xxpart i, xypart i) ; + % (ypart _t_, yypart _t_, yxpart _t_) = (ypart i, yypart i, yxpart i) ; + % addto _p_ also + % textpart i infont fontpart i % todo : other font + % transformed _t_ + % withpen penpart i + % withcolor _f_ + % if mode=3 : t fi ; + addto _p_ also i if mode=3 : t fi ; + fi ; + else : + addto _p_ also i ; + fi ; + endfor ; + setbounds _p_ to _b_ ; + _p_ + endgroup +enddef ; + +% After a question of Denis on how to erase a z variable, Jacko +% suggested to assign whatever to x and y. So a clearz +% variable can be defined as: +% +% vardef clearz@# = +% x@# := whatever ; +% y@# := whatever ; +% enddef ; +% +% but Jacko suggested a redefinition of clearxy: +% +% def clearxy text s = +% clearxy_index_:=0; +% for $:=s: +% clearxy_index_:=clearxy_index_+1; endfor; +% if clearxy_index_=0: +% save x,y; +% else: +% forsuffixes $:=s: x$:=whatever; y$:=whatever; endfor; +% fi +% enddef; +% +% which i decided to simplify to: + +def clearxy text s = + if false for $ := s : or true endfor : + forsuffixes $ := s : x$ := whatever ; y$ := whatever ; endfor ; + else : + save x, y ; + fi +enddef ; + +% so now we can say: clearxy ; as well as clearxy 1, 2, 3 ; + +% show x0 ; z0 = (10,10) ; +% show x0 ; x0 := whatever ; y0 := whatever ; +% show x0 ; z0 = (20,20) ; +% show x0 ; clearxy 0 ; +% show x0 ; z0 = (30,30) ; + +primarydef p smoothed d = + (p llmoved (-xpart paired(d),0) -- p lrmoved (-xpart paired(d),0) {right} .. + p lrmoved (0,-ypart paired(d)) -- p urmoved (0,-ypart paired(d)) {up} .. + p urmoved (-xpart paired(d),0) -- p ulmoved (-xpart paired(d),0) {left} .. + p ulmoved (0,-ypart paired(d)) -- p llmoved (0,-ypart paired(d)) {down} .. cycle) +enddef ; + +primarydef p cornered c = + ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- + for i=1 upto length(p) : + (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- + (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) .. + controls point i of p .. + endfor cycle) +enddef ; + +% cmyk color support + +vardef cmyk(expr c,m,y,k) = + (1-c-k,1-m-k,1-y-k) +enddef ; + +% handy + +vardef bbwidth (expr p) = + (if known p : + if path p or picture p : + xpart (lrcorner p - llcorner p) + else : 0 fi else : 0 + fi ) +enddef ; + +vardef bbheight (expr p) = + (if known p : if path p or picture p : + ypart (urcorner p - lrcorner p) + else : 0 fi else : 0 + fi) +enddef ; + +color nocolor ; numeric noline ; % both unknown signals + +def dowithpath (expr p, lw, lc, bc) = + if known p : + if known bc : + fill p withcolor bc ; + fi ; + if known lw and known lc : + draw p withpen pencircle scaled lw withcolor lc ; + elseif known lw : + draw p withpen pencircle scaled lw ; + elseif known lc : + draw p withcolor lc ; + fi ; + fi ; +enddef ; + +% result from metafont discussion list (denisr/boguslawj) + +def ]] = ] ] enddef ; def ]]] = ] ] ] enddef ; +def [[ = [ [ enddef ; def [[[ = [ [ [ enddef ; + +% not perfect, but useful since it removes redundant points. + +% vardef dostraightened(expr sign, p) = +% if length(p)>2 : % was 1, but straight lines are ok +% save pp ; path pp ; +% pp := point 0 of p ; +% for i=1 upto length(p)-1 : +% if round(point i of p) <> round(point length(pp) of pp) : +% pp := pp -- point i of p ; +% fi ; +% endfor ; +% save n, ok ; numeric n ; boolean ok ; +% n := length(pp) ; ok := false ; +% if n>2 : +% for i=0 upto n : % evt hier ook round +% 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 +% if ok and (cycle p) : -- cycle fi +% else : +% pp +% fi +% else : +% p +% fi +% enddef ; + +% vardef simplified expr p = +% (reverse dostraightened(+1,dostraightened(+1,reverse p))) +% enddef ; + +% vardef unspiked expr p = +% (reverse dostraightened(-1,dostraightened(-1,reverse p))) +% enddef ; + +% simplified : remove same points as well as redundant points +% unspiked : remove same points as well as areas with zero distance + +vardef dostraightened(expr sign, p) = + save _p_, _q_ ; path _p_, _q_ ; + _p_ := p ; + forever : + _q_ := dodostraightened(sign, _p_) ; + exitif length(_p_) = length(_q_) ; + _p_ := _q_ ; + endfor ; + _q_ +enddef ; + +vardef dodostraightened(expr sign, p) = + if length(p)>2 : % was 1, but straight lines are ok + save pp ; path pp ; + pp := point 0 of p ; + for i=1 upto length(p)-1 : + if round(point i of p) <> round(point length(pp) of pp) : + pp := pp -- point i of p ; + fi ; + endfor ; + save n, ok ; numeric n ; boolean ok ; + n := length(pp) ; ok := false ; + if n>2 : + for i=0 upto n : % evt hier ook round + 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 + if ok and (cycle p) : -- cycle fi + else : + pp + fi + else : + p + fi +enddef ; + +% vardef simplified expr p = +% dostraightened(+1,p) +% enddef ; + +% vardef unspiked expr p = +% dostraightened(-1,p) +% enddef ; + +vardef simplified expr p = + (reverse dostraightened(+1,dostraightened(+1,reverse p))) +enddef ; + +vardef unspiked expr p = + (reverse dostraightened(-1,dostraightened(-1,reverse p))) +enddef ; + +% path p ; +% p := (2cm,1cm) -- (2cm,1cm) -- (2cm,1cm) -- (3cm,1cm) -- +% (4cm,1cm) -- (4cm,2cm) -- (4cm,2.5cm) -- (4cm,3cm) -- +% (3cm,3cm) -- (2cm,3cm) -- (1cm,3cm) -- (-1cm,3cm) -- +% .5[(-1cm,3cm),(1cm,1cm)] -- (1cm,1cm) -- cycle ; +% +% p := unitcircle scaled 4cm ; +% +% drawpath p ; drawpoints p ; drawpointlabels p ; +% p := p shifted (4cm,0) ; p := straightened p ; +% drawpath p ; drawpoints p ; drawpointlabels p ; +% p := p shifted (4cm,0) ; p := straightened p ; +% drawpath p ; drawpoints p ; drawpointlabels p ; + +% new + +path originpath ; originpath := origin -- cycle ; + +vardef unitvector primary z = + if abs z = abs origin : z else : z/abs z fi +enddef; + +% also new + +vardef anchored@#(expr p, z) = + p shifted (z + (labxf@#*lrcorner p + labyf@#*ulcorner p + + (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 improved 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 ; addto currentpicture also p ; + endgroup ; +enddef ; + +% makes a (line) into an infinite one (handy for calculating +% intersection points + +vardef infinite expr p = + (-infinity*unitvector(direction 0 of p) + shifted point 0 of p + -- p -- + +infinity*unitvector(direction length(p) of p) + shifted point length(p) of p) +enddef ; + +% obscure macros: create var from string and replace - and : +% (needed for process color id's) + +string _clean_ascii_[] ; + +def register_dirty_chars(expr str) = + for i = 0 upto length(str)-1 : + _clean_ascii_[ASCII substring(i,i+1) of str] := "_" ; + endfor ; +enddef ; + +register_dirty_chars("+-*/:;., ") ; + +vardef cleanstring (expr s) = + save ss ; string ss, si ; ss = "" ; save i ; + for i=0 upto length(s) : + si := substring(i,i+1) of s ; + ss := ss & if known _clean_ascii_[ASCII si] : _clean_ascii_[ASCII si] else : si fi ; + endfor ; + ss +enddef ; + +vardef asciistring (expr s) = + save ss ; string ss, si ; ss = "" ; save i ; + for i=0 upto length(s) : + si := substring(i,i+1) of s ; + if (ASCII si >= ASCII "0") and (ASCII si <= ASCII "9") : + ss := ss & char(scantokens(si) + ASCII "A") ; + else : + ss := ss & si ; + fi ; + endfor ; + ss +enddef ; + +vardef setunstringed (expr s, v) = + scantokens(cleanstring(s)) := v ; +enddef ; + +vardef setunstringed (expr s, v) = + scantokens(cleanstring(s)) := v ; +enddef ; + +vardef getunstringed (expr s) = + scantokens(cleanstring(s)) +enddef ; + +vardef unstringed (expr s) = + expandafter known scantokens(cleanstring(s)) +enddef ; + +% new + +vardef colorpart(expr i) = + (redpart i, greenpart i,bluepart i) +enddef ; + +% for david arnold: + +% showgrid(-5,10,1cm,-10,10,1cm); + +def showgrid (expr MinX, MaxX, DeltaX, MinY, MaxY, DeltaY)= + begingroup + save defaultfont, defaultscale, size ; + string defaultfont ; defaultfont := "cmtt10"; % i.e. infofont + numeric defaultscale ; defaultscale := 8pt / fontsize defaultfont; + numeric size ; size := 2pt ; + for x=MinX upto MaxX : + for y=MinY upto MaxY : + draw (x*DeltaX, y*DeltaY) + withpen pencircle scaled + if (x mod 5 = 0) and (y mod 5 = 0) : + 1.5size withcolor .50white + else : + size withcolor .75white + fi ; + endfor ; + endfor ; + for x=MinX upto MaxX: + label.bot(decimal x, (x*DeltaX,-size)); + endfor ; + for y=MinY upto MaxY: + label.lft(decimal y, (-size,y*DeltaY)) ; + endfor ; + endgroup +enddef; + +% new, handy for: +% +% \startuseMPgraphic{map}{n} +% \includeMPgraphic{map:germany} ; +% c_phantom (\MPvar{n}<1) ( +% fill map_germany withcolor \MPcolor{lightgray} ; +% draw map_germany withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% \includeMPgraphic{map:austria} ; +% c_phantom (\MPvar{n}<2) ( +% fill map_austria withcolor \MPcolor{lightgray} ; +% draw map_austria withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% c_phantom (\MPvar{n}<3) ( +% \includeMPgraphic{map:swiss} ; +% fill map_swiss withcolor \MPcolor{lightgray} ; +% draw map_swiss withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% c_phantom (\MPvar{n}<4) ( +% \includeMPgraphic{map:luxembourg} ; +% fill map_luxembourg withcolor \MPcolor{lightgray} ; +% draw map_luxembourg withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% \stopuseMPgraphic +% +% \useMPgraphic{map}{n=3} + +vardef phantom (text t) = + picture _p_ ; _p_ := image(t) ; addto _p_ also currentpicture ; + setbounds currentpicture to boundingbox _p_ ; +enddef ; + +vardef c_phantom (expr b) (text t) = + if b : + picture _p_ ; _p_ := image(t) ; addto _p_ also currentpicture ; + setbounds currentpicture to boundingbox _p_ ; + else : + t ; + fi ; +enddef ; + +% done + +endinput ; diff --git a/Master/texmf-dist/metapost/expressg/aam.mp b/Master/texmf-dist/metapost/expressg/aam.mp new file mode 100644 index 00000000000..930c16fb526 --- /dev/null +++ b/Master/texmf-dist/metapost/expressg/aam.mp @@ -0,0 +1,921 @@ +% aam.mp MetaPost for AAM figures +% Copyright 2000, 2004 Peter R Wilson +% All rights reserved +input expressg + +verbatimtex + \def\twolines#1#2{\vbox{\hbox{#1} \hbox{#2}}} + \def\threelines#1#2#3{\vbox{\hbox{#1} \hbox{#2} \hbox{#3}}} + \def\fourlines#1#2#3#4{\vbox{\hbox{#1} \hbox{#2} \hbox{#3} \hbox{#4}}} +etex + + + +beginfig(5) % FILES + +numeric lb[]; numeric hb[]; % box dimens +lb1 := namespace(btex Root etex)(nextra); % leaf nodes +lb4 := namespace(btex Root etex)(nextra); % root +hb1 := onelineh; + +numeric upshift, sideshift; +upshift := 10u; +sideshift := 5u; + +numeric cx[]; +numeric lyc[]; + +cx1 := 0; +cx2 := cx1 + sideshift; +cx3 := cx2 + sideshift; +cx4 := cx2 + sideshift + lb1; +cx5 := cx4 + sideshift; +cx6 := cx4 + sideshift + lb1; +cx7 := cx6 + sideshift + lb1; +cx8 := cx7 + sideshift + lb1; +cx9 := cx8 + sideshift + lb1; + +lb2 := (cx9-cx1); % FILES 1 length + +cx11 := cx9 + sideshift; +cx12 := cx11 + sideshift; +cx13 := cx12 + sideshift + lb1; +cx14 := cx13 + 0.5*(sideshift + lb1); +cx15 := cx13 + sideshift + lb1; +cx16 := cx14 + sideshift + lb1; +cx17 := cx16 + sideshift + lb1; +cx18 := cx13 + sideshift; + +lb3 := (cx17-cx11); % FILES 2 length + +lyc1 := 0; +lyc2 := lyc1 + upshift; +lyc3 := lyc2 + upshift + hb1; +lyc4 := lyc3 + upshift + hb1; + +hb3 := (lyc4 + upshift + hb1 -lyc1); % FILES 2 height + +lyc5 := lyc2 + hb1; +lyc6 := lyc5 + upshift + hb1; +lyc7 := lyc6 + upshift + hb1; +lyc8 := lyc7 + upshift + hb1; +lyc9 := lyc8 + upshift + hb1; + +hb2 := (lyc9 - lyc5); % FILES 1 height + +%% left FILE +z15=(cx1,lyc5); +drawENT(15, lb2, hb2)(" "); +label.top(btex FILE 1 etex, z15bm); + +%% right file +z111=(cx11,lyc1); +drawENT(111, lb3, hb3)(""); +label.top(btex FILE 2 etex, z111bm); + +%% bottom row of left tree +z26=(cx2,lyc6); drawENT(26, lb1, hb1)(btex N3 etex); +z46=(cx4,lyc6); drawENT(46, lb1, hb1)(btex N4 etex); +z66=(cx6,lyc6); drawENT(66, lb1, hb1)(btex N5 etex); +z76=(cx7,lyc6); drawENT(76, lb1, hb1)(btex N6 etex); +z86=(cx8,lyc6); drawENT(86, lb1, hb1)(btex L2 etex); + +%% middle row of left tree +z37=(cx3,lyc7); drawENT(37, lb1, hb1)(btex N1 etex); +z57=(cx5,lyc7); drawENT(57, lb1, hb1)(btex L1 etex); +z77=(cx7,lyc7); drawENT(77, lb1, hb1)(btex N2 etex); + +%% top row of left tree +z68=(cx6,lyc8); drawENT(68, lb4, hb1)(btex Root etex); + +%% bottom row right tree +z142=(cx14,lyc2); drawENT(142, lb1, hb1)(btex F4 etex); +z162=(cx16,lyc2); drawENT(162, lb1, hb1)(btex F5 etex); + +%% middle row of right tree +z123=(cx12,lyc3); drawENT(123, lb1, hb1)(btex F1 etex); +z133=(cx13,lyc3); drawENT(133, lb1, hb1)(btex F2 etex); +z153=(cx15,lyc3); drawENT(153, lb1, hb1)(btex F3 etex); + +%% top row of right tree +z184=(cx18,lyc4); drawENT(184, lb4, hb1)(btex Root etex); + +%%%%%%%%%%%%%%%%%%% lines + +%%% thick lines + +%% Arrow L1 to N5 (57-66) +z66A=1/4[z66tl,z66tr]; +pickup thickpen; +drawnormalCA(57bm,66A); +pickup normalpen; + +%% Arrow L2 to F4 (86-142) +pickup thickpen; +drawnormalCA(86bm,142ml); +pickup normalpen; + +%%% thin lines +pickup thinpen; + +%%% file 1 + +%% N1 to N3 & N4 (37, 26, 46) +x36=x37bm; y36=1/2[y26tm,y37bm]; +VyV(26tm, 36, 46tm); +drawnormalfour(26tm, 26tm.vyv, 46tm.vyv, 46tm); +drawnormal(37bm,36); + +%% N2 to N5, N6 & L2 (77, 66, 76, 86) +x76A=x76tm; y76A=1/2[y76tm,y77bm]; +VyV(66tm, 76A, 86tm); +drawnormalfour(66tm, 66tm.vyv, 86tm.vyv, 86tm); +drawnormal(77bm, 76tm); + +%% Root to N1, L1 and N2 (68, 37, 57, 77) +x68A=x68bm; y68A=1/2[y57tm,y68bm]; +VyV(37tm, 68A, 77tm); +drawnormalfour(37tm, 37tm.vyv, 77tm.vyv, 77tm); +drawnormal(68bm,68A); +z57A=(x57tm,y68A); +drawnormal(57A, 57tm); + +%%% file 2 + +%% F3 to F4 and F5 (153, 142, 162) +x153A=x153bm; y153A=1/2[y142tm,y153bm]; +VyV(142tm, 153A, 162tm); +drawnormalfour(142tm, 142tm.vyv, 162tm.vyv, 162tm); +drawnormal(153bm, 153A); + +%% Root to F1, F2 and F3 (184, 123, 133, 153) +x184A=x184bm; y184A=1/2[y184bm,y133tm]; +VyV(123tm, 184A, 153tm); +drawnormalfour(123tm, 123tm.vyv, 153tm.vyv, 153tm); +drawnormal(184bm,184A); +z133A=(x133tm,y184A); +drawnormal(133tm,133A); + + + +pickup normalpen; + +endfig; + +%%end + + + +beginfig(3) % DATA FLOW + + +smoothrad := 2u; + +numeric lb, hb; % length & height of boxes +lb := namespace(btex Analysis Process A0 etex)(nextra); +hb := 5onelineh; + +numeric hspace[]; +hspace1 := namespace(btex Geometry (ISO 10303-203, or other source) etc etex)(ndextra); + +numeric upshift; % vertical distance between rows +upshift = 5u; % 20u +numeric sideshift; % horizontal distance between boxes +sideshift = 5u; % 10u; + +numeric lb[]; + +%lb5 := namespace(btex to Model and etex)(nextra); +lb5 := namespace(btex Computational etex)(nextra); +lb1 := lb5; +lb2 := lb5; +lb3 := lb5; +lb4 := lb5; +lb6 := lb5; +lb25 := lb5; +lb41 := lb5; +lb65 := lb5; +lb84 := lb1; + +numeric hb[]; + +hb1 := 4onelineh; +hb2 := hb1; +hb3 := hb1; +hb4 := hb1; +hb5 := 4onelineh; +hb6 := hb5; +hb25 := 4onelineh; +hb41 := hb25; +hb65 := hb25; +hb84 := 3/2hb1; + +numeric lyc[]; +lyc1 := 0; +lyc2 := lyc1 + hb41; +lyc3 := lyc2 + upshift + hb6; +lyc5 := lyc3 + hb5; +lyc4 := 1/2[lyc3,lyc5]; +lyc6 := lyc5 + upshift; +lyc7 := lyc5 + 4upshift + hb25; +lyc8 := lyc7 + 1/2hb1; +lyc9 := lyc8 + upshift; + +numeric cx[]; +cx1 := 0; +cx2 := cx1 + sideshift; +cx3 := cx2 + sideshift + lb25; +cx4 := cx3 + sideshift + lb1; +cx5 := cx4 + sideshift + lb41; +cx6 := cx5 + sideshift + lb5; +cx7 := cx6 + sideshift + lb65; +cx8 := cx7 + lb4; +cx9 := cx8 + sideshift; + +%%% Modified geometry +z41=(cx4,lyc1); +drawdrum(41, lb41, hb41)(btex \threelines{Modified}{Geometry}{Data} etex); +%%dotlabel.llft("41", z41); + +%%% Optimize Geometry (A6) +z52=(cx5,lyc2); +drawENT(52, lb6, hb6)(btex \threelines{Optimize}{Geometry}{(A6)} etex); +%%dotlabel.llft("52", z52); + +%%% Adaptive Modification (A5) +z53=(cx5,lyc3); +drawENT(53, lb5, hb5)(btex \fourlines{Adaptive}{Modification}{to Model and}{Process (A5)} etex); +%%dotlabel.llft("53", z53); + +%%% Initial Geometry +z25=(cx2,lyc5); +drawdrum(25, lb25, hb25)(btex \twolines{Geometry}{Data} etex); +%%dotlabel.llft("25", z25); + +%%% Aerodynamic data +z65=(cx6,lyc5); +drawdrum(65, lb65, hb65)(btex \twolines{Aerodynamic}{Data} etex); +%%dotlabel.llft("65", z65); + + +%%% Acquire & Modify Geometery (A1) +z37=(cx3,lyc7); +drawENT(37, lb1, hb1)(btex \fourlines{Acquire and}{Modify}{Geometry}{(A1)} etex); +%%dotlabel.llft("37", z37); + + +%%% Extract Engineering Data (A4) +z77=(cx7,lyc7); +drawENT(77, lb4, hb4)(btex \threelines{Extract}{Engineering}{Data (A4)} etex); +%%dotlabel.llft("77", z77); + +%%% Build Computational Model (A2) +z57=(cx5,lyc7); +drawENT(57, lb2, hb2)(btex \threelines{Build}{Computational}{Model (A2)} etex); +%%dotlabel.llft("57", z57); + +%%% Compute Flowfield (A3) +z67=(cx6,lyc7); +drawENT(67, lb3, hb3)(btex \threelines{Compute}{Flowfield}{(A3)} etex); +%%dotlabel.llft("67", z67); + +%%% End Users +z84=(cx8,lyc4); +drawASDT(84, lb84, hb84)(btex \twolines{END}{USERS} etex); +%%dotlabel.llft("84", z84); + + +%%%%%%%%%%%%%%%%%%%%%%% lines + +%%% Geometry INPUT +z18=(cx1,lyc8); +VH(25tml,18); +drawnormal(18, 25tml.vh); +drawnormalCA(25tml.vh, 25tml); +smooth(18, 25tml.vh, 25tml); +label.top(btex Geometry etex, z18); + +%%% Geom -> A1 (25-37) +VH(25tmr, 37ml); +drawnormal(25tmr, 25tmr.vh); +drawnormalCA(25tmr.vh, 37ml); +smooth(25tmr, 25tmr.vh, 37ml); + +%%% A1 -> Modified Geom (37-41) +VH(41tml, 37mr); +drawnormalthreeCA(37mr, 41tml.vh, 41tml); +smooth(37mr, 41tml.vh, 41tml); + +%%% Modified Geom -> A2 (41-57) +VH(41tm, 57ml); +drawnormalthreeCA(41tm, 41tm.vh, 57ml); +smooth(41tm, 41tm.vh, 57ml); + +%%% Adaptive A5 -> Mod Geom (53-41) & A6 -> Mod Geom (52-41) +VH(41tmr, 53ml); +drawnormalthreeCA(53ml, 41tmr.vh, 41tmr); +z42=(x41tmr, y52ml); +drawnormal(52ml,42); +smooth(53ml, 41tmr.vh, 41tmr); +smooth(52ml, 42, 41tmr); + +%% Aero Data -> Adapt mod (A5) & Opt Geom (A6) (65-53,52) +VH(65bm, 52mr); +drawnormalthreeCA(65bm, 65bm.vh, 52mr); +z63=(x65bm, y53mr); +drawnormalCA(63, 53mr); +smooth(65bm, 65bm.vh, 52mr); +smooth(65bm, 63, 53mr); + +%% Mod Geom -> USERS (41-84) +z84A=1/4[z84bl,z84tl]; +%%HvH(41mr, 84A); +HxH(41mr, 77bm, 84A) +drawnormalfourCA(41mr, 41mr.hxh, 84A.hxh, 84A); +smoothtwo(41mr, 41mr.hxh, 84A.hxh, 84A); + +%% Aero -> Model (65-57) +VhV(65tml, 57bm); +drawnormalthreeCA(65tml.vhv, 57bm.vhv, 57bm); +drawnormalCA(65tml.vhv, 65tml); +smoothtwo(65tml, 65tml.vhv, 57bm.vhv, 57bm); + +%% Aero -> Flowfield (65-67) +drawnormalCA(65tm,67bm); +drawnormalCA(67bm,65tm); + +%% Aero -> Data (65-77) +VhV(65tmr, 77bm); +drawnormalthreeCA(65tmr.vhv, 77bm.vhv, 77bm); +drawnormalCA(65tmr.vhv, 65tmr); +smoothtwo(65tmr, 65tmr.vhv, 77bm.vhv, 77bm); + +%% Aero -> USERS (65-84) +z84B=(x84bl, y65mr); +drawnormalCA(65mr, 84B); + +%% Data -> USERS (77-84) +VH(84tm,77mr); +drawnormalthreeCA(77mr, 84tm.vh, 84tm); +smooth(77mr, 84tm.vh, 84tm); + + +%%%%%%%%% test smoothed dashed/dotted line +VH(25bm,41ml); +%%drawdashthree(25bm, 25bm.vh, 41ml); +%%smoothdash(25bm, 25bm.vh, 41ml); +drawdotsthree(25bm, 25bm.vh, 41ml); +smoothdots(25bm, 25bm.vh, 41ml); + +endfig; % end fig 3 + +%%%%%%%%%%%%%%%%%%%%%%% +%%end +%%%%%%%%%%%%%%%%%%%%%%%%% + +beginfig(1) % IDEF A0 model + +%%%%drawgrid; + +smoothrad := 2u; + +numeric lb, hb; % length & height of boxes +lb := namespace(btex Analysis Process A0 etex)(nextra); +hb := 5onelineh; + +numeric hspace[]; +hspace1 := namespace(btex Geometry (ISO 10303-203, or other source) etc etex)(ndextra); + +numeric upshift; % vertical distance between rows +upshift = 20u; +numeric sideshift; % horizontal distance between boxes +sideshift = 10u; + +numeric lyc[]; +lyc1 := 0; +lyc2 := lyc1;% +upshift; +lyc3 := lyc2+upshift; +lyc4 := lyc3+upshift+hb; +lyc5 := lyc4;% +upshift; + +%%%%%%%%%%%%%%%%%%%% A0 box +z33=(hspace1,lyc3); +drawENT(33, lb, hb)(btex \threelines{Computational}{Fluid Dynamics}{Analysis Process} etex); +label.ulft(btex A0 etex, z33br); + +%%%%%%%%%%%%%%%%%%%%%%%%% Inputs +z33A=1/8[z33bl,z33tl]; +z33B=z33ml; +z33C=7/8[z33bl,z33tl]; +z13=(0,y33A); z14=(0,y33B); z15=(0,y33C); +drawnormalCA(13,33A); +label.urt(btex Analysis Objectives etex, z13); +drawnormalCA(14,33B); +label.urt(btex Definition of Expected Flow Physics etex, z14); +drawnormalCA(15,33C); +label.urt(btex Geometry (ISO 10303-203, or other source) etex, z15); + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Outputs +z33D=1/8[z33br,z33tr]; +z33E=z33mr; +z33F=7/8[z33br,z33tr]; + +hspace2 := x33br+namespace(btex Flowfield Data etex)(ndextra); +z63=(hspace2,y33D); z64=(hspace2,y33E); z65=(hspace2,y33F); +drawnormalCA(33D,63); +label.rt(btex Flowfield Data etex, z63); +drawnormalCA(33E,64); +label.rt(btex Optimized Geometry etex, z64); +drawnormalCA(33F,65); +label.rt(btex \twolines{Information to Analysis}{Customer} etex, z65); + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Resources +hspace3 := namespace(btex Organizational etex)(ndextra); +z33G=1/5[z33bl,z33br]; +z33H=2/5[z33bl,z33br]; +z33I=3/5[z33bl,z33br]; +z33J=4/5[z33bl,z33br]; +hspace4 :=1/5lb; + +x41=x33bm + 1/2hspace4 + 1/2hspace3; +x51=x41+hspace3+hspace4; +x31=x41-hspace3-hspace4; +x21=x31-hspace3-hspace4; +y21=y31=y41=-y51=lyc1; +label.bot(btex \twolines{Trained}{Staff} etex, z21); +label.bot(btex \twolines{Computing}{Practices} etex, z31); +label.bot(btex \twolines{Organizational}{Best Practices} etex, z41); +label.bot(btex \twolines{Support}{Infrastructure} etex, z51); + +y1=1/3[lyc1,lyc3]; y2=2/3[lyc1,lyc3]; + +VyV(21,2,33G); +drawnormalthree(21, 21vyv, 33G.vyv); +drawnormalCA(33G.vyv, 33G); +smooth(21, 21vyv, 33G.vyv); %smooth(21vyv, 33G.vyv, 33G); +smooth(33G, 33G.vyv, 21vyv); +VyV(31,1,33H); +drawnormalthree(31, 31vyv, 33H.vyv); +drawnormalCA(33H.vyv, 33H); +smoothtwo(31, 31vyv, 33H.vyv, 33H); +VyV(41,1,33I); +drawnormalthree(41, 41vyv, 33I.vyv); +drawnormalCA(33I.vyv, 33I); +smoothtwo(41, 41vyv, 33I.vyv, 33I); +VyV(51,2,33J); +drawnormalthree(51, 51vyv, 33J.vyv); +drawnormalCA(33J.vyv, 33J); +smooth(51, 51vyv, 33J.vyv); smooth(51vyv, 33J.vyv, 33J); + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Controls +z33M=1/4[z33tl,z33tr]; +z33N=3/4[z33tl,z33tr]; + +z35=(x31,lyc5); z45=(x41,lyc5); +label.top(btex \threelines{Mathematical}{Model of Fluid}{Dynamics} etex, z35); +label.top(btex \twolines{Computing}{Implementation} etex, z45); +VhV(33M,35); +drawnormalthree(35, 35vhv, 33M.vhv); +drawnormalCA(33M.vhv, 33M); +smoothtwo(35, 35vhv, 33M.vhv, 33M); +VhV(33N,45); +drawnormalthree(45, 45vhv, 33N.vhv); +drawnormalCA(33N.vhv, 33N); +smoothtwo(45, 45vhv, 33N.vhv, 33N); + +endfig; % end fig 1 + + + +beginfig(2) % IDEF A1+ model + +%%%%drawgrid; + +numeric lb[]; +numeric hb; % length & height of boxes +lb1 := namespace(btex Acquire and etex)(nextra); +lb2 := namespace(btex Computational etex)(nextra); +lb3 := namespace(btex Flow Field etex)(nextra); +lb4 := namespace(btex Engineering etex)(nextra); +lb5 := namespace(btex Modification to etex)(nextra); +lb6 := lb5; +hb := 4onelineh; + +numeric hspace[]; +hspace1 := namespace(btex Geometry (ISO 10303-203, or other source) etc etex)(ndextra); + +numeric upshift; % vertical distance between rows +upshift = 12u; +numeric sideshift; % horizontal distance between boxes +sideshift = 10u; + +numeric lyc[]; +lyc1 := 0; +lyc2 := lyc1+1/2upshift; +lyc3 := lyc2+upshift; +lyc4 := lyc3+1/2upshift+hb; +lyc5 := lyc4+1/2upshift+hb; +lyc6 := lyc5+1/2upshift+hb; +lyc7 := lyc6 + 1/2upshift + hb; +lyc8 := lyc7 + 1/2upshift; +lyc9 := lyc8 + 1/2upshift; +lyc10 := lyc9+upshift; +lyc11 := lyc10+upshift; + +numeric cx[]; +cx1 := 0; +cx2 := cx1+sideshift; +cx3 := cx2+sideshift; +%%cx4 := cx3+sideshift; +cx5 := cx3 + 5/4sideshift + lb1; +%%cx6 := cx5+sideshift; +cx7 := cx5+sideshift+lb2; +%%cx8 := cx7+sideshift; +cx9 := cx7 + 3/4sideshift + lb3; +%%cx10 := cx9+sideshift; +cx11 := cx9 + 3/4sideshift + lb4; +cx12 := cx11+sideshift; + +%%%%%%%%%%%%%%%%%%%% A1 box +z36=(cx3,lyc6); +drawENT(36, lb1, hb)(btex \threelines{Acquire and}{Modify}{Geometry} etex); +label.ulft(btex A1 etex, z36br); +%%dotlabel.urt("z36", z36); + +%%%%%%%%%%%%%%%%%%%% A2 box +z55=(cx5,lyc5); +drawENT(55, lb2, hb)(btex \threelines{Build}{Computational}{Model (Grid)} etex); +label.ulft(btex A2 etex, z55br); +%%dotlabel.urt("z55", z55); + +%%%%%%%%%%%%%%%%%%%% A3 box +z74=(cx7,lyc4); +drawENT(74, lb3, hb)(btex \twolines{Compute}{Flowfield} etex); +label.ulft(btex A3 etex, z74br); +%%dotlabel.urt("z74", z74); + +%%%%%%%%%%%%%%%%%%%% A4 box +z93=(cx9,lyc3); +drawENT(93, lb4, hb)(btex \threelines{Extract}{Engineering}{Data} etex); +label.ulft(btex A4 etex, z93br); +%%dotlabel.urt("z93", z93); + +%%%%%%%%%%%%%%%%%%%% A5 box +z116=(cx11,lyc6); +drawENT(116, lb5, hb)(btex \fourlines{Adaptive}{Modification to}{Model and}{Process} etex); +label.ulft(btex A5 etex, z116br); +%%dotlabel.urt("z116", z116); + +%%%%%%%%%%%%%%%%%%%% A6 box +z114=(cx11+1/2sideshift,lyc4); +drawENT(114, lb6, hb)(btex \twolines{Optimize}{Geometry} etex); +label.ulft(btex A6 etex, z114br); +%%dotlabel.urt("z114", z114); + +%%%%%%%%%% Computing Implementation CONTROL + +z36A=z36tm; z55A=z55tm; z74A=1/4[z74tl,z74tr]; z93A=z93tm; z116A=z116tm; +x114A=1/2[x116br,x114br]; y114A=y114tr; + +x38=x36A; x58=x55A; x78=x74A; x98=x93A; x1168=x116A; x1148=x114A; +y38=y58=y78=y98=y1168=y1148=lyc8; + +drawnormal(38,1148); +drawnormalCA(38,36A); +drawnormalCA(58,55A); +drawnormalCA(78,74A); +drawnormalCA(98,93A); +drawnormalCA(1168,116A); +drawnormalCA(1148,114A); +%%dotlabel.lft("z38", z38); +%%dotlabel.rt("z1148", z1148); +smooth(36A, 38, 58); +smooth(55A, 58, 78); +smooth(58, 78, 74A); +smooth(78, 98, 93A); +smooth(98, 1168, 116A); +smooth(1168, 1148, 114A); + +z55B=3/4[z55tl,z55tr]; +z59=(x55B,lyc9); z58B=(x55B,lyc8); +drawnormal(59,58B); +label.top(btex \twolines{Computing}{Implementation} etex, z59); +smooth(59, 58B, 58); +smooth(59, 58B, 78); + +drawnormal(1168,58); + +%%%%%%%%%%%%%%%%% Math Model CONTROL + +z74B=3/4[z74tl,z74tr]; +z79=(x74B,lyc9); + +drawnormalCA(79,74B); +label.top(btex \twolines{Mathematical Model}{of Fluid Dynamics} etex, z79); + + +%%%%%%%%%%%%%%%%%%%% Support Infrastructure RESOURCE + +z93F=4/5[z93bl,z93br]; +z74F=4/5[z74bl,z74br]; +z55F=4/5[z55bl,z55br]; +z36F=4/5[z36bl,z36br]; +x92F=x93F; x72F=x74F; x52F=x55F; x32F=x36F; +y92F=y72F=y52F=y32F=lyc2; + +drawnormal(32F,92F); + +x82F=1/2[x74br,x93bl]; +y82F=y92F; +z81F=(x82F,lyc1); +drawnormal(81F,82F); +label.bot(btex \twolines{Support}{Infrastructure} etex, z81F); + +drawnormalCA(92F,93F); +drawnormalCA(72F,74F); +drawnormalCA(52F,55F); +drawnormalCA(32F,36F); +smooth(93F, 92F, 72F); +smooth(92F, 72F, 74F); +smooth(72F, 52F, 55F); +smooth(52F, 32F, 36F); + +smooth(81F, 82F, 92F); +smooth(81F, 82F, 72F); + +drawnormal(52F,72F); + +%%%%%%%%%%%%%%%%%%%%%%% Practices RESOURCE + +z93E=3/5[z93bl,z93br]; +z74E=3/5[z74bl,z74br]; +z55E=3/5[z55bl,z55br]; +z36E=3/5[z36bl,z36br]; +x92E=x93E; x72E=x74E; x52E=x55E; x32E=x36E; +y92E=y72E=y52E=y32E=1/4[lyc2,lyc3]; + +drawnormal(32E,92E); + +x62E=1/2[x55br,x74bl]; +y62E=y92E; +z61E=(x62E,lyc1); +drawnormal(61E,62E); +label.bot(btex \twolines{Organizational}{Best Practices} etex, z61E); + +drawnormalCA(92E,93E); +drawnormalCA(72E,74E); +drawnormalCA(52E,55E); +drawnormalCA(32E,36E); +smoothtwo(61E, 62E, 92E, 93E); +smoothtwo(61E, 62E, 32E, 36E); +smooth(62E, 72E, 74E); +smooth(62E, 52E, 55E); + +%%%%%%%%%%%%%%%%%%%%%%% Computing Assets RESOURCE + +z93D=2/5[z93bl,z93br]; +z74D=2/5[z74bl,z74br]; +z55D=2/5[z55bl,z55br]; +z36D=2/5[z36bl,z36br]; +x92D=x93D; x72D=x74D; x52D=x55D; x32D=x36D; +y92D=y72D=y52D=y32D=2/4[lyc2,lyc3]; + +drawnormal(32D,92D); + +x42D=1/2[x36br,x55bl]; +y42D=y92D; +z41D=(x42D,lyc1); +drawnormal(41D,42D); +label.bot(btex \twolines{Computing}{Assets} etex, z41D); + +drawnormalCA(92D,93D); +drawnormalCA(72D,74D); +drawnormalCA(52D,55D); +drawnormalCA(32D,36D); + +smoothtwo(41D, 42D, 92D, 93D); +smoothtwo(41D, 42D, 32D, 36D); +smooth(42D, 72D, 74D); +smooth(42D, 52D, 55D); + + +%%%%%%%%%%%%%%%%%%%%%%% Staff RESOURCE + +z93C=1/5[z93bl,z93br]; +z74C=1/5[z74bl,z74br]; +z55C=1/5[z55bl,z55br]; +z36C=1/5[z36bl,z36br]; +x92C=x93C; x72C=x74C; x52C=x55C; x32C=x36C; +y92C=y72C=y52C=y32C=3/4[lyc2,lyc3]; + +drawnormal(32C,92C); + +x42C=1/2[x36br,x55bl]; +y42C=y92C; +z41C=(x62C,lyc1); +z31C=(x36C,lyc1); +drawnormal(31C,32C); +label.bot(btex \twolines{Trained}{Staff} etex, z31C); + +drawnormalCA(92C,93C); +drawnormalCA(72C,74C); +drawnormalCA(52C,55C); +drawnormalCA(32C,36C); + +smooth(93C, 92C, 72C); +smooth(74C, 72C, 52C); +smooth(55C, 52C, 32C); +smooth(31C, 32C, 52C); + +drawnormal(72C,32C); +drawnormal(31C,32C); + +%%%%%%%%%%%%%%%%% Geometry INPUT + +x36G=x36; y36G=2/3[y36bl, y36tl]; +z16G=(cx1, y36G); +drawnormalCA(16G, 36G); +label.ulft(btex Geometry etex, z36G); + +%%%%%%%%%%%%%%%%%% Optimized Geometry OUTPUT + +x114P=x114br; y114P=1/3[y114br,y114tr]; +z124P=(x114P+sideshift, y114P); +drawnormalCA(114P,124P); +label.lrt(btex \twolines{Optimized}{Geometry} etex, z114P); + +%%%%%%%%%%%%%%%%%%%% A6 -> A2 + +x114L=x114br; y114L=2/3[y114br,y114tr]; +z124L=(x114L+sideshift, y114L); +drawnormal(114L,124L); + +x55H=x55bl; y55H=4/6[y55bl,y55tl]; +x45H=2/4[x36br,x55H]; y45H=y55H; +drawnormalCA(45H,55H); + +y97A=2/3[y116tl,lyc8]; +VyV(45H, 97A, 124L); +drawnormalfour(45H, 45H.vyv, 124L.vyv, 124L); +smoothtwo(114L, 124L, 124L.vyv, 45H.vyv); +smoothtwo(124L.vyv, 45H.vyv, 45H, 55H); + +%%%%%%%%%%%%%%%%%%%%%%%% A1 -> A2 + +x36M=x36br; y36M=y36mr; +x55I=x55bl; y55I=3/6[y55bl,y55tl]; +x45I=1/4[x36M,x55I]; +HxH(36M, 45I, 55I); +drawnormalthree(36M, 36M.hxh, 55I.hxh); +drawnormalCA(55I.hxh, 55I); +smoothtwo(36M, 36M.hxh, 55I.hxh, 55I); + +%%%%%%%%%%%%%%%%%%%%%%% A2 -> A3 + +x55M=x55br; y55M=y55mr; +x74H=x74bl; y74H=3/5[y74bl,y74tl]; +x64H=1/3[x55M,x74H]; +HxH(55M, 64H, 74H); +drawnormalthree(55M, 55M.hxh, 74H.hxh); +drawnormalCA(74H.hxh, 74H); +smoothtwo(55M, 55M.hxh, 74H.hxh, 74H); + + +%%%%%%%%%%%%%%%%%%%%%% A3 -> A4 + +x74N=x74br; y74N=1/3[y74br,y74tr]; +x93G=x93bl; y93G=3/4[y93bl,y93tl]; +x83G=1/2[x74N,x93G]; +HxH(74N, 83G, 93G); +drawnormalthree(74N, 74N.hxh, 93G.hxh); +drawnormalCA(93G.hxh,93G); +smoothtwo(74N, 74N.hxh, 93G.hxh, 93G); + +%%%%%%%%%%%%%%%%%%%%%% A4 -> A5 + +x93L=x93br; y93L=4/5[y93br,y93tr]; +x116H=x116bl; y116H=1/3[y116bl,y116tl]; +x106H=1/3[x93L,x116H]; +HxH(93L, 106H, 116H); +drawnormalthree(93L, 93L.hxh, 116H.hxh); +drawnormalCA(116H.hxh, 116H); +smoothtwo(93L, 93L.hxh, 116H.hxh, 116H); + +%%%%%%%%%%%%%%%%%%%%%%% A4 -> A6 + +x93M=x93br; y93M=3/5[y93br,y93tr]; +x114H=x114bl; y114H=1/2[y114bl,y114tl]; +x104H=1/2[x93M,x114H]; +HxH(93M, 104H, 114H); +drawnormalthree(93M, 93M.hxh, 114H.hxh); +drawnormalCA(114H.hxh, 114H); +smoothtwo(93M, 93M.hxh, 114H.hxh, 114H); + +%%%%%%%%%%%%%%%%%%%%%% A3 -> A5 + +x74M=x74br; y74M=2/3[y74br,y74tr]; +x116J=x116bl; y116J=2/3[y116bl,y116tl]; +x106J=2/3[x74N,x116J]; +HxH(74M, 106J, 116J); +drawnormalthree(74M, 74M.hxh, 116J.hxh); +drawnormalCA(116J.hxh,116J); +smoothtwo(74M, 74M.hxh, 116J.hxh, 116J); + +%%%%%%%%%%%%%%%%%%%% A5 -> A2 + +x116N=x116br; y116N=1/3[y116br,y116tr]; +x126N=2/3[x114L,x124L]; y126N=y116N; +drawnormal(116N,126N); + +x55G=x55bl; y55G=5/6[y55bl,y55tl]; +x45G=3/4[x36br,x55G]; y45G=y55G; +drawnormalCA(45G,55G); + +y97B=2/3[y116tl,y97A]; +VyV(45G, 97B, 126N); +drawnormalfour(45G, 45G.vyv, 126N.vyv, 126N); +smoothtwo(116N, 126N, 126N.vyv, 45G.vyv); +smoothtwo(126N.vyv, 45G.vyv, 45G, 55G); + +%%%%%%%%%%%%%%%%%%%% A5 -> A3 + +x116M=x116br; y116M=2/3[y116br,y116tr]; +x126M=1/3[x114L,x124L]; y126M=y116M; +drawnormal(116M,126M); + +x74G=x74bl; y74G=4/5[y74bl,y74tl]; +x64G=2/3[x55br,x74G]; y64G=y74G; +drawnormalCA(64G,74G); + +y97C=1/3[y116tl,y97A]; +VyV(64G, 97C, 126M); +drawnormalfour(64G, 64G.vyv, 126M.vyv, 126M); +smoothtwo(116M, 126M, 126M.vyv, 64G.vyv); +smoothtwo(126M.vyv, 64G.vyv, 64G, 74G); + + +%%%%%%%%%%%%%%%%%%%%%% Analysis Objectives INPUT + +x36J=x36bl; y36J=1/3[y36bl, y36tl]; +x93I=x93bl; y93I=2/4[y93bl, y93tl]; +x25=cx2; y25=1/2[y55,y36]; +z15=(cx1,y25); +label.ulft(btex \twolines{Analysis}{Objectives} etex, z25); +HxH(36J, 25, 93I); +drawnormalCA(36J.hxh, 36J); % to A1 +drawnormalCA(93I.hxh, 93I); % to A4 +drawnormal(15,25); +drawnormal(36J.hxh,93I.hxh); +smoothtwo(15, 25, 36J.hxh, 36J); +smoothtwo(15, 25, 93I.hxh, 93I); + +x55J=x55bl; y55J=2/6[y55bl,y55tl]; % to A2 +z25J=(x25,y55J); +drawnormalCA(25J,55J); +smooth(25, 25J, 55J); + +x74J=x74bl; y74J=2/5[y74bl,y74tl]; % to A3 +z24J=(x25,y74J); +drawnormalCA(24J,74J); +smooth(25, 24J, 74J); + +%%%%%%%%%%%%%%%%%%%%%% Flow Physics INPUT + + +x55K=x55bl; y55K=1/6[y55bl,y55tl]; % to A2 +x93J=x93bl; y93J=1/4[y93bl, y93tl]; % to A4 +x25B=1/3[cx2,cx3]; y25B=1/2[y93,y74]; +z15B=(cx1,y25B); +z25C=(x25,y25B); +label.ulft(btex \threelines{Definition of}{Expected Flow}{Physics} etex, z25C); +HxH(55K, 25B, 93J); +drawnormalCA(55K.hxh, 55K); % to A2 +drawnormalCA(93J.hxh, 93J); % to A4 +drawnormal(15B,25B); +drawnormal(55K.hxh, 93J.hxh); +smoothtwo(15B, 25B, 55K.hxh, 55K); +smoothtwo(15B, 25B, 93J.hxh, 93J); + +x74K=x74bl; y74K=1/5[y74bl,y74tl]; % to A3 +z24K=(x25B,y74K); +drawnormalCA(24K,74K); +smooth(25B, 24K, 74K); + +%%%%%%%%%%%%%%%%%%%%%% Flowfield & Customer OUTPUT + +x93N=x93br; y93N=2/5[y93br,y93tr]; +z103N=(x114, y93N); +drawnormalCA(93N,103N); +label.urt(btex Flowfield Data etex, z103N); + +x93P=x93br; y93P=1/5[y93br,y93tr]; +z103P=(x103N,y93P); +drawnormalCA(93P,103P); +label.lrt(btex \twolines{Information to}{Analysis Customer} etex, z103P); + + + +endfig; % end fig 2 + +end + diff --git a/Master/texmf-dist/metapost/expressg/expeg.mp b/Master/texmf-dist/metapost/expressg/expeg.mp new file mode 100644 index 00000000000..d8c5d64982f --- /dev/null +++ b/Master/texmf-dist/metapost/expressg/expeg.mp @@ -0,0 +1,1357 @@ +%% +%% This is file `expeg.mp', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% expressg.dtx (with options: `eg') +%% +%% Author: Peter Wilson (CUA) now at peter.r.wilson@boeing.com until June 2004 +%% (or pandgwilson@earthlink.net) +%% Copyright 1996, 2003 Peter R. Wilson +%% +%% v1.0 1996/05/09 (first release) +%% v1.2 1999/11/15 +%% v1.3 2000/05/22 +%% v1.4 2000/07/10 +%% v1.5 2003/07/31 +%% v1.6 2004/02/29 +%% v1.61 2004/03/17 +%% +%% This work may be distributed and/or modified under the +%% conditions of the LaTeX Project Public License, either +%% version 1.3 of this license or (at your option) any +%% later version. +%% The latest version of the license is in +%% http://www.latex-project.org/lppl.txt +%% and version 1.3 or later is part of all distributions of +%% LaTeX version 2003/06/01 or later. +%% +%% This work has the LPPL maintenance status "author-maintained". +%% +%% This work consists of the files listed in the README file. +%% This program is provided under the terms of the +%% LaTeX Project Public License distributed from CTAN +%% archives in directory macros/latex/base/lppl.txt. +%% +%%% EXPEG.MP Example MetaPost EXPRESS-G diagrams + + +verbatimtex \def\twolines#1#2{\vbox{\hbox{#1} \hbox{#2}}} etex + +input expressg + +beginfig(1) + +z1=(0,0); +drawEXPRESSION(1); + +z2bl=z1tr; +drawINTEGER(2); + +z3bl=z2tr; +drawBOOLEAN(3); + +z4bm=z3tm; +drawcirclebox(4, namespace(btex ABS etex)(nextra))(btex ABS etex); + +numeric diam; +diam = namespace(btex ABS etex)(nextra); + +z5bm=z4tm; +drawcirclebox(5, diam)(btex SAB etex); + +x5ml-x5tl = x5tr-x6bl; +y6mr=y5tm; +drawENT(6, pconl, enth)(btex an\_ent etex); + +z7bm=(x6tm,y6tm+u); +drawLEVENT(7, pconl, eventh)(btex levent etex); + +z8=(x7tl, y7tr+u); +drawGEVENT(8, pconl, eventh)(btex gevent etex); + +z9br=1/8[z3tl,z3tr]; +drawSCHEMA(9, pconl, schemah)(btex a\_schema etex); + +numeric xmid, len; +xmid = x8tr + diam; +len = 2diam; + +z11=(xmid, y1ml); z111=z11 shifted (len, 0); +drawdashO(11, 111); + +pair moveright; +moveright = (len, 0); + +z12=(xmid, y2ml); z121=z12 shifted moveright; +drawnormalO(12, 121); + +z13=(xmid, y3ml); z131=z13 shifted moveright; +drawthickO(13, 131); + +pair moveup; +moveup = (0, y13-y12); + +z14=z13 shifted moveup; z141=z14 shifted moveright; +drawnormalD(14, 141); + +z15=z14 shifted moveup; z151=z15 shifted moveright; +drawnormalCA(15, 151); + +z16=z15 shifted moveup; z161=z16 shifted moveright; +drawnormalOA(16, 161); + +z17=z16 shifted moveup; z171=z17 shifted moveright; +drawnormalF(17, 171); + +z300=(0,y8tm+diam); z301=(x111,y300); +draw z300--z301 dashes; + +numeric mup; mup := onelineh; + +z302=(0,y300+mup); +drawcardbox(302, pconl, onelineh, 1/4onelineh)(""); + +z303bm=(x302tm, y302tm+mup); +drawdiamondbox(303, pconl, 2onelineh)(btex jewel etex); + +z304=(0, y303tm+mup); +drawdoublerectangle(304, pconl, 2onelineh, 3/4); +label(btex top etex, z304ct); + +z305=(0, y304tm+mup); +drawtriplerectangle(305, pconl, 3onelineh, 2/5, 0.2); +label(btex top etex, z305ct); +label("middle", z305cm); + +z306=(0,y305tm+mup); +drawindexbox(306, 2pconl, 3onelineh, 3/4pconl, onelineh)(btex pack etex); +z307=1/8[z306bl,z306tr]; +drawENT(307, 1/4pconl, onelineh)(btex E etex); + +z308=(0, y306P.tl+mup); +z309ml=z308c; +drawcardbox(308, pconl, 2onelineh, 1/4onelineh)(btex covered etex); +drawdashboxover(309, pconl, onelineh); + +z310bm=(x306bm,y309tm+mup); +drawovalbox(310, 2pconl, 2onelineh)(""); + +z311ml=(x310mr+mup, y310ml); +drawroundedbox(311, 2pconl, 2onelineh, 1/2onelineh)("rounded"); + +z312ml=(x311mr+mup, y311mr); +drawroundedbox(312, 2pconl, 2onelineh, 3/2onelineh)(btex large radius etex); + +z314=(x312bm-1/4pconl, y312bm-1/2mup); +hiderectangle(314, 1/2pconl, (3/2onelineh + mup)); + +z315tm=(x312bm, y312bm-mup); +drawdashellipse(315, 2pconl, 2onelineh); + +z316tm=(x315bm, y315bm-mup); +drawdashcircle(316, diam); + +z317bc=(x311bm,y304br); +drawdrum(317, pconl, 3onelineh)(btex drum etex); +z317A=(x317tc, y317tc+2onelineh); +drawnormalthree(317tml, 317A, 317tmr); +smooth(317tml, 317A, 317tmr); + +z320bm = (x317bm, y302); +drawstickman(320, onelineh, 2onelineh); + +z325bm = (x320bm, y306); +drawoutputbox(325, pconl, 2onelineh)(btex output etex); + +z330 = (x320bm, y309ml); +drawCircledDot(330, 3/2onelineh); + +z401bm=(1/2[x11,x111], y301+mup); +drawcircleA(401, diam); + +z402=(xmid, y401tm+mup); z502=(x111, y402); +drawdashA(402, 502); + +z403=(xmid, y402+mup); z503=(x111, y403); +drawdashOA(403, 503); + +z404=(xmid, y403+mup); z504=(x111, y404); +drawnormalOD(404, 504); + +z405=(xmid, y404+mup); z505=(x111, y405); +drawnormalCD(405, 505); + +z406=(xmid, y405+mup); z506=(x111, y406); +drawnormalDCA(406, 506); + +numeric ang; ang = 180/7; +z600=(xmid, y406+2mup); +z699=(x600+len, y600); +z601=z699 rotatedaround(z600, ang); +z602=z699 rotatedaround(z600, 2ang); +z603=z699 rotatedaround(z600, 3ang); +z604=z699 rotatedaround(z600, 4ang); +z605=z699 rotatedaround(z600, 5ang); +z606=z699 rotatedaround(z600, 6ang); +z607=z699 rotatedaround(z600, 7ang); +drawnormalCA(600,601); +drawnormalOA(600,602); +drawnormalF(600,603); +drawdashA(600,604); +drawnormalOD(600,605); +drawnormalCD(600,606); + +endfig; % end figure 1 + +beginfig(2) % schema level model + +numeric lb, hb; % length & height of boxes +lb=20u; hb=schemah; +numeric upshift; % vertical distance between rows +upshift = 20u; +numeric sideshift; % horizontal distance between boxes +sideshift = 10u; + +%%% bottom row + +z9=(lb+sideshift,0); +drawSCHEMA(9, lb, hb)("nine"); + +z11=(x9br+sideshift,y9); +drawSCHEMA(11, lb, hb)("eleven"); + +%%% middle row + +z1=(0,y9tl+upshift); +drawSCHEMA(1, lb, hb)("one"); + +z3=(x1br+sideshift, y1); +drawSCHEMA(3, lb, hb)("three"); + +z5=(x3br+sideshift, y1); +drawSCHEMA(5, lb, hb)("five"); + +z7=(x5br+sideshift, y1); +drawSCHEMA(7, lb, hb)("seven"); + +%%% top row + +x50 = 1/2[x3br,x5bl]; +z31bm=(x50,y1tl+upshift); +drawSCHEMA(31, lb, hb)("thirtyone"); + +%%% connectors + +drawdashOO(9tm, 3bm); % three/nine +drawdashO(5bm, 11tm); % five/eleven +drawdashO(3ml, 1mr); % three/one +drawdashO(3mr, 5ml); % three/five +drawdashOO(9mr, 11ml); % nine/eleven + +%%% thirtyone/nine +z90=((x1bl-sideshift), y9ml); +z31A=3/4[z31bl,z31tl]; +VH(90, 31A); +drawdashO(90vh, 31A); +drawdashthreeO(90vh, 90, 9ml); +pickup thickpen; +draw z90; +pickup normalpen; +label.lft("z90", z90); + +%%% one/eleven +z1A=1/3[z1bl,z1br]; +z11A=(x11bm, (y11bm-sideshift)); +VH(1A, 11A); +drawdashthree(1A, 1A.vh, 11A); % note it is 1A.vh and not 1Avh +drawdashO(11A, 11bm); +dotlabel.rt("z11A", z11A); +dotlabel.lft("z1A.vh", z1A.vh); % note it is z1A.vh and not z1Avh + +%%% thirtyone/eleven +z31B=3/4[z31br,z31tr]; +x31BC=x7br+sideshift; +HxH(31B, 31BC, 11mr); +drawdashfourO(31B, 31B.hxh, 11mr.hxh, 11mr); + +%%% thirtyone/seven +z31D=1/4[z31br,z31tr]; +VH(7tm, 31D); +drawnormalthreeO(31D, 7tm.vh, 7tm); + +%%% thirtyone/one +z31C=1/4[z31bl,z31tl]; +VH(1tm, 31C); +drawdashO(1tm.vh, 31C); +drawdashO(1tm.vh, 1tm); + +%%% thirtyone/three +z31E=1/4[z31bl,z31br]; +VhV(31E, 3tm); +drawnormalfourO(31E, 31E.vhv, 3tm.vhv, 3tm); + +%%% thirtyone/five +z31F=3/4[z31bl,z31br]; +VhV(31F, 5tm); +drawnormalfourO(31F, 31F.vhv, 5tm.vhv, 5tm); + +%%% labeled arrow +z3111=1/4[z31B,z31B.hxh]; +numeric arrowsize; +arrowsize := schemah; +z3112=(x3111, y3111+arrowsize); +drawnormalCA(3112, 3111); +label.rt(btex an\_import etex, 1/2[z3111, z3112]); + +endfig; % end fig 2 + + +%%%% some commonly used variables & values + +numeric pl, ph; % length & height of numeric page connectors +pl:=pconl; ph:=pconh; % for eg., 9,9 (9,9) +numeric plnamed; % length of named page connector +numeric irh; % height of interschema boxes +irh:=ish; % normally one line of text +numeric sdtl, sdth; % length & height of SDT (e.g. INTEGER) boxes +sdtl:=sdtbl; sdth:=sdtbh; +numeric edtl, edth; % length & height of enum boxes (inset is sdtbs) +edth:=sdtbh; % normally one text line +numeric el, eh; % length & height of entity boxes +eh:=enth; % normally one text line +numeric upshift; % vertical space between rows of boxes +numeric nextup; % vertical space between bases of rows of boxes +picture sindex, pindex; +sindex := btex eleven.Index etex; % interschema reference text +pindex := btex 9,9 Index etex; % page reference text +numeric slindex, plindex; +slindex := namespace(sindex)(nextra); % length of Index interschema +plindex := namespace(pindex)(nextra); % length of Index page reference +numeric hspace[]; % horizontal spaces +numeric lyc[]; % Y coords of box bases + +%%%%%%%%%%% end commonly used variables & values + +beginfig(3) % example fig 3 +%%%drawgrid; + +edtl := namespace(btex standard\_data\_name etex)(niextra); +upshift=2sdth; +nextup=sdth+upshift; +%%% the y coords of box bases +lyc1:=0; +lyc2:=lyc1+nextup; +lyc3:=lyc2+nextup; +lyc4:=lyc3+nextup; +lyc5:=lyc4+nextup; +lyc6:=lyc5+nextup; +lyc7:=lyc6+nextup; +lyc8:=lyc7+nextup; +hspace1 := 1/3edtl; % space between data enums +hspace2 := 2/3edtl; % initial space at start of second row + +%%% bottom two rows (1 & 2) + +z11=(0,lyc1); +drawENUM(11, edtl, edth)(btex coordinates etex); + +z22=(hspace2, lyc2); +drawENUM(22, edtl, edth)(btex solution\_data etex); + +z31=(x11br+hspace1, lyc1); +drawENUM(31, edtl, edth)(btex pressure\_loads etex); + +z42=(x22br+hspace1, lyc2); +drawENUM(42, edtl, edth)(btex nondimensional etex); + +z51=(x31br+hspace1, lyc1); +drawENUM(51, edtl, edth)(btex temperature etex); + +z62=(x42br+hspace1, lyc2); +drawENUM(62, edtl, edth)(btex force\_loads etex); + +%%% third row (horizontal line between 2 & 4 row) + +z13=(x11tm,lyc3); +VyV(11tm, 13, 62tm); +drawnormal(11tm.vyv, 62tm.vyv); +z23=(x22tm,lyc3); z33=(x31tm,lyc3); z43=(x42tm,lyc3); z53=(x51tm,lyc3); +drawnormalO(11tm.vyv,11tm); +drawnormalO(23,22tm); +drawnormalO(33,31tm); +drawnormalO(43,42tm); +drawnormalO(53,51tm); +drawnormalO(62tm.vyv,62tm); + +%%% fourth row + +z3224=1/3[z13,z62tm.vyv]; +z3554=2/3[z13,z62tm.vyv]; + +%%% standard_data_name +z24bm=(x3224,lyc4); +drawSELECT(24, edtl, edth)(btex standard\_data\_name etex); +drawnormal(24bm,3224); + +%%% adhoc_data_name +z54bm=(x3554,lyc4); +drawTYPE(54, edtl, edth)(btex adhoc\_data\_name etex); + +%%% STRING +z64br=(x62br,lyc4); +drawSTRING(64); + +%%% fifth row + +z35=(1/2[x24tm,x54tm], lyc5); +VyV(24tm, 35, 54tm); +drawnormalthreeO(35, 24tm.vyv, 24tm); +drawnormalthreeO(35, 54tm.vyv, 54tm); + +%%% sixth row + +z36bm=(x35,lyc6); +drawSELECT(36,edtl, edth)(btex data\_name etex); +drawnormal(36bm,35); + +%%% data_name +z66=(x62,lyc6); +drawPREF(66, sdtl, ph)(btex 3,1 (4) etex); + +%%%% rest of the connectors + +%%% adhoc/STRING (54, 64) +drawnormalO(54mr,64ml); + +%%% PREF/data_name (36, 66) +drawdashO(66ml,36mr); + +endfig; % end fig 3 + + +beginfig(4) % example 4 +%%%drawgrid; + +%%% length of named page reference boxes +plnamed := namespace(btex 9,9 data\_name etex)(nextra); + +%%% length of entity boxes +el := namespace(btex (ABS) Data\_t etex)(nextra); + +upshift := 2sdth; % vertical space between boxes +nextup := sdth+upshift; % vertical space between bases of boxes +hspace1 := 1/2el; % space between entity boxes + +%%% the y coords of box bases +lyc1:=0; +lyc2:=lyc1+nextup; +lyc3:=lyc2+nextup; +lyc4:=lyc3+nextup; +lyc5:=lyc4+nextup; +lyc6:=lyc5+nextup; +lyc7:=lyc6+nextup; +lyc8:=lyc7+nextup; + +%%%% 2nd row + +%%% IntArray +z12=(0,lyc2); +drawENT(12, el, eh)(btex IntArray etex); + +%%% RealArray +z22=(x12br+hspace1, lyc2); +drawENT(22, el, eh)(btex RealArray etex); + +%%% CharArray +z42=(x22br+hspace1, lyc2); +drawENT(42, el, eh)(btex CharArray etex); + +%%% BitArray +z52=(x42br+hspace1, lyc2); +drawENT(52, el, eh)(btex BitArray etex); + +%%%% 1st row + +z11bm=(x12bm,lyc1); +drawINTEGER(11); + +z21bm=(x22bm,lyc1); +drawREAL(21); + +z41bm=(x42bm,lyc1); +drawSTRING(41); + +z51bm=(x52bm,lyc1); +drawBINARY(51); + +%%% 3rd row + +y13= y23= y43= y53=lyc3; +x13=x12tm; x23=x22tm; x43=x42tm; x53=x52tm; +drawthick(13,53); % horizontal line +%%% vertical connectors +drawthickO(13,12tm); drawthickO(23,22tm); +drawthickO(43, 42tm); drawthickO(53, 52tm); + +z33=1/2[z13,z53]; % midpoint of horizontal line + +%%% 4th row + +%%% Data_t +z34bm=(x33,lyc4); +drawENT(34, el, 3eh)(btex \twolines{(ABS)}{Data\_t} etex); +drawthick(34bm,33); +label.urt("1", z33); % label the connection point + +%%% Index +z14=(0,lyc4); +drawPREF(14, plindex, ph)(pindex); + +%%% INTEGER +z54br=(x51br,lyc4); +drawINTEGER(54); + +%%% 5th row + +lyc5:=y34tm-ph; % change the initial y coord value + +%%% Index +z15=(0,lyc5); +drawPREF(15, plindex, ph)(pindex); + +%%% DataType +z55=(x54,lyc5); +drawPREF(55, plnamed, ph)(btex 3,1 data\_name etex); + +%%% 6th row + +%%% PREF to Data_t +lyc6:=lyc5+nextup; +z36bm=(x34tm,lyc6); +drawPREF(36, pl, ph)(btex 7,5 (6) etex); + +%%%% attributes + +%%% Sizes Data_t/Index (34, 14) +z3414=(x34,y14mr); +drawnormal(3414,14mr); +label.ulft(btex Sizes A[1:Limit] etex, z3414); + +%%% num Data_t/INTEGER (34, 54) +z3454=(x34mr,y54ml); +drawnormalO(3454,54ml); +label.urt(btex (DER) num etex, z3454); + +%%% Limit Data_t/Index (34, 15) +z3415=(x34,y15mr); +drawnormal(3415,15mr); +label.ulft(btex Limit etex, z3415); + +%%% Kind Data_t/data_name (34, 55) +z3455=(x34mr, y55ml); +drawnormal(3455, 55ml); +label.urt(btex Kind etex, z3455); + +%%% PREF into Data_t (36, 34) +drawdashO(36bm, 34tm); + +%%% Data IntArray/INTEGER (12, 11) +drawnormalO(12bm, 11tm); +label.lrt(btex Data A[1:num] etex, z12bm); + +%%% Data RealArray/REAL (22, 21) +drawnormalO(22bm, 21tm); +label.lrt(btex Data A[1:num] etex, z22bm); + +%%% Data CharArray/STRING (42, 41) +drawnormalO(42bm, 41tm); +label.lrt(btex Data A[1:num] etex, z42bm); + +%%% Data BitArray/BINARY (52, 51) +drawnormalO(52bm, 51tm); +label.lrt(btex Data A[1:num] etex, z52bm); + +endfig; % end fig 4 + +beginfig(5) % example 5 +%%drawgrid; + +plnamed := namespace(btex 7,4 Unstructured\_Donor etex)(nextra); + +numeric irls, irll; % length of short and long ISR boxes +irls = namespace(btex eleven.MeshLocation etex)(nextra); +irll = namespace(btex eleven.MeshConnectivityType etex)(nextra); + +upshift := irh; +nextup := irh+upshift; + +numeric maxrx; % max x coordinate value of LH of right column boxes +maxrx := maxx-irrl; +numeric xmid; % x coord of figure center +xmid := 1/2[irls, maxx-irll]; + +el := namespace(btex MeshConnectivity1\_1 etex)(nextra); +eh := irh; + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+nextup; +lyc3 := lyc2+nextup; +lyc4 := lyc3+nextup+irh; +lyc5 := lyc4+nextup; +lyc6 := lyc5+nextup; +lyc7 := lyc6+nextup; +lyc8 := lyc7+nextup; +lyc9 := lyc8+nextup; + +%%% Zcol/row +%%% row 1 + +%%% PREF for Overlapping +z21bm=(xmid,lyc1); +drawPREF(21, pl, ph)(btex 5,3 (8) etex) + +%%% row 2 + +%%% OverlappingArea +z22bm=(x21bm,lyc2); +drawENT(22, el, eh)(btex OverlappingArea etex); + +%%% row 3 + +%%% IndexArray +z13=(pl,lyc3); +drawISR(13, irls, irh)(btex eleven.IndexArray etex); + +%%% Index +z23bm=(x22bm,lyc3); +drawISR(23, slindex, irh)(sindex); + +%%% MeshLocation +z33br=(maxx,lyc3); +drawISR(33, irls, irh)(btex eleven.MeshLocation etex); + +%%% row 4 + +%%% MeshConnectivity +z24bm=(x23bm,lyc4); +drawENT(24, el, eh)(btex MeshConnectivity etex); + +%%% PREF for MeshConnectivity +z14ml=(pl,y24ml); +drawPREF(14, pl, ph)(btex 5,2 (8) etex); + +%%% Structured_Donor +z34br=(maxx,lyc4); +drawPREF(34, plnamed, ph)(btex 7,5 Structured\_Donor etex); + +%%% row 5 + +%%% Unstructured_donor +z35br=(maxx,lyc5); +drawPREF(35, plnamed, ph)(btex 7,4 Unstructured\_Donor etex); + +%%% row 6 + +%%% MeshConnType +z36br=(maxx,lyc6); +drawISR(36, irll, irh)(btex eleven.MeshConnectivityType etex); + +%%% row 7 + +%%% IndexRange +z17=(0,lyc7); +drawISR(17, irls, irh)(btex eleven.IndexRange etex); + +%%% INTEGER +x27bm=x24bm; y27ml=y17mr; +drawINTEGER(27); + +%%% Zone +z37br=(maxx,lyc7); +drawISR(37, irls, irh)(btex seven.Zone etex); + +%%% row 8 + +%%% 1to1 +z28bm=(x24bm,lyc8); +drawENT(28, el, eh)(btex MeshConnectivity1\_1 etex); + +%%% row 9 + +%%% PREF to 1to1 +z29bm=(x28bm,lyc9); +drawPREF(29, pl, ph)(btex 5,1 (8) etex); + +%%%% attributes, etc + +drawthickO(21tm,22bm); % PREF to Overlap (21, 22) +drawthickO(14mr,24ml); % PREF to MeshConn (14, 24) +drawthickO(29bm,28tm); % PREF to 1to1 (29, 28) + +%%% PointListSize (22, 23) +drawdashO(22tm,23bm); +label.llft(btex PointListSize etex, z23bm); + +%%% PointRange (22, 17) +z22A=1/4[z22bl,z22tl]; z17A=(1/2[0,x13], y17); +VH(17A,22A); +drawdashthreeO(22A, 17A.vh, 17A); +label.ulft(btex PointRange etex, z22A); + +%%% PointList (22, 13) +z22B=3/4[z22bl,z22tl]; +VH(13bm,22B); +drawdashthreeO(22B, 13bm.vh, 13bm); +label.ulft(btex PointList etex, z22B); + +%%% MeshLocation (22, 33) +z22C=1/4[z22br,z22tr]; +z33B=2/3[z33bl,z33br]; +VH(33B,22C); +drawnormalthreeO(22C, 33B.vh, 33B); +label.urt(btex (DER) Location etex, z22C); + +%%% Meshloc (22, 33) +z22D=3/4[z22br,z22tr]; +z33A=1/3[z33bl,z33br]; +VH(33A,22D); +drawdashthreeO(22D, 33A.vh, 33A); +label.urt(btex Meshloc etex, z22D); + +%%% PointListSize (24, 23) +drawnormalO(24bm, 23tm); +label.ulft(btex PointListSize etex, z23tm); + +%%% StructuredDonor (24, 34) +z24A=(x24br,y34ml); +draw z24A--z34ml dashes; +label.lrt(btex StructuredDonor etex, z24A); + +%%% UnstructuredDonor (24, 35) +z24B=3/4[z24br,z24tr]; +HvH(24B,35ml); +drawdashfourO(24B, 24B.hvh, 35ml.hvh, 35ml); +label.urt(btex UnstructuredDonor etex, z24B.hvh); + +%%% Meshloc (24, 33) +z24C=4/6[z24bl,z24br]; +z33C=(x33A,y33tm); +y2433C=1/3[y33C,y24C]; +VyV(24C, 2433C, 33C); +drawdashfourO(24C, 24C.vyv, 33C.vyv, 33C); +label.lrt(btex Meshloc etex, z24C.vyv); + +%%% Location (24, 33) +z24D=5/6[z24bl,z24br]; +z33D=(x33B,y33tm); +y2433D=2/3[y33D,y24D]; +VyV(24D, 2433D, 33D); +drawnormalfourO(24D, 24D.vyv, 33D.vyv, 33D); +label.lrt(btex (DER) Location etex, z24D.vyv); + +%%% ConnectivityType (24, 36) +z24H=(x24D,y24tr); +z36H=z36bm; +y2436H=1/2[y35tr,y36br]; +VyV(24H, 2436H, 36H); +drawnormalfourO(24H, 24H.vyv, 36H.vyv, 36H); +label.urt(btex (DER) ConnectivityType etex, z24H.vyv); + +%%% Meshcon (24, 36) +z24G=(x24C,y24tr); +z36G=z36ml; +VH(24G,36G); +drawdashthreeO(24G, 24G.vh, 36G); +label.urt(btex Meshcon etex, z24G.vh); + +%%% K (24, 27) +drawnormalO(24tm, 27bm); +label.ulft(btex K etex, z24tm); + +%%% PointRange (24, 17) +z24E=1/4[z24tl,z24tr]; +x17br-x17E = x17A-x17bl; +y17E = y17A; +VhV(24E,17E); +drawdashfourO(24E, 24E.vhv, 17E.vhv, 17E); +label.ulft(btex PointRange etex, z24E); + +%%% PointList (24, 13) +z24F=1/4[z24bl,z24br]; +z13F=1/2[z13tl,z13tr]; +VhV(24F,13F); +drawnormalfourO(24F, 24F.vhv, 13F.vhv, 13F); +label.llft(btex PointList etex, z24F); + +%%% N (28, 27) +z27A=1/5[z27tl,z27tr]; +z28A=(x27A,y28bl); +drawnormalO(28A,27A); +label.llft(btex N etex, z28A); + +%%% trans (28, 27) +z27B=1/2[z27tl,z27tr]; +z28B=(x27B,y28bl); +drawdashO(28B,27B); +label.lrt(btex \twolines{trans}{A[1:N]} etex, z28B); + +%%% Transform (28, 27) +z27C=1/2[z27br,z27tr]; +z28C=(1/2[x27C,x28br], y28br); +VH(28C,27C); +drawnormalthreeO(28C,28C.vh,27C); +label.lrt(btex (DER) Transform A[1:N] etex , z28C); + +%%% DonorZone (28, 37) +z28D=1/2[z28br,z28tr]; +z37D=z37tm; +VH(37D,28D); +drawdashthreeO(28D,37D.vh,37D); +label.urt(btex DonorZone etex, z28D); + +%%% DonorPointRange (28, 17) +z28G=3/4[z28bl,z28tl]; +z17G=(x17A,y17tl); +VH(17G,28G); +drawnormalthreeO(28G,17G.vh,17G); +label.ulft(btex DonorPointRange etex, z28G); + +%%% PointRange (28, 17) +z28H=1/4[z28bl,z28tl]; +z17H=(x17E,y17G); +VH(17H,28H); +drawnormalthreeO(28H,17H.vh,17H); +label.ulft(btex PointRange etex, z28H); + +endfig; % end fig 5 + + +beginfig(6) % example 6 EXPRESS-G +%%%drawgrid; + +upshift := 3/2onelineh; +nextup := onelineh+upshift; + +el := namespace(btex manufacturer etex)(nextra); +eh := onelineh; + +hspace1 := 1/2el; + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+nextup; +lyc3 := lyc2+nextup; +lyc4 := lyc3+nextup; +lyc5 := lyc4+nextup; + +%%% Zcol/row + +%%% rows 4 and 5 +z14=(0,lyc4); +drawENT(14, el, eh)(btex manufacturer etex); + +z25=(x14br+hspace1, lyc5); +drawSTRING(25); + +z34=(x25br+hspace1, lyc4); +drawENT(34, el, eh)(btex car\_model etex); + +%%% row 3 + +z33bm=(x34bm, lyc3); +drawENT(33, el, eh)(btex car etex); + +%%% row 2 + +z22=(x25, lyc2); +drawINTEGER(22); + +%%% row 1 + +z21=(x22, lyc1); +drawSTRING(21); + +%%% attributes + +%%% manufacturer name (14, 25) +VH(14tm, 25ml); +drawnormalthreeO(14tm, 14tm.vh, 25ml); +label.urt(btex *name etex, z14tm.vh); + +%%% model name (34, 25) +VH(34tm, 25mr); +drawnormalthreeO(34tm, 34tm.vh, 25mr); +label.ulft(btex *name etex, z34tm.vh); + +%%% made_by (34, 14) +drawnormalO(34ml, 14mr); +label.ulft(btex made\_by etex, z34ml); + +%%% model_type (33, 34) +drawnormalO(33tm, 34bm); +label.urt(btex model\_type etex, z33tm); + +%%% DER made_by (33, 14) +VH(14bm, 33ml); +drawnormalthreeO(33ml, 14bm.vh, 14bm); +label.ulft(btex (DER) *made\_by etex, z33ml); + +%%% year (33, 22) +z33A=1/3[z33bl, z33br]; +VH(33A, 22mr); +drawnormalthreeO(33A, 33A.vh, 22mr); +label.ulft(btex year etex, z33A.vh); + +%%% serial_no +z33B=2/3[z33bl, z33br]; +VH(33B, 21mr); +drawnormalthreeO(33B, 33B.vh, 21mr); +label.ulft(btex *serial\_no etex, z33B.vh); + +endfig; % end fig 6 + + +beginfig(7) % example 7 +%%%drawgrid; + +el := namespace(btex MANUFACTURER etex)(niextra); +eh := onelineh; + +hspace1 := namespace(btex made by maker of etex)(4ndextra); + +hspace2 := 6onelineh; % height of CAR +hspace3 := 5onelineh; % space between rows +hspace4 := 3onelineh; % height of MANUFACTURER + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+hspace2+hspace3; + +%%% Zcol/row + +%%% row 2 + +z12=(0, lyc2); +drawENT(12, el, hspace4)(""); +x121=x12+sdtbs; +label.rt(btex MANUFACTURER etex, (x121, 2/3[y12bl, y12tl])); +label.rt(btex * manuf-name etex, (x121, 1/3[y12bl, y12tl])); + +z22=(x12br+hspace1, lyc2); +drawENT(22, el, hspace4)(""); +x221=x22+sdtbs; +label.rt(btex CAR-MODEL etex, (x221, 2/3[y12bl, y12tl])); +label.rt(btex * model-name etex, (x221, 1/3[y12bl, y12tl])); + +%%% row 1 + +z21=(x22, lyc1); +drawENT(21, el, hspace2)(""); +x211=x21+sdtbs; +label.rt(btex CAR etex, (x211, 5/6[y21bl, y21tl])); +label.rt(btex o year etex, (x211, 4/6[y21bl, y21tl])); +label.rt(btex o model (R) etex, (x211, 3/6[y21bl, y21tl])); +label.rt(btex * serial-no etex, (x211, 2/6[y21bl, y21tl])); +label.rt(btex * maker (R) etex, (x211, 1/6[y21bl, y21tl])); + +%%%%% relationship lines + +%%% MANUFACTURER / CAR-MODEL (12, 22) +drawnormalDCA(12mr, 22ml); +drawnormalCA(22ml, 12mr); +label.urt(btex { }{ }made by etex, z12mr); +label.llft(btex maker of{ }{ } etex, z22ml); + +%%% MANUFACTURER / CAR (12, 21) +VH(12bm, 21ml); +drawnormalCA(12bm.vh, 12bm); +drawnormalDCA(12bm.vh, 21ml); +label.llft(btex { }{ }made by etex, z12bm); +label.ulft(btex maker of{ }{ } etex, z21ml); + +%%% CAR-MODEL / CAR (22, 21) +drawnormalDCA(22bm, 21tm); +drawnormalCA(21tm, 22bm); +label.lrt(btex { }one of etex, z22bm); +label.ulft(btex type of{ } etex, z21tm); + +endfig; % end fig 7 + + +beginfig(8) % example 8 IDEF1X +%%%drawgrid; + +el := namespace(btex MANUFACTURER etex)(niextra); +eh := onelineh; + +hspace1 := namespace(btex made by maker of etex)(4ndextra); + +hspace2 := 5onelineh; % height of CAR +hspace3 := 5onelineh; % space between rows +hspace4 := 3onelineh; % height of MANUFACTURER + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+hspace2+hspace3; + +%%% Zcol/row + +%%% row 2 + +z12=(0, lyc2); +drawdoublerectangle(12, el, hspace4, 1/2); +label.urt(btex Manufacturer etex, z12tl); +x121=x12+sdtbs; +label.rt(btex manuf-name etex, (x121, 3/4[y12bl, y12tl])); + +z22=(x12br+hspace1, lyc2); +drawdoublerectangle(22, el, hspace4, 1/2); +label.urt(btex Car-model etex, z22tl); +x221=x22+sdtbs; +label.rt(btex Model-name etex, (x221, 3/4[y12bl, y12tl])); +label.rt(btex Manuf-name (FK) etex, (x221, 1/4[y12bl, y12tl])); + +%%% row 1 + +z21=(x22, lyc1); +drawroundedbox(21, el, hspace2, 2sdtbs)(""); +label.urt(btex Car etex, z21tl); +draw z21ml--z21mr; +x211=x21+sdtbs; +label.rt(btex Serial-no etex, (x211, 5/6[y21bl, y21tl])); +label.rt(btex Manuf-name (FK) etex, (x211, 4/6[y21bl, y21tl])); +label.rt(btex Model-name (FK) etex, (x211, 2/6[y21bl, y21tl])); +label.rt(btex Year etex, (x211, 1/6[y21bl, y21tl])); + +%%%%% relationship lines + +%%% MANUFACTURER / CAR-MODEL (12, 22) +drawnormalD(12mr, 22ml); +label.top(btex of etex, 1/2[z12mr, z22ml]); + +%%% MANUFACTURER / CAR (12, 21) +VH(12bm, 21ml); +drawnormalthreeD(12bm, 12bm.vh, 21ml); +label.top(btex makes etex, 1/2[z12bm.vh, z21ml]); +label.ulft(btex P{ } etex, z21ml); + +%%% CAR-MODEL / CAR (22, 21) +drawnormalD(22bm, 21tm); +label.lft(btex of etex, 1/2[z21tm,z22bm]); +label.urt(btex { }P etex, z21tm); + +endfig; % end fig 8 + + +beginfig(9) % example 9 OMT +%%%drawgrid; + +el := namespace(btex {\bf MANUFACTURER} etex)(niextra); +eh := onelineh; + +hspace1 := namespace(btex made by maker of etex)(4ndextra); + +hspace2 := 4onelineh; % height of CAR +hspace3 := 4onelineh; % space between rows +hspace4 := 3onelineh; % height of MANUFACTURER + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+hspace2+hspace3; + +%%% Zcol/row + +%%% row 2 + +z12=(0, lyc2); +drawdoublerectangle(12, el, hspace4, 1/2); +x121=x12+sdtbs; +label.rt(btex {\bf Manufacturer} etex, (x121, 3/4[y12bl, y12tl])); +label.rt(btex name : String etex, (x121, 1/4[y12bl, y12tl])); + +z22=(x12br+hspace1, lyc2); +drawdoublerectangle(22, el, hspace4, 1/2); +x221=x22+sdtbs; +label.rt(btex {\bf Car Model} etex, (x221, 3/4[y22bl, y22tl])); +label.rt(btex name: String etex, (x221, 1/4[y22bl, y22tl])); + +%%% row 1 + +z21=(x22, lyc1); +drawdoublerectangle(21, el, hspace2, 1/3); +x211=x21+sdtbs; +label.rt(btex {\bf Car} etex, (x211, 5/6[y21bl, y21tl])); +label.rt(btex serial-no : String etex, (x211, 4/9[y21bl, y21tl])); +label.rt(btex year : Integer etex, (x211, 2/9[y21bl, y21tl])); + +%%%%% relationship lines + +%%% MANUFACTURER / CAR-MODEL (12, 22) +drawnormalD(12mr, 22ml); +label.top(btex {\it makes} etex, 1/2[z12mr, z22ml]); +label.ulft(btex 1+{ } etex, z22ml); + +%%% MANUFACTURER / CAR (12, 21) +VH(12bm, 21ml); +drawnormalthreeD(12bm, 12bm.vh, 21ml); +label.top(btex {\it makes} etex, 1/2[z12bm.vh, z21ml]); +label.ulft(btex 1+{ } etex, z21ml); + +%%% CAR-MODEL / CAR (22, 21) +drawnormalD(22bm, 21tm); +label.lft(btex {\it produced as} etex, 1/2[z21tm,z22bm]); + +endfig; % end fig 9 + + +beginfig(10) % example 10 E-R +%%%drawgrid; + +numeric diam; diam := 2onelineh; + +upshift := diam; % circle diameter +nextup := diam+upshift; + +el := namespace(btex MANUFACTURER etex)(niextra); +eh := onelineh; + +numeric dl, dh; % length and height of diamond boxes +dl := 1/2el; dh := 2eh; + +numeric marg; marg := 4u; % double the seperation between parallel lines + +hspace1 := 1/2el; + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+nextup; +lyc3 := lyc2+nextup; +lyc4 := lyc3+nextup; +lyc5 := lyc4+nextup; + +%%% Zcol/row +%%% row 4 + +z14=(0,lyc4); +drawENT(14, el, eh)(btex manufacturer etex); + +z34ml=(x14br+hspace1, y14mr); +drawdiamondbox(34, dl, dh)(btex has etex); + +z54ml=(x34mr+hspace1, y34mr); +drawENT(54, el, eh)(btex car\_model etex); + +%%% row 5 + +z15bm=(x14bm, lyc5); +drawcirclebox(15, diam)(btex Name etex); + +z55bm=(x54bm, lyc5); +drawcirclebox(55, diam)(btex Name etex); + +%%% row 3 + +z53bm=(x54bm, lyc3); +drawdiamondbox(53, dl, dh)(btex of etex); + +z13c=(x14bm, y53c); +drawtwodiamondbox(13, dl+marg, dh+marg, 2/5marg)(btex Makes etex); + +%%% row 2 + +z32bm=(x34bm, lyc2); +drawENT(32, el, eh)(btex car etex); +z31c=z32c; +drawENT(31, el+marg, eh+marg)(""); + +%%% row 1 + +z21bm=(x32bl, lyc1); +drawcirclebox(21, 5/4diam)(btex \twolines{Serial}{No} etex); + +z41bm=(x32br, lyc1); +drawcirclebox(41, diam)(btex Year etex); + +%%%%%% lines + +%%% Name / manufacturer (15, 14) +drawnormal(15bm, 14tm); + +%%% Name / model (55, 54) +drawnormal(55bm, 54tm); + +%%% Mnf / has (14, 34) +drawnormal(14mr, 34ml); +label.top(btex 1 etex, 1/2[z14mr,z34ml]); + +%%% has/ model (34, 54) +drawnormal(34mr, 54ml); +label.top(btex N etex, 1/2[z34mr,z54ml]); + +%%% Mnf / makes (14, 13) +drawnormal(14bm, 13tm); +label.rt(btex 1 etex, 1/2[z14bm,z13tm]); + +%%% model / of (54, 53) +drawnormal(54bm, 53tm); +label.rt(btex 1 etex, 1/2[z54bm,z53tm]); + +%%% makes / car (13, 31) +drawnormal(13bm, 31ml); +z31A=(x31ml, y31ml+1/2marg); +z13U-z31A = z13bm-z31ml; +z13A = whatever[z13U,z31A] = whatever[z13bm,z13mr]; +draw z13A--z31A; +label.urt(btex N etex, 1/2[z13A,z31A]); + +%%% of / car (53, 31) +drawnormal(53bm, 31mr); +z31B=(x31mr, y31mr+1/2marg); +z53U - z31B = z53bm - z31mr; +z53B = whatever[z53U,z31B] = whatever[z53bm,z53ml]; +draw z53B--z31B; +label.ulft(btex N etex, 1/2[z53B,z31B]); + +%%% car / serial no (31, 21) +z31C=(x21tm, y31bl); +drawnormal(31C, 21tm); + +%%% car / year (31, 41) +z31D=(x41tm, y31br); +drawnormal(31D, 41tm); + +endfig; % end fig 10 + + +beginfig(11) % example 11 NIAM +%%%drawgrid; + +numeric diam; diam := 2onelineh; % circle diameter + +upshift := diam; +nextup := diam+upshift; + +numeric hel, vel; % length of horizontal and vertical box pairs +eh := onelineh; +hel = namespace(btex made by etex)(nextra); +vel = namespace(btex of prod etex)(nextra); + +numeric del, deh; % horizontal & vertical diameters of oval boxes +del := namespace(btex MANUFACTURER etex)(niextra); +deh := 2eh; + +numeric marg; marg := 2u; % margin for doubly enclosed oval boxes +numeric lmarg; lmarg := marg; % gap for short lines + +numeric dashel, dasheh; % diameters of dashed ellipses +dashel := del+2marg; +dasheh := deh+2marg; + +hspace1 := diam; + +%%% y coords +lyc1 := 0; +lyc2 := lyc1+nextup; +lyc3 := lyc2+nextup; + +%%% Zcol/row + +%%% row 3 + +x13ml=0; y13bm=lyc3; +drawovalbox(13, del, deh)(btex manufacturer etex); +z14=z13c; +drawdashellipse(14, dashel, dasheh); + +z23ml=(x14mr+hspace1, y14mr); +drawENT(23, hel, eh)(btex of etex); + +z33bl=z23br; +drawENT(33, hel, eh)(btex made by etex); + +z44ml=(x33mr+hspace1, y33mr); +drawdashellipse(44, dashel, dasheh); +z43=z44c; +drawovalbox(43, del, deh)(btex car model etex); + +z53ml=(x44mr+hspace1, y44mr); +drawdashcircle(53, diam); +label(btex year etex, z53c); + +%%% row 2 + +z22c=(x23bm,lyc2); +drawcirclebox(22, namespace(btex U etex)(2nextra))(btex U etex); + +x42tm=x43bm; y42ml=lyc2; +drawdoublerectangle(42, vel, 2eh, 1/2); +label(btex of etex, z42ct); +label(btex is of etex, z42cb); + +%%z52c=(x53x,lyc2); +x52tm=x53bm; y52ml=lyc2; +drawdoublerectangle(52, vel, 2eh, 1/2); +label(btex of prod etex, z52ct); +label(btex prod in etex, z52cb); + +%%% row 1 + +z11ml=(x13ml,lyc1); +drawdashellipse(11, del, deh); +label(btex serial no etex, z11c); + +z21ml=(x23ml,lyc1); +drawENT(21, hel, eh)(btex of etex); + +z31bl=z21br; +drawENT(31, hel, eh)(btex has etex); + +z41c=(x43c,lyc1); +drawcirclebox(41, diam)(btex car etex); + +%%%%%% lines + +%%% manufacturer / of (14, 23) +drawnormal(14mr, 23ml); + +%%% made by / car model (33, 44) +drawnormal(33mr, 44ml); +draw (x33tl, y33tl+lmarg)--(x33tr, y33tl+lmarg); +draw (x33mr, y33mr+lmarg)--(x33mr+eh, y33mr+lmarg); + +%%% serial no / of (11, 21) +drawnormal(11mr, 21ml); + +%%% of / of (23, 22, 21) +drawnormal(23bm, 22tm); drawnormal(22bm, 21tm); +label.rt(btex id etex, z22mr); + +%%% has / car (31, 41) +drawnormal(31mr, 41ml); +draw (x31tl, y31tl+lmarg)--(x31tr, y31tl+lmarg); +draw (x31mr, y31mr+lmarg)--(x33mr+eh, y31mr+lmarg); + +%%% model / of (44, 42) +drawnormal(43bm, 42tm); + +%%% is of / car (42, 41) +drawnormal(42bm, 41tm); +draw (x42tfr+lmarg, y42tfr)--(x42tfr+lmarg, y42br); +draw (x42bm+lmarg, y42bm)--(x42bm+lmarg, y42bm-eh); + +%%% year / of prod (53, 52) +drawnormal(53bm, 52tm); + +%%% prod in / car (52, 41) +VH(52bm,41mr); +drawnormalthree(52bm, 52bm.vh, 41mr); +draw (x52tfr+lmarg, y52tfr)--(x52tfr+lmarg, y52br); +draw (x52bm+lmarg, y52bm)--(x52bm+lmarg, y52bm-eh); + +endfig; % end fig 11 + +end + diff --git a/Master/texmf-dist/metapost/expressg/expressg.mp b/Master/texmf-dist/metapost/expressg/expressg.mp new file mode 100644 index 00000000000..01d50b134ce --- /dev/null +++ b/Master/texmf-dist/metapost/expressg/expressg.mp @@ -0,0 +1,1250 @@ +%% +%% This is file `expressg.mp', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% expressg.dtx (with options: `up') +%% +%% Author: Peter Wilson (CUA) now at peter.r.wilson@boeing.com until June 2004 +%% (or pandgwilson@earthlink.net) +%% Copyright 1996, 2003 Peter R. Wilson +%% +%% v1.0 1996/05/09 (first release) +%% v1.2 1999/11/15 +%% v1.3 2000/05/22 +%% v1.4 2000/07/10 +%% v1.5 2003/07/31 +%% v1.6 2004/02/29 +%% v1.61 2004/03/17 +%% +%% This work may be distributed and/or modified under the +%% conditions of the LaTeX Project Public License, either +%% version 1.3 of this license or (at your option) any +%% later version. +%% The latest version of the license is in +%% http://www.latex-project.org/lppl.txt +%% and version 1.3 or later is part of all distributions of +%% LaTeX version 2003/06/01 or later. +%% +%% This work has the LPPL maintenance status "author-maintained". +%% +%% This work consists of the files listed in the README file. +%% This program is provided under the terms of the +%% LaTeX Project Public License distributed from CTAN +%% archives in directory macros/latex/base/lppl.txt. +%% +%%% EXPRESSG.MP MetaPost macros for EXPRESS-G and other BLA diagrams +%%% version 1.5, 31 July 2003 +%%% version 1.6, 29 February 2004 +%%% version 1.61, 17 March 2004 + +show "expressg.mp version 1.61, 2004/03/17"; + +newinternal u; numeric u; +u := 1mm; + +newinternal maxx, maxy; +numeric maxx, maxy; +maxx := 159.5u; % smidgeon under 160mm for ISO +maxy := 210u; % 210mm for ISO + +newinternal defaultdotdiam, dotdiam; +numeric defaultdotdiam, dotdiam; +defaultdotdiam := 2u; +dotdiam := defaultdotdiam; + +newinternal normalpensize, thickpensize, thinpensize; +numeric normalpensize, thickpensize, thinpensize; +normalpensize := 0.5bp; +thickpensize := 1.5bp; +thinpensize := 0.25bp; +newinternal dotsscale; numeric dotsscale; +dotsscale := 2; + +newinternal normalpen, thickpen, thinpen, dotspen, dotpen; +pen normalpen, thickpen, thinpen, dotspen, dotpen; +normalpen := pencircle scaled normalpensize; % i.e. defaultpen; +thickpen := pencircle scaled thickpensize; +thinpen := pencircle scaled thinpensize; +dotspen := pencircle scaled (dotsscale*normalpensize); +dotpen := pencircle scaled dotdiam; + +newinternal defaultsmoothrad; +numeric smoothrad, defaultsmoothrad; +smoothrad := defaultsmoothrad := 2u; + +newinternal defaultdrumlid; +numeric drumlid, defaultdrumlid; +drumlid := defaultdrumlid := 0.2; + +%%% default length and base width for arrowheads and fanin +newinternal defaultgal, defaultgab, defaultgfl, defaultgfb; +numeric defaultgal, defaultgab, defaultgfl, defaultgfb; +defaultgal := defaultgfl := defaultdotdiam; +defaultgab := defaultgfb := defaultgal; + +%%% length and base width of arrowheads and fanins +newinternal gal, gab, gfl, gfb; +numeric gal, gab, gfl, gfb; +gal := defaultgal; +gab := defaultgab; +gfl := defaultgfl; +gfb := defaultgfb; + +newinternal onelineh; +numeric onelineh; +onelineh := 5u; + +%%% length, height & inset for simple data type boxes +newinternal sdtbl, sdtbh, sdtbs; +numeric sdtbl, sdtbh, sdtbs; +sdtbl := 22u; +sdtbh := onelineh; +sdtbs := 2u; + +%%% length, height & inset for EXPRESSION data type boxes +newinternal sdtbel, sdtbeh, sdtbes; +numeric sdtbel, sdtbeh, sdtbes; +sdtbel := 28u; +sdtbeh := sdtbh; sdtbes := sdtbs; + +%%% length, height & inset for GENERICENT data type boxes +newinternal sdtbgel, sdtbgeh, sdtbges; +numeric sdtbgel, sdtbgeh, sdtbges; +sdtbgel := 38u; +sdtbgeh := sdtbh; sdtbges := sdtbs; + +%%% average length of numeric page connector +newinternal pconl; +numeric pconl; % length of page connector (for e.g., 9,9 (9,9) ) +pconl:=15u; +%%% height of page connectors (one line) +newinternal pconh; +numeric pconh; +pconh := onelineh; + +%%% heights of entity, enum, select, type boxes (One text line) +newinternal enth, typeh; +numeric enth, typeh; +enth := onelineh; +typeh := onelineh; + +%%% height of interschema boxes (one text line, no rename), and (name + rename) +newinternal ish, isrh; +numeric ish, isrh; +ish := 2onelineh; +isrh := 3onelineh; + +%%% height of schema boxes (one text line) +newinternal schemah; +numeric schemah; +schemah := 2onelineh; + +%%% height and slope of event boxes +newinternal eventh, eventslope; +numeric eventh, eventslope; +eventh := onelineh; +eventslope := 0.25; + +%%% extra namespaces for boxed names +newinternal nextra, niextra; +numeric nextra, niextra; +nextra := 2u; +niextra := nextra+sdtbs; + +%%% extra namespace for attribute names +newinternal ndextra; +numeric ndextra; +ndextra := nextra+dotdiam; + +%%% calculates mid-point on a path like |_ (vertical, horizontal) +%%% final points are: z$, z$vh, z$$, where z$vh=(x$,y$$) +def VH(suffix $, $$) = + z$vh=(x$,y$$); +enddef; + +%%% Calculates mid-points on a path like |_ +%%% | (vertical, horizontal, vertical) +%%% final points are: z$, z$vhv, z$$vhv, z$$ +def VhV(suffix $, $$) = + y$$vhv=1/2[y$,y$$]; x$$vhv=x$$; + z$vhv=(x$,y$$vhv); +enddef; + +%%% Calculates mid-points on a path like -|_ (horizontal, vertical, horizontal) +%%% final points are: z$, z$hvh, z$$hvh, z$$ +def HvH(suffix $, $$) = + x$hvh=1/2[x$,x$$]; y$hvh=y$; + z$$hvh=(x$hvh,y$$); +enddef; + +%%% Calculates turning points on a U shaped path (vertical, horizontal, vertical) +%%% final points are: z$, z$vyv, z$$vyv, z$$ +def VyV(suffix $, @, $$) = + z$$vyv=(x$$,y@); + z$vyv =(x$, y@); +enddef; + +%%% Calculates corner points rotated U shaped path (horizontal, vertical, horizontal) +%%% final points are: z$, z$hxh, z$$hxh, z$$ +def HxH(suffix $, @, $$) = + z$$hxh=(x@,y$$); + z$hxh =(x@,y$); +enddef; + +%%% calculates length taken up by typesetting str, plus margin +def namespace(text str)(expr margin) = + (xpart lrcorner(str) - xpart llcorner(str) + margin) +enddef; + +def dashes = + dashed evenly +enddef; + +def dots = + dashed withdots +enddef; + +def dashedgrid(expr nx, ny, dist) = + save zg_, zg__, oldpen; + pair zg_[], zg__[]; + pen oldpen; oldpen = currentpen; + pickup thinpen; + for i = 0 upto nx: + zg_[i] = (i*dist, 0); zg_[i+1000] = (i*dist, ny*dist); + draw zg_[i]--zg_[i+1000] dashes; + label.bot(decimal(i), zg_[i]); + endfor + for i = 0 upto ny: + zg__[i] = (0, i*dist); zg__[i+1000] = (nx*dist, i*dist); + draw zg__[i]--zg__[i+1000] dashes; + label.lft(decimal(i), zg__[i]); + endfor + pickup oldpen; +enddef; + +%%% draw a 1cm spaced grid of 16(x) by 21(y) cms. (units are mm) +def drawgrid = + dashedgrid(16, 21, 10mm); +enddef; + +%%% calculates corner and midpoints of a rectangle, +%%% bottom left at $, length l, height h +def rectpoints(suffix $)(expr l, h) = + z$bl = z$; + z$tr = (x$+l, y$+h); + z$br = (x$tr, y$bl); + z$tl = (x$bl, y$tr); + z$ml = 1/2[z$bl, z$tl]; + z$mr = 1/2[z$br, z$tr]; + z$bm = 1/2[z$bl, z$br]; + z$tm = 1/2[z$tl, z$tr]; +enddef; + +%%% calculate corner, midpoints and center point of a rhomboid. +def rhompoints(suffix $)(expr l, h, s) = + save eshift; + numeric eshift; eshift = s*h; + z$bl = z$; + z$tr = (x$+l+eshift, y$+h); + z$br = (x$bl+l, y$bl); + z$tl = (x$bl+eshift, y$tr); + z$ml = 1/2[z$bl, z$tl]; + z$mr = 1/2[z$br, z$tr]; + z$bm = (1/2[x$ml,x$mr], y$bl); + z$tm = (x$bm, y$tr); +enddef; + +%%% calculate circumferential points on a circle +def circpoints(suffix $)(expr diam) = + save rad, sinrad, cosrad; + numeric rad, sinrad, cosrad; + rad = diam/2; + sinrad = rad*(sind 45); + cosrad = rad*(cosd 45); + z$c=z$; + z$ml=(x$c-rad, y$c); + z$mr=(x$c+rad, y$c); + z$bm=(x$c, y$c-rad); + z$tm=(x$c, y$c+rad); + z$tr=(x$c+cosrad, y$c+sinrad); + z$bl=(x$c-cosrad, y$c-sinrad); + z$br=(x$tr, y$bl); + z$tl=(x$bl, y$tr); +enddef; + +%%% circular arc join between two paths +tertiarydef p ~ q = + begingroup + c_ := fullcircle scaled 2smoothrad 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; + +%%% piecewise linear path between the given points +def sharply(text t) = % t is a list of pairs + hide(n_:=0; for z=t: z_[incr n_]:=z; endfor) + z_1 for k=2 upto n_: --z_[k] endfor +enddef; + +%%% piecewise linear path between the given points with smooth corners +def smoothly(text t) = % t is a list of pairs + hide(n_:=0; for z=t: z_[incr n_]:=z; endfor) + (z_1 for k=2 upto n_-1: --z_[k]) ~ (z_[k] endfor --z_[n_]) +enddef; + +%%% Draw an open circle at end of vector from $ to $$ +def drawO(suffix $, $$) = + begingroup + save v_, c_, l, p; + pair v_, c_; + numeric l; + path p; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (dotdiam/(2l))[z$$,z$]; + p := fullcircle scaled dotdiam shifted c_; + unfill p; + draw p; draw p; + endgroup +enddef; + +%%% Draw a closed circle at end of vector from $ to $$ +def drawD(suffix $, $$) = + begingroup + save v_, c_, l, p; + pair v_, c_; + numeric l; + path p; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (dotdiam/(2l))[z$$,z$]; + p := fullcircle scaled dotdiam shifted c_; + fill p; + endgroup +enddef; + +%%% draw an open arrowhead at end of vector from $ to $$ +def drawOA(suffix $, $$) = + begingroup + save v_, c_, v_u, c_t, c_b, l, hb, p; + pair v_, c_, v_u, c_t, c_b; + numeric l, hb; + path p; + hb := gab/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gal/(l))[z$$,z$]; % base of arrowhead + v_u := unitvector v_; + c_t := c_ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - c_ = c_ - c_t; + p = c_b--z$$--c_t--cycle; + unfill p; + draw p; draw p; + endgroup +enddef; + +%%% draw a closed arrowhead at end of vector from $ to $$ +def drawCA(suffix $, $$) = + begingroup + save v_, c_, v_u, c_t, c_b, l, hb, p; + pair v_, c_, v_u, c_t, c_b; + numeric l, hb; + path p; + hb := gab/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gal/(l))[z$$,z$]; % base of arrowhead + v_u := unitvector v_; + c_t := c_ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - c_ = c_ - c_t; + p = c_b--z$$--c_t--cycle; + filldraw p; + endgroup +enddef; + +%%% draw a simple arrowhead at end of vector from $ to $$ +def drawA(suffix $, $$) = + begingroup + save v_, c_, v_u, c_t, c_b, l, hb, p; + pair v_, c_, v_u, c_t, c_b; + numeric l, hb; + path p; + hb := gab/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gal/(l))[z$$,z$]; % base of arrowhead + v_u := unitvector v_; + c_t := c_ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - c_ = c_ - c_t; + p = c_b--z$$--c_t; + draw p; + endgroup +enddef; + +%%% draws a fanin at the end of the vector from $ to $$ +def drawF(suffix $, $$) = + begingroup + save v_, c_, v_u, c_t, c_b, l, hb, p; + pair v_, c_, v_u, c_t, c_b; + numeric l, hb; + path p; + hb := gfb/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gfl/(l))[z$$,z$]; % apex of fan + v_u := unitvector v_; + c_t := z$$ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - z$$ = z$$ - c_t; + p = c_b--c_--c_t; + draw p; + endgroup +enddef; + +%%% Draw a dotted line from $ to $$ +def drawdots(suffix $, $$) = + pickup dotspen; + draw z$--z$$ dots; + pickup normalpen; +enddef; + +%%% Draws the dotted line $--@--$$ +def drawdotsthree(suffix $, @, $$) = + pickup dotspen; + draw z$--z@--z$$ dots; + pickup normalpen; +enddef; + +%%% Draw the dotted line $--@--@@--$$ +def drawdotsfour(suffix $, @, @@, $$) = + pickup dotspen; + draw z$--z@--z@@--z$$ dots; + pickup normalpen; +enddef; + +%%% Draw a dotted line from $ to $$ with open circle at $$ +def drawdotsO(suffix $, $$) = + pickup dotspen; + draw z$--z$$ dots; + pickup normalpen; + drawO($, $$); +enddef; + +%%% Draws the dotted line $--@--$$ +def drawdotsthreeO(suffix $, @, $$) = + pickup dotspen; + draw z$--z@--z$$ dots; + pickup normalpen; + drawO(@, $$); +enddef; + +%%% Draw the dotted line $--@--@@--$$ +def drawdotsfourO(suffix $, @, @@, $$) = + pickup dotspen; + draw z$--z@--z@@--z$$ dots; + pickup normalpen; + drawO(@@, $$); +enddef; + +%%% Draw the dotted line from $ to $$, ending in circles diameter dotdiam at $ and $$ +def drawdotsOO(suffix $, $$) = + pickup dotspen; + draw z$--z$$ dots; + pickup normalpen; + drawO($, $$); drawO($$, $); +enddef; + +%%% draws a dashed line from $ to $$ +def drawdash(suffix $, $$) = + draw z$--z$$ dashes; +enddef; + +%%% draws the dashed line $--@--$$ +def drawdashthree(suffix $, @, $$) = + draw z$--z@--z$$ dashes; +enddef; + +%%% draws the dashed line $--@--@@--$$ +def drawdashfour(suffix $, @, @@, $$) = + draw z$--z@--z@@--z$$ dashes; +enddef; + +%%% draws a dashed line from $ to $$, ending in a circle diameter dotdiam at $$ +def drawdashO(suffix $, $$) = + draw z$--z$$ dashes; + drawO($, $$); +enddef; + +%%% draws the dashed line $--@--$$ with circle at $$ +def drawdashthreeO(suffix $, @, $$) = + draw z$--z@--z$$ dashes; + drawO(@, $$); +enddef; + +%%% draws the dashed line $--@--@@--$$ with circle at $$ +def drawdashfourO(suffix $, @, @@, $$) = + draw z$--z@--z@@--z$$ dashes; + drawO(@@, $$); +enddef; + +%%% draws a dashed line from $ to $$, ending in circles diameter dotdiam at $ and $$ +def drawdashOO(suffix $, $$) = + draw z$--z$$ dashes; + drawO($, $$); drawO($$, $); +enddef; + +%%% draws a normal line from $ to $$. +def drawnormal(suffix $, $$) = + draw z$--z$$; +enddef; + +%%% draws the normal line $--@--$$ +def drawnormalthree(suffix $, @, $$) = + draw z$--z@--z$$; +enddef; + +%%% draws the normal line $--@--@@--$$ +def drawnormalfour(suffix $, @, @@, $$) = + draw z$--z@--z@@--z$$; +enddef; + +%%% draws a normal line from $ to $$, ending in a circle diameter dotdiam at $$ +def drawnormalO(suffix $, $$) = + draw z$--z$$; + drawO($, $$); +enddef; + +%%% draws the normal line $--@--$$, ending in a circle at $$ +def drawnormalthreeO(suffix $, @, $$) = + draw z$--z@--z$$; + drawO(@, $$); +enddef; + +%%% draws the line $--@--@@--$$, ending in a circle at $$ +def drawnormalfourO(suffix $, @, @@, $$) = + draw z$--z@--z@@--z$$; + drawO(@@, $$); +enddef; + +%%% draws a normal line from $ to $$, ending in circles diameter dotdiam at $ and $$ +def drawnormalOO(suffix $, $$) = + draw z$--z$$; + drawO($, $$); drawO($$, $); +enddef; + +%%% draws a normal line from $ to $$, ending in a dot diameter dotdiam at $$ +def drawnormalD(suffix $, $$) = + draw z$--z$$; + drawD($, $$); +enddef; + +%%% draws the normal line $--@--$$, ending in a dot at $$ +def drawnormalthreeD(suffix $, @, $$) = + draw z$--z@--z$$; + drawD(@, $$); +enddef; + +%%% draws the normal line $--@--@@--$$, ending in a dot at $$ +def drawnormalfourD(suffix $, @, @@, $$) = + draw z$--z@--z@@--z$$; + drawD(@@, $$); +enddef; + +%%% draws a normal line from $ to $$, ending in dots diameter dotdiam at $ and $$ +def drawnormalDD(suffix $, $$) = + draw z$--z$$; + drawD($, $$); drawD($$, $); +enddef; + +%%% draws a normal line from $ to $$, ending with an open arrowhead at $$ +def drawnormalOA(suffix $, $$) = + draw z$--z$$; + drawOA($, $$); +enddef; + +%%% draws a normal line from $ to $$, ending with a closed arrowhead at $$ +def drawnormalCA(suffix $, $$) = + draw z$--z$$; + drawCA($, $$); +enddef; + +%%% draws the normal line $--@--$$, ending in a black arrowhead at $$ +def drawnormalthreeCA(suffix $, @, $$) = + draw z$--z@--z$$; + drawCA(@, $$); +enddef; + +%%% draws the normal line $--@--@@--$$, ending in a black arrowhead at $$ +def drawnormalfourCA(suffix $, @, @@, $$) = + draw z$--z@--z@@--z$$; + drawCA(@@, $$); +enddef; + +%%% draws a normal line from $ to $$, ending with a fanin at $$ +def drawnormalF(suffix $, $$) = + draw z$--z$$; + drawF($, $$); +enddef; + +%%% draws a normal line from $ to $$, with a fanin at $ and an open circle at $$ +def drawnormalFO(suffix $, $$) = + draw z$--z$$; + drawO($, $$); drawF($$, $); +enddef; + +%%% draws a thick line from $ to $$. +def drawthick(suffix $, $$) = + pickup thickpen; + draw z$--z$$; + pickup normalpen; +enddef; + +%%% draws a thick line from $ to $$, ending in a circle diameter dotdiam at $$ +def drawthickO(suffix $, $$) = + pickup thickpen; + draw z$--z$$; + drawO($, $$); + pickup normalpen; +enddef; + +%%% draws a thick line from $ to $$, ending in circles diameter dotdiam at $ and $$ +def drawthickOO(suffix $, $$) = + pickup thickpen; + draw z$--z$$; + drawO($, $$); drawO($$, $); + pickup normalpen; +enddef; + +%%% replaces the sharp corner on $--@--$$ with a circular arc radius smoothrad +def smooth(suffix $, @, $$) = + begingroup + save v_, c_, l, p; + pair v_, v_', c_, c_'; + path p; + v_ := z@-z$; + l := (xpart v_)++(ypart v_); % length of $--@ + c_ := (smoothrad/l)[z@,z$]; % start of arc on $--@ + v_' := z$$-z@; + l := (xpart v_')++(ypart v_'); % length of @--$$ + c_' := (smoothrad/l)[z@,z$$]; % end of arc on @--$$ + undraw c_--z@--c_'; % blank original join + draw c_{v_}..{v_'}c_'; % draw the arc + endgroup +enddef; + +%%% replaces the sharp corners on $--@--@@--$$ with a circular arc radius smoothrad +def smoothtwo(suffix $, @, @@, $$) = + smooth($, @, @@); smooth(@, @@, $$); +enddef; + +%%% replaces the sharp corner on the dashed lines $--@--$$ +%%% with a circular arc radius smoothrad +def smoothdash(suffix $, @, $$) = + begingroup + save v_, c_, l, p; + pair v_, v_', c_, c_'; + path p; + v_ := z@-z$; + l := (xpart v_)++(ypart v_); % length of $--@ + c_ := (smoothrad/l)[z@,z$]; % start of arc on $--@ + v_' := z$$-z@; + l := (xpart v_')++(ypart v_'); % length of @--$$ + c_' := (smoothrad/l)[z@,z$$]; % end of arc on @--$$ + undraw c_--z@--c_'; % blank original join + draw c_{v_}..{v_'}c_' dashes; % draw the dashed arc + endgroup +enddef; + +%%% replaces the sharp corner on the dotted line $--@--$$ +%%% with a circular arc radius smoothrad +def smoothdots(suffix $, @, $$) = + begingroup + save oldpen; + pen oldpen; oldpen := currentpen; + save v_, c_, l, p; + pair v_, v_', c_, c_'; + path p; + v_ := z@-z$; + l := (xpart v_)++(ypart v_); % length of $--@ + c_ := (smoothrad/l)[z@,z$]; % start of arc on $--@ + v_' := z$$-z@; + l := (xpart v_')++(ypart v_'); % length of @--$$ + c_' := (smoothrad/l)[z@,z$$]; % end of arc on @--$$ + undraw c_--z@--c_'; % blank original join + pickup dotspen; + draw c_{v_}..{v_'}c_' dots; % draw the dotted arc + pickup oldpen; + endgroup +enddef; + +%%% draws a schema box, bottom left at $, length l, height h +def drawSCHEMA(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + x$c = 1/2[x$ml, x$mr]; + y$c = 1/2[y$ml, y$tl]; + draw z$bl--z$br--z$tr--z$tl--cycle; % outer box + draw z$ml--z$mr; % dividing line + label(str, z$c); +enddef; + +def drawSDT(suffix $)(text str) = + rectpoints($, sdtbl, sdtbh); + z$ti = (x$tr-sdtbs, y$tr); + z$bi = (x$ti, y$br); + z$c = 1/2[z$bl,z$ti]; + draw z$bl--z$br--z$tr--z$tl--cycle; + draw z$bi--z$ti; + label(str, z$c); +enddef; + +def drawASDT(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + z$ti = (x$tr-sdtbs, y$tr); + z$bi = (x$ti, y$br); + z$c = 1/2[z$bl,z$ti]; + draw z$bl--z$br--z$tr--z$tl--cycle; + draw z$bi--z$ti; + label(str, z$c); +enddef; + +def drawBINARY(suffix $) = drawASDT($)(sdtbl, sdtbh)("BINARY"); + enddef; +def drawBOOLEAN(suffix $) = drawASDT($)(sdtbl, sdtbh)("BOOLEAN"); + enddef; +def drawCOMPLEX(suffix $) = drawASDT($)(sdtbl, sdtbh)("COMPLEX"); + enddef; +def drawEXPRESSION(suffix $) = drawASDT($)(sdtbel, sdtbeh)("EXPRESSION"); + enddef; +def drawGENERIC(suffix $) = drawASDT($)(sdtbl, sdtbh)("GENERIC"); + enddef; +def drawINTEGER(suffix $) = drawASDT($)(sdtbl, sdtbh)("INTEGER"); + enddef; +def drawLOGICAL(suffix $) = drawASDT($)(sdtbl, sdtbh)("LOGICAL"); + enddef; +def drawNUMBER(suffix $) = drawASDT($)(sdtbl, sdtbh)("NUMBER"); + enddef; +def drawREAL(suffix $) = drawASDT($)(sdtbl, sdtbh)("REAL"); + enddef; +def drawSTRING(suffix $) = drawASDT($)(sdtbl, sdtbh)("STRING"); + enddef; + +%%% draw an enumeration type box, bottom left at $, length l, height h +def drawENUM(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + z$ti = (x$tr-sdtbs, y$tr); + z$bi = (x$ti, y$br); + z$c = 1/2[z$bl,z$ti]; + draw z$bl--z$br--z$tr--z$tl--cycle dashes; + draw z$bi--z$ti dashes; + label(str, z$c); +enddef; + +%%% draw a select type box, bottom left at $, length l, height h +def drawSELECT(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + z$ti = (x$tl+sdtbs, y$tl); + z$bi = (x$ti, y$bl); + z$c = 1/2[z$br,z$ti]; + draw z$bl--z$br--z$tr--z$tl--cycle dashes; + draw z$bi--z$ti dashes; + label(str, z$c); +enddef; + +%%% draw a simple user defined TYPE box, bottom left at $, length l, height h +def drawTYPE(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + z$c = 1/2[z$bl,z$tr]; + draw z$bl--z$br--z$tr--z$tl--cycle dashes; + label(str, z$c); +enddef; + +%%% draw an entity box, bottom left at $, length l, height h +def drawENT(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + z$c = 1/2[z$bl,z$tr]; + draw z$bl--z$br--z$tr--z$tl--cycle; + label(str, z$c); +enddef; + +def drawOB(suffix $)(expr l, h) = + save rad; + numeric rad; rad := h/2; + rectpoints($, l, h); + z$cl = 1/2[z$bl, z$tl]; + z$cr = 1/2[z$br, z$tr]; + z$bli = (x$bl+rad, y$bl); + z$tli = (x$bli, y$tl); + z$bri = (x$br-rad, y$br); + z$tri = (x$bri, y$tr); + z$c = 1/2[z$bl,z$tr]; + draw z$bli--z$bri..z$cr..z$tri--z$tli..z$cl..cycle; +enddef; + +%%% draw a page reference box oval, bottom left at $, length l, height h +def drawPREF(suffix $)(expr l, h)(text str) = + drawOB($, l, h); + label(str, z$c); +enddef; + +%%% draw an interschema USE box, bottom left at $, length l, height h +def drawISU(suffix $)(expr l, h)(text str) = + save quarter; + numeric quarter; quarter := h/4; + rectpoints($, l, h); + z$o = (x$, y$+quarter); + drawOB($o, l, 2quarter); + z$c = 1/2[z$bl,z$tr]; + label(str, z$c); + draw z$bl--z$br--z$tr--z$tl--cycle; +enddef; + +%%% draw an interschema USE RENAME box, bottom left at $, length l, height h +def drawISUR(suffix $)(expr l, h)(text str, rname) = + save third; + numeric third; third := h/3; + rectpoints($, l, h); + z$o = (x$, y$+third); + drawOB($o, l, third); + z$c = 1/2[z$bl, z$tr]; + label(str, z$c); + z$rnm = 1/2[z$bl,(x$br,y$br+third)]; + draw z$bl--z$br--z$tr--z$tl--cycle; + label(rname, z$rnm); +enddef; + +%%% draw an interschema REFERENCE box, bottom left at $, length l, height h +def drawISR(suffix $)(expr l, h)(text str) = + save quarter; + numeric quarter; quarter := h/4; + rectpoints($, l, h); + z$o = (x$, y$+quarter); + drawOB($o, l, 2quarter); + z$c = 1/2[z$bl,z$tr]; + label(str, z$c); + draw z$bl--z$br--z$tr--z$tl--cycle dashes; +enddef; + +%%% draw an interschema REFERENCE RENAME box, bottom left at $, length l, height h +def drawISRR(suffix $)(expr l, h)(text str, rname) = + save third; + numeric third; third := h/3; + rectpoints($, l, h); + z$o = (x$, y$+third); + drawOB($o, l, third); + z$c = 1/2[z$bl,z$tr]; + label(str, z$c); + z$rnm = 1/2[z$bl,(x$br,y$br+third)]; + draw z$bl--z$br--z$tr--z$tl--cycle dashes; + label(rname, z$rnm); +enddef; + +%%% draw a Local EVENT box, bottom left at $, length l, height h +def drawLEVENT(suffix $)(expr l, h)(text str) = + rhompoints($, l, h, eventslope); + z$c = 1/2[z$ml,z$mr]; + draw z$bl--z$br--z$tr--z$tl--cycle; + label(str, z$c); +enddef; + +%%% draw a Global EVENT box, bottom left at $, length l, height h +def drawGEVENT(suffix $)(expr l, h)(text str) = + rhompoints($, l, h, eventslope); + z$c = 1/2[z$ml,z$mr]; + pickup thickpen; + draw z$bl--z$br--z$tr--z$tl--cycle; + pickup normalpen; + label(str, z$c); +enddef; + +%%% draw a circled name, diameter diam centered at $ +def drawcirclebox(suffix $)(expr diam)(text str) = + circpoints($, diam); + draw z$bl..z$bm..z$br..z$mr..z$tr..z$tm..z$tl..z$ml..cycle; + label(str, z$c); +enddef; + +%%% length and base width of diamond line end styles +newinternal gdl, gdb; +numeric gdl, gdb; +gdl := 2defaultgal; +gdb := 0.75defaultgab; + +def ellipsepoints(suffix $)(expr l, h) = + save epp, move; + path epp; + pair move; + z$ml=(x$-l/2, y$); z$mr=(x$ml+l,y$); + z$tm=(x$, y$+h/2); z$bm=(x$, y$tm-h); + move = 1/2[z$ml,z$mr]; + epp = fullcircle scaled h xscaled (l/h) shifted move; + z$tr = point 1.2 of epp; + z$tl = point 2.8 of epp; + z$bl = point 5.2 of epp; + z$br = point 6.8 of epp; +enddef; + +%%% draws double closed arrowheads at end of vector from $ to $$ +def drawDCA(suffix $, $$) = + begingroup + save v_, c_, v_u, c_t, c_b, l, hb, p; + pair v_, c_, v_u, c_t, c_b; + path p[]; + numeric l, hb; + hb := gab/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gal/(l))[z$$,z$]; % base of arrowhead + v_u := unitvector v_; + c_t := c_ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - c_ = c_ - c_t; + p1 := c_b--z$$--c_t--cycle; + filldraw p1; + p2 := p1 shifted ((xpart c_ - x$$), (ypart c_ - y$$)); + filldraw p2; + endgroup +enddef; + +%%% draws an open diamond at end of vector from $ to $$ +def drawOD(suffix $, $$) = + begingroup + save v_, c_, c__, v_u, c_t, c_b, l, hb, p; + pair v_, c_, c__, v_u, c_t, c_b; + numeric l, hb; + path p; + hb := gdb/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gdl/(2l))[z$$,z$]; % base of diamond + c__ := (gdl/(l))[z$$,z$]; % interior tip of diamond + v_u := unitvector v_; + c_t := c_ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - c_ = c_ - c_t; + p = c_b--z$$--c_t--c__--cycle; + unfill p; + draw p; draw p; + endgroup +enddef; + +%%% draws a closed diamond at end of vector from $ to $$ +def drawCD(suffix $, $$) = + begingroup + save v_, c_, c__, v_u, c_t, c_b, l, hb, p; + pair v_, c_, c__, v_u, c_t, c_b; + numeric l, hb; + path p; + hb := gdb/2; + v_ := z$-z$$; + l := (xpart v_)++(ypart v_); % length of the line + c_ := (gdl/(2l))[z$$,z$]; % base of diamond + c__ := (gdl/(l))[z$$,z$]; % interior tip of diamond + v_u := unitvector v_; + c_t := c_ shifted (-hb*(ypart v_u), hb*(xpart v_u)); + c_b - c_ = c_ - c_t; + p = c_b--z$$--c_t--c__--cycle; + filldraw p; + endgroup +enddef; + +%%% draws a dashed line from $ to $$, ending with an arrowhead at $$ +def drawdashA(suffix $, $$) = + draw z$--z$$ dashes; + drawA($, $$); +enddef; + +%%% draws a dashed line from $ to $$, ending with an open arrowhead at $$ +def drawdashOA(suffix $, $$) = + draw z$--z$$ dashes; + drawOA($, $$); +enddef; + +%%% draws a normal line from $ to $$, ending with double closed arrowheads at $$ +def drawnormalDCA(suffix $, $$) = + draw z$--z$$; + drawDCA($, $$); +enddef; + +%%% draws a normal line from $ to $$, ending with an open diamond at $$ +def drawnormalOD(suffix $, $$) = + draw z$--z$$; + drawOD($, $$); +enddef; + +%%% draws a normal line from $ to $$, ending with a closed diamond at $$ +def drawnormalCD(suffix $, $$) = + draw z$--z$$; + drawCD($, $$); +enddef; + +%%% draws an open dashed circle, center z$, diameter diam +def drawdashcircle(suffix $)(expr diam) = + circpoints($, diam); + draw z$bl..z$bm..z$br..z$mr..z$tr..z$tm..z$tl..z$ml..cycle dashes; +enddef; + +%%% draws an open circle, center z$, diameter diam, with an arrow at the top +def drawcircleA(suffix $)(expr diam) = + circpoints($, diam); + begingroup + save c_, c_t, c_b, hb; + pair c_, c_t, c_b; + numeric hb; + hb := gab/2; + c_ := z$tm shifted (gal*right); % base of arrowhead + c_t := c_ shifted (hb*up); + c_b := c_ shifted (hb*down); + draw z$bl..z$bm..z$br..z$mr..z$tr..z$tm..z$tl..z$ml..cycle; + draw c_t--z$tm--c_b; + endgroup +enddef; + +%%% draws black dot, center z$, diameter diam +def drawDot(suffix $)(expr diam) = + begingroup + save p; + path p; + p := fullcircle scaled diam shifted z$; + filldraw p; + endgroup +enddef; + +%%% draws black dot surrounded by a circle, center z$, diameter diam +def drawCircledDot(suffix $)(expr diam) = + begingroup + save l_, p; + numeric l_; + path p[]; + l_ := 5/7diam; + p1 := fullcircle scaled diam shifted z$; + unfill p1; + draw p1; + p2 := fullcircle scaled l_ shifted z$; + filldraw p2; + endgroup +enddef; + +def drawcardbox(suffix $)(expr l, h, m)(text str) = + rectpoints($, l, h); + begingroup + save c; + pair c[]; + c1 = (x$tr-m, y$tr); + c3 = (x$tr, y$tr-m); + c2 = (xpart c1, ypart c3); + draw z$bl--z$br--c3--c1--z$tl--cycle; + draw c1--c2--c3; + endgroup; + z$c = 1/2[z$ml,z$mr]; + label(str, z$c); +enddef; + +def drawdiamondbox(suffix $)(expr l, h)(text str) = + z$ml=(x$-l/2, y$); z$tm=(x$, y$+h/2); + z$mr=(x$ml+l, y$); z$bm=(x$, y$tm-h); + z$bl=1/2[z$ml,z$bm]; + z$br=1/2[z$bm,z$mr]; + z$tr=1/2[z$mr,z$tm]; + z$tl=1/2[z$tm,z$ml]; + z$c=z$; + draw z$ml--z$bm--z$mr--z$tm--cycle; + label(str, z$c); +enddef; + +def drawtwodiamondbox(suffix $)(expr l, h, mrg)(text str) = + z$ml=(x$-l/2, y$); z$tm=(x$, y$+h/2); + z$mr=(x$ml+l, y$); z$bm=(x$, y$tm-h); + z$bl=1/2[z$ml,z$bm]; + z$br=1/2[z$bm,z$mr]; + z$tr=1/2[z$mr,z$tm]; + z$tl=1/2[z$tm,z$ml]; + z$c=z$; + begingroup + save v_, p, tl, sf; + pair v_; + numeric tl, sf; + path p[]; + p1 = z$ml--z$bm--z$mr--z$tm--cycle; + draw p1; + v_ := z$c-z$tr; + tl := (xpart v_)++(ypart v_); + sf = 1.0 - mrg/tl; + p2 = p1 shifted -z$c scaled sf shifted z$c; + draw p2; + endgroup; + label(str, z$c); + +enddef; + +def drawdoublerectangle(suffix $)(expr l, h, tf) = + rectpoints($, l, h); + z$tfl=tf[z$tl,z$bl]; z$tfr=tf[z$tr,z$br]; + z$cb=1/2[z$bl,z$tfr]; + z$ct=1/2[z$tfl,z$tr]; + draw z$bl--z$br--z$tr--z$tl--cycle; + draw z$tfl--z$tfr; +enddef; + +def drawtriplerectangle(suffix $)(expr l, h, tf, bf) = + rectpoints($, l, h); + z$tfl=tf[z$tl,z$bl]; z$tfr=tf[z$tr,z$br]; + z$bfl=bf[z$bl,z$tl]; z$bfr=bf[z$br,z$tr]; + z$cb=1/2[z$bl,z$bfr]; + z$cm=1/2[z$bfl,z$tfr]; + z$ct=1/2[z$tfl,z$tr]; + draw z$bl--z$br--z$tr--z$tl--cycle; + draw z$bfl--z$bfr; + draw z$tfl--z$tfr; +enddef; + +def hiderectangle(suffix $)(expr l, h) = + begingroup + save c; + pair c[]; + c1=(x$,y$); + c2=c1+(l,0); + c3=c1+(l,h); + c4=c1+(0,h); + unfilldraw c1--c2--c3--c4--cycle; + endgroup +enddef; + +def drawdashboxover(suffix $)(expr l, h) = + rectpoints($, l, h); + hiderectangle($, l, h); + z$c = 1/2[z$bl,z$tr]; + draw z$bl--z$br--z$tr--z$tl--cycle dashes; +enddef; + +def drawindexbox(suffix $)(expr l, h, lp, hp)(text str) = + rectpoints($, l, h); + z$c = 1/2[z$bl,z$tr]; + z$P = z$tl; + rectpoints($P, lp, hp); + z$P.c = 1/2[z$P.bl, z$P.tr]; + draw z$bl--z$br--z$tr--z$tl--cycle; + draw z$P.bl--z$P.br--z$P.tr--z$P.tl--cycle; + label(str, z$P.c); +enddef; + +def drawroundedbox(suffix $)(expr l, h, r)(text str) = + rectpoints($, l, h); + begingroup + save rad; + numeric rad; rad := r; + if rad > l/2: + rad := l/2; + fi + if rad > h/2: + rad := h/2; + fi + draw (x$br-rad, y$br){right}..{up}(x$br, y$br+rad)-- + (x$tr, y$tr-rad){up}..{left}(x$tr-rad, y$tr)-- + (x$tl+rad, y$tl){left}..{down}(x$tl, y$tl-rad)-- + (x$bl, y$bl+rad){down}..{right}(x$bl+rad, y$bl)--cycle; + endgroup; + z$c = 1/2[z$bl,z$tr]; + label(str, z$c); +enddef; + +def drawovalbox(suffix $)(expr l, h)(text str) = + ellipsepoints($, l, h); + z$c = 1/2[z$ml,z$mr]; + begingroup + save p; + path p; + p = fullcircle scaled h xscaled (l/h) shifted z$c; + draw p; + endgroup; + label(str, z$c); +enddef; + +def drawdashellipse(suffix $)(expr l, h) = + ellipsepoints($, l, h); + z$c = 1/2[z$ml,z$mr]; + begingroup + save p; + path p; + p = fullcircle scaled h xscaled (l/h) shifted z$c; + draw p dashes; + endgroup +enddef; + +def drawdrum(suffix $)(expr l, h)(text str) = + save vdia; numeric vdia; + vdia := drumlid*l; % ellipse vertical diameter + save pf, ph; path pf, ph; % full & half ellipse paths + + % points on the basic rectangle + z$bl = z$; + z$tr = (x$+l, y$+h); + z$br = (x$tr, y$); + z$tl = (x$, y$tr); + z$ml = 1/2[z$bl,z$tl]; + z$mr = 1/2[z$br,z$tr]; + z$tc = 1/2[z$tl,z$tr]; % center of top rectangle line + z$bc = 1/2[z$bl,z$br]; + % draw box sides + draw z$tl--z$bl; draw z$tr--z$br; + + % points on top ellipse + z$T''' = z$tc; % ellipse center + ellipsepoints($T''', l, vdia); + z$tm = z$T'''.tm; + z$tml = z$T'''.tl; + z$tmr = z$T'''.tr; + + % points on bottom ellipse + z$B''' = z$bc; + ellipsepoints($B''', l, vdia); + z$bm = z$B'''.bm; + z$bml = z$B'''.bl; + z$bmr = z$B'''.br; + + % box center point + z$c = 1/2[z$T'''.bm, z$B'''.bm]; + + % draw top ellipse + pf = fullcircle scaled vdia xscaled (l/vdia) shifted z$T'''; + draw pf; + % draw bottom half ellipse + ph = (halfcircle rotated 180) scaled vdia xscaled (l/vdia) shifted z$B'''; + draw ph; + label(str, z$c); +enddef; + +def drawoutputbox(suffix $)(expr l, h)(text str) = + rectpoints($, l, h); + begingroup + save c; + pair c[]; + c1 = (x$br, y$br+1/8h); % right side of box is shorter + c2 = (x$bm, y$bm+1/16h); + % draw the tear + draw z$bl..c2{dir 45}..c1{dir -15}--z$tr--z$tl--cycle; + endgroup; + z$c = (x$bm, 1/2(y$bm+y$tm)); + label(str, z$c); +enddef; + +\def drawstickman(suffix $)(expr l, h) = + rectpoints($,l,h); + begingroup + save c; + pair c[]; + c1 = 8/24[z$bm,z$tm]; + c2 = 15/24[z$bm,z$tm]; + c3 = 18/24[z$bm,z$tm]; + c4 = 1/2[c3,z$tm]; + c6 = (x$bl, ypart(c2)); + c7 = (x$br, ypart(c2)); + draw z$bl--c1--z$br; % legs + draw c1--c3; % body + draw c6--c7; % arms + draw c3{right}..z$tm{left}..cycle; % head + endgroup; +enddef; + diff --git a/Master/texmf-dist/metapost/exteps/exteps.mp b/Master/texmf-dist/metapost/exteps/exteps.mp new file mode 100644 index 00000000000..0ec3626f26b --- /dev/null +++ b/Master/texmf-dist/metapost/exteps/exteps.mp @@ -0,0 +1,176 @@ +% Copyright 2005 by Palle Jørgensen +% +% This file is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 2 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, but +% WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +% General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 59 Temple Place - Suite 330, Boston, +% MA 02111-1307, USA. +% +% This is version 0.1 Wed Aug 10 2005 +% +% The module is documentet in exteps.pdf + +picture epspicture; + +%% String handling tool +string string_split[]; +def splitstring expr S = + begingroup + save __splitctr; numeric __splitctr; __splitctr = 0; + save __prevchar; string __prevchar, __currentchar; __prevchar = " "; + for i = 0 upto infinity: + __currentchar := substring(i, i+1) of S; + if (__currentchar = " ") and (__prevchar = " "): + relax; + elseif (__currentchar <> " ") and (__prevchar = " "): + string_split[__splitctr] := __currentchar; + elseif (__currentchar <> " ") and (__prevchar <> " "): + string_split[__splitctr] := string_split[__splitctr] & __currentchar; + elseif (__currentchar = " ") and (__prevchar <> " "): + __splitctr := __splitctr+1; + fi + __prevchar := __currentchar; + endfor + endgroup; +enddef; +%% End string handling tool + +def begineps text F = + begingroup; + save file; string file; file = F; + save angle; numeric angle; angle = 0; + save clip; boolean clip; clip = false; + save scale; pair scale; scale = (1,1); + save base; pair base; base = origin; + save __bbxfound; boolean __bbxfound; __bbxfound = false; + save grid; boolean grid; grid = false; + save gridstep; numeric gridstep; gridstep = 10; + save __base; pair __base; + save __eps__currentline; string __eps__currentline; + save __bbxline; string __bbxline; + save llx, lly, urx, ury; numeric llx, lly, urx, ury; + save pct; numeric pct; + save width; numeric width; + save height; numeric height; +%% Finding the bounding box + forever: + __eps__currentline := readfrom F; + if substring(0,14) of __eps__currentline = "%%BoundingBox:": + __bbxline := substring(14, infinity) of __eps__currentline; + __bbxfound := true; + splitstring __bbxline; + llx = scantokens string_split[0]; + lly = scantokens string_split[1]; + urx = scantokens string_split[2]; + ury = scantokens string_split[3]; + fi + exitif __bbxfound; + endfor + closefrom F; + __base = -(llx,lly); + pct = (urx - llx)/100; +%% To ensure the right bounding box of the output file +%% a picture with the same size as the eps figure is added. + epspicture := nullpicture; + setbounds epspicture to ((0,0)--(0,ury-lly)--(urx-llx,ury-lly)--(urx-llx,0)--cycle); +enddef; + +def endeps = +%% Drawing the grid + if grid: + for i = 0 step gridstep*pct until (urx - llx): + epsdraw (i,0)--(i,ury - lly); + epslabel.bot(((decimal.(i/pct) & "%") infont defaultfont) rotated -90, (i,0)); + endfor + for i = 0 step gridstep*pct until (epsilon + ury - lly): + epsdraw (0,i)--(urx - llx,i); + epslabel.lft(((decimal.(i/pct) & "%") infont defaultfont), (0,i)); + endfor + fi +%% Calculating scale if width and/or height is known + if (known width) and (known height): + scale := (width/(urx - llx),height/(ury - lly)); + elseif known width: + scale := (width/(urx - llx),width/(urx - llx)); + elseif known height: + scale := (height/(ury - lly),height/(ury - lly)); + fi +%% The graphics inclusion commands + special "gsave"; + if base <> origin: + special decimal.xpart.base & " " & decimal.ypart.base & " translate"; + fi + if scale <> (1,1): + special decimal xpart.scale & " " & decimal ypart.scale & " scale"; + fi + if angle <> 0: + special decimal angle & " rotate"; + epspicture := epspicture rotatedaround(origin)(angle); + fi + if __base <> origin: + special decimal.xpart.__base & " " & decimal.ypart.__base & " translate"; + fi + if scale <> (1,1): + epspicture := epspicture scaled xpart.scale + if xpart.scale <> ypart.scale: + yscaled (ypart.scale/xpart.scale) + fi; + fi + if clip: + special "newpath "; + special decimal llx & " " & decimal lly & " moveto"; + special decimal llx & " " & decimal ury & " lineto"; + special decimal urx & " " & decimal ury & " lineto"; + special decimal urx & " " & decimal lly & " lineto"; + special decimal llx & " " & decimal lly & " lineto"; + special "closepath clip"; + fi + special "%%BeginDocument: " & file; + forever: + __eps__currentline := readfrom file; + exitunless __eps__currentline <> EOF; + special __eps__currentline; + endfor + special "%%EndDocument: " & file; + special "grestore"; + closefrom file; + if base <> (0,0): + epspicture := epspicture shifted base; + fi + addto currentpicture also epspicture; +endgroup; +enddef; + +%% Special drawing commands +def epsfill expr c = addto epspicture contour c _op_ enddef; + +def epsdraw expr p = + addto epspicture + if picture p: + also p + else: + doublepath p withpen currentpen + fi + _op_ +enddef; + +def epsfilldraw expr c = + addto epspicture contour c withpen currentpen + _op_ enddef; + +def epsdrawdot expr z = + addto epspicture contour makepath currentpen shifted z + _op_ enddef; + +def epslabel = epsdraw thelabel enddef; + +endinput diff --git a/Master/texmf-dist/metapost/featpost/featpost.mp b/Master/texmf-dist/metapost/featpost/featpost.mp new file mode 100644 index 00000000000..9c30b765fed --- /dev/null +++ b/Master/texmf-dist/metapost/featpost/featpost.mp @@ -0,0 +1,36 @@ +% featpost.mp +% L. Nobre G. +% 2005 +% +% Use "export TEX=latex" in your .bashrc. +% Begin by pre-compiling this set of macros with "inimpost featpost.mp". +% Produce your PostScript (PS) figures with "mpost -mem featpost file". +% The output of this command (one or several files named "file.N") +% must be in the current directory to use the bashscripts laproof, +% lbproof and lcproof. Produce your EncapsulatedPostScript (EPS) figures +% with "bashscript/lXproof file N". laproof tranforms PS into EPS if +% the figure is smaller than an A4 page. lbproof produces JPEG and EPS +% that fits the width of an A4 portrait page and lcproof produces EPS +% that fits the height of an A4 portrait page independently of its +% original size. +% N is the number of the figure (in file) that you want to encapsulate. +% It is not necessary to use "export TEX=latex" nor "lXproof file N" +% if the figures have no text. +% The resulting EPS figures are not insertable in LaTex documents. +% The originals file.N are. + +input plain; +input featpost3Dplus2D; + +dump; + +% It is possible to interactively experiment the effect +% of figure parameters. This requires: +% 1) MetaPost code written as "anglinerigorouscircle.mp". +% 2) xcmd package (kindly provided by Pedro Sebastião); +% it may be downloaded from http://lince.cii.fc.ul.pt/ +% in Debian, Red Hat or tar.gz package formats. +% 3) Perl. +% 4) gv. +% 5) run command "xcmd/xmpost anglinerigorouscircle" or +% "xcmd/xmpost anymetapostwoextension". diff --git a/Master/texmf-dist/metapost/featpost/featpost3Dplus2D.mp b/Master/texmf-dist/metapost/featpost/featpost3Dplus2D.mp new file mode 100644 index 00000000000..b6055afae58 --- /dev/null +++ b/Master/texmf-dist/metapost/featpost/featpost3Dplus2D.mp @@ -0,0 +1,3571 @@ +% featpost3Dplus2D.mp +% L. Nobre G., C. Barbarosie, J. Schwaiger and B. Jackowski +% nobre@lince.cii.fc.ul.pt +% http://matagalatlante.org +% Copyright (C) 2005 +% see also featpost.mp + +% This set of macros extends the MetaPost language +% to three dimensions and eases the production of +% physics diagrams. + +% This is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 2 +% of the License, or (at your option) any later version. + +% This set of macros is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. + + message "Preloading FeatPost macros, version 0.6.7"; + + warningcheck := 0; + + background := 0.987white; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Global Variables %%%%%%%%%%% + + boolean ParallelProj, SphericalDistortion, FCD[], ShadowOn; + boolean OverRidePolyhedricColor; + numeric Nobjects, RefDist[], HoriZon, RopeColorSeq[], PhotoMarks; + numeric Spread, PrintStep, PageHeight, PageWidth, ActuC, Shifts; + numeric NL, npl[], NF, npf[], FC[], MaxFearLimit, TableColors; + numeric TDAtiplen, TDAhalftipbase, TDAhalfthick, RopeColors, NCL; + pair OriginProjPagePos, ShiftV, PhotoPair[]; + path VGAborder, CLPath[]; + color f, viewcentr, V[], L[]p[], F[]p[], TableC[]; + color HigColor, SubColor, LightSource, PhotoPoint[]; + string ostr[]; + pen BackPen, ForePen; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Kept for backward compatibility + + Shifts := 105.00mm; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Default Values %%%%%%%%%%%%%%% + + f := (3,5,4); % This f is the point of view in 3D + + viewcentr := black; % This is the aim of the view + + Spread := 140; % Magnification + + ShiftV := 105.00mm*(1,1); % Central coordinates on paper + + OriginProjPagePos := (105.00mm,148.45mm); % This should be the + % page center. + + ParallelProj := false; % Kind of perspective + % Can't have both true + SphericalDistortion := false; % Kind of lens + + ShadowOn := false; % Some objects may block the light and + + HoriZon := 0; % cast a shadow on a horizontal plane at this Z + + VGAborder := (182.05,210.00)-- % This definition assumes + (412.05,210.00)-- % ShiftV = 105.00mm(1,1) + (412.05,382.05)-- % Use: gs -r200 and you + (182.05,382.05)--cycle; % get few extra pixels + + PrintStep := 5; % Coarseness, in resolvec + + defaultscale := 0.75; + defaultfont := "cmss17"; % This is used by cartaxes + + PageHeight := 9in; + PageWidth := 6in; % And this is used by produce_auto_scale + + MaxFearLimit := 15; % Valid Maximum Distance from Origin + + HigColor := 0.85white; % These two colors are used in + SubColor := 0.35white; % fillfacewithlight + LightSource := 10*(4,-3,4); % This also + OverRidePolyhedricColor:=false; % And also this + + TableC0 := 0.85white; % grey %% G N U P L O T + TableC1 := red; % red %% + TableC2 := ( 0.2, 0.2, 1.0 ); % blue %% colors + TableC3 := ( 1.0, 0.7, 0.0 ); % orange %% + TableC4 := 0.85green; % pale green %% + TableC5 := 0.90*(red+blue); % magenta %% + TableC6 := 0.85*(green+blue); % cyan %% + TableC7 := 0.85*(red+green); % yellow %% + + TableColors := 7; + ActuC := 5; + + RopeColorSeq0 := 3; % + RopeColorSeq1 := 3; % + RopeColorSeq2 := 1; % + RopeColorSeq3 := 3; % ropepattern + RopeColorSeq4 := 7; % + RopeColorSeq5 := 5; % + % + RopeColors := 5; % + + Nobjects := 0; % getready and doitnow + + TDAtiplen := 0.05; % tdarrow + TDAhalftipbase := 0.02; % Three-Dimensional + TDAhalfthick := 0.01; % Arrow + + NCL := 0; % closedline + ForePen := pencircle scaled 15pt; + BackPen := pencircle scaled 9pt; + + %%% The variables PhotoMarks, PhotoPair[], PhotoPoint[] + %%% and CLPath[] have NO default values. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Part I: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Very basic: + +% Colors have three coordinates. Get one. + + def X(expr A) = + redpart A + enddef; + + def Y(expr A) = + greenpart A + enddef; + + def Z(expr A) = + bluepart A + enddef; + +% The length of a vector. + + def conorm(expr A) = + ( X(A) ++ Y(A) ++ Z(A) ) + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Vector Calculus: + +% Calculate the unit vector of a vector (or a point) + + def N(expr A) = + begingroup + save M, exitcolor; + numeric M; + color exitcolor; + M = conorm( A ); + if M > 0: + exitcolor = ( X(A)/M, Y(A)/M, Z(A)/M ); + else: + exitcolor := black; + fi; + ( exitcolor ) + endgroup + enddef; + + def cdotprod(expr A, B) = + ( X(A)*X(B) + Y(A)*Y(B) + Z(A)*Z(B) ) + enddef; + + def ccrossprod(expr A, B) = + ( Y(A)*Z(B) - Z(A)*Y(B), + Z(A)*X(B) - X(A)*Z(B), + X(A)*Y(B) - Y(A)*X(B) ) + enddef; + +% The dotproduct of two normalized vectors is the cosine of the angle +% they form. + + def ndotprod(expr A, B) = + begingroup + save a, b; + color a, b; + a = N(A); + b = N(B); + ( ( X(a)*X(b) + Y(a)*Y(b) + Z(a)*Z(b) ) ) + endgroup + enddef; + +% The normalized crossproduct of two vectors. +% Also check getangle below. + + def ncrossprod(expr A, B) = + N( ccrossprod( A, B ) ) + enddef; + +% Haahaa! Trigonometry. + + def getangle(expr A, B) = + begingroup + save coss, sine; + numeric coss, sine; + coss := cdotprod( A, B ); + sine := conorm( ccrossprod( A, B ) ); + ( angle( coss, sine ) ) + endgroup + enddef; + +% Something I need for spatialhalfsfear. + + def getcossine( expr Center, Radius ) = + begingroup + save a, b; + numeric a, b; + a = conorm( f - Center ); + b = Radius/a; + if abs(b) >= 1: + show "The point of view f is too close (getcossine)."; + b := 2; % DANGER! + fi; + ( b ) + endgroup + enddef; + +% The following routine could be used by kindofcube and may be used to +% rotate polyhedra (must cycle through all Vs before calling makeface). + + def eulerrotation( expr AngA, AngB, AngC, Vec ) = + begingroup + save auxx, auxy, veca, vecb, vecc; + color auxx, auxy, veca, vecb, vecc; + veca = ( cosd(AngA)*cosd(AngB), + sind(AngA)*cosd(AngB), + sind(AngB) ); + auxx = ( cosd(AngA+90), sind(AngA+90), 0 ); + auxy = ccrossprod( veca, auxx ); + vecb = cosd(AngC)*auxx + sind(AngC)*auxy; + vecc = cosd(AngC+90)*auxx + sind(AngC+90)*auxy; + ( X(Vec)*veca + Y(Vec)*vecb + Z(Vec)*vecc ) + endgroup + enddef; + +% inplanarvolume is used by kindofcube. + + def inplanarvolume( expr PointPerpA, PointPerpB, Point ) = + begingroup + save va, vb, vc; + color va, vb, vc; + va = Point - PointPerpA; + vb = Point - PointPerpB; + vc = PointPerpB - PointPerpA; + ( cdotprod(va,vc)*cdotprod(vb,vc) <= 0 ) + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Auxiliary: + +% Projection Size. Meant for objects with size one. +% Used by signalvertex. + + def ps(expr A, Thicken_Factor) = + Thicken_Factor/conorm(A-f)/3 + enddef; + +% Rigorous Projection of a Point. Draws a circle with +% a diameter inversely proportional to the distance of +% that Point from the point of view. + + def signalvertex(expr A, TF, Col) = + draw rp(A) withcolor Col withpen pencircle scaled (Spread*ps(A,TF)) + enddef; + + def signalshadowvertex(expr A, TF, Col) = + begingroup + save auxc, auxn; + color auxc; + numeric auxn; + auxc := cb(A); + auxn := TF*conorm(f-auxc)/conorm(LightSource-A); + signalvertex( auxc, auxn, Col ) + endgroup + enddef; + +% Get the vector that projects onto the resolution + + def resolvec(expr A, B) = + begingroup + save sizel, returnvec; + numeric sizel; + color returnvec; + sizel = abs( rp(A) - rp(B) ); + if sizel > 0: + returnvec = PrintStep*(B-A)/sizel; + else: + returnvec = 0.3*(B-A); + fi; + ( returnvec ) + endgroup + enddef; + +% Movies need a constant frame + + def produce_vga_border = + begingroup + draw VGAborder withcolor background withpen pencircle scaled 0; + clip currentpicture to VGAborder + endgroup + enddef; + + def produce_auto_scale = + begingroup + picture storeall, scaleall; + numeric pwidth, pheight; + storeall = currentpicture shifted -(center currentpicture); + currentpicture := nullpicture; + pwidth = xpart ((lrcorner storeall)-(llcorner storeall)); + pheight = ypart ((urcorner storeall)-(lrcorner storeall)); + if PageHeight/PageWidth < pheight/pwidth: + scaleall = storeall scaled (PageHeight/pheight); + else: + scaleall = storeall scaled (PageWidth/pwidth); + fi; + draw scaleall shifted OriginProjPagePos + endgroup + enddef; + + vardef cstr( expr Cl ) = + "(" & + decimal(X(Cl)) & + "," & + decimal(Y(Cl)) & + "," & + decimal(Z(Cl)) & + ")" + enddef; + + vardef bstr( expr bv ) = + save bstring; string bstring; + if bv: bstring = "true"; else: bstring = "false"; fi; + bstring + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Fundamental: + +% Rigorous Projection. This the kernel of all these lines of code. +% It won't work if R belongs the plane that contains f and that is +% ortogonal to vector f, unless SphericalDistortion is true. +% f must not be on a line parallel to zz and that contains the +% viewcentr. + + def rp(expr R) = + begingroup + + save projpoi; + save v, u; + save verti, horiz, eta, squarf, radio, ang, lenpl; + pair projpoi; + color v, u; + numeric verti, horiz, eta, squarf, radio, ang, lenpl; + + v = N( (-Y(f-viewcentr), X(f-viewcentr), 0) ); + u = ncrossprod( f-viewcentr, v ); + + horiz = cdotprod( R-viewcentr, v ); + verti = cdotprod( R-viewcentr, u ); + + if SphericalDistortion: + if ( horiz <> 0 ) or ( verti <> 0 ): + lenpl = ( horiz ++ verti )*20; %%%%%%%%%%%%%%% DANGER + ang = getangle( f-R, f-viewcentr ); + horiz := ang*horiz/lenpl; + verti := ang*verti/lenpl; + projpoi = (horiz,verti); + else: + projpoi = origin; + fi; + else: + if ParallelProj: + eta = 1; + else: + squarf = cdotprod( f-viewcentr, f-viewcentr ); + radio = cdotprod( R-viewcentr, f-viewcentr ); + eta = 1 - radio/squarf; + if eta < 0.03: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DANGER + eta := 0.03; + fi; + fi; + projpoi = (horiz,verti)/eta; + fi; + + ( projpoi*Spread + ShiftV ) + + endgroup + enddef; + +% Much improved rigorous pseudo-projection algorithm that follows +% an idea from Cristian Barbarosie. This makes shadows. + + def cb(expr R) = + begingroup + save ve, ho; + numeric ve, ho; + LightSource-ho*red-ve*green-HoriZon*blue=whatever*(LightSource-R); + ( ho*red + ve*green + HoriZon*blue ) + endgroup + enddef; + +% And this just projects points rigorously on some generic plane using +% LightSource as the point of convergence (focus). + + def projectpoint(expr ViewCentr, R) = + begingroup + save verti, horiz; + save v, u, lray; + numeric verti, horiz; + color v, u, lray; + lray = LightSource-ViewCentr; + v = N( (-Y(lray), X(lray), 0) ); + u = ncrossprod( lray, v ); + lray - horiz*v - verti*u = whatever*( LightSource - R ); + ( horiz*v + verti*u + ViewCentr ) + endgroup + enddef; + +% And this is the way to calculate the intersection of some line with some +% plan. + + def lineintersectplan( expr LinePoi, LineDir, PlanPoi, PlanDir ) = + begingroup + save incognitus; + color incognitus; + cdotprod( incognitus-PlanPoi, PlanDir ) = 0; + whatever*LineDir + LinePoi = incognitus; + ( incognitus ) + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Basic Functions: + +% Get the 2D path of a straight line in beetween 3D points A and B. +% This would add rigor to rigorousdisc, if one would introduce the +% the concept of three-dimensional path. That is not possible now. +% Also this is only interesting when using SphericalDistortion:=true + + def pathofstraightline( expr A, B ) = + begingroup + save k, i, mark, stepVec, returnp, pos; + numeric k, i; + color mark, stepVec; + path returnp; + pair pos[]; + stepVec = resolvec(A,B); + pos0 = rp( A ); + k = 1; + forever: + mark := A+(k*stepVec); + exitif cdotprod(B-mark,stepVec) <= 0; + pos[k] = rp( mark ); + k := incr(k); + endfor; + pos[k] = rp(B); + returnp = pos0 for i=1 upto k: ..pos[i] endfor; + ( returnp ) + endgroup + enddef; + + def drawsegment( expr A, B )= + begingroup + if SphericalDistortion: + draw pathofstraightline( A, B ); + else: + draw rp(A)--rp(B); + fi + endgroup + enddef; + +% Cartesian axes with prescribed lengths. + + def cartaxes(expr axex, axey, axez) = + begingroup + save orig, axxc, ayyc, azzc; + color orig, axxc, ayyc, azzc; + orig = (0,0,0); + axxc = (axex,0,0); + ayyc = (0,axey,0); + azzc = (0,0,axez); + drawarrow rp(orig)..rp(axxc); + drawarrow rp(orig)..rp(ayyc); + drawarrow rp(orig)..rp(azzc); + label.bot( "x" ,rp(axxc)); %%%%%%%%%%%%%%%%%%%%%%%%% + label.bot( "y" ,rp(ayyc)); %% Some Labels... %% + label.lft( "z" ,rp(azzc)); %%%%%%%%%%%%%%%%%%%%%%%%% + endgroup + enddef; + +% This is it. Draw an arch beetween two straight lines with a +% common point (Or) in three-dimensional-euclidian-space and +% place a label near the middle of the arch. Points A and B +% define the lines. The arch is at a distance W from Or. The +% label is S and the position is RelPos (rt,urt,top,ulft,lft, +% llft,bot,lrt). But arches must be smaller than 180 degrees. + + def angline(expr A, B, Or, W, S)(suffix RelPos) = + begingroup + save G, Dna, Dnb, al; + numeric G; + color Dna, Dnb; + path al; + G = conorm( W*( N(A-Or) - N(B-Or) ) )/2.5; %%%%%%% BIG DANGER! + Dna = ncrossprod(ncrossprod(A-Or,B-Or),A-Or); + Dnb = ncrossprod(ncrossprod(B-Or,A-Or),B-Or); + al = rp(W*N(A-Or)+Or).. + controls rp(W*N(A-Or)+Or+G*Dna) + and rp(W*N(B-Or)+Or+G*Dnb).. + rp(W*N(B-Or)+Or); + draw al; + label.RelPos( S, point 0.5*length al of al ) + endgroup + enddef; + +% As i don't know how to declare variables of type suffix, +% i provide a way to avoid the problem. This time RelPos may +% be 0,1,2,3,4,6,7 or anything else. + + def anglinen(expr A, B, Or, W, S, RelPos) = + begingroup + save G, Dna, Dnb, al, middlarc; + numeric G; + color Dna, Dnb; + path al; + pair middlarc; + G = conorm( W*( N(A-Or) - N(B-Or) ) )/3; + Dna = ncrossprod(ncrossprod(A-Or,B-Or),A-Or); + Dnb = ncrossprod(ncrossprod(B-Or,A-Or),B-Or); + al = rp(W*N(A-Or)+Or).. + controls rp(W*N(A-Or)+Or+G*Dna) + and rp(W*N(B-Or)+Or+G*Dnb).. + rp(W*N(B-Or)+Or); + draw al; + middlarc = point 0.5*length al of al; + if RelPos = 0: + label.rt( S, middlarc ); + elseif RelPos =1: + label.urt( S, middlarc ); + elseif RelPos =2: + label.top( S, middlarc ); + elseif RelPos =3: + label.ulft( S, middlarc ); + elseif RelPos =4: + label.lft( S, middlarc ); + elseif RelPos =5: + label.llft( S, middlarc ); + elseif RelPos =6: + label.bot( S, middlarc ); + elseif RelPos =7: + label.lrt( S, middlarc ); + else: + label( S, middlarc ); + fi + endgroup + enddef; + +% As a bigger avoidance, replace the arch by a paralellogram. + + def squareangline(expr A, B, Or, W) = + begingroup + save sal; + path sal; + sal = rp(Or)--rp(W*N(A-Or)+Or)-- + rp(W*(N(B-Or)+N(A-Or))+Or)--rp(W*N(B-Or)+Or)--cycle; + draw sal + endgroup + enddef; + +% Just as we are here we can draw circles. (color,color,numeric) + + def rigorouscircle( expr CenterPos, AngulMom, Radius ) = + begingroup + save ind, G, Dna, Dnb, al; + numeric ind, G; + color vec[], Dna, Dnb; + path al; + vec1 = ncrossprod( CenterPos-f, AngulMom); + for ind=2 step 2 until 8: + vec[ind+1] = ncrossprod( vec[ind-1], AngulMom ); + vec[ind] = N( vec[ind-1] + vec[ind+1] ); + endfor; + G = conorm( Radius*( vec1 - vec2 ) )/3; + al = rp(Radius*vec1+CenterPos) + for ind=2 upto 8: + hide( + Dna:=ncrossprod(ncrossprod(vec[ind-1],vec[ind]),vec[ind-1]); + Dnb:=ncrossprod(ncrossprod(vec[ind],vec[ind-1]),vec[ind]) + ) + ..controls rp(Radius*vec[ind-1]+CenterPos+G*Dna) + and rp(Radius*vec[ind] +CenterPos+G*Dnb) + ..rp(Radius*vec[ind] +CenterPos) + endfor + ...cycle; + ( al ) + endgroup + enddef; + +% 3D arrow. + + def tdarrow(expr FromPos, ToTip ) = + begingroup + save basevec, longvec, a, b, c, d, e, g, h, len, p; + color basevec, longvec, a, b, c, d, e, g, h; + numeric len; + path p; + len = conorm( ToTip - FromPos ); + longvec := N( ToTip - FromPos ); + basevec := ncrossprod( FromPos-f, longvec ); + if len <= TDAtiplen: + b = basevec*TDAhalftipbase*len/TDAtiplen; + c = FromPos+b; + e = FromPos-b; + p = rp(ToTip)--rp(c)--rp(e)--cycle; + else: + d = ToTip-longvec*TDAtiplen; + a = FromPos+basevec*TDAhalfthick; + h = FromPos-basevec*TDAhalfthick; + b = d+basevec*TDAhalfthick; + g = d-basevec*TDAhalfthick; + c = d+basevec*TDAhalftipbase; + e = d-basevec*TDAhalftipbase; + p = rp(a)--rp(b)--rp(c)--rp(ToTip)--rp(e)--rp(g)--rp(h)--cycle; + fi; + unfill p; + draw p + endgroup + enddef; + +% Draw lines with a better expression of three-dimensionality. + + def emptyline(expr JoinP,ThickenFactor,OutCol,InCol,theN,EmptyFrac,sN) + (text LinFunc) = + begingroup + save i, j, k; + numeric i, j, k; + k = ThickenFactor*EmptyFrac; + if ShadowOn: + for i = 0 upto theN: + signalshadowvertex( LinFunc(i/theN), ThickenFactor, black ); + endfor; + fi; + for j = 0 upto sN-1: + signalvertex( LinFunc(j/theN), ThickenFactor, OutCol ); + endfor; + if JoinP: + for j = -sN upto 0: + signalvertex( LinFunc(j/theN), k, InCol ); + endfor; + fi; + for i = sN upto theN: + signalvertex( LinFunc( i/theN ), ThickenFactor, OutCol ); + for j = sN downto 0: + signalvertex( LinFunc( (i-j)/theN ), k, InCol ); + endfor; + endfor + endgroup + enddef; + +% Draw space-paths of possibly closed lines making use of "getready" + + def closedline( expr ThisIsClosed, theN, ForeFrac, BackFrac ) + ( text LinFunc ) = + begingroup + save i, comm; + numeric i; + string comm; + NCL := incr( NCL ); + if ThisIsClosed: + CLPath[NCL] := + for i=1 upto theN: + rp(LinFunc(i/theN)).. + endfor + cycle; + for i=1 upto theN: + comm:="draw subpath (" + & decimal(i-ForeFrac) + & "," + & decimal(i+ForeFrac) + & ") of CLPath" + & decimal(NCL) + & " withpen ForePen; undraw subpath (" + & decimal(i-BackFrac) + & "," + & decimal(i+BackFrac) + & ") of CLPath" + & decimal(NCL) + & " withpen BackPen;"; + getready( comm, LinFunc(i/theN) ); + endfor; + else: + CLPath[NCL] := rp(LinFunc(0)) + for i=1 upto theN: ..rp(LinFunc(i/theN)) endfor; + comm:="draw subpath (0," + & decimal(ForeFrac) + & ") of CLPath" + & decimal(NCL) + & " withpen ForePen; undraw subpath (0," + & decimal(BackFrac) + & ") of CLPath" + & decimal(NCL) + & " withpen BackPen;"; + getready( comm, LinFunc(1/theN) ); + for i=2 upto theN-1: + comm:="draw subpath (" + & decimal(i-ForeFrac) + & "," + & decimal(i+ForeFrac) + & ") of CLPath" + & decimal(NCL) + & " withpen ForePen; undraw subpath (" + & decimal(i-BackFrac) + & "," + & decimal(i+BackFrac) + & ") of CLPath" + & decimal(NCL) + & " withpen BackPen;"; + getready( comm, LinFunc(i/theN) ); + endfor; + comm:="draw subpath (" + & decimal(theN-ForeFrac) + & "," + & decimal(theN) + & ") of CLPath" + & decimal(NCL) + & " withpen ForePen; undraw subpath (" + & decimal(theN-BackFrac) + & "," + & decimal(theN) + & ") of CLPath" + & decimal(NCL) + & " withpen BackPen;"; + getready( comm, LinFunc(1) ); + fi + endgroup + enddef; + +% The next allows you to draw any solid that has no vertices and that has +% two, exactly two, cyclic edges. In fact, it doesn't need to be a solid. +% In order to complete the drawing of this solid you have to choose one of +% the edges to be drawn immediatly afterwards. + + def twocyclestogether( expr CycleA, CycleB )= + begingroup + numeric TheLengthOfA, TheLengthOfB, TheMargin, Leng, i; + path SubPathA, SubPathB, PolygonPath, FinalPath; + TheMargin = 0.02; + TheLengthOfA = ( length CycleA ) - TheMargin; + TheLengthOfB = ( length CycleB ) - TheMargin; + SubPathA = subpath ( 0, TheLengthOfA ) of CycleA; + SubPathB = subpath ( 0, TheLengthOfB ) of CycleB; + PolygonPath = makepath makepen ( SubPathA--SubPathB--cycle ); + Leng = (length PolygonPath) - 1; + FinalPath = point 0 of PolygonPath + for i = 1 upto Leng: + --point i of PolygonPath + endfor + --cycle; + ( FinalPath ) + endgroup + enddef; + +% Ellipse on the air. + + def ellipticpath(expr CenterPos, OneAxe, OtherAxe ) = + begingroup + save cirath, ind, vec; + numeric ind; + color vec[]; + path cirath; + for ind=1 upto 36: + vec[ind] = CenterPos+OneAxe*cosd(ind*10)+OtherAxe*sind(ind*10); + endfor; + cirath = rp( vec1 ) + for ind=2 upto 36: + ...rp( vec[ind] ) + endfor + ...cycle; + ( cirath ) + endgroup + enddef; + +% Shadow of an ellipse on the air. + + def ellipticshadowpath(expr CenterPos, OneAxe, OtherAxe ) = + begingroup + save cirath, ind, vec; + numeric ind; + color vec[]; + path cirath; + for ind=1 upto 36: + vec[ind] = CenterPos+OneAxe*cosd(ind*10)+OtherAxe*sind(ind*10); + endfor; + cirath = rp( cb( vec1 ) ) + for ind=2 upto 36: + ...rp( cb( vec[ind] ) ) + endfor + ...cycle; + ( cirath ) + endgroup + enddef; + +% It should be possible to attach some text to some plan. +% Unfortunately, this only works correctly when ParallelProj := true; + + def labelinspace(expr KeepRatio,RefPoi,BaseVec,UpVec) + (text SomeString)= + begingroup + save labelpic, plak, lrc, ulc, llc, centerc, aratio, newbase; + picture labelpic; + pair lrc, ulc, llc; + transform plak; + color centerc, newbase; + numeric aratio; + labelpic = thelabel( SomeString, origin ); + lrc = lrcorner labelpic; + ulc = ulcorner labelpic; + llc = llcorner labelpic; + aratio = (xpart lrc - xpart llc)/(ypart ulc - ypart llc); + if KeepRatio: + newbase = conorm(UpVec)*aratio*N(BaseVec); + else: + newbase = BaseVec; + fi; + rp(RefPoi+newbase) = lrc transformed plak; + rp(RefPoi+UpVec) = ulc transformed plak; + centerc = RefPoi+0.5(newbase+UpVec); + rp(RefPoi) = llc transformed plak; + label( labelpic transformed plak, rp(centerc) ) + endgroup + enddef; + +% It should be possible to attach some path to some surface. + + def closedpathinspace( expr SomeTDPath )( text ConverterFunc )= + begingroup + save i, outpath; + numeric i; + path outpath; + outpath = for i=0.25 step 0.25 until (length SomeTDPath): + ConverterFunc( point i of SomeTDPath ) -- + endfor cycle; + ( outpath ) + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Standard Objects: + +% And more precisely. The next routines spatialhalfcircle and +% rigorousfear require circles drawn in a systematic and precise way. + + def goodcirclepath(expr CenterPos, AngulMom, Radius ) = + begingroup + save cirath, vecx, vecy, ind, goodangulmom, decision; + numeric ind, decision; + color vecx, vecy, vec[], goodangulmom, view; + path cirath; + view = f-CenterPos; + decision = cdotprod( view, AngulMom ); + if decision < 0: + goodangulmom = -AngulMom; + else: + goodangulmom = AngulMom; + fi; + vecx = ncrossprod( view, goodangulmom ); + decision := getangle( view, goodangulmom ); + if decision > 0.5: %%%%%%%%%%%%%%% DANGER %%% + vecy = ncrossprod( goodangulmom, vecx ); + for ind=1 upto 36: + vec[ind] := vecx*cosd(ind*10) + vecy*sind(ind*10); + vec[ind] := CenterPos + vec[ind]*Radius; + endfor; + cirath = rp( vec1 ) + for ind=2 upto 36: + ...rp( vec[ind] ) + endfor + ...cycle; + else: + cirath = head_on_circle( CenterPos, Radius ); + fi; + ( cirath ) + endgroup + enddef; + +% And its shadow. + + def circleshadowpath(expr CenterPos, AngulMom, Radius ) = + begingroup + save cirath, vecx, vecy, view, decision; + numeric decision; + color vecx, vecy, view; + path cirath; + view = LightSource-CenterPos; + vecx = ncrossprod( view, AngulMom ); + decision := getangle( view, AngulMom ); + if decision > 0.5: %%%%%%%%%%%%%%% DANGER %%% + vecy = ncrossprod( AngulMom, vecx ); + cirath = ellipticshadowpath(CenterPos,vecx*Radius,vecy*Radius); + else: + vecx := N( (-Y(view), X(view), 0) ); + vecy = ncrossprod( view, vecx ); + cirath = ellipticshadowpath(CenterPos,vecx*Radius,vecy*Radius); + fi; + ( cirath ) + endgroup + enddef; + +% When there are numerical problems with the previous routine +% use the following alternative: + + def head_on_circle(expr Pos, Radius ) = + begingroup + save cirath, vecx, vecy, ind, view; + numeric ind; + color vecx, vecy, vec[], view; + path cirath; + view = f-Pos; + vecx = N( (-Y(view), X(view), 0) ); + vecy = ncrossprod( view, vecx ); + for ind=1 upto 36: + vec[ind] := vecx*cosd(ind*10) + vecy*sind(ind*10); + vec[ind] := Pos + vec[ind]*Radius; + endfor; + cirath = rp( vec1 ) + for ind=2 upto 36: + ...rp( vec[ind] ) + endfor + ...cycle; + ( cirath ) + endgroup + enddef; + +% The nearest or the furthest part of a circle returned as a path. +% This function has been set to work for rigorousdisc (next). +% Very tough settings they were. + + def spatialhalfcircle(expr Center, AngulMom, Radius, ItsTheNearest ) = + begingroup + save auxil, auxih; + color va, vb, vc, cc, vd, ux, uy, pa, pb; + numeric nr, cn, valx, valy, valr, choiceang; + path auxil, auxih, fcirc, returnp; + boolean choice; + va := Center - f; + vb := N( AngulMom ); + vc := vb*( cdotprod( va, vb ) ); + cc := f + vc; + vd := cc - Center; % vd := va + vc; + nr := conorm( vd ); + if Radius >= nr: + returnp := rp( cc ); + else: + valr := Radius*Radius; + valx := valr/nr; + valy := sqrt( valr - valx*valx ); + ux := N( vd ); + choiceang := getangle( vc, va ); %%%%%%%%%%%%% + choice := ( choiceang < 89 ) or ( choiceang > 91 );%% DANGER % + if choice: %%%%%%%%%%%%% + uy := ncrossprod( vc, va ); + else: + uy := ncrossprod( AngulMom, va ); + fi; + pa := valx*ux + valy*uy + Center; + pb := pa - 2*valy*uy; + if choice: + auxil := rp(1.1[Center,pb])--rp(0.9[Center,pb]); + auxih := rp(1.1[Center,pa])--rp(0.9[Center,pa]); + fcirc := goodcirclepath( Center, AngulMom, Radius ); + if ItsTheNearest: + returnp := (fcirc cutafter auxih) cutbefore auxil; + else: + returnp := (fcirc cutbefore auxih)..(fcirc cutafter auxil); + fi; + else: + if ItsTheNearest: + if cdotprod( va, AngulMom ) > 0: + returnp := rp(pb)--rp(pa); + else: + returnp := rp(pa)--rp(pb); + fi; + else: + if cdotprod( va, AngulMom ) < 0: + returnp := rp(pb)--rp(pa); + else: + returnp := rp(pa)--rp(pb); + fi; + fi; + fi; + fi; + ( returnp ) + endgroup + enddef; + +% Cylinders or tubes ( numeric, boolean, color, numeric, color ). +% Great stuff. The "disc" in the name comes from the fact that +% when SphericalDistortion := true; the sides of cylinders are +% not drawn correctly (they are straight). And when it is a tube +% you should force the background to be white. + + def rigorousdisc(expr InRay, FullFill, BaseCenter, Radius, LenVec) = + begingroup + save va, vb, vc, cc, vd, base, holepic; + save vA, cC, nr, vala, valb, hashole, istube; + save auxil, auxih, rect, halfl, halfh, thehole; + save auxili, auxihi, rect, theshadow; + + color va, vb, vc, cc, vd, base; + picture holepic; + color vA, cC; + numeric nr, vala, valb; + boolean hashole, istube; + path auxil, auxih, halfl, halfh, thehole; + path auxili, auxihi, rect, theshadow; + + va := BaseCenter - f; + vb := N( LenVec ); + vc := vb*( cdotprod( va, vb ) ); + cc := f + vc; + vd := cc - BaseCenter; + nr := conorm( vd ); + base := BaseCenter + LenVec; + vA := base - f; + vala := conorm( va ); + valb := conorm( vA ); + if ShadowOn: + auxil := circleshadowpath( BaseCenter, LenVec, Radius ); + auxih := circleshadowpath( base, LenVec, Radius ); + fill twocyclestogether( auxil, auxih ); + fi; + auxil := goodcirclepath( base, LenVec, Radius ); + auxih := goodcirclepath( BaseCenter, LenVec, Radius ); + istube := false; + hashole := false; + if InRay > 0: + istube := true; + auxili := goodcirclepath( base, LenVec, InRay ); + auxihi := goodcirclepath( BaseCenter, LenVec, InRay ); + hashole := (-1,-1) <> ( auxili intersectiontimes auxihi ); + if hashole: + draw auxili; + draw auxihi; + holepic := currentpicture; + clip holepic to auxili; + clip holepic to auxihi; + fi; + fi; + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if Radius >= nr: % THE CASE Radius > nr > InRay IS NOT SUPPORTED % + if vala <= valb : + thehole := auxil; + auxil := auxih; + auxih := thehole; + fi; + if istube: + if vala <= valb : + thehole := auxili; + auxili := auxihi; + auxihi := thehole; + fi; + holepic := currentpicture; + clip holepic to auxihi; + fi; + unfill auxil; + draw auxil; + if istube: + draw holepic; + draw auxihi; + fi; + else: + cC := base + vd; + if ( cdotprod( f - cc, f - cC ) <= 0 ) or ( not FullFill ): + halfl := spatialhalfcircle(BaseCenter,LenVec,Radius,true); + halfh := spatialhalfcircle(base,LenVec,Radius,true); + if FullFill: + rect := halfl--halfh--cycle; + else: + rect := halfl--(reverse halfh)--cycle; + fi; + unfill rect; + draw rect; + elseif vala > valb: + halfl := spatialhalfcircle(BaseCenter,LenVec,Radius,true); + halfh := spatialhalfcircle(base,LenVec,Radius,false); + rect := halfl--halfh--cycle; + unfill rect; + draw rect; + if istube: + if hashole: + draw holepic; + fi; + draw auxili; + fi; + draw auxil; + else: + halfl := spatialhalfcircle(BaseCenter,LenVec,Radius,false); + halfh := spatialhalfcircle(base,LenVec,Radius,true); + rect := halfl--halfh--cycle; + unfill rect; + draw rect; + if istube: + if hashole: + draw holepic; + fi; + draw auxihi; + fi; + draw auxih; + fi; + fi + endgroup + enddef; + +% And maybe a full cone border. The vertex may go anywhere. +% Choose the full cone border (UsualForm=true) or just the nearest +% part of the base edge (UsualForm=false). +% This is used by tropicalglobe as a generic spatialhalfcircle to +% draw only the in fact visible part of circular lines. Please, don't +% put the vertex too close to the base plan when UsualForm=false. + + def rigorouscone(expr UsualForm,CenterPos,AngulMom,Radius,VertexPos)= + begingroup + save basepath, themargin, thelengthofc, thesubpath, fullpath; + save newlen, finalpath, i, auxpath, pa, pb, auxt, bigcirc; + save startt, endt; + path basepath, thesubpath, fullpath, finalpath, auxpath; + path bigcirc; + numeric themargin, newlen, i, auxt, startt, endt; + pair pa, pb, pc, pd, pe; + themargin = 0.02; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DANGER + basepath = goodcirclepath( CenterPos, AngulMom, Radius ); + thelengthofc = ( length basepath ) - themargin; + thesubpath = subpath ( 0, thelengthofc ) of basepath; + fullpath = makepath makepen ( rp(VertexPos)--thesubpath--cycle ); + pa = 0.995[rp(CenterPos),rp(VertexPos)]; + pb = 1.005[rp(CenterPos),rp(VertexPos)]; + auxpath = pa--pb; + pc = auxpath intersectiontimes fullpath; + if pc <> (-1,-1): + auxt = ypart pc; + newlen = length fullpath; + if UsualForm: + finalpath = point auxt of fullpath + --point auxt+1 of fullpath + for i = auxt+2 upto auxt+newlen-1: + ...point i of fullpath + endfor + --cycle; + else: + bigcirc = goodcirclepath( CenterPos, AngulMom, 1.005*Radius ); + pd = bigcirc intersectiontimes fullpath; + pe = ( reverse bigcirc ) intersectiontimes fullpath; + startt = floor( xpart pd ); + endt = ceiling( ( length bigcirc ) - ( xpart pe ) ); + finalpath = subpath (startt,endt) of basepath; + fi; + else: + finalpath = rp(VertexPos); + fi; + ( finalpath ) + endgroup + enddef; + + def verygoodcone(expr BackDash,CenterPos,AngulMom,Radius,VertexPos)= + begingroup + save thepath, lenpath, bonevec, sidevec, viewaxe, cipath; + save thelengthofc, thesubpath, themargin, basepath; + color bonevec, sidevec, viewaxe; + path thepath, cipath, basepath, thesubpath; + numeric lenpath, thelengthofc, themargin; + themargin = 0.02; + bonevec = VertexPos - CenterPos; + if cdotprod( bonevec, AngulMom ) < 0: + sidevec = -N(AngulMom); + else: + sidevec = N(AngulMom); + fi; + viewaxe = f-CenterPos; + if ShadowOn: + basepath = circleshadowpath( CenterPos, AngulMom, Radius ); + thelengthofc = ( length basepath ) - themargin; + thesubpath = subpath ( 0, thelengthofc ) of basepath; + fill makepath makepen ( rp(cb(VertexPos))--thesubpath--cycle ); + fi; + thepath = rigorouscone(true,CenterPos,AngulMom,Radius,VertexPos); + lenpath = length thepath; + if lenpath<>0: + unfill thepath; + draw thepath; + if cdotprod( sidevec, viewaxe ) < 0: + draw goodcirclepath( CenterPos, AngulMom, Radius ); + else: + if BackDash: + draw + goodcirclepath( CenterPos, AngulMom, Radius ) dashed evenly; + fi; + fi; + else: + cipath = goodcirclepath( CenterPos, AngulMom, Radius ); + unfill cipath; + draw cipath; + if cdotprod( sidevec, viewaxe ) > 0: + draw rp( VertexPos ); + fi; + fi + endgroup + enddef; + +% Its a sphere, don't fear, but remember that the rigorous projection +% of a sphere is an ellipse. + + def rigorousfearpath(expr Center, Radius ) = + begingroup + save auxil; + color ux, uy, newcen; + numeric nr, valx, valy, valr; + path auxil; + nr := conorm( Center - f ); + valr := Radius**2; + valx := valr/nr; + valy := sqrt( valr - valx**2 ); + newcen := valx*( f - Center )/nr; + auxil := head_on_circle( Center+newcen, valy ); + ( auxil ) + endgroup + enddef; + + def rigorousfearshadowpath(expr Center, Radius ) = + begingroup + save auxil, auxih; + color ux, uy, newcen; + numeric nr, valx, valy, valr, lenr; + path auxil, auxih, fcirc, returnp; + pair dcenter; + nr := conorm( Center - LightSource ); + valr := Radius**2; + valx := valr/nr; + valy := sqrt( valr - valx**2 ); + newcen := valx*( LightSource - Center )/nr; + auxil := circleshadowpath( Center+newcen, newcen, valy ); + ( auxil ) + endgroup + enddef; + +% It's a globe (without land). + + def tropicalglobe( expr NumLats, TheCenter, Radius, AngulMom )= + begingroup + save viewaxe, sinalfa, sinbeta, globaxe, aux, limicos, lc; + save stepang, actang, newradius, foc, newcenter, cpath, i; + save outerpath, conditiona, conditionb; + color viewaxe, globaxe, foc, newcenter; + numeric sinalfa, sinbeta, aux, limicos, stepang, actang; + numeric newradius, lc, i; + path cpath, outerpath; + boolean conditiona, conditionb; + if ShadowOn: + fill rigorousfearshadowpath( TheCenter, Radius ); + fi; + viewaxe = f-TheCenter; + sinalfa = Radius/conorm( viewaxe ); + aux = cdotprod( viewaxe, AngulMom ); + if aux < 0: + globaxe = -N(AngulMom); + else: + globaxe = N(AngulMom); + fi; + sinbeta = cdotprod( globaxe, N(viewaxe) ); + aux := sqrt((1-sinalfa**2)*(1-sinbeta**2)); + limicos = aux - sinalfa*sinbeta; + stepang = 180/NumLats; + globaxe := globaxe*Radius; + outerpath = rigorousfearpath(TheCenter,Radius); + unfill outerpath; + draw outerpath; + for actang = 0.5*stepang step stepang until 179: + if cosd(actang) < limicos-0.005: %%%%%%%%%%%%%%%%%%%%%%%% DANGER + newradius := Radius*sind(actang); + newcenter := TheCenter - globaxe*cosd(actang); + conditiona:=(actang<94) and (actang>86); % DANGER % DANGER VV + conditionb:=abs(cdotprod(globaxe/Radius,N(f-newcenter)))<0.08; + if conditiona or conditionb: + draw spatialhalfcircle(newcenter,globaxe,newradius,true); + else: + foc := TheCenter - globaxe/cosd(actang); + lena := -Radius*cosd(actang); + lenb := cdotprod(viewaxe,globaxe/Radius); + if (actang <= 86) or ((lenb<lena) and (actang>=94)): + cpath := + rigorouscone(false,newcenter,globaxe,newradius,foc); + draw cpath; + else: + cpath := + rigorouscone(true,newcenter,globaxe,newradius,foc); + lc := length cpath; + if lc <> 0: + draw subpath (1,lc-1) of cpath; + else: + draw rigorouscircle( newcenter,globaxe,newradius ); + fi; + fi; + fi; + fi; + endfor + endgroup + enddef; + +% An elliptical frustum: + + def whatisthis(expr CenterPos,OneAxe,OtherAxe,CentersDist,TheFactor)= + begingroup + save patha, pathb, pathc, centersvec, noption; + path patha, pathb, pathc; + color centersvec; + numeric noption; + centersvec = CentersDist*ncrossprod( OneAxe, OtherAxe ); + if ShadowOn: + patha = ellipticshadowpath( CenterPos, + OneAxe, + OtherAxe ); + pathb = ellipticshadowpath( CenterPos+centersvec, + TheFactor*OneAxe, + TheFactor*OtherAxe ); + pathc = twocyclestogether( patha, pathb ); + fill pathc; + fi; + patha := ellipticpath( CenterPos, + OneAxe, + OtherAxe ); + pathb := ellipticpath( CenterPos+centersvec, + TheFactor*OneAxe, + TheFactor*OtherAxe ); + pathc := twocyclestogether( patha, pathb ); + unfill pathc; + draw pathc; + noption = cdotprod( centersvec, f-CenterPos ); + if noption > (CentersDist**2): + draw pathb; + elseif noption < 0: + draw patha; + fi + endgroup + enddef; + +% You can't see through this hole. f must not be on the hole axis. +% Not yet documented because "buildcycle" doesn't work properly. + + def fakehole( expr CenterPos, LenVec, Radius )= + begingroup + save patha, pathb, pathc, noption, hashole, auxv, poption, vv; + path patha, pathb, pathc; + numeric noption; + boolean hashole, poption; + color auxv, vv; + vv = f-CenterPos; + patha := rigorouscircle( CenterPos, LenVec, Radius ); + pathb := rigorouscircle( CenterPos+LenVec, LenVec, Radius ); +% patha := goodcirclepath( CenterPos, LenVec, Radius ); +% pathb := goodcirclepath( CenterPos+LenVec, LenVec, Radius ); + auxv := ncrossprod( LenVec, ccrossprod( vv, LenVec ) ); + poption := abs( cdotprod( vv, auxv ) ) <= 1.05*Radius;% DANGER! + if poption: + draw patha; + draw pathb; + else: +% draw patha withcolor green; show patha; +% draw pathb withcolor green; show pathb; + hashole := (-1,-1) <> ( patha intersectiontimes pathb ); + if hashole: + pathc := buildcycle( patha, pathb ); % I don't get it! + %fill pathc withcolor red; % see fakehole.mp + fi; + noption = cdotprod( LenVec, vv ); + if noption > (conorm(LenVec)**2): + draw pathb; + if hashole: + draw pathc; + fi; + elseif noption < 0: + draw patha; + if hashole: + draw pathc; + fi; + fi; + fi + endgroup + enddef; + +% It is time for a kind of cube. Don't use SphericalDistortion here. + + def kindofcube(expr WithDash, IsVertex, RefP, + AngA, AngB, AngC, LenA, LenB, LenC ) = + begingroup + save star, pos, patw, patb, refv, near, centre, farv; + save newa, newb, newc, veca, vecb, vecc, auxx, auxy, i; + color star, pos[], refv, near, newa, newb, newc; + color veca, vecb, vecc, auxx, auxy, centre, farv; + path patw, patb; + numeric i; + veca = ( cosd(AngA)*cosd(AngB), + sind(AngA)*cosd(AngB), + sind(AngB) ); + auxx = ( cosd(AngA+90), sind(AngA+90), 0 ); + auxy = ccrossprod( veca, auxx ); + vecb = cosd(AngC)*auxx + sind(AngC)*auxy; + vecc = cosd(AngC+90)*auxx + sind(AngC+90)*auxy; + veca := LenA*veca; + vecb := LenB*vecb; + vecc := LenC*vecc; + if IsVertex: + star = RefP; + centre = RefP + 0.5*( veca + vecb + vecc); + else: + star = RefP - 0.5*( veca + vecb + vecc); + centre = RefP; + fi; + pos1 = star + veca; + pos2 = pos1 + vecb; + pos3 = pos2 + vecc; + pos4 = pos3 - vecb; + pos5 = pos4 - veca; + pos6 = pos5 + vecb; + pos7 = pos6 - vecc; + if ShadowOn: + patw = rp(cb(star))--rp(cb(pos1))--rp(cb(pos2)) + --rp(cb(pos3))--rp(cb(pos4)) + --rp(cb(pos5))--rp(cb(pos6))--rp(cb(pos7))--cycle; + patb = makepath makepen patw; + fill patb; + fi; + patw := rp(star)--rp(pos1)--rp(pos2)--rp(pos3)--rp(pos4) + --rp(pos5)--rp(pos6)--rp(pos7)--cycle; + patb := makepath makepen patw; + unfill patb; + draw patb; + i = 0; + if inplanarvolume( star, star+veca, f ): i := incr( i ); fi; + if inplanarvolume( star, star+vecb, f ): i := incr( i ); fi; + if inplanarvolume( star, star+vecc, f ): i := incr( i ); fi; + if (i=2) and WithDash: + message "Unable to dash kindofcube " & cstr( RefP ) & "."; + elseif i = 3: + message "f is inside kindofcube " & cstr( RefP ) & "."; + else: + refv = f - centre; + if cdotprod( refv, veca ) > 0: + newa = -veca; + else: + newa = veca; + fi; + if cdotprod( refv, vecb ) > 0: + newb = -vecb; + else: + newb = vecb; + fi; + if cdotprod( refv, vecc ) > 0: + newc = -vecc; + else: + newc = vecc; + fi; + near = centre - 0.5*( newa + newb + newc ); + draw rp(near)--rp(near+newa); + draw rp(near)--rp(near+newb); + draw rp(near)--rp(near+newc); + if WithDash: + if i=1: + message "Unable to dash kindofcube " & cstr( RefP ) & "."; + else: + farv = centre + 0.5*( newa + newb + newc ); + draw rp(farv)--rp(farv-newa) dashed evenly; + draw rp(farv)--rp(farv-newb) dashed evenly; + draw rp(farv)--rp(farv-newc) dashed evenly; + fi; + fi; + fi + endgroup + enddef; + +% Maybe you would like to calculate the angular arguments of kindofcube... + + def getanglepair( expr InVec ) = + begingroup + save alphaone, alphatwo; + numeric alphaone, alphatwo; + alphaone = angle( ( X(InVec), Y(InVec) ) ); + alphatwo = angle( ( X(InVec) ++ Y(InVec), Z(InVec) ) ); + ( (alphaone,alphatwo) ) + endgroup + enddef; + +% It's a bit late now but the stage must be set. + + def setthestage( expr NumberOfSideSquares, SideSize )= + begingroup + save i, j, squaresize, squarepath, ca, cb, cc, cd; + numeric i, j, squaresize; + path squarepath; + color ca, cb, cc, cd; + squaresize = SideSize/(2*NumberOfSideSquares-1); + for i=-0.5*SideSize step 2*squaresize until 0.5*SideSize: + for j=-0.5*SideSize step 2*squaresize until 0.5*SideSize: + ca := (i,j,HoriZon); + cb := (i,j+squaresize,HoriZon); + cc := (i+squaresize,j+squaresize,HoriZon); + cd := (i+squaresize,j,HoriZon); + squarepath := rp(ca)--rp(cb)--rp(cc)--rp(cd)--cycle; + unfill squarepath; + draw squarepath; + endfor; + endfor + endgroup + enddef; + + def setthearena( expr NumberOfDiameterCircles, ArenaDiameter )= + begingroup + save i, j, circlesize, polar, currpos, phi, cpath; + numeric i, j, circlesize, polar, phi; + color currpos; + path cpath; + circlesize = ArenaDiameter/NumberOfDiameterCircles; + for i=0.5*ArenaDiameter step -circlesize until 0.4*circlesize: + polar := floor(6.28318*i/circlesize); + for j=1 upto polar: + phi := 360*j/polar; + currpos := i*(cosd(phi),sind(phi),0)+(0,0,HoriZon); + cpath := rigorouscircle( currpos, blue, 0.3*circlesize); + unfill cpath; + draw cpath; + endfor; + endfor + endgroup + enddef; + +% And a transparent dome. The angular momentum vector is supposed +% to point from the concavity of the dome and into outer space. +% The pen can only be changed with a previous drawoptions(). + + def spatialhalfsfear(expr Center, AngulMom, Radius ) = + begingroup + save spath, cpath, fpath, rpath, cutp; + path spath, cpath, fpath, rpath, cutp; + save ap, bp, cp, dp, cuti, cute, vp; + pair ap, bp, cp, dp, cuti, cute, vp; + save auxcos, actcos, actsin, auxsin; + numeric auxcos, actcos, actsin, auxsin; + picture partoffear; + save A, B; + color A, B; + spath = rigorousfearpath( Center, Radius ); + auxcos = getcossine( Center, Radius ); + actcos = cdotprod( N( f - Center ), N( AngulMom ) ); + actsin = sqrt(1-actcos**2); + auxsin = sqrt(1-auxcos**2); + if actsin <= auxcos: + if actcos >= 0: + cpath = goodcirclepath( Center, AngulMom, Radius ); + draw cpath; + else: + draw spath; + fi; + else: + fpath = spatialhalfcircle( Center, AngulMom, Radius, true ); + rpath = spatialhalfcircle( Center, AngulMom, Radius, false ); + cuti = point 0 of rpath; + cute = point ( length rpath ) of rpath; + ap = 1.1[cuti,cute]; + bp = 1.1[cute,cuti]; + partoffear = nullpicture; + addto partoffear doublepath spath; + A = ncrossprod( f-Center, ncrossprod( f-Center, AngulMom ) ); + B = Center + 1.1*Radius*( auxcos*N( f-Center ) + auxsin*A ); + vp = rp(B) - rp(Center); + cp = ap + vp; + dp = bp + vp; + cutp = ap--cp--dp--bp--cycle; + clip partoffear to cutp; + draw fpath; + draw partoffear; + if actcos >= 0: + draw rpath; + fi; + fi + endgroup + enddef; + +% Take a donut. + + def smoothtorus( expr Tcenter, Tmoment, Bray, Sray ) = + begingroup + save nearaxe, sideaxe, viewline, circlecenter, circlemoment; + save ang, ind, i, anglim, angstep, cuspcond, holepic, coofrac; + save cpath, apath, opath, ipath, wp, ep, refpair, distance, lr; + color nearaxe, sideaxe, viewline, circlecenter, circlemoment; + numeric ang, ind, i, anglim, angstep, distance, coofrac, lr; + path cpath, apath, opath, ipath, wp, ep; + pair outerp[], innerp[], refpair; + boolean cuspcond; + picture holepic; + save tmoment; + color tmoment; + angstep= 4; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DANGER! + viewline = f-Tcenter; + if cdotprod( viewline, Tmoment ) < 0: + tmoment = -Tmoment; + else: + tmoment = Tmoment; + fi; + refpair = unitvector( rp(Tcenter+tmoment)-rp(Tcenter) ); + sideaxe = Bray*ncrossprod( tmoment, viewline ); + nearaxe = Bray*ncrossprod( sideaxe, tmoment ); + coofrac = cdotprod( viewline, N( tmoment ) )/Sray; + if (coofrac <= 1.04) and (coofrac >= 1.01): %%%%%%%%%%% DANGER! + ind = 360/angstep; + anglim = 0.5*angstep; + for i=1 upto ind: + ang := i*angstep-anglim-180.0; + circlecenter:= nearaxe*cosd(ang)+sideaxe*sind(ang)+Tcenter; + circlemoment:=-nearaxe*sind(ang)+sideaxe*cosd(ang); + cpath:=spatialhalfcircle(circlecenter,circlemoment,Sray,true); + if i >= 0.5*ind+1: + outerp[i]=point 0 of cpath; + else: + outerp[i]=point (length cpath) of cpath; + fi; + endfor; + opath = for i=1 upto ind: outerp[i].. endfor cycle; + unfill opath; + draw opath; + elseif coofrac < 1.01: + distance = conorm( viewline ); + lr = Bray + Sray*( 1 +-+ coofrac ); + anglim = angle( ( lr, distance +-+ lr ) ); + ind = 2*floor(anglim/angstep); + angstep := 2*anglim/(ind+1); + for i=0 upto 0.5*ind-1: + ang := i*angstep-anglim; + circlecenter:= nearaxe*cosd(ang)+sideaxe*sind(ang)+Tcenter; + circlemoment:=-nearaxe*sind(ang)+sideaxe*cosd(ang); + cpath:=spatialhalfcircle(circlecenter,circlemoment,Sray,true); + innerp[i]=point 0 of cpath; + outerp[i]=point (length cpath) of cpath; + endfor; + for i=0.5*ind upto ind-2: + ang := (i+2)*angstep-anglim; + circlecenter:= nearaxe*cosd(ang)+sideaxe*sind(ang)+Tcenter; + circlemoment:=-nearaxe*sind(ang)+sideaxe*cosd(ang); + cpath:=spatialhalfcircle(circlecenter,circlemoment,Sray,true); + outerp[i]=point 0 of cpath; + innerp[i]=point (length cpath) of cpath; + endfor; + if coofrac > 0.94: + apath = innerp0 + for i=1 upto ind-2: + ..innerp[i] + endfor + --cycle; + else: + apath = innerp0 for i=2 upto ind-2: ..innerp[i] endfor + ..outerp[ind-2] for i=ind-3 downto 0: ..outerp[i] endfor + ..cycle; + fi; + unfill apath; + draw apath; + else: + ind = 360/angstep; + anglim = 0.5*angstep; + for i=1 upto ind: + ang := i*angstep-anglim-180.0; + circlecenter:= nearaxe*cosd(ang)+sideaxe*sind(ang)+Tcenter; + circlemoment:=-nearaxe*sind(ang)+sideaxe*cosd(ang); + cpath:=spatialhalfcircle(circlecenter,circlemoment,Sray,true); + if i >= 0.5*ind+1: + outerp[i]=point 0 of cpath; + innerp[i]=point (length cpath) of cpath; + else: + innerp[i]=point 0 of cpath; + outerp[i]=point (length cpath) of cpath; + fi; + endfor; + opath = for i=1 upto ind: outerp[i].. endfor cycle; + ipath = for i=1 upto ind: innerp[i].. endfor cycle; + holepic = currentpicture; + clip holepic to ipath; + unfill opath; + draw holepic; + draw opath; + draw ipath; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Perhaps there is an analytic way of getting the angle of the cusp point? +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + i := ceiling(1+0.5*ind); + cuspcond = false; + forever: + i := incr( i ); + exitif i > ind-1; + cuspcond := + refpair dotprod innerp[i+1] < refpair dotprod innerp[i]; + exitif cuspcond; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if cuspcond: + show "Torus shows cusp points."; + ep = outerp[ind-i+1]--innerp[ind-i+1]; + wp = innerp[i]--outerp[i]; + unfill buildcycle(reverse opath,ep,ipath,wp); + draw opath; + draw subpath (i-1,ind-i) of ipath; + fi; + fi; + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Non-standard objects: + + def positivecharge( expr InFactPositive, Center, BallRay ) = + begingroup + save auxc, axehorf, axeside, viewline, spath, pa, pb, pc, pd; + color auxc, axehorf, axeside, viewline, pa, pb, pc, pd; + path spath; + viewline = f - Center; + axehorf = N( ( X(viewline), Y(viewline), 0 ) ); + axeside = ccrossprod( axehorf, blue ); + if ShadowOn: + fill rigorousfearshadowpath( Center, BallRay ); + fi; + spath = rigorousfearpath( Center, BallRay ); + unfill spath; + draw spath; + auxc = Center + sqrt(3)*axehorf; + pa = auxc + axeside; + pb = auxc - axeside; + angline( pa, pb, Center, BallRay, "", top ); + if InFactPositive: + pc = auxc + blue; + pd = auxc - blue; + angline( pc, pd, Center, BallRay, "", top ); + fi + endgroup + enddef; + + def simplecar(expr RefP, AngCol, LenCol, FronWheelCol, RearWheelCol )= + begingroup + save veca, vecb, vecc, anga, angb, angc, lena, lenb, lenc; + save auxn, viewline, auxm, fl, fr, rl, rr, auxx, auxy; + save fmar, fthi, fray, rmar, rthi, rray, inrefp;; + color veca, auxx, auxy, vecb, vecc, viewline; + color fl, fr, rl, rr, inrefp; + numeric anga, angb, angc, lena, lenb, lenc, auxm, auxn; + numeric fmar, fthi, fray, rmar, rthi, rray; + anga = X( AngCol ); + angb = Y( AngCol ); + angc = Z( AngCol ); + lena = X( LenCol ); + lenb = Y( LenCol ); + lenc = Z( LenCol ); + fmar = X( FronWheelCol ); + fthi = Y( FronWheelCol ); + fray = Z( FronWheelCol ); + rmar = X( RearWheelCol ); + rthi = Y( RearWheelCol ); + rray = Z( RearWheelCol ); + veca = ( cosd(anga)*cosd(angb), + sind(anga)*cosd(angb), + sind(angb) ); + auxx = ( cosd(anga+90), sind(anga+90), 0 ); + auxy = ccrossprod( veca, auxx ); + vecb = cosd(angc)*auxx + sind(angc)*auxy; + vecc = cosd(angc+90)*auxx + sind(angc+90)*auxy; + viewline = f - RefP; + auxm = cdotprod( viewline, veca ); + auxn = cdotprod( viewline, vecb ); + inrefp = RefP - 0.5*lenc*vecc; + fl = inrefp + (0.5*lena-fmar-fray)*veca + 0.5*lenb*vecb; + fr = inrefp + (0.5*lena-fmar-fray)*veca - 0.5*lenb*vecb; + rl = inrefp - (0.5*lena-rmar-rray)*veca + 0.5*lenb*vecb; + rr = inrefp - (0.5*lena-rmar-rray)*veca - 0.5*lenb*vecb; + if auxn > 0.5*lenb: + if auxm > 0: + rigorousdisc( 0, true, rr, rray, -rthi*vecb ); + rigorousdisc( 0, true, fr, fray, -fthi*vecb ); + kindofcube(false,false,RefP,anga,angb,angc,lena,lenb,lenc); + rigorousdisc( 0, true, rl, rray, rthi*vecb ); + rigorousdisc( 0, true, fl, fray, fthi*vecb ); + else: + rigorousdisc( 0, true, fr, fray, -fthi*vecb ); + rigorousdisc( 0, true, rr, rray, -rthi*vecb ); + kindofcube(false,false,RefP,anga,angb,angc,lena,lenb,lenc); + rigorousdisc( 0, true, fl, fray, fthi*vecb ); + rigorousdisc( 0, true, rl, rray, rthi*vecb ); + fi; + elseif auxn < -0.5*lenb: + if auxm > 0: + rigorousdisc( 0, true, rl, rray, rthi*vecb ); + rigorousdisc( 0, true, fl, fray, fthi*vecb ); + kindofcube(false,false,RefP,anga,angb,angc,lena,lenb,lenc); + rigorousdisc( 0, true, rr, rray, -rthi*vecb ); + rigorousdisc( 0, true, fr, fray, -fthi*vecb ); + else: + rigorousdisc( 0, true, fl, fray, fthi*vecb ); + rigorousdisc( 0, true, rl, rray, rthi*vecb ); + kindofcube(false,false,RefP,anga,angb,angc,lena,lenb,lenc); + rigorousdisc( 0, true, fr, fray, -fthi*vecb ); + rigorousdisc( 0, true, rr, rray, -rthi*vecb ); + fi; + else: + if auxm > 0: + rigorousdisc( 0, true, rl, rray, rthi*vecb ); + rigorousdisc( 0, true, fl, fray, fthi*vecb ); + rigorousdisc( 0, true, rr, rray, -rthi*vecb ); + rigorousdisc( 0, true, fr, fray, -fthi*vecb ); + kindofcube(false,false,RefP,anga,angb,angc,lena,lenb,lenc); + else: + rigorousdisc( 0, true, fl, fray, fthi*vecb ); + rigorousdisc( 0, true, rl, rray, rthi*vecb ); + rigorousdisc( 0, true, fr, fray, -fthi*vecb ); + rigorousdisc( 0, true, rr, rray, -rthi*vecb ); + kindofcube(false,false,RefP,anga,angb,angc,lena,lenb,lenc); + fi; + fi + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Differential Equations: + +% Oh! Well... I couldn't do without differential equations. +% The point is that I want to draw vectorial field lines in space. +% Keep it simple: second-order Runge-Kutta method. + + def fieldlinestep( expr Spos, Step )( text VecFunc )= + begingroup + save kone, ktwo; + color kone, ktwo; + kone = Step*VecFunc( Spos ); + ktwo = Step*VecFunc( Spos+0.5*kone ); + ( Spos+ktwo ) + endgroup + enddef; + + def fieldlinepath( expr Numb, Spos, Step )( text VecFunc )= + begingroup + save ind, flpath, prevpos, thispos; + numeric ind; + color prevpos, thispos; + path flpath; + prevpos = Spos; + flpath = rp( Spos ) + for ind=1 upto Numb: + hide( thispos := fieldlinestep( prevpos, Step, VecFunc ) ) + ..rp( thispos ) + hide( prevpos := thispos ) + endfor; + ( flpath ) + endgroup + enddef; + +% Another point is that I want to draw trajectories in space. + + def trajectorypath( expr Numb, Spos, Svel, Step )( text VecFunc )= + begingroup + save ind, flpath, prevpos, thispos, prevvel, thisvel; + save rone, rtwo, vone, vtwo; + numeric ind; + color prevpos, thispos, prevvel, thisvel; + color rone, rtwo, vone, vtwo; + path flpath; + prevpos = Spos; + prevvel = Svel; + flpath = rp( Spos ) + for ind=1 upto Numb: + hide( + vone := Step*VecFunc( prevpos ); + rone := Step*prevvel; + vtwo := Step*VecFunc( prevpos+0.5*rone ); + rtwo := Step*( prevvel+0.5*vone ); + thisvel := prevvel+vtwo; + thispos := prevpos+rtwo + ) + ..rp( thispos ) + hide( + prevpos := thispos; + prevvel := thisvel + ) + endfor; + ( flpath ) + endgroup + enddef; + +% And now i stop. + + def magnetictrajectorypath( expr Numb, Spos, Svel, Step ) + ( text VecFunc )= + begingroup + save ind, flpath, prevpos, thispos, prevvel, thisvel; + save rone, rtwo, rthr, rfou, vone, vtwo, vthr, vfou; + numeric ind; + color prevpos, thispos, prevvel, thisvel; + color rone, rtwo, rthr, rfou, vone, vtwo, vthr, vfou; + path flpath; + prevpos = Spos; + prevvel = Svel; + flpath = rp( Spos ) + for ind=1 upto Numb: + hide( + vone := Step*ccrossprod( VecFunc( prevpos ), prevvel ); + rone := Step*prevvel; + vtwo := + Step*ccrossprod(VecFunc(prevpos+0.5*rone),prevvel+0.5*vone); + rtwo := Step*( prevvel+0.5*vone ); + vthr := + Step*ccrossprod(VecFunc(prevpos+0.5*rtwo),prevvel+0.5*vtwo); + rthr := Step*( prevvel+0.5*vtwo ); + vfou := + Step*ccrossprod( VecFunc( prevpos+rthr ), prevvel+vthr ); + rfou := Step*( prevvel+vthr ); + thisvel := prevvel+(vtwo+vthr)/3+(vone+vfou)/6; + thispos := prevpos+(rtwo+rthr)/3+(rone+rfou)/6 + ) + ..rp( thispos ) + hide( + prevpos := thispos; + prevvel := thisvel + ) + endfor; + ( flpath ) + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Part II: +%%%%%%%%%%%%%%%%%%%%%%%%%%%% Advanced 3D-Object Definition Functions %%%%% +% Please check the examples in planpht.mp or the default object below %%%% + + vardef makeline@#( text vertices )= + save counter; + numeric counter; + counter = 0; + for ind=vertices: + counter := incr( counter ); + L@#p[counter] := V[ind]; + endfor; + npl@# := counter; + NL := @# + enddef; + + vardef makeface@#( text vertices )= + save counter; + numeric counter; + counter = 0; + for ind=vertices: + counter := incr( counter ); + F@#p[counter] := V[ind]; + endfor; + npf@# := counter; + NF := @#; + FCD[NF] := false + enddef; + + vardef getready( expr commstr, refpoi ) = + Nobjects := incr( Nobjects ); + ostr[Nobjects] := commstr; + RefDist[Nobjects] := conorm( f - refpoi ) + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Definition of a 3D-Object +% define vertices + V1 := (1,0,0); + V2 := (0,0,0); + V3 := (0,1,0); + V4 := (-0.3,0.2,1); + V5 := (1,0,1); + V6 := (0,1,1); + V7 := (0,0,2); + V8 := (-0.5,0.6,1.2); + V9 := (0.6,-0.5,1.2); + makeline1(8,9); + makeface1(1,2,7); + makeface2(2,3,7); + makeface3(5,4,6); +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% or the old way below %%%%%%%%% +% define lines +% NL := 1; % number of lines +% npl1 := 2; % number of vertices of the first line +% L1p1 := V8; +% L1p2 := V9; +% define faces +% NF := 3; % number of faces +% npf1 := 3; % number of vertices of the first face +% F1p1 := V1; +% F1p2 := V2; +% F1p3 := V7; +% npf2 := 3; % number of vertices of the second face +% F2p1 := V2; +% F2p2 := V3; +% F2p3 := V7; +% npf3 := 3; % number of vertices of the third face +% F3p1 := V5; +% F3p2 := V4; +% F3p3 := V6; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% Flip first argument accordingly to the second + + def flipvector(expr A, B) = + begingroup + save nv; + color nv; + if cdotprod( A, B) < 0 : + nv = -A; + else: + nv = A; + fi; + ( nv ) + endgroup + enddef; + +% Frontside of a face given by three of its vertices + + def facevector(expr A, B, C) = + begingroup + save nv; + color nv; + nv = ncrossprod( A-B, B-C ); + ( flipvector( nv, f-B ) ) + endgroup + enddef; + +% Center or inside of a face + + def masscenter(expr Nsides)(suffix Coords) = + begingroup + save mc, counter; + numeric counter; + color mc; + mc = (0,0,0); + for counter=1 upto Nsides: + mc := mc + Coords[counter]; + endfor; + ( mc / Nsides ) + endgroup + enddef; + +% Direction of coverability. The trick is here. +% The condition for visibility is +% that the angle beetween the vector that goes from the side of a face to +% the mark position and the covervector must be greater than 90 degrees. + + def covervector(expr A, B, MassCenter) = + begingroup + save nv; + color nv; + nv = ncrossprod( A-f, B-f ); + ( flipvector( nv, MassCenter-B) ) + endgroup + enddef; + +% O.K., the following macro tests the visibility of a point + + def themarkisinview(expr Mark, OwnFace) = + begingroup + save c, faceVec, centerPoint, coverVec, inview, l, m; + color c, faceVec, centerPoint, coverVec; + boolean inview; + numeric l, m; + l = 0; + forever: % cycle over faces until the mark is covered + l := incr(l); + if l = OwnFace: + l := incr(l); + fi; + exitif l > NF; + faceVec := facevector(F[l]p1,F[l]p2,F[l]p3); + inview := true; + if cdotprod(Mark-F[l]p1, faceVec) < 0: + centerPoint := masscenter(npf[l], F[l]p); + m := 0; + forever: % cycle over segments of a face + m := incr(m); + exitif m > npf[l]; + if m < npf[l]: + c := F[l]p[m+1]; + else: + c := F[l]p1; + fi; + coverVec := covervector(F[l]p[m], c, centerPoint); + inview := cdotprod(Mark-c,coverVec) <= 0; + exitif inview; + endfor; + fi; + exitif not inview; + endfor; + ( inview ) + endgroup + enddef; + +% Check for possible intersection or crossing. + + def maycrossviewplan(expr Ea, Eb, La, Lb) = + begingroup + ( abs( cdotprod( ccrossprod(Ea-f,Eb-f), La-Lb ) ) > 0.001 ) + endgroup + enddef; + +% Calculate the intersection of two sides. This is very nice. + + def crossingpoint(expr Ea, Eb, La, Lb) = + begingroup + save thecrossing, perpend, exten, aux; + color thecrossing, perpend; + numeric exten, aux; + if ( Ea = Lb ) or ( Ea = La ): + thecrossing = Ea; + elseif ( Eb = Lb ) or ( Eb = La ): + thecrossing = Eb; + else: + perpend = ccrossprod( Ea-f, Eb-f ); + if conorm( perpend ) = 0: + thecrossing = Eb; + else: + aux = cdotprod( perpend, f ); + cdotprod( perpend, thecrossing ) = aux; + ( La-Lb )*exten = La-thecrossing; + fi; + fi; + ( thecrossing ) + endgroup + enddef; + +% Calculate the intersection of an edge and a face. + + def crossingpointf(expr Ea, Eb, Fen) = + begingroup + save thecrossing, perpend, exten; + color thecrossing, perpend; + numeric exten; + perpend = ccrossprod( F[Fen]p1-F[Fen]p2, F[Fen]p3-F[Fen]p2 ); + cdotprod(perpend,thecrossing) = cdotprod( perpend, F[Fen]p2 ); + ( Ea-Eb )*exten = Ea-thecrossing; + ( thecrossing ) + endgroup + enddef; + +% Check for possible intersection of an edge and a face. + + def maycrossviewplanf(expr Ea, Eb, Fen) = + begingroup + save perpend; + color perpend; + perpend = ccrossprod( F[Fen]p1-F[Fen]p2, F[Fen]p3-F[Fen]p2 ); + ( abs( cdotprod( perpend, Ea-Eb ) ) > 0.001 ) + endgroup + enddef; + +% The intersection point must be within the extremes of the segment. + + def insidedge(expr Point, Ea, Eb) = + begingroup + save fract; + numeric fract; + fract := cdotprod( Point-Ea, Point-Eb ); + ( fract < 0 ) + endgroup + enddef; + +% Skip edges that are too far away + + def insideviewsphere(expr Ea, Eb, La, Lb) = + begingroup + save furthestofedge, nearestofline, flag, exten; + color nearestofline, furthestofedge; + boolean flag; + numeric exten; + nearestofline = La+exten*(Lb-La); + cdotprod( nearestofline-f, Lb-La ) = 0; + if conorm(Ea-f) < conorm(Eb-f): + furthestofedge := Eb; + else: + furthestofedge := Ea; + fi; + if conorm(nearestofline-f) < conorm(furthestofedge-f): + flag := true; + else: + flag := false; + fi; + ( flag ) + endgroup + enddef; + +% The intersection point must be within the triangle defined by +% three points. Really smart. + + def insidethistriangle(expr Point, A, B, C ) = + begingroup + save arep, area, areb, aret, flag; + color arep, area, areb, aret; + boolean flag; + aret = ccrossprod( A-C, B-C ); + arep = flipvector( ccrossprod( C-Point, A-Point ), aret ); + area = flipvector( ccrossprod( A-Point, B-Point ), aret ); + areb = flipvector( ccrossprod( B-Point, C-Point ), aret ); + flag = ( conorm( arep + area + areb ) <= 2*conorm( aret ) ); + ( flag ) + endgroup + enddef; + +% The intersection point must be within the triangle defined by the +% point of view f and the extremes of some edge. + + def insideviewtriangle(expr Point, Ea, Eb) = + insidethistriangle( Point, Ea, Eb, f ) + enddef; + +% The intersection point must be within the face + + def insidethisface(expr Point, FaN) = + begingroup + save flag, m, central; + boolean flag; + numeric m; + color central; + m = npf[FaN]; + central = masscenter( m, F[FaN]p ); + flag = insidethistriangle( Point, + central, F[FaN]p[m], F[FaN]p[1] ); + for m=2 upto npf[FaN]: + exitif flag; + flag := insidethistriangle( Point, + central, F[FaN]p[m-1], F[FaN]p[m] ); + endfor; + ( flag ) + endgroup + enddef; + +% Draw the visible parts of a straight line in beetween points A and B +% changing the thickness of the line accordingly to the distance from f + + def coarse_line(expr A, B, Facen, Press, Col) = + begingroup + save k, mark, stepVec; + numeric k; + color mark, stepVec; + stepVec := resolvec(A,B); + k := 0; + forever: % cycle along a whole segment + mark := A+(k*stepVec); + exitif cdotprod(B-mark,stepVec) < 0; + if themarkisinview(mark,Facen): + signalvertex(mark, Press, Col); + fi; + k := incr(k); + endfor + endgroup + enddef; + +% Get the 2D rigorous projection path of a face. +% Don't use SphericalDistortion here. + + def facepath(expr Facen) = + begingroup + save thispath, counter; + path thispath; + numeric counter; + thispath = rp(F[Facen]p[1])-- + for counter=2 upto (npf[Facen]): + rp(F[Facen]p[counter])-- + endfor + cycle; + ( thispath ) + endgroup + enddef; + + def faceshadowpath(expr Facen) = + begingroup + save thispath, counter; + path thispath; + numeric counter; + thispath = rp(cb(F[Facen]p[1]))-- + for counter=2 upto (npf[Facen]): + rp(cb(F[Facen]p[counter]))-- + endfor + cycle; + ( thispath ) + endgroup + enddef; + +% FillDraw a face + + def face_invisible( expr Facen )( text LineAtribs )= + begingroup + save ghost; + path ghost; + ghost = facepath( Facen ); + unfill ghost; + draw ghost LineAtribs + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Different kinds of renderers: + +% Draw only the faces, calculating edge-intersections. +% Mind-blogging kind of thing. +% Only two constraints: i) faces must be planar and +% ii) faces must be convex. +% Pay attention: depends on PrintStep (resolvec). + + def sharpraytrace +%% ( expr LabelCrossPoints ) + = + begingroup + save i, j, k, l, counter, a, b, c, d, currcross; + save flag, swapc, swapn, somepoint, frac, exten; + save trythis, refpath, otherpath, intertimes; + save counter, infolabel; + numeric i, j, k, l, counter, swapn; + color a, b, c, d, currcross, swapc; + boolean flag, trythis; + path refpath, otherpath; + pair intertimes; + string infolabel; + color crosspoin[]; + numeric sortangle[]; + for i=1 upto NF: % scan all faces + for j=1 upto npf[i]: % scan all edges + a := F[i]p[j]; + if j <> npf[i]: + b := F[i]p[j+1]; + else: + b := F[i]p1; + fi; + crosspoin[1] := a; + counter := 2; + refpath := rp(a)--rp(b); % The limits a and b of one + % side of one face + for k=1 upto NF: + otherpath := facepath(k); + intertimes := refpath intersectiontimes otherpath; + trythis := xpart intertimes <> 0; + if trythis and (xpart intertimes <> 1) and (k <> i): + for l=1 upto npf[k]: + c := F[k]p[l]; + if l < npf[k]: + d := F[k]p[l+1]; + else: + d := F[k]p1; + fi; + if insideviewsphere( a, b, c, d ): + if maycrossviewplan( a, b, c, d ): + currcross := crossingpoint( a, b, c, d ); + if insideviewtriangle( currcross, a, b ): + if insidedge( currcross, c, d ): + swapc := ccrossprod( a-b, f-currcross); + swapc := ccrossprod(swapc,f-currcross); + color somepo; + numeric fract; + (b-a)*fract = somepo-a; + cdotprod(swapc,somepo)=cdotprod(swapc,f); + if (fract>0) and (fract<1): + crosspoin[counter] := somepo; + counter := incr(counter); + fi; + fi; + fi; + fi; + fi; + endfor; + if maycrossviewplanf( a, b, k ): + currcross := crossingpointf( a, b, k ); + if insidethisface( currcross, k ): + if insidedge( currcross, a, b ): + crosspoin[counter] := currcross; + counter := incr(counter); + fi; + fi; + fi; + fi; + endfor; + crosspoin[counter] := b; + sortangle[1] := 0; + for k=2 upto counter: + sortangle[k] := conorm(crosspoin[k]-a); + endfor; + forever: + flag := true; + for k=2 upto counter: + if sortangle[k] < sortangle[k-1]: + swapn := sortangle[k-1]; + sortangle[k-1] := sortangle[k]; + sortangle[k] := swapn; + swapc := crosspoin[k-1]; + crosspoin[k-1] := crosspoin[k]; + crosspoin[k] := swapc; + flag := false; + fi; + endfor; + exitif flag; + endfor; + for k=2 upto counter: + swapc := resolvec(crosspoin[k-1],crosspoin[k]); + flag := themarkisinview( crosspoin[k-1]+swapc, i ); + if flag and themarkisinview( crosspoin[k]-swapc, i ): + draw rp(crosspoin[k-1])--rp(crosspoin[k]); + fi; + endfor; +% if LabelCrossPoints: +% for k=1 upto counter: +% infolabel:=decimal(i)&","&decimal(j)&","&decimal(k); +% infolabel := "0"; +% dotlabelrand(infolabel,rp(crosspoin[k])); +% endfor; +% fi; + endfor; + endfor + endgroup + enddef; + +% Draw three-dimensional lines checking visibility. + + def lineraytrace(expr Press, Col) = + begingroup + save i, j, a, b; + numeric i, j; + color a, b; + for i=1 upto NL: % scan all lines + for j=1 upto npl[i]-1: + a := L[i]p[j]; + b := L[i]p[j+1]; + coarse_line( a, b, 0, Press, Col); + endfor; + endfor + endgroup + enddef; + +% Draw only the faces, rigorously projecting the edges. + + def faceraytrace(expr Press, Col)= + begingroup + save i, j, a, b; + numeric i, j; + color a, b; + for i=1 upto NF: % scan all faces + for j=1 upto npf[i]: + a := F[i]p[j]; + if j <> npf[i]: + b := F[i]p[j+1]; + else: + b := F[i]p1; + fi; + coarse_line( a, b, i, Press, Col); + endfor; + endfor + endgroup + enddef; + +% Fast test for your three-dimensional object + + def draw_all_test( expr AlsoDrawLines )= + begingroup + save i, j, a, b; + numeric i, j; + color a, b; + if ShadowOn: + for i=1 upto NF: + fill faceshadowpath( i ); + endfor; + if AlsoDrawLines: + for i=1 upto NL: % scan all lines + for j=1 upto npl[i]-1: + a := L[i]p[j]; + b := L[i]p[j+1]; + drawsegment( cb(a), cb(b) ); + endfor; + endfor; + fi; + fi; + for i=1 upto NF: % scan all faces + for j=1 upto npf[i]: + a := F[i]p[j]; + if j <> npf[i]: + b := F[i]p[j+1]; + else: + b := F[i]p1; + fi; + drawsegment( a, b ); + endfor; + endfor; + if AlsoDrawLines: + for i=1 upto NL: % scan all lines + for j=1 upto npl[i]-1: + a := L[i]p[j]; + b := L[i]p[j+1]; + drawsegment( a, b ); + endfor; + endfor; + fi + endgroup + enddef; + +% Don't use SphericalDistortion here. + + def fill_faces( text LineAtribs )= + begingroup + save i; + numeric i; + if ShadowOn: + for i=1 upto NF: + fill faceshadowpath( i ); + endfor; + fi; + for i=1 upto NF: + face_invisible( i, LineAtribs ); + endfor + endgroup + enddef; + + def doitnow = + begingroup + save i, j, farone; + numeric i, j, farone[]; + for i=1 upto Nobjects: + farone[i] := i; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Shell's Method of sorting %%%%%%%% + save inc, v, vv; + numeric inc, v, vv; + inc = 1; + forever: + inc := 3*inc+1; + exitif inc > Nobjects; + endfor; + forever: + inc := round(inc/3); + for i=inc+1 upto Nobjects: + v := RefDist[i]; + vv:= farone[i]; + j := i; + forever: + exitunless RefDist[j-inc] > v; + RefDist[j] := RefDist[j-inc]; + farone[j] := farone[j-inc]; + j := j-inc; + exitif j <= inc; + endfor; + RefDist[j] := v; + farone[j] := vv; + endfor; + exitunless inc > 1; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + for i=Nobjects downto 1: + j := farone[i]; + scantokens ostr[j]; + endfor + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Nematic Liquid Crystal wise: + + def generatedirline(expr Lin, Phi, Theta, Long, Currpos ) = + begingroup + save longvec; + color longvec; + npl[Lin] := 2; + longvec := Long*( cosd(Phi)*cosd(Theta), + sind(Phi)*cosd(Theta), + sind(Theta) ); + L[Lin]p1 := Currpos-0.5*longvec; + L[Lin]p2 := Currpos+0.5*longvec + endgroup + enddef; + + def generatedirface(expr Fen, Phi, Theta, Long, Base, Currpos ) = + begingroup + save basevec, longvec; + color basevec, longvec; + npf[Fen] := 3; + longvec := Long*( cosd(Phi)*cosd(Theta), + sind(Phi)*cosd(Theta), + sind(Theta) ); + basevec := Base*ncrossprod( Currpos-f, longvec ); + F[Fen]p1 := Currpos-0.5*(longvec+basevec); + F[Fen]p2 := Currpos+0.5*longvec; + F[Fen]p3 := Currpos-0.5*(longvec-basevec) + endgroup + enddef; + + def generateonebiax(expr Lin, Phi, Theta, Long, + SndDirAngl, Base, Currpos ) = + begingroup + save basevec, longvec, u, v; + color basevec, longvec, u, v; + npl[Lin] := 4; + longvec := Long*( cosd(Phi)*cosd(Theta), + sind(Phi)*cosd(Theta), + sind(Theta) ); + v = (-sind(Phi), cosd(Phi), 0); + u = ( cosd(Phi)*cosd(Theta+90), + sind(Phi)*cosd(Theta+90), + sind(Theta+90) ); + basevec := Base*( v*cosd(SndDirAngl)+u*sind(SndDirAngl) ); + L[Lin]p1 := Currpos-0.5*longvec; + L[Lin]p2 := Currpos+0.5*basevec; + L[Lin]p3 := Currpos+0.5*longvec; + L[Lin]p4 := Currpos-0.5*basevec + endgroup + enddef; + + def director_invisible( expr SortEmAll, ThickenFactor, CyclicLines )= + begingroup + save i, j, k, farone, thisfar; + save outerr, innerr, direc, ounum; + numeric i, j, k, farone[], dist[], thisfar, ounum; + pen actualpen, outerr, innerr; + path direc; + actualpen = currentpen; + if SortEmAll: + for i=1 upto NL: % scan all lines + dist[i] := conorm( masscenter( npl[i], L[i]p ) - f ); + farone[i] := i; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Shell's Method of sorting %%%%%%%% + save inc, v, vv; + numeric inc, v, vv; + inc = 1; + forever: + inc := 3*inc+1; + exitif inc > NL; + endfor; + forever: + inc := round(inc/3); + for i=inc+1 upto NL: + v := dist[i]; + vv:= farone[i]; + j := i; + forever: + exitunless dist[j-inc] > v; + dist[j] := dist[j-inc]; + farone[j] := farone[j-inc]; + j := j-inc; + exitif j <= inc; + endfor; + dist[j] := v; + farone[j] := vv; + endfor; + exitunless inc > 1; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + else: + for i=1 upto NL: + farone[i] := i; + endfor; + fi; + for i=NL downto 1: % draw all pathes + j := farone[i]; + direc := rp( L[j]p1 ) + for k=2 upto npl[j]: + --rp( L[j]p[k] ) + endfor; + if CyclicLines: + direc := direc--cycle; + fi; + ounum := Spread*ps( masscenter(npl[j],L[j]p), ThickenFactor ); + outerr := pencircle scaled ounum; + innerr := pencircle scaled (0.8*ounum); %% DANGER %% + pickup outerr; + draw direc withcolor black; + pickup innerr; + draw direc withcolor background; + endfor; + pickup actualpen + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Plotting: + +% Define and draw surfaces with a triangular mesh. +% On a hexagonal or triangular area. Without sorting (no need). + + def hexagonaltrimesh( expr BeHexa,theN,SideSize )( text SurFunc ) = + begingroup + save i, j, posx, posy, posz, higx, higy, + counter, stepx, stepy, poi, lowx, lowy, + newn, bola, bolb, bolc; + numeric i, j, posx, posy, posz, higx, higy, + counter, stepx, stepy, lowx, lowy, newn; + color poi[][]; + boolean bola, bolb, bolc; + npf0 := 3; + FCD0 := true; % this is used in the calls to fillfacewithlight + ActuC := incr( ActuC ); + if ActuC > TableColors: + ActuC := 1; + fi; + FC0 := ActuC; %% + counter = 0; + stepy = SideSize/theN; + stepx = 0.5*stepy*sqrt(3); + lowy = -0.5*SideSize; + lowx = -sqrt(3)*SideSize/6; + higy = -lowy; + higx = sqrt(3)*SideSize/3; + for i=0 upto theN: + for j=0 upto theN-i: + posx := lowx + i*stepx; + posy := lowy + i*stepx/sqrt(3) + j*stepy; + posz := SurFunc( posx, posy ); + poi[i][j] := ( posx, posy, posz ); + endfor; + endfor; + if BeHexa: + newn = round((theN+1)/3)+1; + else: + newn = 1; + fi; + for j=newn upto theN-newn+1: + F0p1 := poi[0][j-1]; + F0p2 := poi[0][j]; + F0p3 := poi[1][j-1]; + fillfacewithlight( 0 ); % see below + endfor; + for i=1 upto theN-1: + for j=1 upto theN-i: + bola := ( i < newn ) and ( j < newn-i ); + bolb := ( i < newn ) and ( j > theN-newn+1 ); + bolc := ( i > theN-newn ); + if not ( bola or bolb or bolc ): + F0p1 := poi[i-1][j]; + F0p2 := poi[i][j-1]; + F0p3 := poi[i][j]; + fillfacewithlight( 0 ); + F0p1 := poi[i+1][j-1]; + fillfacewithlight( 0 ); + fi; + endfor; + endfor; + i := theN-newn+1; + for j=1 upto newn-1: + F0p1 := poi[i-1][j]; + F0p2 := poi[i][j-1]; + F0p3 := poi[i][j]; + fillfacewithlight( 0 ); + endfor; + endgroup + enddef; + + def fillfacewithlight( expr FaceN ) = + begingroup + save perpvec, reflectio, viewvec, inciden, refpos, projincid; + save shiftv, fcol, lcol, theangle, ghost, pa, pb, pc, j, lowcolor; + color perpvec, reflectio, viewvec, inciden, refpos, projincid; + color shiftv, fcol, lcol, pa, pb, pc, lowcolor; + numeric theangle, j; + path ghost; + ghost := rp( F[FaceN]p1 ) + for j=2 upto npf[FaceN]: + --rp( F[FaceN]p[j] ) + endfor + --cycle; + if OverRidePolyhedricColor: + unfill ghost; + else: + refpos = masscenter( npf[FaceN], F[FaceN]p ); + pa = F[FaceN]p1; + pb = F[FaceN]p2; + pc = F[FaceN]p3; + inciden = LightSource - refpos; + viewvec = f - refpos; + perpvec = ncrossprod( pa-pb, pb-pc ); + if cdotprod( perpvec, blue ) < 0: + perpvec := -perpvec; + fi; + projincid = perpvec*cdotprod( perpvec, inciden ); + shiftv = inciden - projincid; + reflectio = projincid - shiftv; + theangle = getangle( reflectio, viewvec ); + if FCD[FaceN]: + lowcolor = TableC[FC[FaceN]]; + else: + lowcolor = TableC0; + fi; + lcol = (cosd( theangle ))[lowcolor,HigColor]; + if cdotprod( viewvec, perpvec ) < 0: + fcol = lcol - SubColor; + else: + fcol = lcol; + fi; + fill ghost withcolor fcol; + fi; + draw ghost; + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Part III (parametric plots and another renderer): +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%% Kindly contributed by Jens Schwaiger %%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% dmin_ is the minimal distance of all faces to f; +% dmax_ is the maximal distance of all faces to f; +% (both values are determined in "draw_invisible") +% Facen is the number of the face to be filled; +% ColAtrib is the color used for filling; +% ColAtribone the color used for drawing; +% Colordensity depends on distance of the face from f + + def face_drawfill( expr Facen, dmin_, dmax_ ,ColAtrib, ColAtribone )= + begingroup + save j, ptmp, colfac_, coltmp_; + path ghost; + numeric j, colfac_; + color ptmp, coltmp_; + ghost := rp( F[Facen]p1 ); + for j=2 upto npf[Facen]: + ghost := ghost--rp( F[Facen]p[j] ); + endfor; + ghost := ghost--cycle; + ptmp:= masscenter( npf[Facen], F[Facen]p ) - f; + % 0<=colfac_<=1 + colfac_ := ( conorm(ptmp)-dmin_ )/( dmax_ - dmin_ ); + % color should be brighter, if distance to f is smaller + colfac_ := 1 - colfac_; + % color should be not to dark, i.e., >=0.1 (and <=1) + colfac_ := 0.9colfac_ + 0.1; + % now filling and drawing with appropriate color; + fill ghost withcolor colfac_*ColAtrib; + draw ghost withcolor colfac_*ColAtribone; + endgroup + enddef; + +% Now a much faster faces-only-ray-tracer based upon the unfill +% command and the constraint of non-intersecting faces of similar +% sizes. Faces are sorted by distance from nearest vertex or +% masscenter to the point of view. This routine may be used to +% draw graphs of 3D surfaces (use masscenters in this case). +% +% Option=true: test all vertices +% Option=false: test masscenters of faces +% DoJS=true: use face_drawfill by J. Schwaiger +% DoJS=false: use fillfacewithlight by L. Nobre G. +% ColAtrib=color for filling faces +% ColAtribone=color for drawing edges + + def draw_invisible( expr Option, DoJS, ColAtrib, ColAtribone )= + begingroup + save i, j, a, b, thisfar, ptmp, farone; + numeric i, j, farone[], dist[], thisfar, distmin_, distmax_; + color a, b, ptmp; + for i=1 upto NF: % scan all faces + if Option: % for distances of + dist[i] = conorm( F[i]p1 - f ); % nearest vertices + if i=1: + distmin_ := dist1; % initialisation of + distmax_ := dist1; % dmin_ and dmax_ + fi; + distmin_ := min( distmin_, dist[i] ); + distmax_ := max( distmax_, dist[i] ); + for j=2 upto npf[i]: + thisfar := conorm( F[i]p[j] - f ); + distmin_ := min( distmin_, thisfar ); + distmax_ := max( distmax_, thisfar ); + if thisfar < dist[i]: + dist[i] := thisfar; + fi; + endfor; + else: % for distances of centers of mass + dist[i] := conorm( masscenter( npf[i], F[i]p ) - f ); + if i=1: + distmin_ := dist1; % initialisation of + distmax_ := dist1; % dmin_ and dmax_ in this case + fi; + distmin_ := min( distmin_, dist[i] ); + distmax_ := max( distmax_, dist[i] ); + fi; + farone[i] = i; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Shell's Method of sorting %%%%%%%% + save inc, v, vv; + numeric inc, v, vv; + inc = 1; + forever: + inc := 3*inc+1; + exitif inc > NF; + endfor; + forever: + inc := round(inc/3); + for i=inc+1 upto NF: + v := dist[i]; + vv:= farone[i]; + j := i; + forever: + exitunless dist[j-inc] > v; + dist[j] := dist[j-inc]; + farone[j] := farone[j-inc]; + j := j-inc; + exitif j <= inc; + endfor; + dist[j] := v; + farone[j] := vv; + endfor; + exitunless inc > 1; + endfor; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + for i=NF downto 1: % draw and fill all pathes + j := farone[i]; + if DoJS: + face_drawfill( j, distmin_, distmax_, ColAtrib, ColAtribone ); + else: + fillfacewithlight( j ); + fi; + endfor; + endgroup + enddef; + +% Move to the good range (-1,1). + + def bracket( expr low, poi, hig ) = + begingroup + save zout; + numeric zout; + zout = (2*poi-hig-low)/(hig-low); + if zout > 1: + zout := 1; + fi; + if zout < -1: + zout := -1; + fi; + ( zout ) + endgroup + enddef; + +% Define parametric surfaces with a triangular mesh... unless a +% quadrangular mesh can do a fine, rigorous job just as well. + + def partrimesh( expr nt,ns, + lowt,higt,lows,higs, + lowx,higx,lowy,higy, + lowz,higz, + facz)( text parSurFunc ) = + begingroup + save i, j, k, posx, posy, posz; + save counter, stept, steps, poss, post, tmpaux; + save veca, vecb, vecc, vecd; + numeric i, j, k, posx, posy, posz, counter, stept, steps; + color poi[][], tmpaux, veca, vecb, vecc, vecd; + counter := NF; % <-- NF must be initialized! + ActuC := incr( ActuC ); + if ActuC > TableColors: + ActuC := 1; + fi; + steps = ( higs - lows )/ns; + stept = ( higt - lowt )/nt; + for i=0 upto ns: + for j=0 upto nt: + poss := lows + i*steps; + post := lowt + j*stept; + tmpaux := parSurFunc( poss, post ); + posz := Z(tmpaux); + posx := X(tmpaux); + posy := Y(tmpaux); + posx := bracket(lowx,posx,higx); + posy := bracket(lowy,posy,higy); + posz := bracket(lowz,posz,higz)/facz; + poi[i][j] := ( posx, posy, posz ); + endfor; + endfor; + for i=1 upto ns: + for j=1 step 1 until nt: + veca := poi[i][j]-poi[i-1][j]; + vecb := poi[i][j]-poi[i-1][j-1]; + vecc := poi[i][j]-poi[i][j-1]; + if abs(cdotprod(ccrossprod(veca,vecb),vecc))<0.00005: %DANGER! + counter := incr(counter); + npf[counter] := 4; + F[counter]p1 := poi[i-1][j-1]; + F[counter]p2 := poi[i-1][j]; + F[counter]p3 := poi[i][j]; + F[counter]p4 := poi[i][j-1]; + FC[counter] := ActuC; + FCD[counter] := true; + else: + tmpaux:= + 0.25*(poi[i-1][j-1]+poi[i-1][j]+poi[i][j]+poi[i][j-1]); + veca := poi[i-1][j-1]-tmpaux; + vecb := poi[i-1][j]-tmpaux; + vecc := poi[i][j]-tmpaux; + vecd := poi[i][j-1]-tmpaux; + if getangle(vecb,vecd)>getangle(veca,vecc): + for k=-1 upto 0: + counter := incr(counter); + npf[counter] := 3; + F[counter]p1 := poi[i-1][j-1]; + F[counter]p2 := poi[i+k][j-1-k]; + F[counter]p3 := poi[i][j]; + FC[counter] := ActuC; + FCD[counter] := true; + endfor; + else: + for k=-1 upto 0: + counter := incr(counter); + npf[counter] := 3; + F[counter]p1 := poi[i+k][j+k]; + F[counter]p2 := poi[i][j-1]; + F[counter]p3 := poi[i-1][j]; + FC[counter] := ActuC; + FCD[counter] := true; + endfor; + fi; + fi; + endfor; + endfor; + NF := counter; + endgroup + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Part IV (automatic perspective tuning, polyhedric vertex approximation): +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + def randomfear = + begingroup + save a, b, c, i, h; + numeric a, b, c, i, h; + i = uniformdeviate( 360 ); + h = uniformdeviate( 180 ); + a = cosd( h )*cosd( i ); + b = sind( h )*cosd( i ); + c = sind( i ); + ( (a,b,c) ) + endgroup + enddef; + + def renormalizevc( expr inF, inVC ) = + begingroup + save a; + color a; + cdotprod( inF, a ) = 0; + inF - a = whatever*( inF - inVC ); + ( a ) + endgroup + enddef; + + def calculatecost( expr TryF, TryVc, TrySp, TrySh ) = + begingroup + save sumsquares, i, difpair, xx, yy; + numeric sumsquares, i, xx, yy; + pair difpair; + sumsquares = 0; + f := TryF; + viewcentr := TryVc; + Spread := TrySp; + ShiftV := TrySh; + for i=1 upto PhotoMarks: + difpair := 0.05*(rp(PhotoPoint[i]) - PhotoPair[i]); % DANGER + xx := ((xpart difpair)**2)/PhotoMarks; + yy := ((ypart difpair)**2)/PhotoMarks; + sumsquares := sumsquares + xx + yy; + endfor; + ( sumsquares ) + endgroup + enddef; + + def forcepointinsidefear( text A ) = + begingroup + if abs( X(A) ) > 0.5*MaxFearLimit : + A := 0.5*A*MaxFearLimit/abs( X(A) ); + fi; + if abs( Y(A) ) > 0.5*MaxFearLimit : + A := 0.5*A*MaxFearLimit/abs( Y(A) ); + fi; + if abs( Z(A) ) > 0.5*MaxFearLimit : + A := 0.5*A*MaxFearLimit/abs( Z(A) ); + fi; + ( A ) + endgroup + enddef; + + def forcepairinsidepage( text A ) = + begingroup + if xpart A > 2*(xpart OriginProjPagePos): + A := ( 2*(xpart OriginProjPagePos), ypart A ); + fi; + if ypart A > 2*(ypart OriginProjPagePos): + A := ( xpart A, 2*(ypart OriginProjPagePos) ); + fi; + if xpart A < 0: + A := ( 0, ypart A ); + fi; + if ypart A < 0: + A := ( xpart A, 0 ); + fi; + ( A ) + endgroup + enddef; + + def calculatejump( expr AverCost, PrevCost, RandCost, JumpLimit ) = + begingroup + save funfact, numer, denom; + numeric funfact, numer, denom; + if RandCost+PrevCost > 2*AverCost: + numer := 3*PrevCost - 4*AverCost + RandCost; + denom := 4*( RandCost + PrevCost - 2*AverCost ); + if abs( denom )*JumpLimit < abs( numer ): + funfact := 0; + else: + funfact := numer/denom; + fi; + else: + funfact := 0; + fi; + ( funfact ) + endgroup + enddef; + + def photoreverse( expr IterNum, ExpTao, JumpFact ) = + begingroup + save j, auxvc, actfact, auxfac; + save prevf, randf, averf, prevvc, randvc, avervc; + save prevsp, randsp, aversp, prevsh, randsh, aversh; + save prevcost, randcost, avercost, spreadlimit, expfact; + numeric j, prevsp, randsp, aversp, actfact; + numeric prevcost, randcost, avercost; + numeric spreadlimit, expfact; + color prevf, randf, averf, prevvc, randvc, avervc, auxvc; + pair prevsh, randsh, aversh; + spreadlimit = 20; % DANGER + prevf = f; + prevvc= viewcentr; + prevsp= Spread; + prevsh= ShiftV; + prevcost = calculatecost( prevf, prevvc, prevsp, prevsh ); + show prevcost; + auxfac = -1280.0/ExpTao/IterNum; + for j=0 upto IterNum: + expfact := mexp(auxfac*j); + randf := prevf + expfact*randomfear; + randcost := calculatecost( randf, prevvc, prevsp, prevsh ); + averf := 0.5[prevf,randf]; + avercost := calculatecost( averf, prevvc, prevsp, prevsh ); + actfact := calculatejump(avercost,prevcost,randcost,JumpFact); + prevf := actfact[prevf,randf]; + auxvc := prevvc + expfact*randomfear; + randvc:= renormalizevc( randf, auxvc ); + randcost := calculatecost( prevf, randvc, prevsp, prevsh ); + auxvc := 0.5[prevvc,randvc]; + avervc:= renormalizevc( averf, auxvc ); + avercost := calculatecost( prevf, avervc, prevsp, prevsh ); + actfact := calculatejump(avercost,prevcost,randcost,JumpFact); + auxvc := actfact[prevvc,randvc]; + prevvc:= renormalizevc( prevf, auxvc ); + randsp:= prevsp+expfact*spreadlimit*(uniformdeviate( 1 ) - 0.5); + randcost := calculatecost( prevf, prevvc, randsp, prevsh ); + aversp:= 0.5[prevsp,randsp]; + avercost := calculatecost( prevf, prevvc, aversp, prevsh ); + actfact := calculatejump(avercost,prevcost,randcost,JumpFact); + prevsp:= actfact[prevsp,randsp]; + randsh:= prevsh + expfact*dir( uniformdeviate( 360 ) ); % DANGER + randcost := calculatecost( prevf, prevvc, prevsp, randsh ); + aversh:= 0.5[prevsh,randsh]; + avercost := calculatecost( prevf, prevvc, prevsp, aversh ); + actfact := calculatejump(avercost,prevcost,randcost,JumpFact); + prevsh:= actfact[prevsh,randsh]; + prevcost := calculatecost( prevf, prevvc, prevsp, prevsh ); + %show (prevcost,expfact); + endfor; + show prevcost; + endgroup + enddef; + + def calculatecostver(expr VerA,DisA,VerB,DisB,VerC,DisC,TryV) = + begingroup + save a, b, c; + numeric a, b, c; + a = conorm( TryV - VerA ) - DisA; + b = conorm( TryV - VerB ) - DisB; + c = conorm( TryV - VerC ) - DisC; + ( ( a ++ b ++ c )**2 ) + endgroup + enddef; + +% Be aware of the next three danger parameters. + + def improvertex( expr VerA, DisA, VerB, DisB, VerC, DisC, IniV ) = + begingroup + save j, iternum, prevcost, factry, actpoi, actfact; + save jumplim, trypoi, halfpo, expfact, randcost, avercost; + numeric j, iternum, prevcost, factry, randcost, avercost, actfact; + numeric jumplim, expfact; + color actpoi, trypoi, halfpo; + iternum = 100; % DANGER! + factry = 0.25; % DANGER! + jumplim = 2.5; % DANGER! + prevcost = calculatecostver(VerA,DisA,VerB,DisB,VerC,DisC,IniV); + trypoi = IniV; + show prevcost; + for j=0 upto iternum: + expfact := mexp(-j*200/iternum); % DANGER! + actpoi := trypoi+factry*expfact*randomfear; + randcost := + calculatecostver(VerA,DisA,VerB,DisB,VerC,DisC,actpoi); + halfpo := 0.5[trypoi,actpoi]; + avercost := + calculatecostver(VerA,DisA,VerB,DisB,VerC,DisC,halfpo); + actfact := calculatejump(avercost,prevcost,randcost,jumplim); + trypoi := actfact[trypoi,actpoi]; + prevcost := + calculatecostver(VerA,DisA,VerB,DisB,VerC,DisC,trypoi); +% show prevcost; + endfor; + show prevcost; + ( trypoi ) + endgroup; + enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% Part V (strictly two-dimensional): +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Produce the schematics of a spring. + + def springpath( expr begp, endp, piturnum, piturnproj, spgfrac )= + begingroup + boolean leftside; + numeric counter, springwidth; + pair stepdir, leftdir, rightdir, auxil, lastp, endvec; + path thespring; + leftside = true; + stepdir = spgfrac*(endp-begp)/piturnum; + endvec = (1-spgfrac)*(endp-begp)/2; + springwidth = piturnproj +-+ abs( stepdir ); + auxil = ( -ypart stepdir, xpart stepdir ); + leftdir = springwidth*unitvector( auxil ); + auxil := ( ypart stepdir, -xpart stepdir ); + rightdir = springwidth*unitvector( auxil ); + leftdir := (stepdir + leftdir)/2; + rightdir := (stepdir + rightdir)/2; + lastp = begp+endvec; + thespring := begp--lastp; + for counter=1 upto piturnum: + if leftside: + auxil := lastp + leftdir; + else: + auxil := lastp + rightdir; + fi; + lastp := lastp + stepdir; + thespring := thespring--auxil--lastp; + leftside := not leftside; + endfor; + thespring := thespring--endp; + ( thespring ) + endgroup + enddef; + +% Summarize a great length in a zig-zag frontier line + + def zigzagfrontier( expr begp, endp, nzigs, + dev, zthick, tthick, fthick, excol, incol )= + begingroup + interim linecap := squared; + interim linejoin := mitered; + boolean leftside; + numeric counter, tmpval; + pair stepdir, leftdir, rightdir, auxil, lastp; + path thefrontier; + leftside = true; + stepdir = (endp-begp)/nzigs; + leftdir = unitvector( ( -ypart stepdir, xpart stepdir ) ); + rightdir = unitvector( ( ypart stepdir, -xpart stepdir ) ); + thefrontier = begp; + lastp = begp; + for counter=1 upto nzigs-1: + lastp := lastp + stepdir; + tmpval := zthick+normaldeviate*dev; + if leftside: + auxil := lastp + leftdir*tmpval; + else: + auxil := lastp + rightdir*tmpval; + fi; + thefrontier := thefrontier--auxil; + leftside := not leftside; + endfor; + thefrontier := thefrontier--endp; + draw + thefrontier withcolor excol withpen pencircle scaled tthick; + draw + thefrontier withcolor incol withpen pencircle scaled fthick; + ( thefrontier ) + endgroup + enddef; + +% The name says it all. + + def randomcirc( expr radi, stddev, numpois )= + begingroup + numeric i, astep; + path ranc; + astep = 360/numpois; + ranc = (radi+stddev*normaldeviate)*dir(-180); + for i= -180+astep step astep until 180: + ranc := ranc--((radi+stddev*normaldeviate)*dir(i)); + endfor; + ranc := ranc--cycle; + ( ranc ) + endgroup + enddef; + +% Just label some 2D-place in a way similar to anglinen. + + def labeln(expr S, Pos, RelPos) = + begingroup + if RelPos = 0: + label.rt( S, Pos ); + elseif RelPos =1: + label.urt( S, Pos ); + elseif RelPos =2: + label.top( S, Pos ); + elseif RelPos =3: + label.ulft( S, Pos ); + elseif RelPos =4: + label.lft( S, Pos ); + elseif RelPos =5: + label.llft( S, Pos ); + elseif RelPos =6: + label.bot( S, Pos ); + elseif RelPos =7: + label.lrt( S, Pos ); + else: + label( S, Pos ); + fi + endgroup + enddef; + +% There must be a sort of planar cross-product. The z coordinate. + + def paircrossprod(expr A, B) = + ( (xpart A)*(ypart B) - (xpart B)*(ypart A) ) + enddef; + +% Just dot-label some 2D-place in a random way. + + def dotlabelrand(expr S, Pos ) = + begingroup + save RelPos; + numeric RelPos; + RelPos = floor( uniformdeviate(9) ); + if RelPos = 0: + dotlabel.rt( S, Pos ); + elseif RelPos =1: + dotlabel.urt( S, Pos ); + elseif RelPos =2: + dotlabel.top( S, Pos ); + elseif RelPos =3: + dotlabel.ulft( S, Pos ); + elseif RelPos =4: + dotlabel.lft( S, Pos ); + elseif RelPos =5: + dotlabel.llft( S, Pos ); + elseif RelPos =6: + dotlabel.bot( S, Pos ); + elseif RelPos =7: + dotlabel.lrt( S, Pos ); + else: + dotlabel( S, Pos ); + fi + endgroup + enddef; + + def radialcross( expr A, la, B, lb, GoUp) = + begingroup + numeric x, y, xa, xb, ya, yb, YM, YA, La, Lb; + numeric AA, BB, CC, auxil, na, nb, norm; + pair As, Bs, selectedpoint; + na = abs(A); + nb = abs(B); + norm := 0; + for t = na, nb, la, lb: + if norm < t: + norm := t; + fi; + endfor; + xa = xpart A/norm; + xb = xpart B/norm; + ya = ypart A/norm; + yb = ypart B/norm; + La = la/norm; + Lb = lb/norm; + if abs( ya - yb ) < 0.005 : + x := La**2 - Lb**2 + xb**2 - xa**2; + x := 0.5*x/( xb - xa ); + auxil := sqrt( La**2 - (xa-x)**2 ); + As = ( x, ya + auxil ); + Bs = ( x, ya - auxil ); + else: + YM := (xb-xa)/(ya-yb); + YA := Lb**2 - La**2 + xa**2 - xb**2; + YA := 0.5*( YA - (ya-yb)**2 )/(ya-yb); + AA := 1 + YM**2; + BB := 2*( YM*YA - xa ); + CC := xa**2 - La**2 + YA**2; + CC := sqrt( BB**2 - 4*AA*CC ); + x := -0.5*( BB + CC )/AA; + y := YA + ya + YM*x; + Bs = ( x, y ); + x := -0.5*( BB - CC )/AA; + y := YA + ya + YM*x; + As = ( x, y ); + fi; + if ypart As > ypart Bs: + if GoUp: + selectedpoint = As; + else: + selectedpoint = Bs; + fi; + elseif ypart As = ypart Bs: + if xpart As > xpart Bs: + if GoUp: + selectedpoint = As; + else: + selectedpoint = Bs; + fi; + else: + if GoUp: + selectedpoint = Bs; + else: + selectedpoint = As; + fi; + fi; + else: + if GoUp: + selectedpoint = Bs; + else: + selectedpoint = As; + fi; + fi; + ( norm*selectedpoint ) + endgroup + enddef; + + def ropethread( expr Index ) = + begingroup + save aux; + numeric aux; + if Index > RopeColors: + aux = 0; + else: + aux = Index; + fi; + ( aux ) + endgroup + enddef; + + def ropepattern( expr BasePath, RopeWidth, Nturns ) = + begingroup + save indturns, nmoves, indthread, movelen, turnlen, totlen; + numeric indturns, nmoves, indthread, movelen, turnlen, totlen; + save lenpos, timar, steplen, indstep, startdownc, startupcol; + numeric lenpos, timar, steplen, startdownc, indstep; + save actuc, actdc, stepwidth; + numeric actuc, actdc, stepwidth, startupcol; + save p; + pair p[]; + save actcolor; + color actcolor; + nmoves = 2*(RopeColors+1); + totlen = arclength BasePath; + turnlen = totlen/Nturns; + movelen = turnlen/nmoves; + steplen = movelen/2; + startdownc = 0; + startupcol = RopeColors; + stepwidth = RopeWidth/RopeColors; + for indturns=0 upto Nturns-1: + for indmove=0 upto nmoves-1: + for indstep=0 upto 3: + lenpos := + indturns*turnlen+indmove*movelen+indstep*steplen; + timar := arctime lenpos of BasePath; + p[indstep] := direction timar of BasePath rotated 90; + p[indstep] := unitvector( p[indstep] ); + p[indstep+4] := point timar of BasePath; + endfor; + actdc := startdownc; + for indthread=0 upto RopeColors: + p8 := p5-p1*(0.5*RopeWidth-(indthread-0.5)*stepwidth); + p9 := p4-p0*(0.5*RopeWidth-indthread*stepwidth); + p10:= p5-p1*(0.5*RopeWidth-(indthread+0.5)*stepwidth); + p11:= p6-p2*(0.5*RopeWidth-indthread*stepwidth); + actcolor := TableC[RopeColorSeq[actdc]]; + fill p8--p9--p10--p11--cycle withcolor actcolor; + actdc := ropethread( incr( actdc ) ); + endfor; + startdownc := ropethread( incr( startdownc ) ); + actuc := startupcol; + p9 := p5+p1*0.5*(RopeWidth+stepwidth); + p10:= p6+p2*0.5*RopeWidth; + p11:= p7+p3*0.5*(RopeWidth+stepwidth); + actcolor := TableC[RopeColorSeq[actuc]]; + fill p9--p10--p11--cycle withcolor actcolor; + actuc := ropethread( incr( actuc ) ); + for indthread=0 upto RopeColors-1: + p8 := p6+p2*(0.5*RopeWidth-indthread*stepwidth); + p9 := p5+p1*(0.5*RopeWidth-(indthread+0.5)*stepwidth); + p10:= p6+p2*(0.5*RopeWidth-(indthread+1)*stepwidth); + p11:= p7+p3*(0.5*RopeWidth-(indthread+0.5)*stepwidth); + actcolor := TableC[RopeColorSeq[actuc]]; + fill p8--p9--p10--p11--cycle withcolor actcolor; + actuc := ropethread( incr( actuc ) ); + endfor; + p8 := p6-p2*0.5*RopeWidth; + p9 := p5-0.5*p1*(RopeWidth+stepwidth); + p11:= p7-0.5*p3*(RopeWidth+stepwidth); + actcolor := TableC[RopeColorSeq[actuc]]; + fill p8--p9--p11--cycle withcolor actcolor; + startupcol := ropethread( incr( startupcol ) ); + endfor; + endfor + endgroup + enddef; + + def firsttangencypoint( expr Path, Point, ResolvN ) = + begingroup + save auxp, i, cutp, va, vb; + path auxp; + numeric i; + pair cutp, va, vb; + auxp = + hide( va := unitvector( point 0 of Path - Point ); + vb := unitvector( direction 0 of Path ); ) + ( paircrossprod( va, vb ), 0 ) + for i=1/ResolvN step 1/ResolvN until length Path: + hide( va := unitvector( point i of Path - Point ); + vb := unitvector( direction i of Path ); ) + ...( paircrossprod( va, vb ), i ) + endfor; + cutp = auxp intersectionpoint ( origin--( 0, length Path ) ); + ( point ( ypart cutp ) of Path ) + endgroup + enddef; + +% Calculate path areas (contributed by Boguslaw Jackowski +% to the metapost mailing list) + + vardef segmentarea( expr Ps ) = + save xa, xb, xc, xd, ya, yb, yc, yd; + ( xa, 20ya ) = point 0 of Ps; + ( xb, 20yb ) = postcontrol 0 of Ps; + ( xc, 20yc ) = precontrol 1 of Ps; + ( xd, 20yd ) = point 1 of Ps; + ( xb - xa )*( 10ya + 6yb + 3yc + yd ) + + ( xc - xb )*( 4ya + 6yb + 6yc + 4yd ) + + ( xd - xc )*( ya + 3yb + 6yc + 10yd ) + enddef; + + vardef cyclicpatharea( expr P ) = % result = area of the interior + segmentarea(subpath (0,1) of P) + for t=1 upto length(P)-1: + segmentarea(subpath (t,t+1) of P) endfor + enddef; + +% EOF diff --git a/Master/texmf-dist/metapost/feynmf/feynmp.mp b/Master/texmf-dist/metapost/feynmf/feynmp.mp new file mode 100644 index 00000000000..bda118cdf4a --- /dev/null +++ b/Master/texmf-dist/metapost/feynmf/feynmp.mp @@ -0,0 +1,2029 @@ +%% +%% This is file `feynmp.mp', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% feynmf.dtx (with options: `base,mp') +%% +%% Copyright (C) 1989, 1990, 1992-1995 by Thorsten.Ohl@Physik.TH-Darmstadt.de +%% +%% This file is NOT the source for feynmf, because almost all comments +%% have been stripped from it. It is NOT the preferred form of feynmf +%% for making modifications to it. +%% +%% Therefore you can NOT redistribute and/or modify THIS file. You can +%% however redistribute the complete source (feynmf.dtx and feynmf.ins) +%% and/or modify it under the terms of the GNU General Public License as +%% published by the Free Software Foundation; either version 2, or (at +%% your option) any later version. +%% +%% As a special exception, you can redistribute parts of this file for +%% the electronic distribution of scientific papers, provided that you +%% include a short note pointing to the complete source. +%% +%% Feynmf is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%% GNU General Public License for more details. +%% +%% You should have received a copy of the GNU General Public License +%% along with this program; if not, write to the Free Software +%% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% \CheckSum{924} +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren \( Right paren \) +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +def subgraph (expr x, y, wd, ht) = + begingroup + save c, ne, nw, sw, se; + pair c, ne, nw, sw, se; + sw = (x,y); + se = sw + (wd,0); + nw = sw + (0,ht); + ne = sw + (wd,ht); + c = .5[sw,ne]; +enddef; +def endsubgraph = + endgroup +enddef; +if known cmbase: + errhelp + "feynmf will only work with plain Metafont, as described in the book."; + errmessage "feynmf: CMBASE detected. Please use the PLAIN base."; + forever: + errmessage "No use in trying! You'd better eXit now ..."; + errorstopmode; + endfor +fi +vardef parse_RCS (suffix RCS) (expr s) = + save n, c; + numeric n, RCS[]; + string c; + RCS[0] := 0; + for n = 1 upto length (s): + c := substring (n-1,n) of s; + exitif ((RCS[0] > 0) and (c = " ")); + if ((c = "0") or (c = "1") or (c = "2") + or (c = "3") or (c = "4") or (c = "5") + or (c = "6") or (c = "7") or (c = "8") + or (c = "9")): + if RCS[0] = 0: + RCS[0] := 1; + RCS[RCS[0]] := 0; + fi + RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c); + elseif c = ".": + RCS[0] := RCS[0] + 1; + RCS[RCS[0]] := 0; + else: + fi + endfor +enddef; +vardef require_RCS_revision expr s = + save n, TeX_rev, mf_rev; + numeric n; + parse_RCS (TeX_rev, s); + parse_RCS (mf_rev, "$Revision: 1.30 $"); + for n = 1 upto min (2, TeX_rev[0], mf_rev[0]): + if TeX_rev[n] > mf_rev[n]: + errhelp + "Your version of `feynmf.sty' is higher that of your `feynmf.mf'."; + errmessage "feynmf: Metafont macros out of date"; + elseif TeX_rev[n] < mf_rev[n]: + errhelp + "Your version of `feynmf.mf' is higher that of your `feynmf.sty'."; + errmessage "feynmf: LaTeX style out of date"; + fi + exitif (TeX_rev[n] <> mf_rev[n]); + endfor +enddef; +vardef cullit = \ enddef; +color foreground; +foreground = black; +vardef beginchar (expr c, wd, ht, dp) = + LaTeX_file := ""; + beginfig(c); + w:=wd; + h:=ht; +enddef; +string LaTeX_file; +vardef endchar = + setbounds currentpicture to (0,0)--(w,0)--(w,h)--(0,h)--cycle; + if LaTeX_file <> "": + write EOF to LaTeX_file; + LaTeX_file := ""; + fi + endfig +enddef; +bp# := bp; +cc# := cc; +cm# := cm; +dd# := dd; +in# := in; +mm# := mm; +pc# := pc; +pt# := pt; +vardef define_blacker_pixels(text t) = + forsuffixes $=t: + $:=$.#; + endfor +enddef; +picture unitpixel; +unitpixel = nullpicture; +addto unitpixel contour unitsquare; +def t_ = \ enddef; +boolean feynmfwizard; +feynmfwizard := false; +thin# := 1pt#; % dimension of the lines +thick# := 2thin#; +arrow_len# := 4mm#; +arrow_ang := 15; +curly_len# := 3mm#; +dash_len# := 3mm#; % 'photon' lines +dot_len# := 2mm#; % 'photon' lines +wiggly_len# := 4mm#; % 'photon' lines +wiggly_slope := 60; +zigzag_len# := 2mm#; +zigzag_width# := 2thick#; +decor_size# := 5mm#; +dot_size# := 2thick#; +define_blacker_pixels (thick, thin, + dash_len, dot_len, wiggly_len, curly_len, + zigzag_len, zigzag_width, arrow_len, decor_size, dot_size); +def shrink expr s = + begingroup + if shrinkables <> "": + save tmp_; + forsuffixes $ = scantokens shrinkables: + if known $.#: + tmp_ := $.#; + save $; + $.# := s * tmp_; + define_blacker_pixels ($); + else: + tmp_ := $; + save $; + $ := s * tmp_; + fi + endfor + fi +enddef; +def endshrink = + endgroup +enddef; +string shrinkables; +shrinkables := ""; +vardef addto_shrinkables (text l) = + forsuffixes $ = l: + shrinkables := shrinkables & "," & str $; + endfor +enddef; +shrinkables := "thick,thin"; +addto_shrinkables (dash_len, dot_len); +addto_shrinkables (wiggly_len, curly_len); +addto_shrinkables (zigzag_len, zigzag_width); +addto_shrinkables (arrow_len); +addto_shrinkables (decor_size, dot_size); +LaTeX_unitlength := mm; +vardef count (text list) = + forsuffixes $ = list: + 1 endfor +enddef; +vardef getopt (suffix opt) (expr s) = + save n, argp, escape, anchor, skip; + numeric opt.first, opt.last, n, anchor; + string opt[], opt[]arg; + boolean opt[]tainted, argp, escape, skip; + opt.first := 0; + opt.last := 0; + opt[opt.last] := ""; + argp := false; + escape := false; + anchor := 0; + skip := true; + for n = 1 upto length (s): + if skip and (substring (n-1, n) of s = " "): + anchor := anchor + 1; + else: + skip := false; + if not escape and (substring (n-1, n) of s = ","): + if substring (n, n+1) of s = ",": + escape := true; + opt[opt.last]tainted := true; + else: + if argp: + opt[opt.last]arg := substring (anchor, n-1) of s; + else: + opt[opt.last] := substring (anchor, n-1) of s; + fi + anchor := n; + argp := false; + skip := true; + opt.last := opt.last + 1; + fi + elseif not argp and (substring (n-1, n) of s = "="): + opt[opt.last] := substring (anchor, n-1) of s; + anchor := n; + argp := true; + skip := true; + elseif argp or (substring (n-1, n) of s <> " "): + escape := false; + fi + fi + endfor + if argp: + opt[opt.last]arg := substring (anchor, length s) of s; + else: + opt[opt.last] := substring (anchor, length s) of s; + fi + for n = opt.first upto opt.last: + if known opt[n]tainted: + if opt[n]tainted: + opt[n]arg := untaint_string opt[n]arg; + fi + fi + endfor +enddef; +vardef untaint_string suffix s = + save n, anchor; + numeric n, anchor; + anchor := 0; + for n = 1 upto length (s) - 1: + if substring (n-1,n+1) of s = ",,": + substring (anchor, n-1) of s & + hide (anchor := n) + fi + endfor + substring (anchor, length s) of s +enddef; +vardef split_string (suffix comp) (expr s) = + save n, anchor; + numeric comp.first, comp.last, n, anchor; + string comp[]; + comp.first := 0; + comp.last := 0; + comp[comp.last] := ""; + anchor := 0; + for n = 1 upto length (s): + if substring (n-1,n) of s = ".": + comp[comp.last] := substring (anchor, n-1) of s; + comp.last := comp.last + 1; + anchor := n; + fi + endfor + comp[comp.last] := substring (anchor, length s) of s; +enddef; +vardef match_prefix (expr prefix, s) = + (prefix = substring (0, length prefix) of s) +enddef; +vardef match_option (expr s, option) = + save sc, optionc, n, i; + numeric sc.first, sc.last, optionc.first, optionc.last; + string sc[], optionc[]; + numeric n, i; + split_string (sc, s); + split_string (optionc, option); + n := sc.last - sc.first; + if n <> (optionc.last - optionc.first): + false + else: + true + for i = 0 upto n: + and match_prefix (sc[sc.first+i], + optionc[optionc.first+i]) + endfor + fi +enddef; +def save_picture text t = + save t; picture t; forsuffixes p=t: p:=nullpicture; endfor +enddef; +def begin_sketch = + begingroup save_picture currentpicture; + sketchlevel := sketchlevel+1; +enddef; +def end_sketch = + sketchlevel := sketchlevel-1; + sketchpad[sketchlevel] := currentpicture; + endgroup +enddef; +picture sketchpad[]; +sketchlevel := 1; +vardef use_sketch text t = + addto currentpicture also (sketchpad[sketchlevel] t) +enddef; +vardef cdraw expr p = + draw p withcolor foreground +enddef; +vardef cfill expr p = + fill p withcolor foreground +enddef; +vardef cfilldraw expr p = + filldraw p withcolor foreground +enddef; +vardef ccutdraw expr p = + cutdraw p withcolor foreground +enddef; +vardef cdrawdot expr p = + drawdot p withcolor foreground +enddef; +vardef isdigit expr s = + save n; + (s = "0") + for n = 1 upto 9: + or (s = decimal n) + endfor +enddef; +vardef digits_index (expr s, start) = + save n, m, from, to; + for n = start upto (length s)-1: + if isdigit (substring (n,n+1) of s): + from := n; + for m = n upto length s: + if not isdigit (substring (m,m+1) of s): + to := m; + fi + exitif known to; + endfor + fi + exitif known from; + endfor + (from, if known to: to else: infinity fi) +enddef; +vardef digits_to_brackets suffix suf = + save s, idx; + string s; + pair idx; + s = str suf; + idx = (0,0); + forever: + idx := digits_index (s, xpart idx); + exitif unknown xpart idx; + s := substring (0,xpart idx) of s + & "[]" & substring (ypart idx,infinity) of s; + endfor + s +enddef; +tile_grain := 1in/300; +vardef def_tile (suffix t) (expr wd, ht) = + if not picture tlist.t: + picture tlist.scantokens (digits_to_brackets t); + fi + tlist.t := nullpicture; + tlist.t.dx := max (floor wd, 1); + tlist.t.dy := max (floor ht, 1); +enddef; +vardef use_tile (suffix t) (expr x, y, wd, ht) = + fill unitsquare xscaled wd yscaled ht shifted (x,y) + withcolor background; + if str t = "shaded": + shade_rectangle (4thin, x, y, wd, ht); + elseif str t = "hatched": + shade_rectangle (5thin, x, y, wd, ht); + shade_rectangle (-5thin, x, y, wd, ht); + else: + if (picture tlist.t): + for nx = 0 upto wd/tlist.t.dx: + for ny = 0 upto ht/tlist.t.dy: + addto currentpicture + also (tlist.t shifted + ((x,y) + (nx*tlist.t.dx, ny*tlist.t.dy)) t_); + endfor + endfor + else: + errhelp "feynmf: your tiling has not been defined, " + & "check spelling and reprocess!"; + errmessage "feynmf: tiling `" & str t & "' not known, " + & "replaced by `shaded'"; + use_tile (shaded, x, y, wd, ht); + fi + fi +enddef; +vardef shade_rectangle (expr dd, x, y, wd, ht) = + save d, u, dx, dy, currentpen; + pen currentpen; + pickup pencircle scaled thin; + d := max (floor (abs dd), 1); + dx := max (wd, ht); + dy := max (wd, ht); + for u = 0 step d/dx until 1: + if dd > 0: + cdraw (x-d,y+u*dy-d)--(x+(1-u)*dx+d,y+dy+d); + cdraw (x+u*dx-d,y-d)--(x+dx+d,y+(1-u)*dy+d); + else: + cdraw (x-d,y+u*dy+d)--(x+u*dx+d,y-d); + cdraw (x+(1-u)*dx-d,y+dy+d)--(x+dx+d,y+(1-u)*dy-d); + fi + endfor +enddef; +def addto_tile (suffix t) = + addto tlist.t +enddef; +vardef tile_from_string (suffix t) (expr str) = + tile_grain := max (floor tile_grain, 1); + save grain, mx, x, y, n, c, pic; + string c; + picture pic; + pic := nullpicture; + grain := tile_grain; + mx := 0; + x := 0; + y := 0; + for n := 1 upto length str: + c := substring (n-1,n) of str; + if c = "/": + mx := max (mx, x); + y := y+1; + x := 0; + elseif c = "*": + addto pic also (unitpixel shifted (x,-y) t_); + x := x+1; + elseif c = ".": + x := x+1; + fi + endfor + def_tile (t, grain*mx, grain*(y+1)); + addto_tile (t) also (pic shifted (0,y) scaled grain t_); + pic := nullpicture; +enddef; +tile_from_string (gray10, + " ... /"& + " .*. /"& + " ... "); +tile_from_string (gray25, + " .. /"& + " *. "); +tile_from_string (gray50, + " .* /"& + " *. "); +tile_from_string (gray75, + " ** /"& + " .* "); +tile_from_string (gray90, + " *** /"& + " *.* /"& + " *** "); +vardef make_halftone (suffix t) (expr g, wd, ht) = + def_tile (t, wd, ht); + addto tlist.t contour unitsquare + xscaled wd yscaled ht withcolor ((1-g)*foreground + g*background) +enddef; +vardef tile (suffix t) (expr p) = + save u, x, y, max_x, min_x, max_y, min_y, xx, yy; + -max_x = -max_y = min_x = min_y = infinity; + for u = 0 step 0.1 until length p: + x := xpart (point u of p); + y := ypart (point u of p); + max_x := max(max_x, x); + max_y := max(max_y, y); + min_x := min(min_x, x); + min_y := min(min_y, y); + endfor + begin_sketch + use_tile (t, min_x, min_y, max_x-min_x, max_y-min_y); + clip currentpicture to p; + end_sketch; + use_sketch; +enddef; +vardef drawtile (suffix t) (expr p) = + tile (t, p); + cdraw p +enddef; +vardef use_halftone (expr g, x, y, wd, ht) = + fill unitsquare xscaled wd yscaled ht + shifted (x,y) withcolor ((1-g)*foreground + g*background) +enddef; +vardef halftone (expr g, p) = + fill p withcolor ((1-g)*foreground + g*background) +enddef; +vardef drawhalftone (expr g, p) = + fill p withcolor ((1-g)*foreground + g*background); + cdraw p +enddef; +vardef shade expr p = + tile (shaded, p) +enddef; +vardef hatch expr p = + tile (hatched, p) +enddef; +vardef emptydraw expr p = + cullit; + unfill p; + cullit; + cdraw p; +enddef; +vardef shadedraw expr p = + cullit; + unfill p; + cullit; + shade p; + cdraw p; +enddef; +vardef hatchdraw expr p = + cullit; + unfill p; + cullit; + hatch p; + cdraw p; +enddef; +vardef marrow (expr p, frac) = + save a, t, z; + pair z; + a = angle direction frac*length(p) of p; + z = point frac*length(p) of p; + (t1,whatever) = p intersectiontimes + (halfcircle scaled 2/3arrow_len rotated (a+90) shifted z); + (t2,whatever) = p intersectiontimes + (halfcircle scaled 4/3arrow_len rotated (a-90) shifted z); + arrow_head (p, t1, t2, arrow_ang) +enddef; +vardef tarrow (expr p, frac) = + save a, t, z; + pair z; + t1 = frac*length p; + a = angle direction t1 of p; + z = point t1 of p; + (t2,whatever) = p intersectiontimes + (halfcircle scaled 2arrow_len rotated (a-90) shifted z); + arrow_head (p, t1, t2, arrow_ang) +enddef; +vardef harrow (expr p, frac) = + save a, t, z; + pair z; + t2 = frac*length p; + a = angle direction t2 of p; + z = point t2 of p; + (t1,whatever) = p intersectiontimes + (halfcircle scaled 2arrow_len rotated (a+90) shifted z); + arrow_head (p, t1, t2, arrow_ang) +enddef; +vardef arrow_head (expr p, from, to, ang) = + save tip, ap, t; + pair tip; + path ap; + t1 := from; + t2 := to; + if t1 = -1: t1 := 0; fi + if t2 = -1: t2 := infinity; fi + tip = point t2 of p; + ap = subpath (t1,t2) of p shifted -tip; + (ap rotated ang + forced_join reverse ap rotated -ang + -- cycle) shifted tip +enddef; +vardef arrow expr p = + marrow (p, .5) +enddef; +tertiarydef p forced_join q = + subpath (0, length p - 1) of p + & point (length p - 1) of p + .. controls postcontrol (length p - 1) of p + and precontrol infinity of p + .. .5[point infinity of p, point 0 of q] + .. controls postcontrol 0 of q and precontrol 1 of q + .. point 1 of q + & subpath (1, infinity) of q +enddef; +vardef cut_decors (suffix from) (expr p) (suffix to) = + subpath (if known from.decor.shape: + xpart (p intersectiontimes + (from.decor.shape scaled from.decor.size + shifted from.loc)) + else: + 0 + fi, + if known to.decor.shape: + length p + - xpart (reverse p intersectiontimes + (to.decor.shape scaled to.decor.size + shifted to.loc)) + else: + infinity + fi) of p +enddef; +vardef make_blob (expr z_arg, diameter) = + save p,currentpen; path p; pen currentpen; + pickup pencircle scaled thick; + p = fullcircle scaled diameter shifted z_arg; + shadedraw p; +enddef; +vardef draw_blob (expr z_arg, diameter) = + if sketched_blob_diameter <> diameter: % drawn lately? + begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work! + sketched_blob_diameter:= diameter; % record it + fi + use_sketch shifted z_arg; % the easy way ... +enddef; +def force_new_blob = sketched_blob_diameter := -1; enddef; +force_new_blob; % initialize it. +vardef pixlen (expr p, n) = + for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor +enddef; +vardef segment_pixlen (expr p, n) = + for k=1 upto n: + abs (point k/n of p - point (k-1)/n of p) endfor +enddef; +vardef wiggly expr p_arg = + save wpp; + numeric wpp; + wpp = ceiling (pixlen (p_arg, 10) / wiggly_len) / length p_arg; + for k=0 upto wpp*length(p_arg) - 1: + point k/wpp of p_arg + {direction k/wpp of p_arg rotated wiggly_slope} .. + point (k+.5)/wpp of p_arg + {direction (k+.5)/wpp of p_arg rotated - wiggly_slope} .. + endfor + if cycle p_arg: cycle else: point infinity of p_arg fi +enddef; +vardef curly expr p = + save cpp; + numeric cpp; + cpp := ceiling (pixlen (p, 10) / curly_len) / length p; + if cycle p: + for k=0 upto cpp*length(p) - 1: + point (k+.33)/cpp of p + {direction (k+.33)/cpp of p rotated 90} .. + point (k-.33)/cpp of p + {direction (k-.33)/cpp of p rotated -90} .. + endfor + cycle + else: + point 0 of p + {direction 0 of p rotated -90} .. + for k=1 upto cpp*length(p) - 1: + point (k+.33)/cpp of p + {direction (k+.33)/cpp of p rotated 90} .. + point (k-.33)/cpp of p + {direction (k-.33)/cpp of p rotated -90} .. + endfor + point infinity of p + {direction infinity of p rotated 90} + fi +enddef; +vardef zigzag expr p = + save zpp; + numeric zpp; + zpp = ceiling (pixlen (p, 10) / zigzag_len) / length p; + if not cycle p: + point 0 of p -- + fi + for k = 0 upto zpp*length(p) - 1: + point (k+1/3)/zpp of p shifted + (zigzag_width + * dir angle (direction (k+1/3)/zpp of p rotated 90)) -- + point (k+2/3)/zpp of p shifted + (zigzag_width + * dir angle (direction (k+2/3)/zpp of p rotated -90)) -- + endfor + if cycle p: + cycle + else: + point infinity of p + fi +enddef; +save vsty_hash; +def style_def suffix s = + vsty_hash.s := 1; + expandafter quote vardef scantokens ("draw_" & str s) +enddef; +vardef vsty_exists suffix s = + known vsty_hash.s +enddef; +vardef valid_style expr s = + expandafter vsty_exists scantokens (s) +enddef; +style_def phantom expr p = + \ +enddef; +style_def phantom_arrow expr p = + cfill (arrow p); +enddef; +style_def plain expr p = + cdraw p; +enddef; +style_def plain_arrow expr p = + cdraw p; + cfill (arrow p); +enddef; +style_def dbl_plain expr p = + draw_double p; +enddef; +style_def dbl_plain_arrow expr p = + draw_double_arrow p; +enddef; +style_def wiggly expr p = + cdraw (wiggly p); +enddef; +style_def dbl_wiggly expr p = + draw_double (wiggly p); +enddef; +style_def curly expr p = + cdraw (curly p); +enddef; +style_def dbl_curly expr p = + draw_double (curly p); +enddef; +style_def zigzag expr p = + cdraw (zigzag p); +enddef; +style_def dbl_zigzag expr p = + draw_double (zigzag p); +enddef; +style_def dashes expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dash_len) / length p; + for k=0 upto dpp*length(p) - 1: + cdraw point k/dpp of p .. + point (k+.5)/dpp of p; + endfor +enddef; +style_def dbl_dashes expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dash_len) / length p; + for k=0 upto dpp*length(p) - 1: + draw_double point k/dpp of p .. + point (k+.5)/dpp of p; + endfor +enddef; +style_def dbl_dashes_arrow expr p = + draw_dbl_dashes p; + shrink (1.5); + cfill (arrow p); + endshrink; +enddef; +style_def dashes_arrow expr p = + draw_dashes p; + cfill (arrow p); +enddef; +style_def dots expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dot_len) / length p; + for k=0 upto dpp*length(p): + cdrawdot point k/dpp of p; + endfor +enddef; +style_def dbl_dots expr p = + save dpp; + numeric dpp; + dpp = ceiling (pixlen (p, 10) / dot_len) / length p; + begingroup + save oldpen; + pen oldpen; + oldpen := currentpen; + pickup oldpen scaled 3; % draw a thick linn + for k=0 upto dpp*length(p): + cdrawdot point k/dpp of p; + endfor + pickup oldpen; + cullit; + for k=0 upto dpp*length(p): + undrawdot point k/dpp of p; + endfor + cullit; % and remove the stuffing + endgroup; +enddef; +style_def dbl_dots_arrow expr p = + draw_dbl_dots p; + shrink (1.5); + cfill (arrow p); + endshrink; +enddef; +style_def dots_arrow expr p = + draw_dots p; + cfill (arrow p); +enddef; +style_def double expr p = + save oldpen; + pen oldpen; + oldpen := currentpen; + pickup oldpen scaled 3; + ccutdraw p; + pickup oldpen; + cullit; undraw p; cullit; +enddef; +style_def double_arrow expr p = + draw_double p; + shrink (1.5); + cfill (arrow p); + endshrink; +enddef; +style_def vanilla expr p = draw_plain p enddef; +style_def fermion expr p = draw_plain_arrow p enddef; +style_def quark expr p = draw_plain_arrow p enddef; +style_def electron expr p = draw_plain_arrow p enddef; +style_def photon expr p = draw_wiggly p enddef; +style_def boson expr p = draw_wiggly p enddef; +style_def gluon expr p = draw_curly p enddef; +style_def heavy expr p = draw_dbl_plain_arrow p enddef; +style_def ghost expr p = draw_dots_arrow p enddef; +style_def scalar expr p = draw_dashes_arrow p enddef; +vardef fermion expr path_arg = + cfill (arrow (path_arg)); + path_arg +enddef; +vardef photon expr path_arg = + wiggly path_arg +enddef; +vardef gluon expr path_arg = + curly path_arg +enddef; +tracingstats:=1; +boolean vtracing; +vtracing := false; % true +def vinit = + save vhash; + numeric vlist.first, vlist.last; + vlist.first := 1; + vlist.last := 0; + pair vlist[]loc; + numeric vlist[]decor.size, vlist[]decor.ang, + vlist[]arc.first, vlist[]arc.last, + vlist[]arc[], vlist[]arc[]lsr, + vlist[]arc[]tns, vlist[]arc[]lbl.dist, + vlist[]arc[]tag, vlist[]arc[]wd, vlist[]arc[]rub, + vlist[]constr.first, vlist[]constr.last, + vlist[]constr[], lambdax[][], lambday[][]; + string vlist[]name, vlist[]lbl, vlist[]decor.sty, + vlist[]arc[]sty, vlist[]arc[]lbl, vlist[]arc[]lbl.side; + numeric vlist[]lbl.ang; + path vlist[]decor.shape; + color vlist[]fore, vlist[]back, + vlist[]arc[]fore, vlist[]arc[]back; + numeric plist.first, plist.last, plist[]cnt, plist[]vtx[], + plist[]pull, plist[]lbl.ang, plist[]lbl.dist; + string plist[]lbl, plist[]sty, plist[]cona, plist[]conb; + plist.first := 1; + plist.last := 0; + numeric vlist[]poly.first, vlist[]poly.last, + vlist[]poly[], vlist[]poly[]idx; + pair lambdap[][]; + color plist[]fore, plist[]back; +enddef; +def vertices = + vlist.first upto vlist.last +enddef; +def varcs (text i) = + vlist[i]arc.first upto vlist[i]arc.last +enddef; +def vconstr (text i) = + vlist[i]constr.first upto vlist[i]constr.last +enddef; +def polygons = + plist.first upto plist.last +enddef; +def vpoly (text i) = + vlist[i]poly.first upto vlist[i]poly.last +enddef; +vardef venter suffix v = + if not vexists v: + vlist.last := vlist.last + 1; + vhash.v := vlist.last; + vlist[vhash.v]name := str v; + vlist[vhash.v]loc := (whatever,whatever); + vlist[vhash.v]arc.first := 1; + vlist[vhash.v]arc.last := 0; + vlist[vhash.v]constr.first := 1; + vlist[vhash.v]constr.last := 0; + vlist[vhash.v]lbl := ""; + vlist[vhash.v]lbl.ang := whatever; + vlist[vhash.v]lbl.dist := 3thick; + vlist[vhash.v]fore := (whatever, whatever, whatever); + vlist[vhash.v]back := (whatever, whatever, whatever); + vlist[vhash.v]poly.first := 1; + vlist[vhash.v]poly.last := 0; + fi +enddef; +vardef vexists suffix v = + if known vhash.v: true else: false fi +enddef; +vardef vlookup suffix v = + if vexists v: vhash.v else: 0 fi +enddef; +vardef vloc suffix v = + vlist[vlookup v]loc +enddef; +vardef vconnect (expr linesty) (text vl) = + save from, nfrom, nto, nopt, sty; + numeric from, nfrom, nto, nopt; + string sty; + getopt (opt, linesty); + sty := opt[opt.first]; + if known opt[opt.first]arg: + message "feynmf: line styles don't take arguments. " + & "Argument `" & opt[opt.first]arg & "' ignored."; + fi + opt.first := opt.first + 1; + forsuffixes to = vl: + venter to; + nto := vlookup to; + if known nfrom: + vlist[nfrom]arc.last := vlist[nfrom]arc.last + 1; + vlist[nfrom]arc[vlist[nfrom]arc.last] := nto; + vlist[nfrom]arc[vlist[nfrom]arc.last]tns := 1; + if nfrom <> nto: + vlist[nto]arc.last := vlist[nto]arc.last + 1; + vlist[nto]arc[vlist[nto]arc.last] := nfrom; + vlist[nto]arc[vlist[nto]arc.last]tns := 1; + fi + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl := ""; + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side := ""; + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist := 3thick; + for nopt = opt.first upto opt.last: + if match_option (opt[nopt], "tension"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]tns); + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nto]arc[vlist[nto]arc.last]tns); + elseif match_option (opt[nopt], "left"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr + := - scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := -1; + fi + elseif match_option (opt[nopt], "straight"): + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 0; + ignore_argument (opt[nopt], opt[nopt]arg); + elseif match_option (opt[nopt], "right"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr + := scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 1; + fi + elseif match_option (opt[nopt], "label"): + get_argument (opt[nopt], opt[nopt]arg, + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl); + elseif match_option (opt[nopt], "label.side"): + get_argument (opt[nopt], opt[nopt]arg, + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side); + elseif match_option (opt[nopt], "label.dist"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist); + elseif match_option (opt[nopt], "tag"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]tag + := scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]tag := 0; + fi + elseif match_option (opt[nopt], "width"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]wd); + elseif match_option (opt[nopt], "foreground"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]fore); + elseif match_option (opt[nopt], "background"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + vlist[nfrom]arc[vlist[nfrom]arc.last]back); + elseif match_option (opt[nopt], "rubout"): + if known opt[nopt]arg: + vlist[nfrom]arc[vlist[nfrom]arc.last]rub + := scantokens (opt[nopt]arg); + else: + vlist[nfrom]arc[vlist[nfrom]arc.last]rub := 2; + fi + else: + ignore_option (opt[nopt], opt[nopt]arg); + fi + endfor + handle_line_style (vlist[nfrom]arc[vlist[nfrom]arc.last]sty, sty); + vlist[nto]arc[vlist[nto]arc.last]lsr + := vlist[nfrom]arc[vlist[nfrom]arc.last]lsr; + fi + nfrom := nto; + endfor +enddef; +vardef handle_line_style (suffix sty) (expr name) = + if valid_style name: + sty := name; + else: + errhelp "feynmf: your linestyle is not recognizable, " + & "check spelling and reprocess!"; + errmessage "feynmf: line style `" & name & "' not known, " + & "replaced by `vanilla'"; + sty := "vanilla"; + fi +enddef; +vardef get_argument (expr opt, arg) (suffix variable) = + if known arg: + variable := arg; + else: + message "feynmf: option `" & opt & "' needs an argument. Ignored."; + fi +enddef; +vardef ignore_argument (expr opt, arg) = + if known arg: + message "feynmf: option `" & opt & "' doesn't take an argument. " + & "Argument `" & arg & "' ignored."; + fi +enddef; +vardef ignore_option (expr opt, arg)= + if known arg: + message "feynmf: ignoring option " & opt & "=" & arg & "."; + else: + message "feynmf: ignoring option " & opt & "."; + fi +enddef; +vardef vconnectn (expr linesty) (suffix v) (expr n) = + vconnect (linesty, vmklist (v, n)); +enddef; +vardef vpath@# (suffix from, to) = + save nfrom, nto, origin, index, unknown_path; + numeric nfrom, nto, origin, index; + path unknown_path; + if (known vloc from) and (known vloc to): + nfrom := vlookup from; + nto := vlookup to; + vmatch_path (nfrom, nto, maybe_empty@#); + if (unknown origin) or (unknown index): + vmatch_path (nto, nfrom, maybe_empty@#); + fi + fi + if (known origin) and (known index): + vbuild_cut_arc (origin, index) + else: + unknown_path + fi +enddef; +vardef maybe_empty@# = + save _prefix; + _prefix=137; + if known _prefix@#: + whatever + else: + @# + fi +enddef; +vardef vmatch_path (expr nfrom, nto, t) = + save i; + for i = varcs (nfrom): + if (vlist[nfrom]arc[i] = nto) and (known vlist[nfrom]arc[i]sty): + if unknown t: + origin := nfrom; + index := i; + else: + if known vlist[nfrom]arc[i]tag: + if vlist[nfrom]arc[i]tag = t: + origin := nfrom; + index := i; + fi + fi + fi + fi + endfor +enddef; +vardef vcyclen (expr sty) (suffix v) (expr n) = + for $ = 1 upto n - 1: + vconnect (sty, v[$], v[$+1]); + endfor + vconnect (sty, v[n], v[1]); +enddef; +vardef vrcyclen (expr sty) (suffix v) (expr n) = + vconnect (sty, v[1], v[n]); + for $ = n downto 2: + vconnect (sty, v[$], v[$-1]); + endfor +enddef; +vardef vforce (expr z) (suffix v) = + venter v; + vlist[vlookup v]loc := z; +enddef; +vardef vshift (expr z) (text vl) = + forsuffixes $=vl: + if vexists $: + vlist[vlookup $]loc := vlist[vlookup $]loc + z; + fi + endfor +enddef; +vardef vconstraint (expr z) (text vl) = + save nfrom, nto; + numeric nfrom, nto; + forsuffixes to = vl: + venter to; + nto := vlookup to; + if known nfrom: + vlist[nfrom]constr.last := vlist[nfrom]constr.last + 1; + vlist[nto]constr.last := vlist[nto]constr.last + 1; + vlist[nfrom]constr[vlist[nfrom]constr.last] := nto; + vlist[nto]constr[vlist[nto]constr.last] := nfrom; + vlist[nto]loc = vlist[nfrom]loc + z; + fi + nfrom := nto; + endfor +enddef; +vardef vpolygon (expr psty) (suffix v) (text vl) = + save nopt, csty, nfrom, nfrom_, nto, i, n, j; + numeric nopt, nfrom, nfrom_, nto, i, n, j; + string csty; + n := count (vl) + 1; + plist.last := plist.last + 1; + plist[plist.last]cnt := n; + plist[plist.last]lbl := ""; + plist[plist.last]lbl.ang := whatever; + plist[plist.last]lbl.dist := 0; + csty := "phantom"; + getopt (opt, psty); + for nopt = opt.first upto opt.last: + if match_option (opt[nopt], "filled"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]sty); + elseif match_option (opt[nopt], "tension"): + if known opt[nopt]arg: + csty := csty & ",tension=" & opt[nopt]arg; + else: + message "feynmf: option `tension' needs an argument. Ignored."; + fi + elseif match_option (opt[nopt], "label"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]lbl); + elseif match_option (opt[nopt], "label.angle"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]lbl.ang); + elseif match_option (opt[nopt], "label.dist"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]lbl.dist); + elseif match_option (opt[nopt], "pull"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]pull); + elseif match_option (opt[nopt], "cona"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]cona); + elseif match_option (opt[nopt], "conb"): + get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]conb); + elseif match_option (opt[nopt], "smooth"): + plist[plist.last]cona := ".."; + plist[plist.last]conb := ".."; + ignore_argument (opt[nopt], opt[nopt]arg); + elseif match_option (opt[nopt], "foreground"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]fore); + elseif match_option (opt[nopt], "background"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), + plist[plist.last]back); + elseif match_option (opt[nopt], "phantom"): + plist[plist.last]sty := "phantom"; + elseif match_option (opt[nopt], "empty"): + plist[plist.last]sty := "empty"; + elseif match_option (opt[nopt], "full"): + plist[plist.last]sty := "full"; + elseif match_option (opt[nopt], "hatched"): + plist[plist.last]sty := "hatched"; + elseif match_option (opt[nopt], "shaded"): + plist[plist.last]sty := "shaded"; + else: + ignore_option (opt[nopt], opt[nopt]arg); + fi + endfor + canonicalize_filling plist[plist.last]sty; + vconnect (csty, v, vl, v); + i := 1; + forsuffixes to = v, vl, v: + nto := vlookup to; + if known nfrom: + if known nfrom_: + vlist[nto]loc = vlist[nfrom]loc + + (vlist[nfrom]loc - vlist[nfrom_]loc) rotated (360/n); + fi + vlist[nto]poly.last := vlist[nto]poly.last + 1; + vlist[nto]poly[vlist[nto]poly.last] := plist.last; + vlist[nto]poly[vlist[nto]poly.last]idx := i; + plist[plist.last]vtx[i] := nto; + i := i + 1; + nfrom_ := nfrom; + fi + nfrom := nto; + endfor +enddef; +vardef canonicalize_filling suffix f = + if known f: + if is_a_number (f): + if scantokens f <= 1: + f := + if scantokens f = 1: + "full" + elseif scantokens f > 0: + "shaded" + elseif scantokens f = 0: + "empty" + else: + "hatched" + fi; + fi + fi + fi +enddef; +vardef vpolygonn (expr sty) (suffix v) (expr n) = + vpolygon (sty, v[1], for $=2 upto n-1: v[$], endfor v[n]); +enddef; +vardef vrpolygonn (expr sty) (suffix v) (expr n) = + vpolygon (sty, v[n], for $=n-1 downto 2: v[$], endfor v[1]); +enddef; +vardef vlabel (expr s) (suffix v) = + venter v; + vlist[vlookup v]lbl := s; +enddef; +vardef vvertex (expr vtxsty) (text vl) = + save nopt, sty, arg; + numeric nopt, arg; + string sty; + getopt (opt, vtxsty); + forsuffixes v = vl: + venter v; + n := vlookup v; + for nopt = opt.first upto opt.last: + handle_vertex_option (vlist[n], opt[nopt], opt[nopt]arg); + endfor + endfor +enddef; +vardef handle_vertex_option (suffix v) (expr opt, arg) = + if match_option (opt, "label"): + get_argument (opt, arg, v.lbl); + elseif match_option (opt, "label.angle"): + get_argument (opt, scantokens (arg), v.lbl.ang); + elseif match_option (opt, "label.dist"): + get_argument (opt, scantokens (arg), v.lbl.dist); + elseif match_option (opt, "decoration.shape"): + if known arg: + make_decor_shape (v.decor.shape, arg); + else: + message "feynmf: option `decor.shape' needs an argument. Ignored."; + fi + elseif match_option (opt, "decoration.filled"): + get_argument (opt, arg, v.decor.sty); + canonicalize_filling v.decor.sty; + elseif match_option (opt, "decoration.size"): + get_argument (opt, scantokens (arg), v.decor.size); + elseif match_option (opt, "decoration.angle"): + get_argument (opt, scantokens (arg), v.decor.ang); + elseif match_option (opt, "foreground"): + get_argument (opt, scantokens (arg), v.fore); + elseif match_option (opt, "background"): + get_argument (opt, scantokens (arg), v.back); + else: + ignore_option (opt, arg); + fi +enddef; +vardef make_decor_shape (suffix p) (expr n) = + if match_prefix (n, "circle"): p := fullcircle; + elseif match_prefix (n, "square"): + p := unitsquare shifted -(.5,.5); + elseif match_prefix (n, "cross"): p := polycross 4; + elseif match_prefix (n, "triangle"): p := polygon 3; + elseif match_prefix (n, "triagon"): p := polygon 3; + elseif match_prefix (n, "diamond"): p := polygon 4; + elseif match_prefix (n, "tetragon"): p := polygon 4; + elseif match_prefix (n, "pentagon"): p := polygon 5; + elseif match_prefix (n, "hexagon"): p := polygon 6; + elseif match_prefix (n, "triagram"): p := polygram 3; + elseif match_prefix (n, "tetragram"): p := polygram 4; + elseif match_prefix (n, "pentagram"): p := polygram 5; + elseif match_prefix (n, "hexagram"): p := polygram 6; + elseif match_prefix (n, "triacross"): p := polycross 3; + elseif match_prefix (n, "tetracross"): p := polycross 4; + elseif match_prefix (n, "pentacross"): p := polycross 5; + elseif match_prefix (n, "hexacross"): p := polycross 6; + else: + if feynmfwizard: + p := scantokens(n); + else: + message "feynmf: invalid argument `" & n + & "' to option `decor.shape'. Ignored."; + fi + fi +enddef; +vardef is_a_number expr s = + save n; + if known s: + (true + for n = 1 upto length s: + and ((substring (n-1,n) of s = ".") + or (substring (n-1,n) of s = "-") + or isdigit substring (n-1,n) of s) + endfor) + else: + false + fi +enddef; +vardef vvertexn (expr vtxsty) (suffix v) (expr n) = + vvertex (vtxsty, vmklist (v, n)); +enddef; +vardef vblob (expr bd) (text vl)= + forsuffixes $=vl: + if not vexists $: venter $; fi + vlist[vlookup $]decor.shape := fullcircle; + vlist[vlookup $]decor.size := bd; + vlist[vlookup $]decor.sty := "shaded"; + endfor +enddef; +vardef vdot (text vl)= + forsuffixes $=vl: + if not vexists $: venter $; fi + vlist[vlookup $]decor.shape := fullcircle; + vlist[vlookup $]decor.size := dot_size; + vlist[vlookup $]decor.sty := "full"; + endfor +enddef; +vardef vdotn (suffix v) (expr n) = + vdot (vmklist (v, n)); +enddef; +vardef vblobn (suffix v) (expr n) = + vblob (vmklist (v, n)); +enddef; +vardef curved_left_gallery = .9[se,sw] .. .5[sw,nw] .. .1[nw,ne] enddef; +vardef curved_right_gallery = .9[sw,se] .. .5[se,ne] .. .1[ne,nw] enddef; +vardef curved_bottom_gallery = .9[nw,sw] .. .5[sw,se] .. .1[se,ne] enddef; +vardef curved_top_gallery = .9[sw,nw] .. .5[nw,ne] .. .1[ne,se] enddef; +vardef curved_surround_gallery = + superellipse (.5[se,ne], .5[ne,nw], .5[nw,sw], .5[sw,se], .75) +enddef; +vardef straight_left_gallery = sw -- nw enddef; +vardef straight_right_gallery = se -- ne enddef; +vardef straight_bottom_gallery = sw -- se enddef; +vardef straight_top_gallery = nw -- ne enddef; +vardef straight_surround_gallery = + .5[se,ne] -- ne -- .5[ne,nw] -- nw + -- .5[nw,sw] -- sw -- .5[sw,se] -- se -- cycle +enddef; +vardef curved_galleries = + vardef left_gallery = curved_left_gallery enddef; + vardef right_gallery = curved_right_gallery enddef; + vardef bottom_gallery = curved_bottom_gallery enddef; + vardef top_gallery = curved_top_gallery enddef; + vardef surround_gallery = curved_surround_gallery enddef; +enddef; +vardef straight_galleries = + vardef left_gallery = straight_left_gallery enddef; + vardef right_gallery = straight_right_gallery enddef; + vardef bottom_gallery = straight_bottom_gallery enddef; + vardef top_gallery = straight_top_gallery enddef; + vardef surround_gallery = straight_surround_gallery enddef; +enddef; +vardef vleft (text vl) = vdistribute (left_gallery, vl) enddef; +vardef vright (text vl) = vdistribute (right_gallery, vl) enddef; +vardef vbottom (text vl) = vdistribute (bottom_gallery, vl) enddef; +vardef vtop (text vl) = vdistribute (top_gallery, vl) enddef; +vardef vsurround (text vl) = vdistribute (surround_gallery, vl) enddef; +curved_galleries; +vardef vdistribute (expr p) (text vl) = + save numv, len, off; + numeric numv, len, off; + numv = count (vl); + if cycle p: numv := numv + 1; fi + len := length (p); + if numv = 1: + vforce (point len/2 of p, vl); + else: + off := 0; + forsuffixes $ = vl: + vforce (point off of p, $); + off := off + len/(numv-1); + endfor + fi +enddef; +def vmklist (suffix v) (expr n) = + for $ = 1 upto n-1: v[$], endfor v[n] +enddef; +vardef vleftn (suffix v) (expr n) = + vleft (vmklist (v, n)); +enddef; +vardef vrightn (suffix v) (expr n) = + vright (vmklist (v, n)); +enddef; +vardef vbottomn (suffix v) (expr n) = + vbottom (vmklist (v, n)); +enddef; +vardef vtopn (suffix v) (expr n) = + vtop (vmklist (v, n)); +enddef; +vardef vsurroundn (suffix v) (expr n) = + vsurround (vmklist (v, n)); +enddef; +vardef vfreeze = + for i = vertices: + if unknown vlist[i]loc: + origin = origin + for j = varcs (i): + + vlist[i]arc[j]tns * (vlist[i]loc - vlist[vlist[i]arc[j]]loc) + endfor + for j = vconstr (i): + if i < vlist[i]constr[j]: + + lambda (i, vlist[i]constr[j]) + elseif i > vlist[i]constr[j]: + - lambda (vlist[i]constr[j], i) + fi + endfor + for j = vpoly (i): + + lambdapoly (vlist[i]poly[j], plist[vlist[i]poly[j]]cnt, + vlist[i]poly[j]idx) + endfor; + fi + endfor + if vtracing: vdump; fi +enddef; +vardef lambda (expr i, j) = + (if known (xpart(vlist[i]loc - vlist[j]loc)): + lambdax[i][j] + else: + 0 + fi, + if known (ypart(vlist[i]loc - vlist[j]loc)): + lambday[i][j] + else: + 0 + fi) +enddef; +vardef lambdapoly (expr p, n, i) = + origin + if i = 1: + + lambdap[p][2] rotated (-360/n) + elseif i = 2: + - lambdap[p][1] + fi + if i = n - 1: + - lambdap[p][n] rotated (-360/n) + elseif i = n: + + lambdap[p][n-1] + fi + if (i > 1) and (i < n): + + lambdap[p][i-1] + lambdap[p][i+1] rotated (-360/n) + - lambdap[p][i] - lambdap[p][i] rotated (-360/n) + fi +enddef; +vardef idraw (expr linesty, p) = + save nopt, sty, lbl, wd, rub; + numeric nopt, lbl.dist, wd, rub; + save fore, back; + color fore, back; + string sty, lbl, lbl.side; + getopt (opt, linesty); + sty := opt[opt.first]; + if known opt[opt.first]arg: + message "feynmf: line styles don't take arguments. " + & "Argument `" & opt[opt.first]arg & "' ignored."; + fi + opt.first := opt.first + 1; + lbl := ""; + lbl.side := ""; + lbl.dist := 3thick; + for nopt = opt.first upto opt.last: + if match_option (opt[nopt], "label"): + get_argument (opt[nopt], opt[nopt]arg, lbl); + elseif match_option (opt[nopt], "label.side"): + get_argument (opt[nopt], opt[nopt]arg, lbl.side); + elseif match_option (opt[nopt], "label.dist"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), lbl.dist); + elseif match_option (opt[nopt], "width"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), wd); + elseif match_option (opt[nopt], "foreground"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), fore); + elseif match_option (opt[nopt], "background"): + get_argument (opt[nopt], scantokens (opt[nopt]arg), back); + elseif match_option (opt[nopt], "rubout"): + if known opt[nopt]arg: + rub := scantokens (opt[nopt]arg); + else: + rub := 2; + fi + else: + ignore_option (opt[nopt], opt[nopt]arg); + fi + endfor + handle_line_style (sty, sty); + begingroup + if known fore: + save foreground; + color foreground; + foreground = fore; + fi + if known back: + save background; + color background; + foreground = back; + fi + vdraw_arc_rubout (rub, sty, wd, p, lbl); + endgroup; +enddef; +vardef ivertex (expr vtxsty, pos) = + save nopt, v; + numeric nopt, v.lbl.ang, v.lbl.dist, + v.decor.size, v.decor.ang; + pair v.loc; + string v.lbl, v.decor.sty; + path v.decor.shape; + v.loc := pos; + v.lbl := ""; + v.lbl.ang := whatever; + v.lbl.dist := 3thick; + v.decor.size := decor_size; + getopt (opt, vtxsty); + for nopt = opt.first upto opt.last: + handle_vertex_option (v, opt[nopt], opt[nopt]arg); + endfor + vdraw_label (v.loc, v.lbl); + vdraw_vertex v; +enddef; +vardef vdraw = + if not feynmfwizard: + vcheck_typos; + fi + for i = vertices: + if not known vlist[i]loc: + errhelp "Your graph specification was not complete (probably a " + & "lone vertex). Check logic and reprocess!"; + errmessage "feynmf: vertex `" & vlist[i]name & "' not determined, " + & "replaced by `(0,0)'."; + vlist[i]loc := origin; + fi + if unknown vlist[i]decor.size: + vlist[i]decor.size = decor_size; + fi + endfor + for i = vertices: + for j = varcs (i): + if known vlist[i]arc[j]sty: + if vlist[i]arc[j]sty <> "": + if unknown vlist[i]arc[j]rub: + begingroup + if known vlist[i]arc[j]fore: + save foreground; color foreground; + foreground = vlist[i]arc[j]fore; + fi + if known vlist[i]arc[j]back: + save background; color background; + background = vlist[i]arc[j]back; + fi + vdraw_arc (vlist[i]arc[j]sty, vlist[i]arc[j]wd, + vbuild_cut_arc (i, j), vlist[i]arc[j]lbl); + vlist[i]arc[j]sty := ""; + endgroup; + fi + fi + fi + endfor; + endfor + for i = polygons: + vdraw_label (pcenter plist[i], plist[i]lbl); + vdraw_polygon plist[i]; + endfor + for i = vertices: + vdraw_label (vlist[i]loc, vlist[i]lbl); + vdraw_vertex vlist[i]; + endfor + for i = vertices: + for j = varcs (i): + if known vlist[i]arc[j]sty: + if vlist[i]arc[j]sty <> "": + if known vlist[i]arc[j]rub: + begingroup + if known vlist[i]arc[j]fore: + save foreground; color foreground; + foreground = vlist[i]arc[j]fore; + fi + if known vlist[i]arc[j]back: + save background; color background; + background = vlist[i]arc[j]back; + fi + vdraw_arc_rubout (vlist[i]arc[j]rub, + vlist[i]arc[j]sty, + vlist[i]arc[j]wd, + vbuild_cut_arc (i, j), + vlist[i]arc[j]lbl); + vlist[i]arc[j]sty := ""; + endgroup; + fi + fi + fi + endfor; + endfor +enddef; +vardef vcheck_typos = + save j, err; + boolean wrn; + wrn := false; + for i = vertices: + save connections; + connections = vlist[i]arc.last - vlist[i]arc.first + 1; + if connections < 1: + if unknown vlist[i]loc: + message "feynmf: warning: disconnected and unspecified vertex `" + & substring (2,infinity) of vlist[i]name + & "'."; + wrn := true; + fi + elseif connections = 1: + j := vlist[i]arc[vlist[i]arc.last]; + if j < i: + if vlist[i]loc = vlist[j]loc: + message "feynmf: warning: dangling vertex `" + & substring (2,infinity) of vlist[i]name + & "' colliding with `" + & substring (2,infinity) of vlist[j]name + & "'."; + wrn := true; + fi + fi + fi + endfor + if wrn: + message "feynmf: Have you seen the warning messages above?"; + message " They are usually caused by misspelling a vertex'"; + message " name and can trigger errors further below!"; + message " Fix the typos and run LaTeX and Metafont again."; + fi +enddef; +vardef vbuild_arc (expr lsr, from, to) = + if unknown lsr: + from -- to + else: + if lsr = 0: + from -- to + else: + from + .. (1-lsr)/2 *(to rotatedabout (.5[from,to], 90)) + + (1+lsr)/2 * (to rotatedabout (.5[from,to], -90)) + .. to + fi + fi +enddef; +vardef vbuild_cut_arc (expr origin, index) = + cut_decors (vlist[origin], + if vlist[origin]arc[index] <> origin: + vbuild_arc (vlist[origin]arc[index]lsr, + vlist[origin]loc, + vlist[vlist[origin]arc[index]]loc) + else: + vbuild_tadpole (origin, index) + fi, + vlist[vlist[origin]arc[index]]) +enddef; +vardef vbuild_tadpole (expr origin, index) = + save j, n, nn, nnn, aidx, aang, agap, bgap, ngap, distsum; + n := 0; + distsum := 0; + for j = varcs (origin): + if vlist[origin]arc[j] <> origin: + ang := angle direction 0 of + vbuild_arc (vlist[origin]arc[j]lsr, + vlist[origin]loc, + vlist[vlist[origin]arc[j]]loc); + n := n + 1; + distsum := distsum + + abs (vlist[vlist[origin]arc[j]]loc - vlist[origin]loc); + aang[n] := 360; + for nn = 1 upto n: + if ang < aang[nn]: + for nnn = n - 1 downto nn: + aang[nnn+1] := aang[nnn]; + aidx[nnn+1] := aidx[nnn]; + endfor + aang[nn] := ang; + aidx[nn] := n; + fi + exitif known aidx[n]; + endfor + fi + endfor + aidx[n+1] := aidx[1]; + aang[n+1] := aang[1] + 360; + for nn = 1 upto n: + agap[nn] = aang[nn+1] - aang[nn]; + endfor + if known vlist[origin]arc[index]lsr: + ngap := n; + for nn = 1 upto n: + if (aang[nn] < vlist[origin]arc[index]lsr) + and (vlist[origin]arc[index]lsr < aang[nn+1]): + ngap := nn; + fi + endfor + else: + bgap := 0; + for nn = 1 upto n: + if agap[nn] > bgap: + bgap := agap[nn]; + ngap := nn; + fi + endfor + fi + if vtracing: adump (n + 1); fi + vlist[origin]loc{dir(aang[ngap]+agap[ngap]/4)} + ... vlist[origin]loc + 2/3 * distsum/n + / vlist[origin]arc[index]tns + * dir(aang[ngap]+agap[ngap]/2) + ... {-dir(aang[ngap+1]-agap[ngap]/4)}vlist[origin]loc +enddef; +vardef adump expr n = + save i; + for i = 1 upto n: + message "aidx[" & decimal_ (i) & "]=" & decimal_ (aidx[i]) + & ", aang[" & decimal_ (i) & "]=" & decimal_ (aang[i]) + & ", agap[" & decimal_ (i) & "]=" & decimal_ (agap[i]); + endfor +enddef; +vardef vdraw_arc (expr sty, wd, arc) (suffix lbl) = + if known wd: + save currentpen; + pen currentpen; + pickup pencircle scaled wd; + fi + scantokens ("draw_" & sty) (arc); + vdraw_arc_label (arc, lbl); +enddef; +let plain_draw = draw; +vardef vdraw_arc_rubout (expr rub, sty, wd, arc) (suffix lbl) = + if known rub: + begingroup + def draw expr p = + save oldpen; pen oldpen; + oldpen := currentpen; + save currentpen; pen currentpen; + pickup oldpen scaled rub; + erase plain_draw (subpath (.1,.9)*length(p) of p) + enddef; + vdraw_arc (sty, wd, arc, lbl); + let draw = plain_draw; + endgroup; + fi + vdraw_arc (sty, wd, arc, lbl); +enddef; +vardef vbuild_polygon suffix p = + if known p.pull: + save c; pair c; + c := pcenter p; + for i = 1 upto (p.cnt - 1): + vbuild_polygon_section (p, i, i+1) + endfor + vbuild_polygon_section (p, p.cnt, 1) + else: + for i = 1 upto p.cnt: + vlist[p.vtx[i]]loc + if known p.cona: scantokens (p.cona) else: -- fi + endfor + fi + cycle +enddef; +def vbuild_polygon_section (suffix p) (expr from, to) = + vlist[p.vtx[from]]loc + if known p.cona: scantokens (p.cona) else: -- fi + p.pull[c,.5[vlist[p.vtx[from]]loc,vlist[p.vtx[to]]loc]] + if known p.conb: scantokens (p.conb) else: -- fi +enddef; +vardef pcenter suffix p = + (origin for i = 1 upto p.cnt: + + vlist[p.vtx[i]]loc + endfor) / p.cnt +enddef; +vardef vdraw_arc_label (expr arc) (suffix lbl) = + if lbl <> "": + save _a, _z, _zz, _r; + numeric _a; + pair _z, _zz, _r; + _z := point .5 length (arc) of arc; + if lbl.dist = 0: + LaTeX_text (_z, whatever, lbl); + else: + _r := direction .5 length (arc) of arc rotated - 90; + if lbl.side = "left": + _a := angle (-_r); + elseif lbl.side = "right": + _a := angle (_r); + else: + _zz = _z - .5[point 0 of arc, point infinity of arc]; + if ((_zz if length (_zz) > 0: / length (_zz) fi) + dotprod _r) >= 0: + _a := angle (_r); + else: + _a := angle (-_r); + fi + fi + LaTeX_text (_z + lbl.dist * dir _a, _a, lbl); + fi + fi +enddef; +vardef vdraw_label (expr loc) (suffix lbl) = + if lbl <> "": + save a; + numeric a; + if lbl.dist = 0: + LaTeX_text (loc, whatever, lbl); + else: + if unknown lbl.ang: + if loc = (.5w,.5h): + a := 0; + else: + a := angle (loc - (.5w,.5h)); + fi + else: + a := lbl.ang; + fi + LaTeX_text (loc + lbl.dist * dir a, a, lbl); + fi + fi +enddef; +vardef vdraw_vertex suffix v = + if known v.decor.shape: + if known v.fore: + save foreground; + color foreground; + foreground = v.fore; + fi + if known v.back: + save background; + color background; + background = v.back; + fi + if known v.decor.sty: + if v.decor.sty = "empty": + emptydraw ( + elseif v.decor.sty = "full": + cfilldraw ( + elseif is_a_number v.decor.sty: + drawhalftone (1 - scantokens v.decor.sty / 100, + else: + drawtile (scantokens v.decor.sty, + fi + else: + cfilldraw ( + fi + v.decor.shape + if known v.decor.ang: rotated v.decor.ang fi + scaled v.decor.size shifted v.loc); + fi +enddef; +vardef polygon expr n = + if n > 2: + for i = 1 upto n: + (.5up rotated (360i/n)) -- + endfor + cycle + else: + fullcircle + fi +enddef; +vardef polygram expr n = + if n > 2: + for i = 1 upto n: + (.5up rotated (360i/n)) -- + (.2up rotated (360(i+.5)/n)) -- + endfor + cycle + else: + fullcircle + fi +enddef; +vardef polycross expr n = + save i; + for i = 1 upto n: + origin -- .5 dir (360(i-.5)/n) -- + endfor + cycle +enddef; +vardef vdraw_polygon suffix p = + if known p.fore: + save foreground; + color foreground; + foreground = p.fore; + fi + if known p.back: + save background; + color background; + background = p.back; + fi + if known p.sty: + if p.sty = "phantom": + elseif p.sty = "empty": + emptydraw (vbuild_polygon p); + elseif p.sty = "full": + cfilldraw (vbuild_polygon p); + elseif is_a_number p.sty: + drawhalftone (1 - scantokens p.sty / 100, vbuild_polygon p); + else: + drawtile (scantokens p.sty, vbuild_polygon p); + fi + else: + cdraw (vbuild_polygon p); + fi +enddef; +vardef LaTeX expr text = + if LaTeX_file = "": + LaTeX_file := jobname & ".t" & decimal charcode; + write ("% " & LaTeX_file & " -- generated from " & jobname & ".mp") + to LaTeX_file; + fi + write (text & "%") to LaTeX_file +enddef; +vardef LaTeX_text (expr z, a, txt) = + LaTeX "\fmfL(" & (decimal (xpart z/LaTeX_unitlength)) & "," + & (decimal (ypart z/LaTeX_unitlength)) & "," + & (voctant a) & "){" & txt & "}"; +enddef; +vardef voctant expr a = + if known a: + voctant_list[floor (a/45 + .5)] + else: + "c" + fi +enddef; +string voctant_list[]; +voctant_list[-4] := "r"; +voctant_list[-3] := "rt"; +voctant_list[-2] := "t"; +voctant_list[-1] := "lt"; +voctant_list[0] := "l"; +voctant_list[1] := "lb"; +voctant_list[2] := "b"; +voctant_list[3] := "rb"; +voctant_list[4] := "r"; +vardef vdump = + message ">>>>> Vertices and arcs for diagram #" & decimal charcode + & " of " & jobname & ".mf:"; + for i = vertices: + message "> " & vlist[i]name & "=" & decimal_pair (vlist[i]loc) + & ": #lines=" + & decimal (vlist[i]arc.last - vlist[i]arc.first + 1) + if vlist[i]lbl <> "": + & ", lbl=" & vlist[i]lbl + & ", l.angle=" & decimal_ (vlist[i]lbl.ang) + & ", l.dist=" & decimal_ (vlist[i]lbl.dist) + fi + & "."; + endfor + for i = vertices: + for j = varcs (i): + if known vlist[i]arc[j]sty: + message "> " & vlist[i]name & "*" & vlist[vlist[i]arc[j]]name + & ": " & vlist[i]arc[j]sty + & ", tns=" & decimal_ (vlist[i]arc[j]tns) + & ", lsr=" & decimal_ (vlist[i]arc[j]lsr) + & ", wd=" & decimal_ (vlist[i]arc[j]wd) + & ", rub=" & decimal_ (vlist[i]arc[j]rub) + if vlist[i]arc[j]lbl <> "": + & ", lbl=" & vlist[i]arc[j]lbl + & ", l.side=" & vlist[i]arc[j]lbl.side + & ", l.dist=" & decimal_ (vlist[i]arc[j]lbl.dist) + fi + & "."; + fi + endfor + for j = vconstr (i): + if i < vlist[i]constr[j]: + save z; + pair z; + z = vlist[vlist[i]constr[j]]loc - vlist[i]loc; + message "> " & vlist[i]name & "&" + & vlist[vlist[i]constr[j]]name + & ": " & decimal_pair (z); + fi + endfor; + endfor +enddef; +vardef decimal_ (text n) = + if known n: decimal n else: "?" fi +enddef; +vardef decimal_pair (text z) = + "(" & decimal_ (xpart z) & "," & decimal_ (ypart z) & ")" +enddef; +def show_diagram_ expr frame = + if (screen_cols < w + 2 xpart frame) or (screen_rows < h + 2 ypart frame): + screen_cols := w + 2 xpart frame; + screen_rows := h + 2 ypart frame; + openwindow currentwindow + from origin to (screen_rows, screen_cols) + at (- xpart frame, h + ypart frame); + fi + showit_; + if showstopping > 0: + stop "This is diagram #" & decimal charcode + & ". Hit return to continue..."; + fi +enddef; +def show_diagram = + def show_diagram = + display blankpicture inwindow currentwindow; + show_diagram_ + enddef; + show_diagram_ +enddef; +def show_all_diagrams expr frame = + def showit = show_diagram frame enddef; + displaying:=1; +enddef; +endinput; +\endinput +%% +%% End of file `feynmp.mp'. diff --git a/Master/texmf-dist/metapost/feynmf/manpics.mp b/Master/texmf-dist/metapost/feynmf/manpics.mp new file mode 100644 index 00000000000..e5e666e6f76 --- /dev/null +++ b/Master/texmf-dist/metapost/feynmf/manpics.mp @@ -0,0 +1,331 @@ +% manpics.mp -- pictures for the feynmf manual +% Copyright (C) 1995 by Thorsten.Ohl @ Physik.TH-Darmstadt.de +% $Id: manpics.mp,v 1.5 1996/10/08 20:22:02 ohl Exp $ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Feynmf is free software; you can redistribute it and/or modify it +% under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 2, or (at your option) +% any later version. +% +% Feynmf is distributed in the hope that it will be useful, but +% WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +input boxes + +verbatimtex + \font\sc=cmcsc10 + \font\manfnt=manfnt + \def\LaTeX{% + {\rm L\kern-.36em\raise.3ex\hbox{\sc a}\kern-.15em% + T\kern-.1667em\lower.7ex\hbox{E}\kern-.125emX}} + \def\cs#1{{\tt\char`\\#1}} + \def\arg#1{{\tt\char`\{#1\char`\}}} + \def\c{{\tt\char`\%}} + \parindent=0pt + \parskip=0pt + \def\ctr#1{\vbox{\halign{\hfil##\hfil\cr#1\cr}}} +etex; + +def first_latex_pass = \ enddef; +def second_latex_pass = dashed withdots enddef; +def mf_pass = dashed evenly enddef; +def dvixx_pass = dashed evenly scaled 2 enddef; + +def connect (suffix from, to) = + (from.c -- to.c cutbefore bpath.from cutafter bpath.to) +enddef; + +ahlength := 4mm; +ahangle := 30; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +beginfig (1); + h := 10cm; + w := 13.3cm; + pickup pencircle scaled 1.5; + boxit.tex (btex \tt\vbox{ + \hbox{\c\ foo.tex} + \hbox{...} + \hbox{\cs{usepackage}\arg{feynmf}} + \hbox{...} + \hbox{\cs{begin}\arg{fmffile}\arg{fd}} + \hbox{\cs{begin}\arg{fmfchar*}(100,50)} + \hbox{...} + \hbox{\cs{end}\arg{fmfchar*}} + \hbox{...} + \hbox{\cs{end}\arg{fmffile}} + \hbox{...}} + etex); + boxit.mf (btex \tt\vbox{ + \hbox{\c\ fd.mf -- do not edit} + \hbox{input feynmf} + \hbox{beginchar(1,100*1pt\#,50*1pt\#,0);} + \hbox{\quad vinit;} + \hbox{\quad ...} + \hbox{\quad vfreeze;} + \hbox{\quad vdraw;} + \hbox{endchar;} + \hbox{...}} + etex); + boxit.log (btex \ctr{\LaTeX{} labels\cr{\tt fd.log}} etex); + boxit.t1 (btex \ctr{\LaTeX{} labels\cr{\tt fd.t1}} etex); + boxit.t2 (btex \ctr{\LaTeX{} labels\cr{\tt fd.t2}} etex); + boxit.tfm (btex \ctr{font metric\cr information\cr{\tt fd.tfm}} etex); + boxit.gf (btex \ctr{font bitmap\cr{\tt fd.300gf}} etex); + boxit.dvi (btex \ctr{device independent\cr output file\cr{\tt foo.dvi}} etex); + boxit.lpr (btex \ctr{printer\cr{\tt lpr}} etex); + tex.nw = (0,h); mf.ne = (w,h); + dvi.sw = (0,0); lpr.se = (w,0); + gf.c = .5[mf.c,lpr.c]; + log.c = .5[mf.c,dvi.c]; + tfm.c = .75[log.c,gf.c] - (0,2cm); + .5[log.c,dvi.c] = .1[t1.c,t2.c]; + t2.w - t1.e = (5mm,0); + % forsuffixes $ = tex, mf, log, tfm, gf, t1, t2, dvi, lpr: + % fill bpath.$ withcolor .9white; + % endfor + drawboxed (tex, mf, log, tfm, gf, t1, t2, dvi, lpr); + drawarrow connect (tex, dvi) second_latex_pass; + drawarrow connect (tex, mf) first_latex_pass; + drawarrow connect (mf, log) mf_pass; + drawarrow connect (mf, tfm) mf_pass; + drawarrow connect (mf, gf) mf_pass; + drawarrow connect (log, t1) second_latex_pass; + drawarrow connect (log, t2) second_latex_pass; + drawarrow connect (t1, dvi) second_latex_pass; + drawarrow connect (t2, dvi) second_latex_pass; + drawarrow connect (tfm, dvi) second_latex_pass; + drawarrow connect (tfm, lpr) dvixx_pass; + drawarrow connect (gf, lpr) dvixx_pass; + drawarrow connect (dvi, lpr) dvixx_pass; + circleit.latex1 (btex {\tt latex foo} etex); + latex1.dx = latex1.dy; + circleit.latex2 (btex {\tt latex foo} etex); + latex2.dx = latex2.dy; + % circleit.mf.gf (btex {\tt mf fd} etex); + % mf.gf.dx = mf.gf.dy; + circleit.mf.tfm (btex {\tt mf fd} etex); + mf.tfm.dx = mf.tfm.dy; + % circleit.mf.log (btex {\tt mf fd} etex); + % mf.log.dx = mf.log.dy; + circleit.dvixx (btex {\tt dvixx foo} etex); + dvixx.dx = dvixx.dy; + latex1.s - (0,2mm) = point .5 of connect (tex, mf); + latex2.e + (2mm,0) = point .5 of connect (tex, dvi); + % mf.gf.w - (2mm,0) = point .5 of connect (mf, gf); + mf.tfm.e + (2mm,0) = point .5 of connect (mf, tfm); + % mf.log.w - (2mm,0) = point .5 of connect (mf, log); + dvixx.n + (0,2mm) = point .5 of connect (dvi, lpr); + forsuffixes $ = latex1, latex2, mf.tfm, dvixx: + fill bpath.$ withcolor .9white; + endfor + drawboxed (latex1, latex2, mf.tfm, dvixx); +endfig; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +beginfig (2); + h := 10cm; + w := 13.3cm; + pickup pencircle scaled 1.5; + boxit.tex (btex \tt\vbox{ + \hbox{\c\ foo.tex} + \hbox{...} + \hbox{\cs{usepackage}\arg{feynmp}} + \hbox{...} + \hbox{\cs{begin}\arg{fmffile}\arg{fd}} + \hbox{\cs{begin}\arg{fmfchar*}(100,50)} + \hbox{...} + \hbox{\cs{end}\arg{fmfchar*}} + \hbox{...} + \hbox{\cs{end}\arg{fmffile}} + \hbox{...}} + etex); + boxit.mp (btex \tt\vbox{ + \hbox{\c\ fd.mp -- do not edit} + \hbox{input feynmp} + \hbox{beginchar(1,100*1pt\#,50*1pt\#,0);} + \hbox{\quad vinit;} + \hbox{\quad ...} + \hbox{\quad vfreeze;} + \hbox{\quad vdraw;} + \hbox{endchar;} + \hbox{...}} + etex); + boxit.t1 (btex \ctr{\LaTeX{} labels\cr{\tt fd.t1}} etex); + boxit.t2 (btex \ctr{\LaTeX{} labels\cr{\tt fd.t2}} etex); + boxit.p1 (btex \ctr{encapsulated\cr PostScript\cr file\cr{\tt fd.1}} etex); + boxit.p2 (btex \ctr{encapsulated\cr PostScript\cr file\cr{\tt fd.2}} etex); + boxit.dvi (btex \ctr{device independent\cr output file\cr{\tt foo.dvi}} etex); + boxit.lpr (btex \ctr{printer\cr{\tt lpr}} etex); + tex.nw = (0,h); mp.ne = (w,h); + dvi.sw = (0,0); lpr.se = (w,0); + .5[mp.c,dvi.c] = .8[t1.c,t2.c]; + t2.w - t1.e = (5mm,0); + .5[mp.c,lpr.c] = .8[p1.c,p2.c]; + p2.w - p1.e = (5mm,2.5cm); + drawboxed (tex, mp, t1, t2, p1, p2, dvi, lpr); + drawarrow connect (tex, dvi) second_latex_pass; + drawarrow connect (tex, mp) first_latex_pass; + drawarrow connect (mp, t1) mf_pass; + drawarrow connect (mp, t2) mf_pass; + drawarrow connect (mp, p1) mf_pass; + drawarrow connect (mp, p2) mf_pass; + drawarrow connect (t1, dvi) second_latex_pass; + drawarrow connect (t2, dvi) second_latex_pass; + drawarrow connect (p1, dvi) second_latex_pass; + drawarrow connect (p2, dvi) second_latex_pass; + drawarrow connect (p1, lpr) dvixx_pass; + drawarrow connect (p2, lpr) dvixx_pass; + drawarrow connect (dvi, lpr) dvixx_pass; + circleit.latex1 (btex {\tt latex foo} etex); + latex1.dx = latex1.dy; + circleit.latex2 (btex {\tt latex foo} etex); + latex2.dx = latex2.dy; + circleit.run.mp (btex {\tt mp fd} etex); + run.mp.dx = run.mp.dy; + circleit.dvixx (btex {\tt dvixx foo} etex); + dvixx.dx = dvixx.dy; + latex1.s - (0,2mm) = point .5 of connect (tex, mp); + latex2.e + (2mm,0) = point .5 of connect (tex, dvi); + run.mp.w - (2mm,0) = point .5 of connect (mp, t2); + dvixx.n + (0,2mm) = point .5 of connect (dvi, lpr); + forsuffixes $ = latex1, latex2, run.mp, dvixx: + fill bpath.$ withcolor .9white; + endfor + drawboxed (latex1, latex2, run.mp, dvixx); +endfig; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +vardef declare_boxes (text l) = + forsuffixes $ = l: + pair $.n, $.e, $.s, $.w, $.ne, $.se, $.sw, $.nw, $.c; + endfor +enddef; + +vardef setup_boxes (text l) = + forsuffixes $ = l: + $.n = .5[$.nw, $.ne]; $.s = .5[$.sw, $.se]; + $.w = .5[$.nw, $.sw]; $.e = .5[$.ne, $.se]; + $.c = .5[$.n, $.s]; + endfor +enddef; + +vardef border suffix b = + b.nw -- b.ne -- b.se -- b.sw -- cycle +enddef; + +beginfig (3); + h := 10cm; + w := 13.3cm; + pickup pencircle scaled 1.5; + + declare_boxes (mf, tex, immediate, list); + setup_boxes (mf, tex); + + list.n = .5[list.nw, list.ne]; + list.s = .5[list.sw, list.se]; + list.w = .5[list.nw, list.sw]; + % list.e free! + list.c = .5[list.n, list.s]; + + immediate.n = .5[immediate.nw, immediate.ne]; + immediate.s = .5[immediate.sw, immediate.se]; + % immediate.w free! + immediate.e = .5[immediate.ne, immediate.se]; + immediate.c = .5[immediate.n, immediate.s]; + + mf.sw = (0,0); mf.se = (w,0); + tex.nw = (0,h); tex.ne = (w,h); + + mf.nw = tex.sw; mf.ne = tex.se; + tex.sw = .5[tex.nw,mf.sw]; tex.se = .5[tex.ne,mf.se]; + + list.w = .5[tex.nw,mf.sw]; + list.e - list.w = immediate.e - immediate.w = (.4w,0); + list.nw - list.sw = (0,.8h); + immediate.ne - immediate.se = (0,.5h); + immediate.w = list.e; immediate.nw = list.ne; immediate.sw = list.se; + + list.ne = .7[list.nw,immediate.ne]; + list.se = .3[list.sw,immediate.se]; + + fill border tex withcolor .9white; % draw border tex; + fill border mf withcolor .6white; % draw border mf; + fill border list withcolor .8white; % draw border list; + fill border immediate withcolor .7white; % draw border immediate; + + path imm_to_lst, lst_to_imm, tex_to_mf; + + imm_to_lst = immediate.c .. .7[immediate.sw,immediate.nw] .. list.c; + lst_to_imm = list.c .. .3[immediate.sw,immediate.nw] .. immediate.c; + tex_to_mf = .85[tex.nw,tex.ne] .. .95[tex.sw,tex.se] .. .85[mf.sw,mf.se]; + + drawarrow subpath (.3length(imm_to_lst), .7length(imm_to_lst)) of imm_to_lst; + drawarrow subpath (.3length(lst_to_imm), .7length(lst_to_imm)) of lst_to_imm; + drawarrow subpath (.3length(tex_to_mf), .7length(tex_to_mf)) of tex_to_mf; + + boxit.name.imm_to_lst (btex \cs{fmfforce} etex); + boxit.name.lst_to_imm (btex \tt\ctr{vloc\cr vpath} etex); + boxit.name.tex_to_mf (btex \cs{fmfcmd} etex); + boxit.name.tex (btex \LaTeX etex); + boxit.name.mf (btex \manfnt METAFONT etex); + + name.imm_to_lst.s = point .5length(imm_to_lst) of imm_to_lst + (-2mm,3mm); + name.lst_to_imm.n = point .5length(lst_to_imm) of lst_to_imm - (0,2mm); + name.tex_to_mf.se = point .5length(tex_to_mf) of tex_to_mf - (2mm,0); + name.tex.ne = (.95w,.95h); + name.mf.se = (.95w,.05h); + + boxit.name.lst (btex \vbox{\halign{ + \hfil # \cr + {\sc Vertex Mode}\cr\cr + Objects:\qquad\cr + vertices\cr + arcs\cr + polygons\cr\cr + Commands:\qquad\cr + \cs{fmf}\arg{}\arg{}\cr + \cs{fmfv}\arg{}\arg{}\cr + \cs{fmfleft}\arg{}\cr + {\tt ...}\cr}} + etex); + + boxit.name.imm (btex \vbox{\halign{ + \hfil #\cr + {\sc Immediate Mode}\cr\cr + Objects:\qquad\cr + pairs\cr + paths\cr\cr + Commands:\qquad\cr + \cs{fmfi}\arg{}\arg{}\cr + \cs{fmfiv}\arg{}\cr + \cs{fmfiequ}\arg{}\cr + {\tt ...}\cr}} + etex); + + name.lst.w = list.w + (2mm,0); + name.imm.e = immediate.e - (2mm,0); + + forsuffixes $ = imm_to_lst, lst_to_imm, tex_to_mf, imm, lst, tex, mf: + fill bpath.name.$ withcolor white; + drawunboxed (name.$); + endfor + +endfig; + +end; +endinput +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +Local Variables: +compile-command:"sh -c 'mp manpics && tex mproof manpics.[0-9]* && dvips mproof'" +End: diff --git a/Master/texmf-dist/metapost/frcursive/chars.mp b/Master/texmf-dist/metapost/frcursive/chars.mp new file mode 100644 index 00000000000..7dbfa32a43a --- /dev/null +++ b/Master/texmf-dist/metapost/frcursive/chars.mp @@ -0,0 +1,143 @@ +%&mfplain + +% The resolution tu use for rounding. + +pixel = 1in/300; + +% The rounding primitives, adapted from plain.mf. + +vardef round primary u = + if numeric u: floor(u+.5) + elseif pair u: (hround xpart u, vround ypart u) + else: u fi enddef; +vardef hround primary x = (floor(x/pixel+.5)*pixel) enddef; +vardef vround primary y = (floor(y/pixel.o_+.5)_o_*pixel) enddef; + +def define_pixels(text t) = + forsuffixes $=t: $:=$.#*hppp; endfor enddef; +def define_whole_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp); endfor enddef; +def define_whole_vertical_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp); endfor enddef; +def define_good_x_pixels(text t) = + forsuffixes $=t: $:=good.x($.#*hppp); endfor enddef; +def define_good_y_pixels(text t) = + forsuffixes $=t: $:=good.y($.#*hppp); endfor enddef; +def define_blacker_pixels(text t) = + forsuffixes $=t: $:=$.#*hppp+blacker; endfor enddef; +def define_whole_blacker_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp+blacker); + if $<=0: $:=1; fi endfor enddef; +def define_whole_vertical_blacker_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp+blacker); + if $<=0: $:=1_o_; fi endfor enddef; +def define_corrected_pixels(text t) = + forsuffixes $=t: $:=vround($.#*hppp*o_correction)+eps; endfor enddef; +def define_horizontal_corrected_pixels(text t) = + forsuffixes $=t: $:=hround($.#*hppp*o_correction)+eps; endfor enddef; + +vardef good.x primary x = hround(x+pen_lft)-pen_lft enddef; +vardef good.y primary y = vround(y+pen_top)-pen_top enddef; +vardef good.lft primary z = save z_; pair z_; + (z_+(pen_lft,0))t_=round((z+(pen_lft,0))t_); z_ enddef; +vardef good.rt primary z = save z_; pair z_; + (z_+(pen_rt,0))t_=round((z+(pen_rt,0))t_); z_ enddef; +vardef good.top primary z = save z_; pair z_; + (z_+(0,pen_top))t_=round((z+(0,pen_top))t_); z_ enddef; +vardef good.bot primary z = save z_; pair z_; + (z_+(0,pen_bot))t_=round((z+(0,pen_bot))t_); z_ enddef; + + +% We change the stroke routine a bit and we save some character shapes. + +let saved_beginchar = beginchar; +let saved_endchar = endchar; + +picture pic[]; + +def penstroke text t = + forsuffixes e = l,r: path_.e:=t; endfor + fill path_.l -- reverse path_.r -- cycle; + draw path_.l -- reverse path_.r -- cycle + withpen pencircle scaled 1 withcolor black enddef; + +def beginchar (expr c,w,h,d) = +if (byte c) >= 128: + proofcolor := .3[white,red]; +else: + proofcolor :=.3[white,black]; +fi +saved_beginchar(c,w,h,d) +enddef; + +def endchar = ; +%if charcode = 97: + for pos = 0 step pixel until w: proofrule((pos,-d), (pos,h)); endfor + for pos = 0 step pixel until h: proofrule((0,pos), (w,pos)); endfor + for pos = -pixel step -pixel until -d: proofrule((0,pos), (w,pos)); endfor +%fi +%if save_char(charcode): +% pic[charcode] = currentpicture; +% wid[charcode] = w +%fi; +%if make_char(charcode): + saved_endchar +%else: endgroup fi +enddef; + + +% We build a figure with a string, using saved characters. + +def txt = + 128, "a", 132, "b", 143, "j", 129, "e", 129, "c", 137, "t" +enddef; + +def make_char (expr c) = + for cc = "A", "a", "b", "j": (c = byte cc) or endfor false enddef; +def save_char (expr c) = + for cc = txt: (c = byte cc) or endfor false enddef; + + +% Here we read the actual font, providing an explicit driver (this is frcr10). + +proofing := -1; + +mode_setup; + +ex# := 155.0/36 pt#; +med# := .400 pt#; +thin# := .200 pt#; +thick# := .610 pt#; +dot_size# := .800 pt#; + +base_width := .800; +slant := 0; +accent_wd := 0.7; +link_width := 0.13; +straight_ascend := 2; +loop_ascend := 2.5; +uc_ascend := 2.5; +straight_descend := 1.2; +loop_descend := 1.5; +dot_height := 1.4; +accent_bot := 1.2; +accent_top := 1.6; +cedilla_dp = 0.2; + +input frcursive + + +% Here is the word built as one figure. + +let beginchar = saved_beginchar; +let endchar = saved_endchar; + +beginchar(0,0,0,0) + xpos := 0; + for c = txt: + addto currentpicture also pic[byte c] shifted (xpos,0); + xpos := xpos + wid[byte c]; + endfor; +endchar; + +end diff --git a/Master/texmf-dist/metapost/hatching/hatching.mp b/Master/texmf-dist/metapost/hatching/hatching.mp new file mode 100644 index 00000000000..af86e19d2b6 --- /dev/null +++ b/Master/texmf-dist/metapost/hatching/hatching.mp @@ -0,0 +1,64 @@ +%%% addto clip hatchfill hatchfill_ +%%% numeric color +%%% length withcolor +% This is HATCHING.MP file defining a set of METAPOST macros for +% hatching interior of closed paths. +% +% Made in BOP, Gda\'nsk, Poland +% E-mail contact: B.Jackowski@gust.org.pl +% Public domain software (no copyrights, copylefts, copyups, copydowns, etc.) +% Current version: 11.07.2000 -- ver 0.1 (pre-release) +% Current version: 21.09.2000 -- ver 0.11 (ending semicolon +% added in |extra_beginfig|; |hatchfill_| introduced in order +% to make possible something like |def fill = hatchfill enddef| +def hatchfill_ expr c = addto currentpicture contour c _op_ enddef; + +vardef hatchfill text p = + save c_,p_; path p_; color c_[\\]; c_.num:=0; + save withcolor_; let withcolor_:=withcolor; + def withcolor = ; c_[incr c_.num]:= enddef; + p_:=p; let withcolor:=withcolor_; + for i_:=c_.num downto 1: % find the least ``true'' fill + c_.num':=i_; exitif bluepart(c_[i_])>0; + endfor + if c_.num>0: + for i_:=c_.num' upto c_.num: + if bluepart(c_[i_])<0: draw hatched(p_)c_[i_]; + else: hatchfill_ p_ withcolor c_[i_]; fi + endfor + else: hatchfill_ p_; fi +enddef; + +vardef hatched(expr o) primary c = + save a_, b_, d_, l_, i_, r_, za_, zb_, zc_, zd_; + path b_; picture r_; pair za_, zb_, zc_, zd_; + r_:=image( + a_:=redpart(c) mod 180; l_:=greenpart(c); d_:=-bluepart(c); + b_:=o rotated -a_; + b_:=if a_>=90: (lrcorner b_--llcorner b_--ulcorner b_--urcorner b_--cycle) + else: (llcorner b_--lrcorner b_--urcorner b_--ulcorner b_--cycle) fi + rotated a_; + za_:=point 0 of b_; zb_:=point 1 of b_; + zc_:=point 2 of b_; zd_:=point 3 of b_; + if hatch_match>0: + n_:=round(length(zd_-za_)/l_); if n_<2: n_:=2; fi; l_:=length(zd_-za_)/n_; + else: n_:=length(zd_-za_)/l_; fi + % show (greenpart(c), l_); + for i_:=if hatch_match>0: 1 else: 0 fi upto ceiling n_-1: + draw_hatched_band((i_/n_)[zd_,za_],(i_/n_)[zc_,zb_],a_,l_,d_); + endfor + ); + clip r_ to o; r_ +enddef; + +def draw_hatched_band(expr za,zb,a,l,d) = % normally, |a| and |l| are ignored + draw za--zb withpen pencircle scaled d _hop_; +enddef; + +def hatchoptions(text t) = def _hop_ = t enddef enddef; + +newinternal hatch_match; hatch_match:=1; +hatchoptions(); extra_beginfig:=extra_beginfig & ";hatchoptions();"; + +endinput +%%\end diff --git a/Master/texmf-dist/metapost/latexmp/latexmp.mp b/Master/texmf-dist/metapost/latexmp/latexmp.mp new file mode 100644 index 00000000000..3be76550b79 --- /dev/null +++ b/Master/texmf-dist/metapost/latexmp/latexmp.mp @@ -0,0 +1,454 @@ +%D \module +%D [ file=latexmp.mp, +%D system={latexMP}, +%D version=1.1.0, +%D title=latexMP, +%D subtitle=LaTeX typesetting in \METAPOST, +%D author=Jens-Uwe Morawski, +%D date={2003/10/02}, +%D copyright={none; this module is Public Domain}] +%D +%C - all variables start with prefix "latexmp_" +%C - all internal macros have suffix "_latexmp" +%C - macros without "_latexmp" suffix are: +%C textext, setupLaTeXMP + +%D \section{Initialisation} +if known latexmp_module: message(" not loaded again"); endinput ; fi ; +boolean latexmp_module ; latexmp_module := true ; + +%D set the name of the temporary file +string latexmp_lmpfile ; latexmp_lmpfile := "ltx-" & jobname & ".tmp" ; + +%D since {\LaTeX} will be used a different \type{prologues} setting +%D makes not much sense +prologues:=2 ; + +%D save some original \METAPOST\ definitions +inner end ; inner bye ; +let origEnd_latexmp=end ; +let origBye_latexmp=bye ; +let origShipit_latexmp=shipit ; +string latexmp_extrabeginfig, latexmp_extraendfig ; +latexmp_extrabeginfig := extra_beginfig ; +latexmp_extraendfig := extra_endfig ; +color latexmp_background ; +latexmp_background := background ; + +%D The runtime control of latexMP states: +%D (1) is this the second run in \type{rerun} mode ; (2) has the temporary +%D mp file already been read; (3) is the LaTeX preamble already +%D been written to the temporary file +boolean latexmp_secondrun, latexmp_lmploaded, latexmp_texinit ; +latexmp_secondrun := false ; +latexmp_lmploaded := false ; +latexmp_texinit := false ; + +%D The current number of \type{textext()} in the input file. The counter +%D is incremented at every \type{textext} call. It is used to assign the +%D pictures from the temporary file. +numeric latexmp_counter ; latexmp_counter := 0 ; + +%D \section{Setup} +%D LaTeX preamble variables +string latexmp_docclass, latexmp_classoptions, +latexmp_inputenc, latexmp_fontenc, latexmp_babellang, +latexmp_packages, latexmp_preamble, latexmp_lmpprefix, +latexmp_preamblefile ; + +latexmp_docclass := "article" ; +latexmp_classoptions := "" ; +latexmp_inputenc := "" ; +latexmp_fontenc := "" ; +latexmp_babellang := "" ; +latexmp_packages := "" ; +latexmp_preamble := "" ; +latexmp_preamblefile := "" ; + +%D The setup variables that control activation of the specials: +numeric latexmp_mode ; latexmp_mode := 1 ; +boolean latexmp_subsinfont ; latexmp_subsinfont := false ; +boolean latexmp_multicolor ; latexmp_multicolor := false ; +boolean latexmp_debug ; latexmp_debug := false ; + +%D The setup command: +def setupLaTeXMP(text kvps) = + if not latexmp_secondrun: + if latexmp_texinit: + message("LaTeXMP: setupLaTeXMP cannot be used if textext" & + "has already been used; set-up ignored."); + else: + begingroup; +%D declaration of key-value parameters for LaTeX preamble + save class, options, inputencoding, fontencoding, language, + packages, preamble, preamblefile ; + string class, options, inputencoding, fontencoding, language, + packages, preamble, preamblefile; +%D declaration of key and synonyms for \type{mode} + save mode, normal, rerun ; + numeric mode, normal, rerun ; + normal:=1 ; rerun := 2 ; +%D declaration of keys and synonyms for the specials + save textextlabel, multicolor, debug ; + boolean textextlabel, multicolor, debug, enable, disable ; + enable:=true ; disable := false ; + + processKeyvals_latexmp(kvps) ; + + if known class: + if (length class) >0: latexmp_docclass:=class ; + else: latex_docclass:="article"; + fi; + fi; + if known options: latexmp_classoptions:=options ; fi; + if known inputencoding: latexmp_inputenc:=inputencoding ; fi; + if known fontencoding: latexmp_fontenc:=fontencoding ; fi; + if known language: latexmp_babellang:=language ; fi; + if known preamble:latexmp_preamble:=preamble ; fi; + if known preamblefile: latexmp_preamblefile:=preamblefile ; fi; + if known packages: latexmp_packages:=packages ; fi; + if known mode: + if (mode=normal) or (mode=rerun): latexmp_mode:=mode ; + else: + errmessage("latexMP error: set mode either to 'normal' or 'rerun'.") ; + latexmp_mode := 1 ; + fi; + fi; + if known textextlabel: latexmp_subsinfont:=textextlabel ; fi; + if known multicolor: latexmp_multicolor:=multicolor ; fi; + if known debug: latexmp_debug:=debug ; fi; + endgroup; + +%D overwrite the default definition of \type{thelabel} if user has specified +%D \type{textextlabel=enable}: + if latexmp_subsinfont: + vardef thelabel@#(expr s,z) = + save p; picture p; + if picture s: p=s + else: p = textext(s) + fi; + p shifted (z + labeloffset*laboff@# - + (labxf@#*lrcorner p + labyf@#*ulcorner p + + (1-labxf@#-labyf@#)*llcorner p )) + enddef; + fi; + +%D In \type{rerun} mode for the first run own definitions for \type{end} +%D and \type{bye} are used; output is disabled for first run. + if latexmp_mode=2: + let end=end_latexmp ; + let bye=end_latexmp ; + let shipit=relax ; +%D Since in the first run the temporary file will not contain +%D correct definitions automatic loading of that file by \type{textext} +%D is disabled (we fake here that it is already loaded). Loading of the +%D temporary file in \type{end_latexmp}. + latexmp_lmploaded := true ; + fi; + fi;fi; +enddef; + +%D used in \type{writeLaTeXpreamble_latexmp} +%D to generate \type{\usepackage} statements +def writepackages_latexmp= + begingroup; + save inoptions, currentpackage, currentoptions, s ; + boolean inoptions ; inoptions:=false; + string currentpackage, currentoptions, s ; + currentpackage:=""; currentoptions:="" ; + + for c=0 upto ((length latexmp_packages)-1): + s := substring (c,c+1) of latexmp_packages ; + if s="[": inoptions := true ; + elseif s="]": inoptions := false; + elseif s=",": + if inoptions: currentoptions:= currentoptions & s ; + else: + if (length currentpackage)>0: + s:="{" & currentpackage & "}" ; + if (length currentoptions)>0: + s:="[" & currentoptions & "]" & s ; + fi; + write ("\usepackage" & s) to latexmp_lmpfile ; + currentpackage:=""; currentoptions:="" ; + fi; + fi; + else: + if inoptions: currentoptions:= currentoptions & s ; + else: currentpackage:= currentpackage & s ; + fi; + fi; + endfor; + if (length currentpackage)>0: s:="{" & currentpackage & "}" ; + if (length currentoptions)>0: s:="[" & currentoptions & "]" & s ; fi; + write ("\usepackage" & s) to latexmp_lmpfile ; + fi; + endgroup; +enddef; + +%D \section{LaTeX preamble} + +def writeLaTeXpreamble_latexmp = + write "verbatimtex" to latexmp_lmpfile ; + write "%&latex" to latexmp_lmpfile ; + if latexmp_multicolor: + write ("\makeatletter") to latexmp_lmpfile ; + write ("\font\latexmp@special=cmtt8 scaled 250") to latexmp_lmpfile ; + write ("\def\reset@color{" & + "\parbox[t][0pt][t]{0pt}{\makebox[0pt][l]{\latexmp@special ecolorxxx}}}") + to latexmp_lmpfile ; + write ("\newcommand*{\color}[2][named]{\parbox[t][0pt][t]{0pt}{" & + "\makebox[0pt][l]{\latexmp@special bcolorxxx:#1:#2}}" & + "\aftergroup\reset@color\ignorespaces}") to latexmp_lmpfile ; + write ("\def\textcolor#1#{\@textcolor{#1}}") to latexmp_lmpfile ; + write ("\def\@textcolor#1#2#3{\protect\leavevmode{\color#1{#2}#3}}") + to latexmp_lmpfile ; + write ("\newcommand*{\transparent}[3][1]{\parbox[t][0pt][t]{0pt}{"& + "\makebox[0pt][l]{\latexmp@special btransxxx:#1,#2}}"& + "#3\parbox[t][0pt][t]{0pt}{" & + "\makebox[0pt][l]{\latexmp@special etransxxx}}}") to latexmp_lmpfile ; + write "\makeatother" to latexmp_lmpfile ; + fi; +%D If preamble file has been specified in the setup only a +%D \type{\input} for this file will be used in the LaTeX preamble: + if (length latexmp_preamblefile)>0: + write ("\input{" & latexmp_preamblefile & "}") to latexmp_lmpfile ; + else: +%D Specific definitions from the setup parameters: + write ("\documentclass" + if (length latexmp_classoptions)>0: + & "[" & latexmp_classoptions & "]" + fi & "{" & latexmp_docclass & "}") to latexmp_lmpfile ; + if (length latexmp_fontenc)>0: + write ("\usepackage[" & latexmp_fontenc & "]{fontenc}") + to latexmp_lmpfile ; + fi + if (length latexmp_inputenc)>0: + write ("\usepackage[" & latexmp_inputenc & "]{inputenc}") + to latexmp_lmpfile ; + fi + if (length latexmp_babellang)>0: + write ("\usepackage[" & latexmp_babellang & "]{babel}") + to latexmp_lmpfile ; + fi + if (length latexmp_packages)>0: writepackages_latexmp ; fi; + if (length latexmp_preamble)>0: + write latexmp_preamble to latexmp_lmpfile ; + fi + fi; + write "\begin{document}" to latexmp_lmpfile ; + write "etex" to latexmp_lmpfile ; + write "picture latexmp_picture[];" to latexmp_lmpfile ; +enddef; + +%D \section{Main Macros} + +%D The macro that does the job: +vardef textext@#(expr s)= + save pic ; picture pic ; + latexmp_counter:= latexmp_counter+1 ; + getpicture_latexmp ; + addstring_latexmp(s) ; + thelabel@#(pic,origin) +enddef; + +%D setting \type{latexmp_attachstrings} to \type{1} enables attaching +%D of strings \type{latexmp_prepend} and \type{latexmp_append} to the +%D string passed to \type{textext}. This may be useful for package +%D authors to implement styling interfaces. +newinternal latexmp_attachstrings ; latexmp_attachstrings:=0 ; +string latexmp_prepend, latexmp_append ; +latexmp_prepend:= "" ; latexmp_append := "" ; + +def addstring_latexmp(expr s)= + if not latexmp_texinit: + write EOF to latexmp_lmpfile ; + writeLaTeXpreamble_latexmp ; + latexmp_texinit := true ; + fi; + write "latexmp_picture[" & (decimal latexmp_counter) & "]:= btex " & + if latexmp_attachstrings=1: latexmp_prepend & s & latexmp_append else: s fi + & " etex ;" to latexmp_lmpfile ; +enddef; + +def getpicture_latexmp = + if not latexmp_lmploaded: + if not (readfrom latexmp_lmpfile=EOF): + scantokens ("input " & latexmp_lmpfile) ; + fi; + latexmp_lmploaded := true ; + fi; + if known latexmp_picture[latexmp_counter]: + if latexmp_multicolor and not latexmp_debug: + pic := colorspecials_latexmp(latexmp_picture[latexmp_counter]) ; + else: + pic := latexmp_picture[latexmp_counter] ; + fi; + else: + pic := ("LaTeXMP " & (decimal latexmp_counter)) + infont defaultfont ; + fi; +enddef; + +%D The following is only used if option \type{multicolor} is set in +%D \type{setupLaTeXMP}. It is employed in \type{getpicture_latexmp} +%D in order to strip specials from the LaTeX picture and change +%D the colors of text elements accordigly. +vardef colorspecials_latexmp(expr p) = + save _P, _bb, _tp, _fp, _t, _addto_P ; + save _withcolor, _colorpointer, _transparent, _transpointer; + picture _P ; path _bb ; + string _withcolor[], _transparent[], _tp, _fp, _addto_P ; + numeric _colorpointer, _transpointer ; + _P := nullpicture ; _bb := pathpart p ; + _withcolor[0]:= "" ; _colorpointer := 0 ; _transparent[0]:="" ; + _transpointer:=0 ; + _addto_P := "addto _P also _tp infont _fp transformed _t " ; + for c within p: + if textual c: + _tp:= textpart c ; + _fp:= fontpart c ; + transform _t ; + (xpart _t,xxpart _t,xypart _t)=(xpart c,xxpart c,xypart c) ; + (ypart _t,yypart _t,yxpart _t)=(ypart c,yypart c,yxpart c) ; + if (_fp="cmtt8") and ((substring (1,9) of _tp)="colorxxx"): + % color special found + if (substring (0,1) of _tp)="b": + % begin color special + _colorpointer := _colorpointer+1; + _withcolor[_colorpointer]:= colormacro_latexmp(substring (10,(length _tp)) of _tp) ; + elseif (substring (0,1) of _tp)="e": + % end color special + if not (_colorpointer=0): +%C if \type{\color} is used ungrouped in a parbox the \type{ecolorxxx} +%C appears prior \type{bcolorxxx}. multiple instances of \type{ecolorxxx} +%C would result in counting \type{_colorpointer<0}. thus checking +%C for \type{_colorpointer=0} is a ugly hack for this problem. + _colorpointer := _colorpointer-1; + fi; +%C else:?? ooops; should not happen + fi; + elseif (_fp="cmtt8") and ((substring (1,9) of _tp)="transxxx"): + % transparency special found + if (substring (0,1) of _tp)="b": + % begin trans special + _transpointer := _transpointer+1; + _transparent[_transpointer]:= substring (10,(length _tp)) of _tp ; + elseif (substring (0,1) of _tp)="e": + % end trans special + _transpointer := _transpointer-1; + fi; + else: + scantokens (_addto_P & withcurrentcolor_latexmp ) ; + fi; + fi; + endfor; + setbounds _P to _bb ; + _P +enddef; + +vardef colormacro_latexmp(expr colspec)= + save _cmd, _pos, _m, _c ; string _cmd, _m, _c ; + _pos := 0 ; _cmd:="" ; + for i=1 upto (length colspec): + if (substring (i-1,i) of colspec)=":": + _pos := i ; + fi; + endfor; + if _pos<2: % "x:..." --> no color model found + errmessage("LaTeXMP: no color model found in: " & colspec) ; + else: + _m := substring (0,(_pos-1)) of colspec ; + _c := substring (_pos,(length colspec)) of colspec ; + if expandafter known (scantokens ("latexmp_color_" & _m)): + _cmd := (scantokens ("latexmp_color_" & _m)) & "(" & _c & ")" ; + else: + errmessage("LaTeXMP: color model '" & _m & "' not supported)") ; + fi; + fi; + _cmd +enddef; + +vardef withcurrentcolor_latexmp= + if (length _withcolor[_colorpointer])>0: + if (length _transparent[_transpointer])>0: + " withcolor transparent(" & _transparent[_transpointer] & "," & + _withcolor[_colorpointer] &")" + else: " withcolor " & _withcolor[_colorpointer] fi + else: + if (length _transparent[_transpointer])>0: + " withcolor transparent(" & _transparent[_transpointer] & ",black)" + else: "" fi + fi +enddef; + +%D \section{The end macro for rerun mode} +string latexmp_beforererun ; latexmp_beforererun := "" ; + +def end_latexmp = +%D read temporary file if strings have been written there + if latexmp_counter>0: + write EOF to latexmp_lmpfile; + scantokens ("input " & latexmp_lmpfile) ; + fi; +%D re-init + latexmp_counter := 0 ; latexmp_secondrun := true ; latexmp_texinit := false ; +%D restore defaults + extra_beginfig := latexmp_extrabeginfig ; + extra_endfig := latexmp_extraendfig ; + background := latexmp_background ; + let end=origEnd_latexmp ; let bye=origBye_latexmp ; + let shipit=origShipit_latexmp ; + clear_pen_memory; clearit; + pickup pencircle scaled .5bp; defaultpen := savepen; +%D run pre-rerun hooks + scantokens latexmp_beforererun ; +%D input current job again + scantokens ("input " & jobname) ; +enddef; + +%D \section{color support} +vardef Hsvcolor_latexmp(expr H,s,v) = + save h, o, b, d, pc, sc; numeric h, o, b, d, pc, sc ; + h := H/60 ; pc := floor h ; sc := h - pc ; + o := (1-s)*v ; b := (1-(sc*s))*v ; d := (1-((1-sc)*s))*v ; + if (pc = 0) or (pc = 6): (v,d,o) + elseif pc = 1: (b,v,o) + elseif pc = 2: (o,v,d) + elseif pc = 3: (o,b,v) + elseif pc = 4: (d,o,v) + else:(v,o,b) + fi +enddef; +vardef cmykcolor_latexmp(expr c,m,y,k) = +%D use MetaFun cmyk-specials if available; macro \type{cmyk()} +%D checks if \type{cmykcolors=true} + if known context_spec: cmyk(c,m,y,k) else: (1-c-k,1-m-k,1-y-k) fi +enddef; +vardef graycolor_latexmp(expr g) = (g,g,g) enddef ; + +%D which macro should be used for a given color model in multicolor mode. +string latexmp_color_Hsv, latexmp_color_rgb, +latexmp_color_gray, latexmp_color_cmyk, latexmp_color_named ; + +latexmp_color_Hsv := "Hsvcolor_latexmp" ; +latexmp_color_gray := "graycolor_latexmp" ; +latexmp_color_rgb := "" ; +latexmp_color_cmyk := "cmykcolor_latexmp" ; +latexmp_color_named := "" ; + +%D \section{Key-Value Support Macros} +def processKeyvals_latexmp (text _kvps_)= + begingroup; + save _equals, _assign ; + let _equals= = ; + + primarydef _ll_ _assign _rr_ = + hide(_ll_ _equals _rr_ ) 1 + enddef; + + save = ; + let = _equals _assign ; + for _xx_ _equals _kvps_ : endfor ;% NOP + endgroup; +enddef; diff --git a/Master/texmf-dist/metapost/makecirc/ejemplos.mp b/Master/texmf-dist/metapost/makecirc/ejemplos.mp new file mode 100644 index 00000000000..3b1953be694 --- /dev/null +++ b/Master/texmf-dist/metapost/makecirc/ejemplos.mp @@ -0,0 +1,307 @@ +input makecirc; + +initlatex("\usepackage{amsmath,amssymb}"); + + +beginfig(1); + source.a(origin, AC, 90,"v","220 V"); + resistor.a(S.a.p+(2cm,1cm),normal,0,"R","5\ohm"); + centreof.A(R.a.r+(2cm,0),(xpart R.a.r + 2cm,ypart S.a.n - 1cm),cap); + capacitor.a(c.A,normal,phi.A,"C",""); + wire(S.a.p,R.a.l,udsq); + wire(R.a.r,C.a.l,rlsq); + wireU(S.a.n,C.a.r,-1cm,udsq); + imesh(S.a.n+(3cm,5mm),25mm,15mm,cw,0,"i(t)"); +endfig; + +beginfig(2); + source.a(origin, AC, 90,"v","220 V"); + resistor.a(S.a.p+(2cm,1cm),normal,0,"R","15\ohm"); + inductor.a(R.a.r+(2cm,-10mm),Up,-90,"L",""); + wire(S.a.p,R.a.l,udsq); + wire(R.a.r,L.a.l,rlsq); + wireU(S.a.n,L.a.r,-1cm,udsq); +endfig; + +beginfig(3); + source.a(origin,AC,90,"v","220 V"); + resistor.a(S.a.p+(2cm,1cm),normal,0,"R","15\ohm"); + inductor.a(R.a.r+(2cm,-10mm),Up,-90,"L","5 H"); + centerto.A(R.a.l,R.a.r)(-3.2cm,cap); + capacitor.a(A,normal,0,"C","12 pF"); + wire(S.a.p,R.a.l,udsq); + wire(R.a.r,L.a.l,rlsq); + wire(S.a.n,C.a.l,udsq); + wire(C.a.r,L.a.r,rlsq); +endfig; + +beginfig(4); + source.a(origin,AC,90,"v",""); + resistor.a(S.a.n+(2cm,5mm),normal,90,"R_L",""); + inductor.a(R.a.l,Down,-90,"L",""); + resistor.b(R.a.l+(2cm,0),normal,90,"R_C",""); + capacitor.a(R.b.l,normal,-90,"C",""); + wireU(S.a.p,R.a.r,1cm,udsq); + wireU(S.a.n,L.a.r,-1cm,udsq); + wire((xpart R.a.r,ypart S.a.p + 1cm),R.b.r,rlsq); + wire(C.a.r,(xpart L.a.r,ypart S.a.n-1cm),udsq); +endfig; + +beginfig(5); + source.a(origin,AC,90,"v",""); + diode.a(S.a.p+(1cm,1cm),normal,0,pinA,"D_r",""); + impedance.a(D.a.K+(1cm,-1cm),-90,"Z_L",""); + wire(S.a.p,D.a.A,udsq); + wire(D.a.K,Z.a.l,rlsq); + wireU(S.a.n,Z.a.r,-1cm,udsq); +endfig; + +beginfig(6); + transformer.a(origin,mid,0); + diode.a(tf.a.ss+(1cm,1cm),normal,0,pinA,"D_1",""); + diode.b(tf.a.si+(1cm,-1cm),normal,0,pinA,"D_2",""); + impedance.a(D.a.K+(3cm,-4mm),-90,"Z_L","300\ohm"); + wire(tf.a.ss,D.a.A,udsq); + wire(tf.a.si,D.b.A,udsq); + wire(D.a.K,Z.a.l,rlsq); + wire(Z.a.r,tf.a.m,udsq); + wire(D.b.K,D.a.K+(1cm,0),rlsq); + junction.a(D.a.K+(1cm,0),"")(top); + centerto.A(tf.a.pi,tf.a.ps)(-25mm,sac); + source.a(A,AC,90,"v","220 V"); + wire(S.a.p,tf.a.ps,udsq); + wire(S.a.n,tf.a.pi,udsq); + centreof.A((xpart S.a.p,ypart tf.a.ps),tf.a.ps,cur); + current.a(c.A,phi.A,"i(t)","5 A"); + imesh(tf.a.ss+(2cm,0),3cm,1cm,cw,0,"I_{cc}"); +endfig; + +beginfig(7); + source.a(origin,AC,90,"v",""); + junction.a(S.a.p+(3cm,1cm),"")(top); + diode.a(J.a,normal,-45,pinA,"D_1",""); + diode.b(D.a.K,normal,-135,pinK,"D_2",""); + diode.c(D.b.A,normal,135,pinK,"D_3",""); + diode.d(D.c.A,normal,45,pinA,"D_4",""); + junction.b(D.b.A,"")(bot); + centerto.A(S.a.n,S.a.p)(5cm,imp); + impedance.a(A,90,"Z_L",""); + wireU(S.a.p,D.a.A,1.5cm,udsq); + wireU(S.a.n,D.b.A,-1.5cm,udsq); + wire(D.a.K,Z.a.r,rlsq); + wire(Z.a.l,Z.a.l+(0,-4mm),nsq); + wireU(Z.a.l+(0,-4mm),D.d.A,-4cm,rlsq); +endfig; + +beginfig(8); + junction.a(origin,"1b")(bot); + junction.b((0,4cm),"1a")(top); + resistor.a((1cm,4cm),normal,0,"R_1","0,82\ohm"); + inductor.a(R.a.r,Up,0,"X_{L1}","0,92\ohm"); + centerto.A(J.a,J.b,4cm,res); + resistor.b(A,normal,90,"G_{\phi}","0,41"); + centerto.B(J.a,J.b,6cm,ind); + inductor.b(B,Down,90,"B_{\phi}","2,24"); + inductor.c(L.a.r+(2.6cm,0),Up,0,"X'_{L2}","0,9\ohm"); + resistor.c(L.c.r,normal,0,"R'_2","0,8\ohm"); + junction.c(R.c.r+(1cm,0),"2a")(top); + junction.d(R.c.r+(1cm,-4cm),"2b")(bot); + wire(J.a,J.d,nsq); + wire(J.b,R.a.l,nsq); + wireU(R.b.r,L.b.r,3mm,udsq); + wireU(R.b.l,L.b.l,-3mm,udsq); + wire(L.a.r,(5cm,ypart R.b.r + 3mm),rlsq); + wire((5cm,ypart R.b.l - 3mm),(5cm,0),nsq); + wire(R.c.r,J.c,nsq); + wire(L.c.l,(5cm,ypart L.c.l),nsq); + ctext(J.a,J.b,"$V_1$",noarrow); + ctext(J.c,J.d,"$V'_2$",noarrow); +endfig; + +beginfig(9); + rheostat.a(origin,Lrheo,0); + wire(rh.a.s,rh.a.s+(-1cm,0),udsq); + wire(rh.a.i,(-1cm,0),nsq); + transformer.a((5cm,0),normal,0); + meains.a(tf.a.ps-(1cm,0),ampere,180,""); + meains.b((xpart rh.a.r + 5mm,ypart tf.a.ps),watt,0,""); + centerto.A(tf.a.pi,tf.a.ps,-1cm,ins); + centerto.B(mi.a.r,mi.b.r,0,0); + meains.c((xpart B,ypart A),volt,90,""); + wire(rh.a.i,tf.a.pi,nsq); + wire(rh.a.r,mi.b.l,udsq); + wire(mi.b.r,mi.a.r,nsq); + wire(B,mi.c.r,nsq); + wire(mi.c.l,(xpart B,0),nsq); + wire(mi.b.p,(xpart mi.b.p,0),nsq); + wire(mi.a.l,tf.a.ps,nsq); + wireU(tf.a.si,tf.a.ss,1cm,rlsq); + current(mi.b.l-(2mm,0),0,"I_1",""); +endfig; + +beginfig(10); + generator.a(origin,90,"E_g",""); + resistor.a(G.a.B,normal,90,"R_a",""); + resistor.f(G.a.D-(2cm,0),normal,90,"",""); + resistor.F(R.f.r,variable,90,"",""); + resistor.L(G.a.B+(2cm,-5mm),normal,90,"R_L",""); + current.a(R.a.r,90,"I_a",""); + wireU(i.a.d,R.L.r,5mm,udsq); + wireU(G.a.D,R.L.l,-5mm,udsq); + wire(i.a.d+(0,5mm),R.F.r,rlsq); + wire(R.f.l,G.a.D-(0,5mm),udsq); + ctext(R.f.l-(5mm,0),R.F.r-(5mm,0),"$R_f$",noarrow); + current.f(i.a.d+(-1cm,5mm),180,"","$I_f$"); + current.L(i.a.d+(1cm,5mm),0,"I_L",""); + ctext.lft(R.f.l-(1cm,5mm),(xpart R.F.r-1cm,ypart i.a.d+5mm),"$V_f$",witharrow); + ctext.rt((xpart R.L.l+1cm,-5mm),(xpart R.L.r+1cm,ypart i.a.d+5mm),"$V_L$",witharrow); +endfig; + +beginfig(11); + generator.a(origin,90,"E_g","500 V"); + resistor.a(G.a.B,normal,90,"R_a",""); + current.a(G.a.D+(2mm,-1cm),0,"I_a",""); + junction.A(i.a.d+(2mm,0),"A")(top); + current.s(J.A+(4mm,0),0,"I_s",""); + resistor.s(i.s.d,normal,0,"R_s",""); + junction.B(R.s.r+(2mm,0),"B")(top); + current.d(J.A+(4mm,-1cm),0,"I_d","54 A"); + resistor.d(i.d.d,variable,0,"R_d",""); + current.f(J.B+(2mm,5mm),90,"I_f",""); + current.L(J.B+(1cm,0),0,"I_L",""); + resistor.L(i.L.d+(1cm,1.25cm),normal,90,"R_L",""); + resistor.f(i.f.d+(0,2mm),normal,90,"",""); + resistor.F(R.f.r,variable,90,"",""); + wire(R.F.r,R.a.r,rlsq); + wire(R.F.r,R.L.r,rlsq); + wire(R.L.l,J.B,udsq); + wire(J.B+(2mm,0),R.f.l,nsq); + wire(J.B,R.d.r,udsq); + wire(R.d.l,J.A,rlsq); + wire(J.A,R.s.l,nsq); + wire(R.s.r,J.B,nsq); + wire(J.A,G.a.D,rlsq); + puttext("$R_f$",R.f.r-(5mm,0)); +endfig; + +beginfig(12); + junction.a(origin,"")(bot); + junction.b((0,4cm),"")(top); + ctext.lft(J.a,J.b,"$V_a=V_L=120\,\text{V}$",witharrow); + current.L(J.b+(5mm,0),0,"I_L",""); + current.f(i.L.d+(5mm,-5mm),-90,"I_f",""); + current.a(i.L.d+(2cm,0),0,"I_a",""); + resistor.a(i.a.d+(15mm,-8mm),normal,-90,"R_a","0,25\ohm"); + motor.a(R.a.r,-90,"E_c",""); + resistor.f(i.f.d,normal,-90,"",""); + resistor.F(R.f.r,variable,-90,"",""); + puttext("$R_f$",R.f.r+(5mm,0)); + wire(J.b,R.a.l,rlsq); + wire(J.a,M.a.B,rlsq); + wire(i.f.s+(0,5mm),R.f.l,nsq); + wire(R.F.r,(xpart R.F.r,0),nsq); +endfig; + +beginfig(13); + junction.a(origin,"")(bot); + rheostat.a((5mm,2cm),Rrheo,0); + junction.b(rh.a.s-(5mm,0),"")(top); + resistor.a(rh.a.r+(2cm,0),normal,-90,"R_a","0,2\ohm"); + motor.a((xpart R.a.r,0),90,"E_c",""); + resistor.F(R.a.l+(2cm,0),variable,-90,"",""); + resistor.f((xpart R.F.l,0),normal,90,"",""); + wire(J.b,rh.a.s,nsq); + wire(rh.a.r,R.a.l,nsq); + wire(R.a.l,R.F.l,nsq); + wire(R.F.r,R.f.r,nsq); + wire(R.a.r,M.a.B,nsq); + wire(J.a,R.f.l,nsq); + ctext(J.a,J.b,"$V_a$",noarrow); +endfig; + +beginfig(14); + transistor.a(origin,pnp,0); + junction.B(T.a.B,"B")(top); + junction.E(T.a.E,"E")(llft); + junction.C(T.a.C,"C")(top); + resistor.C(T.a.C+(2cm,-5mm),normal,-90,"R_C",""); + source.CC(R.C.r,DC,-90,"V_{CC}",""); + resistor.B(T.a.B-(2cm,0),normal,-90,"R_B",""); + source.EE(R.B.r,DC,-90,"V_{BB}",""); + capacitor.a(T.a.B-(3cm,0),normal,180,"C_a",""); + junction.a(C.a.r-(1cm,0),"")(top); + junction.b((xpart J.a,ypart S.EE.p-5mm),"")(bot); + wire(T.a.C,R.C.l,rlsq); + wire(T.a.B,C.a.l,nsq); + wire(C.a.r,J.a,nsq); + wireU(S.EE.p,S.CC.p,-5mm,udsq); + wire(J.b,S.EE.p-(0,5mm),nsq); + wire(T.a.E,(xpart T.a.E,ypart S.EE.p-5mm),nsq); + current.E(T.a.E-(0,1cm),90,"I_E",""); + current.C(T.a.C+(5mm,0),0,"I_C",""); + current.B(J.B-(5mm,0),180,"I_B",""); + ctext.lft(J.a,J.b,"$E_1$",witharrow); + wire(R.C.l,R.C.l+(1cm,0),nsq); + wire(R.C.r,R.C.r+(1cm,0),nsq); + ctext.rt(R.C.l+(1cm,0),R.C.r+(1cm,0),"$E_2$",witharrow); +endfig; + +beginfig(15); + source.a(origin,AC,90,"v",""); + diode.a(S.a.p+(1cm,1cm),normal,0,pinA,"D_r",""); + capacitor.a(D.a.K+(5mm,-12mm),electrolytic,-90,"C_e",""); + impedance.a(D.a.K+(2cm,-1cm),-90,"Z_L",""); + wire(S.a.p,D.a.A,udsq); + wire(D.a.K,Z.a.l,rlsq); + wireU(S.a.n,Z.a.r,-1cm,udsq); + wire(D.a.K+(5mm,0),C.a.l,nsq); + wire(C.a.r,(xpart C.a.r,ypart S.a.n-1cm),nsq); +endfig; + +beginfig(16); + transformer.a(origin,mid,0); + diode.a(tf.a.ss+(1cm,1cm),normal,0,pinA,"D_1",""); + diode.b(tf.a.si+(1cm,-1cm),normal,0,pinA,"D_2",""); + capacitor.a(D.a.K+(3cm,-6mm),electrolytic,-90,"C_e",""); + impedance.a(D.a.K+(5cm,-4mm),-90,"Z_L",""); + wire(tf.a.ss,D.a.A,udsq); + wire(tf.a.si,D.b.A,udsq); + wire(D.a.K,Z.a.l,rlsq); + wire(Z.a.r,tf.a.m,udsq); + wire(D.b.K,D.a.K+(1cm,0),rlsq); + junction.a(D.a.K+(1cm,0),"")(top); + centerto.A(tf.a.pi,tf.a.ps)(-25mm,sac); + source.a(A,AC,90,"v",""); + wire(S.a.p,tf.a.ps,udsq); + wire(S.a.n,tf.a.pi,udsq); + wire(D.a.K+(3cm,0),C.a.l,nsq); + wire(C.a.r,(xpart C.a.r,ypart tf.a.m),nsq); +endfig; + +beginfig(17); + inductor.a(origin,Up,90,"",""); + inductor.b(origin,Down,90+120,"",""); + inductor.c(origin,Up,90-120,"",""); + inductor.d(origin,Up,-90,"",""); + inductor.e(origin,Down,-90-120,"",""); + inductor.f(origin,Up,-90+120,"",""); + diode.a((3cm,ypart L.a.r),normal,0,pinA,"",""); + diode.b((3cm,ypart L.b.r-1.2cm),normal,0,pinA,"",""); + diode.c((3cm,ypart L.c.r),normal,0,pinA,"",""); + diode.d((3cm,ypart L.d.r),normal,0,pinA,"",""); + diode.e((3cm,ypart L.e.r+1.2cm),normal,0,pinA,"",""); + diode.f((3cm,ypart L.f.r),normal,0,pinA,"",""); + centerto.A(D.e.K,(xpart D.e.K,0),2cm,imp); + impedance.a(A,90,"Z_L",""); + wire(L.a.r,D.a.A,nsq); + wire(L.b.r,D.b.A,udsq); + wire(L.c.r,D.c.A,nsq); + wire(L.d.r,D.d.A,nsq); + wire(L.e.r,D.e.A,udsq); + wire(L.f.r,D.f.A,nsq); + wire(D.e.K,Z.a.r,rlsq); + wire(Z.a.l,origin,udsq); + wire(D.b.K,D.e.K,nsq); + junction.a(D.e.K,"")(top); +endfig; +end.
\ No newline at end of file diff --git a/Master/texmf-dist/metapost/makecirc/latex.mp b/Master/texmf-dist/metapost/makecirc/latex.mp new file mode 100644 index 00000000000..f2f1945ef32 --- /dev/null +++ b/Master/texmf-dist/metapost/makecirc/latex.mp @@ -0,0 +1,246 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% latex.mp Parametrizable latex labels for metapost +%% Copyright (c) 2003 JL Diaz +%% based on an idea taken from Metafun, by Hans Hagen +% +% This program may be distributed and/or modified under the conditions +% of the LaTeX Project Public License, either version 1.2 of this +% license or (at your option) any later version. The latest version +% of this license is in http://www.latex-project.org/lppl.txt and +% version 1.2 or later is part of all distributions of LaTeX version +% 1999/12/01 or later. +% +% This program consists of the file latex.mp +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% For the impatient: Jump to "USAGE" +% +% Introduction: The problem +% +% Let us suppose that you need to typeset several labels of the form +% $x_1$, $x_2$, ... $x_{10}$. Since each label is a formula, the +% construction btex/etex is required to typeset it through TeX (or +% LaTeX). So, the straighforward solution is: +% +% label(btex $x_1$ etex, (1u,0u)); +% label(btex $x_2$ etex, (2u,0u)); +% ... +% label(btex $x_{10}$ etex, (10u,0u)); +% +% This repeated structure is inviting us to convert it into a for +% loop. A naive attempt would be: +% +% for i=1 upto 10: +% label (btex $x_{i}$ etex, (i*u, 0)); +% endfor; +% +% Unfortunately the above would produce ten times the same label +% $x_{i}$, because i is not evaluated in this context as a variable. +% +% A second, more clever attempt would be: +% +% for i=1 upto 10: +% label("btex $x_{" & decimal i & "}$ etex", (i*u, 0)); +% endfor; +% +% where we are making use of the string concatenation operator (&), +% and the "decimal" operator, which produces an string whith the +% decimal representation of its argument. This way, the macro label +% will receive successively as first argument the strings: "btex +% $x_{1}$ etex", "btex $x_{2}$ etex", end so on. +% +% This solution does not work either, because label is receiving a +% string, instead of a picture (which is the result of a proper +% btex/etex construction). When a string is received, label simply +% outputs that string, without calling TeX (LaTeX) for formatting it. +% +% Metapost provides a way of "executing" the code which is stored in +% a string, it is the scantokens primitive. So, it appears that a +% modification of the label primitive would be possible, which +% applies the scantokens primitive on the string which it receives as +% parameter. Unfortunately this does not work either, because the way +% in which btex/etex works procludes it use as argument of +% scantokens. +% +% So, apparently, there is not an easy solution to the problem of +% passing arguments to the etex/btex construct. +% +% The solution +% +% Since the construct btex/etex can only be used at the "top level" +% of a source file, and not embedded in any string, the only way to +% achieve the desired result is to store the string "btex ... etex" +% in an external temporal file, and input back that file. +% +% This solution is implemented in the macro package "TEX.mp" which is +% part of the standard metapost distribution. Using this package, the +% problem of printing the ten labels $x_1$ .. $x_{10}$ becomes simple: +% +% for i=0 upto 10: +% label(TEX("$x_{" & decimal i & "}$", (u*i,0)); +% endfor; +% +% The macro TEX receives an string as argument, and uses TeX to +% typeset it. This is achieved, as already explained, by creating a +% new string which encapsulated the given argument into a btex/etex +% pair, writing this new string in an external file, and inputting +% that file back. +% +% This approach has two main drawbacks: +% +% 1) An external file is created, and processed each time TEX is +% used. This is very inefficient, and the slowdown is noticeable if +% TEX is used often. +% +% 2) If we want to use latex istead of tex, the TEX macro will not +% work, because the external file created through this macro does +% not include the verbatimtex header required to initialize latex. +% +% Metafun approach: a clever solution +% +% In the excelent macro package Metafun (by Hans Hagens), a nice +% solution is found to the first problem. Instead of writing the +% auxiliar file and inputting it again, what is wrote is an auxiliar +% metapost program which defines a serie of picture variables, each +% one with the result of a btex/etex pair. In the first run of +% metapost, this auxiliar file is write-only. In the second run, the +% file is read at the beginning, so all picture variables get +% defined. In this second run, each time the TEX macro is called, it +% checks if the corresponding picture variable is already defined, +% and in this case it simply returns its value. +% +% This approach is much more efficient, since a single externa file +% is produced and processed, no matter how much the TEX macro is +% called. The only drawback is that two metapost runs are required. +% +% latex.mp: my solution +% +% I liked very much the metafun solution, but I did not want to use +% the whole Metafun package only to obtain this +% functionality. Moreover, metafun relies in a set of external +% scripts, which decide to input or not the external file, depending +% on the existence of that file. I would prefer do not require perl +% nor any other scripting language. Only metapost. +% +% This is why I wrote "latex.mp". It implements the idea in the +% metafun package, but it does not require any external script in +% order to check the existence of the auxiliar file. +% +% ================================================================ +% +% USAGE +% +% input "latex"; +% initlatex(...); +% ... +% +% latex("string to be formatted by latex"); +% % Returns a picture which can be used in a label +% +% The initlatex macro writes a latex header in an auxiliar file. You +% do not need to call this macro if you use TeX as typesetting engine. +% +% On the other hand, if you want to use LaTeX as typesetting engine, +% you need to call this macro before the first beginfig(). The macro +% requires a mandatory argument, which is a string with adittional +% macro commands to be placed before the "\begin{document}". For +% example: +% +% initlatex("\usepackage[latin1]{inputenc}\usepackage{amsmath}"); +% +% If you do not need any aditional package, you can use "" as +% argument. +% +% You can use the latex macro in any place where a picture is +% expected, as in the first argument of a label comand. For example: +% +% for i=0 upto 10: +% label(latex("$x_{$ & decimal i & "}$", (u*i,0)); +% endfor; +% +% In order to correctly obtain the labels which use the latex macro, +% you need to process your source file twice through metapost. The +% first run all labels will show as "[?]", but the second run they +% will have the correct value. +% +% IMPORTANT: +% +% If the text passed to the latex macro contains errors, latex will be +% unable to complete its run. This will make impossible to run mpost +% on the source, even if the errors are corrected, until you delete +% the auxiliar file (which has .mpt extension) +% +% +%================================================================ +% Implementation +% +numeric NumPic; % Total number of times that latex() macro has been + % called +picture LaTeXPic[]; % Picture array which stores the result of each + % latex macro call. This array is filled when the + % axiliar file is read. +string LaTeXsetup; % additional packages and macro definitions for latex + +% Initialization +NumPic:=0; +LaTeXsetup:="\documentclass{article}"; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Entry point +% +% The auxiliar file is read, but only if it exists +% +if readfrom(jobname&".mpt") <> EOF: + scantokens ("input "&jobname & ".mpt"); +fi; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% initlatex() +% +% By calling this function, the user can specify aditional packages and +% macro definitions to the be used by latex. +% +% For example: +% +% initlatex("\usepackage[latin1]{inputenc}\usepackage{amsmath}"); +% +% The global variable LaTeXsetup is also provided, mainly for third +% party libraries which require to define their own macros. The +% programmers of these libraries should append their own material to +% the LaTeXsetup variable, by using the & operator. For example: +% +% LaTeXsetup:=LaTeXsetup & "\def\TO{\Longrightarrow}"; +% +def initlatex primary s = + write "verbatimtex" to jobname & ".mpt"; + write "%&latex" to jobname & ".mpt"; + write LaTeXsetup to jobname & ".mpt"; + write s to jobname & ".mpt"; + write "\begin{document}" to jobname & ".mpt"; + write "etex" to jobname & ".mpt"; +enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% latex() +% +% This macro receives a string, and returns a picture which contains +% the result of running the string by latex. The result can be used +% whenever a picture argument is expected, as for example in a label. + +vardef latex@#(expr txt) = + NumPic := NumPic + 1 ; + if string txt : + write "% figure " & decimal charcode & " : " & char(10) & + "LaTeXPic[" & decimal NumPic & "] := btex " & + txt & " etex ;" to jobname & ".mpt" ; + if unknown LaTeXPic[NumPic] : + thelabel@#("[??]",origin) + else : + thelabel@#(LaTeXPic[NumPic],origin) + fi + else : + thelabel@#(txt,origin) + fi +enddef ; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% EOF diff --git a/Master/texmf-dist/metapost/makecirc/makecirc.mp b/Master/texmf-dist/metapost/makecirc/makecirc.mp new file mode 100644 index 00000000000..0c6d8c8751d --- /dev/null +++ b/Master/texmf-dist/metapost/makecirc/makecirc.mp @@ -0,0 +1,981 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%||||||||||||||||||||«makecirc.mp»|||||||||||||||||||||||||%% +%%==========================================================%% +%<------------------- version 1.1 ------------------------->%% +% A MetaPost library for drawing electrical circuit diagrams. +% Copyright (c) 2003 GS Bustamante Argañaraz. +% It uses latex.mp by JL Diaz. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% This program may be distributed and/or modified under the conditions +% of the LaTeX Project Public License, either version 1.2 of this +% license or (at your option) any later version. The latest version +% of this license is in http://www.latex-project.org/lppl.txt and +% version 1.2 or later is part of all distributions of LaTeX version +% 1999/12/01 or later. +% +% This program consists of the files makecirc.mp and latex.mp +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +input latex; +% +% Commands definitions to do the labeled easier % +% +LaTeXsetup:=LaTeXsetup & +"\def\ohm{\ensuremath{\,\Omega}}" & +"\def\kohm{\,k\ensuremath{\Omega}}" & +"\def\modarg#1#2{\setbox0=\hbox{$\mkern-1mu/#2^\circ$}" & +"\dp0=.21ex $#1\underline{\box0}$}"; +% +newinternal labeling, rotatelabel, norotatelabel; +labeling:=0; norotatelabel:=labeling; rotatelabel:=1; + +% Macros for the pens, I define them as such so when they expand, +% look for the last value assigned to linewd and use it +% (thanks to JLD). The linewd value assigns it as newinternal to +% be able to change it «from out». + +newinternal linewd; +linewd:=0.25mm; + +def line = pencircle scaled linewd enddef; +def misc = pencircle scaled .8linewd enddef; + +% Arrowhead definitions % + +vardef miscahead expr p = +save A,u,a,b; pair A,u; path a,b; +A := point length(p) of p; +u := unitvector(direction length(p)/2 of p); +a := A--(A - ahlength*u rotated 15); +b := A--(A - ahlength*u rotated -15); +(a & reverse(a) & b & reverse(b))--cycle +enddef; + +vardef bjtahead expr p = +save A,u,a,b; pair A,u; path a,b; +A := point 0.7length(p) of p; +u := unitvector(direction length(p)/2 of p); +a := A--(A - ahlength*u rotated 20); +b := A--(A - ahlength*u rotated -20); +(a & reverse(a) & b & reverse(b))--cycle +enddef; + +vardef txtahead expr p = +save A,B,u,a; pair A,B,u; path a; +A := point length p of p; +B := point .97length p of p; +u := unitvector(direction length p of p); +a := A{-u}..(A - 7*u rotated 15)--B + --(A - 7*u rotated -15)..A{u}--cycle; +a +enddef; + +% Macros for wire the symbols % + +newinternal nsq, udsq, rlsq, usq; +nsq:=0; udsq:=2; rlsq:=3; usq:=4; + +def wire(expr pin_beg,pin_end,type)= + if type=nsq: + draw pin_beg--pin_end withpen line + elseif type=udsq: + draw pin_beg--(xpart pin_beg,ypart pin_end)--pin_end withpen line + elseif type=rlsq: + draw pin_beg--(xpart pin_end,ypart pin_beg)--pin_end withpen line + fi; +enddef; + +% Macro to connect two branches in parallel % + +def wireU(expr pin_beg,pin_end,dist,type)= + if type=udsq: + draw pin_beg--(pin_beg+(0,dist))--(xpart pin_end,ypart pin_beg + dist) + --pin_end withpen line + elseif type=rlsq: + draw pin_beg--(pin_beg+(dist,0))--(xpart pin_beg + dist,ypart pin_end) + --pin_end withpen line + fi; +enddef; + +% Variable to find the center of two pins, for to include a symbols. It returns the point +% and the input angle for the symbol that we want to place. + +vardef centreof@#(expr pin_beg,pin_end,lchar)= + pair c@#; numeric phi@#; + c@#= -lchar*dir angle(xpart(pin_end)-xpart(pin_beg), + ypart(pin_end)-ypart(pin_beg)) shifted .5[pin_beg,pin_end]; + phi@#=angle(xpart(pin_end)-xpart(pin_beg), + ypart(pin_end)-ypart(pin_beg)); +enddef; + +% Variable to center an element regarding the pins of another, at +% a distance «dist» of the same one. It returns the point in which we should +% place the symbol that we want to center. + +vardef centerto.@#(expr pinref_beg,pinref_end)(expr dist,elem)= + pair @#; + if (xpart(pinref_beg)=xpart(pinref_end)): + @#:=(.5[pinref_beg,pinref_end]+(dist,-elem)) + elseif (ypart(pinref_beg)=ypart(pinref_end)): + @#:=(.5[pinref_beg,pinref_end]+(-elem,dist)) + fi +enddef; + +% Macro for scale the circuit when it is concluded. % + +def scalecirc expr factor = + currentpicture:=currentpicture scaled factor +enddef; + +% Macro to include text into the circuits % + +vardef puttext@#(expr txt, point)= + label@#(latex(txt),point); +enddef; + +% Macro to center text among two pins % + +newinternal witharrow, noarrow; +witharrow:=0; noarrow:=1; + +vardef ctext@#(expr pin_beg,pin_end,txt,type)= + save ctxt; picture ctxt; + ctxt:=nullpicture; + %ahlength:=10; + if type=noarrow: + addto ctxt also thelabel(latex(txt),.5[pin_beg,pin_end]); + elseif type=witharrow: + addto ctxt doublepath pin_beg--pin_end; + addto ctxt contour txtahead pin_beg--pin_end; + addto ctxt contour txtahead reverse(pin_beg--pin_end); + addto ctxt also thelabel@#(latex(txt),.5[pin_beg,pin_end]); + fi; + draw ctxt withpen line; +enddef; + +% Definition of lbsep (label separation), distance among symbol and label. % + +newinternal lbsep; +lbsep:=3mm; + +% Macros to facilitate the one labeled of the symbols % + +def putlabel(expr pin_beg,pin_end,lchar,lcharv,ang,name,val)= +if labeling=rotatelabel: + if ((ang > (-90)) and (ang <= 90)) or ((ang > 270) and (ang <= 450)): + label(latex("$" & name & "$") rotatedaround (.5[pin_beg,pin_end],ang), + (lchar+lbsep)*dir (90+ang) shifted .5[pin_beg,pin_end]); + + label(latex(val) rotatedaround (.5[pin_beg,pin_end],ang), + (lcharv+lbsep)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif ((ang > 90) and (ang <= 270)) or ((ang > (-270)) and (ang <= (-90))): + label(latex("$" & name & "$") rotatedaround (.5[pin_beg,pin_end],180+ang), + (lchar+lbsep)*dir (90+ang) shifted .5[pin_beg,pin_end]); + + label(latex(val) rotatedaround (.5[pin_beg,pin_end],180+ang), + (lcharv+lbsep)*dir (270+ang) shifted .5[pin_beg,pin_end]); + fi; + elseif labeling=norotatelabel: + if (ang = 0): + label.top(latex("$" & name & "$"), (lchar+.25lbsep)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.bot(latex(val),(lcharv+.25lbsep)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif (ang > 0) and (ang < 90): + label.ulft(latex("$" & name & "$"), (lchar)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.lrt(latex(val),(lcharv)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif (ang = 90): + label.lft(latex("$" & name & "$"),(lchar+.25lbsep)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.rt(latex(val),(lcharv+.25lbsep)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif (90 < ang) and (ang < 180): + label.llft(latex("$" & name & "$"),(lchar)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.urt(latex(val),(lcharv)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif (ang = 180) or (ang = (-180)): + label.bot(latex("$" & name & "$"), (lchar+.25lbsep)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.top(latex(val),(lcharv+.25lbsep)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif ((ang > 180) and (ang < 270)) or ((ang > (-180)) and (ang < (-90))): + label.lrt(latex("$" & name & "$"),(lchar)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.ulft(latex(val),(lcharv)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif (ang = 270) or (ang = (-90)): + label.rt(latex("$" & name & "$"), (lchar+.25lbsep)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.lft(latex(val),(lcharv+.25lbsep)*dir (270+ang) shifted .5[pin_beg,pin_end]); + elseif ((270 < ang) and (ang < 360)) or ((ang < 0) and (ang > (-90))): + label.urt(latex("$" & name & "$"),(lchar)*dir (90+ang) + shifted .5[pin_beg,pin_end]); + + label.llft(latex(val),(lcharv)*dir (270+ang) shifted .5[pin_beg,pin_end]); + fi; + fi; +enddef; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%% Here the symbols begin %%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%<---Inductor (bobina) --->%%% + +newinternal coil, Up, Down; +coil:=2mm; Up:=0; Down:=1; + +vardef inductor@#(expr z,type,ang,name,val)= + save bobina; + pair L@#.l, L@#.r; % pines % + L@#.l=z; L@#.r=(z+(6coil,0)) rotatedaround (z,ang); + picture bobina; + bobina:=nullpicture; + + if type=Up: + addto bobina doublepath z--(z+(coil,0)){up}.. for i=2 upto 4: + {down}(z+(i*coil,0)){up}.. endfor {down}(z+(5coil,0))--(z+(6coil,0)); + putlabel(L@#.l,L@#.r,coil,.5coil,ang,name,val); + elseif type=Down: + addto bobina doublepath z--(z+(coil,0)){down}.. for i=2 upto 4: + {up}(z+(i*coil,0)){down}.. endfor {up}(z+(5coil,0))--(z+(6coil,0)); + putlabel(L@#.l,L@#.r,coil,.5coil,(ang-180),name,val); + fi; + + draw bobina rotatedaround(z,ang) withpen line; +enddef; + +%%%<---Capacitor (condensador)--->%%% + +newinternal normal, electrolytic, variable, variant, platsep; +normal:=0; electrolytic:=1; variable:=2; platsep:=1mm; variant:=3; + +vardef capacitor@#(expr z,type,ang,name,val)= + save cap; + pair C@#.l, C@#.r; % pines % + C@#.l:=z; + C@#.r:=(xpart(z)+7platsep,ypart(z)) rotatedaround(z,ang); + picture cap; cap:=nullpicture; + + addto cap doublepath z--(xpart(z)+3platsep,ypart(z)) withpen line; + addto cap doublepath (xpart(z)+4platsep,ypart(z)) + --(xpart(z)+7platsep,ypart(z)) withpen line; + + if type=normal: + addto cap doublepath (xpart(z)+3platsep,ypart(z)-2.5platsep) + --(xpart(z)+3platsep,ypart(z)+2.5platsep) withpen line; + addto cap doublepath (xpart(z)+4platsep,ypart(z)-2.5platsep) + --(xpart(z)+4platsep,ypart(z)+2.5platsep) withpen line; + elseif type=electrolytic: + addto cap doublepath (xpart(z)+3platsep,ypart(z)-1.8platsep) + --(xpart(z)+3platsep,ypart(z)+1.8platsep) withpen line; + addto cap doublepath (xpart(z)+2platsep,ypart(z)-2.5platsep) + --(xpart(z)+4platsep,ypart(z)-2.5platsep)--(xpart(z)+4platsep,ypart(z)+2.5platsep) + --(xpart(z)+2platsep,ypart(z)+2.5platsep) withpen line; + elseif type=variable: + addto cap doublepath (xpart(z)+3platsep,ypart(z)-2.5platsep) + --(xpart(z)+3platsep,ypart(z)+2.5platsep) withpen line; + addto cap doublepath (xpart(z)+4platsep,ypart(z)-2.5platsep) + --(xpart(z)+4platsep,ypart(z)+2.5platsep) withpen line; + addto cap doublepath (xpart(z)+platsep,ypart(z)-2.5platsep) + --(xpart(z)+6platsep,ypart(z)+2.5platsep) withpen misc; + ahlength:=1.7platsep; + addto cap contour miscahead (xpart(z)+platsep,ypart(z)-2.5platsep) + --(xpart(z)+6platsep,ypart(z)+2.5platsep) withpen misc; + elseif type=variant: + addto cap doublepath (xpart(z)+3platsep,ypart(z)-2.5platsep) + --(xpart(z)+3platsep,ypart(z)+2.5platsep) withpen line; + addto cap doublepath (z+(4.5platsep,-2.5platsep))..(z+(4platsep,0)) + ..(z+(4.5platsep,2.5platsep)) withpen line; + fi; + + draw cap rotatedaround(z,ang); + + putlabel(C@#.l,C@#.r,2.5platsep,2.5platsep,ang,name,val); +enddef; + +%%%<--- Electrical machines (maquinas electricas) --->%%% + +vardef motor@#(expr z,ang,name,val)= + save mot, p, q, r, s, ca, cb, c, hc; + pair M@#.D, M@#.B; % pines % + M@#.D:=z; M@#.B:=(z+(2ssize,0)) rotatedaround(z,ang); + picture mot; mot:=nullpicture; + + addto mot doublepath z--(z+(.4ssize,0)); + addto mot doublepath (z+(1.6ssize,0))--(z+(2ssize,0)); + addto mot doublepath fullcircle scaled ssize shifted (z+(ssize,0)); + addto mot also thelabel(latex("\textsf{M}") scaled (ssize/6mm) + rotated (-ang), (z+(ssize,0))); + + path p,q,r,s,ca,cb,c,hc; + p=(z+(.6ssize,.075ssize))--(z+(.4ssize,.075ssize)); + q=(z+(.4ssize,.075ssize))--(z+(.4ssize,-.075ssize)); + ca=(z+(.4ssize,-.075ssize))--(z+(.6ssize,-.075ssize)); + + + r=(z+(1.4ssize,.075ssize))--(z+(1.6ssize,.075ssize)); + s=(z+(1.6ssize,.075ssize))--(z+(1.6ssize,-.075ssize)); + cb=(z+(1.6ssize,-.075ssize))--(z+(1.4ssize,-.075ssize)); + + c=fullcircle scaled ssize shifted (z+(ssize,0)); + hc=halfcircle scaled ssize rotated 270 shifted (z+(ssize,0)); + + addto mot contour buildcycle(p,q,ca,c); + addto mot doublepath buildcycle(p,q,ca,c); + + addto mot contour buildcycle(cb,s,r,hc); + addto mot doublepath buildcycle(cb,s,r,hc); + + draw mot rotatedaround(z,ang) withpen line; + + putlabel(M@#.D,M@#.B,.5ssize,.5ssize,ang,name,val); +enddef; + +vardef generator@#(expr z,ang,name,val)= + save gen; + pair G@#.D, G@#.B; % pines % + G@#.D:=z; G@#.B:=(z+(2ssize,0)) rotatedaround(z,ang); + picture gen; gen:=nullpicture; + + addto gen doublepath z--(z+(.5ssize,0)); + addto gen doublepath (z+(1.5ssize,0))--(z+(2ssize,0)); + addto gen doublepath fullcircle scaled ssize shifted (z+(ssize,0)); + addto gen also thelabel(latex("\textsf{G}") scaled (ssize/6mm) + rotated (-ang), (z+(ssize,0))); + + draw gen rotatedaround(z,ang) withpen line; + + putlabel(G@#.D,G@#.B,.5ssize,.5ssize,ang,name,val); +enddef; + +newinternal mid, Fe, auto; +mid:=1; Fe:=2; auto:=3; + +vardef transformer@#(expr z,type,ang)= + save trafo; + pair tf@#.pi, tf@#.ps, tf@#.si, tf@#.ss, tf@#.m; + tf@#.pi:=z; tf@#.ps:=(z+(0,8coil)) rotatedaround(z,ang); + tf@#.si:=(z+(2.4coil,0)) rotatedaround(z,ang); + tf@#.ss:=(z+(2.4coil,8coil)) rotatedaround(z,ang); + tf@#.m:=(z+(3.4coil,4coil)) rotatedaround(z,ang); + + picture trafo; trafo:=nullpicture; + + if type=normal: + tf@#.pi:=z; tf@#.ps:=(z+(0,8coil)) rotatedaround(z,ang); + tf@#.si:=(z+(2.4coil,0)) rotatedaround(z,ang); + tf@#.ss:=(z+(2.4coil,8coil)) rotatedaround(z,ang); + addto trafo doublepath z--(z+(0,coil)){right}.. + for i=2 upto 6: {left}(z+(0,i*coil)){right}.. endfor + {left}(z+(0,7coil))--(z+(0,8coil)); + addto trafo doublepath (z+(coil,coil))--(z+(coil,7coil)); + addto trafo doublepath (z+(1.4coil,coil))--(z+(1.4coil,7coil)); + addto trafo doublepath (z+(2.4coil,0))--(z+(2.4coil,coil)){left}.. + for i=2 upto 6: {right}(z+(2.4coil,i*coil)){left}.. endfor + {right}(z+(2.4coil,7coil))--(z+(2.4coil,8coil)); + elseif type=mid: + tf@#.pi:=z; tf@#.ps:=(z+(0,8coil)) rotatedaround(z,ang); + tf@#.si:=(z+(2.4coil,0)) rotatedaround(z,ang); + tf@#.ss:=(z+(2.4coil,8coil)) rotatedaround(z,ang); + tf@#.m:=(z+(3.4coil,4coil)) rotatedaround(z,ang); + addto trafo doublepath z--(z+(0,coil)){right}.. + for i=2 upto 6: {left}(z+(0,i*coil)){right}.. endfor + {left}(z+(0,7coil))--(z+(0,8coil)); + addto trafo doublepath (z+(coil,coil))--(z+(coil,7coil)); + addto trafo doublepath (z+(1.4coil,coil))--(z+(1.4coil,7coil)); + addto trafo doublepath (z+(2.4coil,0))--(z+(2.4coil,coil)){left}.. + for i=2 upto 6: {right}(z+(2.4coil,i*coil)){left}.. endfor + {right}(z+(2.4coil,7coil))--(z+(2.4coil,8coil)); + addto trafo doublepath (z+(2.4coil,4coil))--(z+(3.4coil,4coil)); + elseif type=Fe: + tf@#.pi:=z rotatedaround(z,ang); tf@#.ps:=(z+(0,5.3coil)) rotatedaround(z,ang); + tf@#.si:=(z+(14coil,0)) rotatedaround(z,ang); + tf@#.ss:=(z+(14coil,5.228coil)) rotatedaround(z,ang); + addto trafo doublepath z+(2coil,-2.5coil)--z+(12coil,-2.5coil) + --z+(12coil,7.5coil)--z+(2coil,7.5coil)--cycle; + addto trafo doublepath z+(4coil,-.5coil)--z+(10coil,-.5coil) + --z+(10coil,5.5coil)--z+(4coil,5.5coil)--cycle; + addto trafo doublepath z--z+(2coil,0)--z+(4coil,0.728coil) + {right}..{left}z+(4coil,1.3*coil); + for i=1 upto 4: + addto trafo doublepath z+(2coil,(i+.5)*coil){left}.. + {right}z+(2coil,i*coil)--z+(4coil,(i+0.728)*coil) + {right}..{left}z+(4coil,(i+1.3)*coil); + endfor; + addto trafo doublepath z+(2coil,5.3coil)--z+(0,5.3coil); + for i=0 upto 3: + addto trafo doublepath z+(10coil,i*coil){left}.. + {right}z+(10coil,(i+.5)*coil)--z+(12coil,(i+.5+0.728)*coil) + {right}..{left}z+(12coil,(i+.656)*coil); + endfor; + addto trafo doublepath z+(10coil,4coil){left}..{right} + z+(10coil,4.5coil)--z+(12coil,5.228coil)--z+(14coil,5.228coil); + addto trafo doublepath z+(12coil,0)--z+(14coil,0); + elseif type=auto: + tf@#.pi:=z rotatedaround(z,ang); tf@#.ps:=(z+(0,4coil)) rotatedaround(z,ang); + tf@#.si:=(z+(4coil,-6coil)) rotatedaround(z,ang); + tf@#.ss:=(z+(4coil,4coil)) rotatedaround(z,ang); + addto trafo doublepath z--z+(2coil,0); + addto trafo doublepath z+(2coil,-6coil)--z+(2coil,-5coil){right}.. + for i=2 upto 10: {left}(z+(2coil,(i-6)*coil)){right}.. endfor + {left}(z+(2coil,5coil))--z+(2coil,6coil)--z+(0,6coil); + addto trafo doublepath z+(2coil,6coil)--z+(4coil,6coil); + addto trafo doublepath z+(2coil,-6coil)--z+(4coil,-6coil); + fi; + + draw trafo rotatedaround(z,ang) withpen line; +enddef; + +%%%<---Sources (fuentes de alimentaci'on)--->%%% + +newinternal AC,DC,I,V,ssize; +AC:=1; DC:=0; I:=2; V:=3; ssize:=6mm; + +vardef source@#(expr z,type,ang,name,val)= + save fuente, positive, negative, seno; + pair S@#.p,S@#.n; % pines % + if (type=AC) or (type=I) or (type=V): + S@#.n:=z; + S@#.p:=(z+(2ssize,0)) rotatedaround(z,ang); + elseif type=DC: + S@#.p:=(z+(ssize,0)) rotatedaround(z,ang); + S@#.n:=z; + fi; + + picture fuente, positive, negative, seno; + positive:=nullpicture; negative:=nullpicture; + + addto positive doublepath (z+(1.05ssize,0))--(z+(1.45ssize,0)) withpen misc; + addto positive doublepath (z+(1.25ssize,-.2ssize))--(z+(1.25ssize,.2ssize)) withpen misc; + addto negative doublepath (z+(.95ssize,0))--(z+(.55ssize,0)) withpen misc; + + seno:=nullpicture; + addto seno doublepath (z+(2ssize/3,0)){dir 45} + ..{right}.5[z+(2ssize/3,.2ssize),z+(ssize,.2ssize)]..{dir -45}(z+(ssize,0)) + ..{right}.5[z+(ssize,-.2ssize),z+(4ssize/3,-.2ssize)]..{dir 45}(z+(4ssize/3,0)) + withpen line; + + fuente:=nullpicture; + if (type=AC) or (type=I) or (type=V): + addto fuente doublepath z--(z+(.5ssize,0)) withpen line; + addto fuente doublepath (z+(1.5ssize,0))--(z+(2ssize,0)) withpen line; + addto fuente doublepath fullcircle scaled ssize shifted (z+(ssize,0)) + withpen line; + if type=AC: + addto fuente also seno rotatedaround((z+(ssize,0)),-ang); + elseif type=I: + ahlength:=4ssize/15; ahangle:=30; + addto fuente doublepath (z+(ssize-ssize/3,0))--(z+(ssize+ssize/3,0)) + withpen line; + addto fuente contour arrowhead (z+(ssize-ssize/3,0))--(z+(ssize+ssize/3,0)) + withpen line; + ahlength:=4; ahangle:=45; + elseif type=V: + addto fuente also positive rotatedaround(z+(1.25ssize,0),-ang); + addto fuente also negative rotatedaround(z+(.75ssize,0),-ang); + fi; + elseif type=DC: + addto fuente doublepath z--(z+(0.4ssize,0)) withpen line; + addto fuente doublepath (z+(.6ssize,0))--(z+(ssize,0)) withpen line; + addto fuente doublepath (z+(.4ssize,-.2ssize))--(z+(.4ssize,.2ssize)) withpen line; + addto fuente doublepath (z+(.6ssize,-.6ssize))--(z+(.6ssize,.6ssize)) withpen line; + fi; + + if (type=AC) or (type=V) or (type=I): + putlabel(S@#.n,S@#.p,.5ssize,.5ssize,ang,name,val); + elseif (type=DC): + putlabel(S@#.n,S@#.p,.6ssize,.6ssize,ang,name,val); + fi; + + draw fuente rotatedaround (z,ang); +enddef; + +%%%<---Resistor (Resistencia)--->%%% + +newinternal rstlth; +rstlth:=2mm; + +vardef resistor@#(expr z,type,ang,name,val)= + save rst; + pair R@#.l,R@#.r; % pines % + R@#.l:=z; + R@#.r:=(z+(7rstlth,0)) rotatedaround(z,ang); + picture rst; + rst:=nullpicture; + addto rst doublepath z--(z+(2rstlth,0))--(z+(2.25rstlth,.75rstlth))-- + for i=.5 step .5 until 2.5: (z+((2.25+i)*rstlth,((-1)**(2i))*.75rstlth))-- + endfor (z+(5rstlth,0))--(z+(7rstlth,0)) withpen line; + if type=normal: + % no change % + elseif type=variable: + ahlength:=.8rstlth; + addto rst doublepath (z+(2rstlth,-rstlth))--(z+(5.5rstlth,rstlth)) withpen misc; + addto rst contour miscahead (z+(2rstlth,-rstlth))--(z+(5.5rstlth,rstlth)) + withpen misc; + fi; + + putlabel(R@#.l,R@#.r,.8rstlth,.8rstlth,ang,name,val); + + draw rst rotatedaround(z,ang); +enddef; + +%%%<--- Diode (diodo) --->%%% +newinternal zener, LED, diodeht, pinK, pinA; +zener:=1; LED:=2; diodeht:=3.5mm; pinK:=3; pinA:=4; + +vardef diode@#(expr z,type,ang,pin,name,val)= + save diodo; + pair D@#.K,D@#.A; % pines % + picture diodo; + diodo:=nullpicture; + + addto diodo doublepath z--(z+(diodeht,0))--(z+(diodeht,.5diodeht)) + --(z+(2diodeht,0))--(z+(diodeht,-.5diodeht))--(z+(diodeht,0)) withpen line; + addto diodo doublepath (z+(2diodeht,0))--(z+(3diodeht,0)) withpen line; + + if type=normal: + addto diodo doublepath (z+(2diodeht,-.5diodeht))--(z+(2diodeht,.5diodeht)) + withpen line; + elseif type=zener: + addto diodo doublepath (z+(2.5diodeht,-.5diodeht))--(z+(2diodeht,-.5diodeht)) + --(z+(2diodeht,.5diodeht))--(z+(1.5diodeht,.5diodeht)) withpen line; + elseif type=LED: + addto diodo doublepath (z+(2diodeht,-.5diodeht))--(z+(2diodeht,.5diodeht)) + withpen line; + + addto diodo doublepath (0.25diodeht*dir + (angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted (z+(2diodeht,.5diodeht))) + --(diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))+270) shifted + (0.25diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted + (z+(2diodeht,.5diodeht)))) withpen misc; + + addto diodo doublepath (0.6diodeht*dir + (angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted (z+(2diodeht,.5diodeht))) + --(diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))+270) shifted + (0.6diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted + (z+(2diodeht,.5diodeht)))) withpen misc; + + ahlength:=.4diodeht; ahangle:=30; + addto diodo contour arrowhead (0.25diodeht*dir + (angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted (z+(2diodeht,.5diodeht))) + --(diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))+270) shifted + (0.25diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted + (z+(2diodeht,.5diodeht)))) withpen misc; + + addto diodo contour arrowhead (0.6diodeht*dir + (angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted (z+(2diodeht,.5diodeht))) + --(diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))+270) shifted + (0.6diodeht*dir(angle(xpart(z+(diodeht,.5diodeht))-xpart(z+(2diodeht,0)), + ypart(z+(diodeht,.5diodeht))-ypart(z+(2diodeht,0)))) shifted + (z+(2diodeht,.5diodeht)))) withpen misc; + ahlength:=4; ahangle:=45; + fi; + + if pin=pinA: + D@#.A:=z; + D@#.K:=(z+(3diodeht,0)) rotatedaround(z,ang); + draw diodo rotatedaround(z,ang); + elseif pin=pinK: + D@#.K:=z; + D@#.A:=(z+(3diodeht,0)) rotatedaround(z,ang); + diodo:=diodo rotatedaround(.5[z,(z+(3diodeht,0))],180); + draw diodo rotatedaround(z,ang); + fi; + + if (type=normal) or (type=zener): + putlabel(D@#.A,D@#.K,.6diodeht,.6diodeht,ang,name,val); + elseif (type=LED): + putlabel(D@#.A,D@#.K,1.5diodeht,.6diodeht,ang,name,val); + fi; +enddef; + +%%%<--- Transistor --->%%% +newinternal npn, pnp, cnpn, cpnp, bjtlth; +npn:=1; pnp:=-1; cnpn:=0; cpnp:=2; bjtlth:=7mm; + +vardef transistor@#(expr z,type,ang)= + save BJT; + pair T@#.B,T@#.E,T@#.C; % pines: Base, Emisor, Colector % + T@#.B:=z; + T@#.E:=(z+(bjtlth,-.75bjtlth)) rotatedaround(z,ang); + T@#.C:=(z+(bjtlth,.75bjtlth)) rotatedaround(z,ang); + picture BJT; + BJT:=nullpicture; + + addto BJT doublepath z--(z+(.5bjtlth,0)) withpen line; + addto BJT doublepath (z+(.5bjtlth,-.5bjtlth))--(z+(.5bjtlth,.5bjtlth)) withpen line; + addto BJT doublepath (z+(.5bjtlth,.2bjtlth))--(z+(bjtlth,.5bjtlth)) + --(z+(bjtlth,.75bjtlth)) withpen line; + + if type=npn: + addto BJT doublepath (z+(.5bjtlth,-.2bjtlth))--(z+(bjtlth,-.5bjtlth)) + --(z+(bjtlth,-.75bjtlth)) withpen line; + addto BJT contour bjtahead (z+(.5bjtlth,-.2bjtlth)) + --(z+(bjtlth,-.5bjtlth)) withpen line; + elseif type=cnpn: + addto BJT doublepath (z+(.5bjtlth,-.2bjtlth))--(z+(bjtlth,-.5bjtlth)) + --(z+(bjtlth,-.75bjtlth)) withpen line; + addto BJT contour bjtahead (z+(.5bjtlth,-.2bjtlth)) + --(z+(bjtlth,-.5bjtlth)) withpen line; + addto BJT doublepath fullcircle scaled 1.3bjtlth shifted (z+(.65bjtlth,0)) + withpen line; + elseif type=pnp: + addto BJT doublepath (z+(bjtlth,-.75bjtlth))--(z+(bjtlth,-.5bjtlth)) + --(z+(.5bjtlth,-.2bjtlth)) withpen line; + addto BJT contour bjtahead (z+(bjtlth,-.5bjtlth)) + --(z+(.5bjtlth,-.2bjtlth)) withpen line; + elseif type=cpnp: + addto BJT doublepath (z+(bjtlth,-.75bjtlth))--(z+(bjtlth,-.5bjtlth)) + --(z+(.5bjtlth,-.2bjtlth)) withpen line; + addto BJT contour bjtahead (z+(bjtlth,-.5bjtlth)) + --(z+(.5bjtlth,-.2bjtlth)) withpen line; + addto BJT doublepath fullcircle scaled 1.3bjtlth shifted (z+(.65bjtlth,0)) withpen line; + fi; + + draw BJT rotatedaround(z,ang); +enddef; + +%%%<--- Measurement instruments (Intrumentos de medicion)--->%%% +newinternal volt, ampere, watt; +volt:=0; ampere:=1; watt:=2; + +vardef meains@#(expr z,type,ang,name)= + save meter; + pair mi@#.l, mi@#.r, mi@#.p; % pines % + mi@#.l:=z; mi@#.r:=(z+(2ssize,0)) rotatedaround(z,ang); + + picture meter; meter:=nullpicture; + addto meter doublepath z--(z+(.5ssize,0)); + addto meter doublepath (z+(1.5ssize,0))--(z+(2ssize,0)); + if (type=volt) or (type=ampere): + addto meter doublepath fullcircle scaled ssize shifted (z+(ssize,0)); + if type=volt: + addto meter also thelabel(latex("\textsf{V}") scaled (ssize/6mm) + rotated (-ang), (z+(ssize,0))); + elseif type=ampere: + addto meter also thelabel(latex("\textsf{A}") scaled (ssize/6mm) + rotated (-ang), (z+(ssize,0))); + fi; + elseif (type=watt): + mi@#.p:=(z+(ssize,-ssize)) rotatedaround(z,ang); + addto meter doublepath (z+(.5ssize,-.5ssize))--(z+(.5ssize,.5ssize)) + --(z+(1.5ssize,.5ssize))--(z+(1.5ssize,-.5ssize))--cycle; + addto meter doublepath (z+(ssize,-.5ssize))--(z+(ssize,-ssize)); + addto meter also thelabel(latex("\textsf{W}") scaled (ssize/6mm) + rotated (-ang), (z+(ssize,0))); + fi; + + draw meter rotatedaround(z,ang) withpen line; + + if labeling=rotatelabel: + if ((ang > (-90)) and (ang <= 90)) or ((ang > 270) and (ang <= 450)): + label(latex(name) rotatedaround (.5[mi@#.l,mi@#.r],ang), + (.5ssize+lbsep)*dir (90+ang) shifted .5[mi@#.l,mi@#.r]); + elseif ((ang > 90) and (ang <= 270)) or ((ang > (-270)) and (ang <= (-90))): + label(latex(name) rotatedaround (.5[mi@#.l,mi@#.r],180+ang), + (.5ssize+lbsep)*dir (90+ang) shifted .5[mi@#.l,mi@#.r]); + fi; + elseif labeling=norotatelabel: + if (ang = 0): + label.top(latex(name), (.5ssize+.25lbsep)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif (ang > 0) and (ang < 90): + label.ulft(latex(name), (.5ssize)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif (ang = 90): + label.lft(latex(name),(.5ssize+.25lbsep)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif (90 < ang) and (ang < 180): + label.llft(latex(name),(.5ssize)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif (ang = 180) or (ang = (-180)): + label.bot(latex(name), (.5ssize+.25lbsep)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif ((ang > 180) and (ang < 270)) or ((ang > (-180)) and (ang < (-90))): + label.lrt(latex(name),(.5ssize)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif (ang = 270) or (ang = (-90)): + label.rt(latex(name), (.5ssize+.25lbsep)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + elseif ((270 < ang) and (ang < 360)) or ((ang < 0) and (ang > (-90))): + label.urt(latex(name),(.5ssize)*dir (90+ang) + shifted .5[mi@#.l,mi@#.r]); + fi; + fi; +enddef; + +%%%<--- Miscellaneous symbols --->%%% + +newinternal gndlth, implth, simple, shield; +gndlth:=5mm; implth:=7mm; simple:=1; shield:=2; + +vardef ground@#(expr z,type,ang)= + save GND; + pair gnd@#; % unico pin % + gnd@#:=z; + picture GND; GND:=nullpicture; + addto GND doublepath z--(z+(0,-.5gndlth)) withpen line; + if type=shield: + addto GND doublepath (z+(-.5gndlth,-.5gndlth))--(z+(.5gndlth,-.5gndlth)) withpen line; + addto GND doublepath (z+(-.35gndlth,-.6gndlth))--(z+(.35gndlth,-.6gndlth)) withpen line; + addto GND doublepath (z+(-.2gndlth,-.7gndlth))--(z+(.2gndlth,-.7gndlth)) withpen line; + elseif type=simple: + addto GND doublepath (z+(-.5gndlth,-.5gndlth))--(z+(.5gndlth,-.5gndlth)) + withpen pencircle scaled 2linewd; + fi; + draw GND rotatedaround(z,ang); +enddef; + +newinternal junctiondiam; +junctiondiam:=1.25mm; + +vardef junction@#(expr z,name)(suffix $)= + pair J@#; J@#:=z; + draw z withpen pencircle scaled junctiondiam; + label.$(latex(name),z); +enddef; + +vardef impedance@#(expr z,ang,name,val)= + save imp; + pair Z@#.l, Z@#.r; % pines % + Z@#.l:=z; + Z@#.r:=(z+(1.5implth,0)) rotatedaround(z,ang); + picture imp; imp:=nullpicture; + + addto imp doublepath z--(z+(.25implth,0)); + addto imp doublepath (z+(.25implth,-.18implth))--(z+(.25implth,.18implth)) + --(z+(1.25implth,.18implth))--(z+(1.25implth,-.18implth))--cycle; + addto imp doublepath (z+(1.25implth,0))--(z+(1.5implth,0)); + + draw imp rotatedaround(z,ang) withpen line; + + putlabel(Z@#.l,Z@#.r,.2implth,.2implth,ang,name,val); +enddef; + +vardef lamp@#(expr z,ang,name,val)= + save ampl, p, q, r, s; + pair La@#.l,La@#.r; % pines % + La@#.l:=z; La@#.r:=(z+(2ssize,0)) rotatedaround(z,ang); + + picture ampl; ampl:=nullpicture; + + addto ampl doublepath z--(z+(.5ssize,0)); + addto ampl doublepath fullcircle scaled ssize shifted (z+(ssize,0)); + addto ampl doublepath (z+(1.5ssize,0))--(z+(2ssize,0)); + + pair p, q, r, s; + p=(-ssize*dir 45 shifted (z+(ssize,0))--(z+(ssize,0))) intersectionpoint + (fullcircle scaled ssize shifted (z+(ssize,0))); + q=(ssize*dir 45 shifted (z+(ssize,0))--(z+(ssize,0))) intersectionpoint + (fullcircle scaled ssize shifted (z+(ssize,0))); + r=(-ssize*dir (-45) shifted (z+(ssize,0))--(z+(ssize,0))) intersectionpoint + (fullcircle scaled ssize shifted (z+(ssize,0))); + s=(ssize*dir (-45) shifted (z+(ssize,0))--(z+(ssize,0))) intersectionpoint + (fullcircle scaled ssize shifted (z+(ssize,0))); + + addto ampl doublepath p--q; + addto ampl doublepath r--s; + + draw ampl rotatedaround(z,ang) withpen line; + + putlabel(La@#.l,La@#.r,.5ssize,.5ssize,ang,name,val); +enddef; + +%%%<--- Switches (Llaves) --->%%% + +newinternal NO, NC, ssep, swt; +NO:=0; NC:=1; ssep:=3mm; swt:=1.2ssep; + +vardef switch@#(expr z,type,ang,name,val)= + save swt; + pair st@#.l, st@#.r; + st@#.l:=z; st@#.r:= (z+(2.4ssep,0)) rotatedaround(z,ang); + picture swt; swt:=nullpicture; + + addto swt doublepath z--(z+(.7ssep,0)); + addto swt doublepath (z+(1.7ssep,ssep/3))--(z+(1.7ssep,0))--(z+(2.4ssep,0)); + + if type=NO: + addto swt doublepath (z+(.7ssep,0))--(z+(1.8ssep,.7ssep)); + elseif type=NC: + addto swt doublepath (z+(.7ssep,0))--(z+(2ssep,ssep/3)); + fi; + + draw swt rotatedaround(z,ang) withpen line; + + putlabel(st@#.l,st@#.r,.6ssep,.6ssep,ang,name,val); +enddef; + +%%%<--- Battery (bater'ia) --->%%% + +vardef battery@#(expr z,ang,name,val)= + save bat; + pair B@#.n, B@#.p; + B@#.n:=z; B@#.p:=(z+(1.8ssize,0)) rotatedaround(z,ang); + + picture bat; bat:=nullpicture; + addto bat doublepath z--(z+(0.4ssize,0)) withpen line; + addto bat doublepath (z+(1.4ssize,0))--(z+(1.8ssize,0)); + for i=0 upto 2: + addto bat doublepath (z+((.4+.4i)*ssize,-.2ssize))--(z+((.4+.4i)*ssize,.2ssize)); + addto bat doublepath (z+((.6+.4i)*ssize,-.6ssize))--(z+((.6+.4i)*ssize,.6ssize)); + endfor; + + draw bat rotatedaround(z,ang) withpen line; + + putlabel(B@#.n,B@#.p,.6ssize,.6ssize,ang,name,val); +enddef; + +%%%<--- Current (Corriente) --->%%% + +vardef current@#(expr z,ang,name,val)= + save cur; + pair i@#.s,i@#.d; + i@#.s:=z; i@#.d:=(z+(3platsep,0)) rotatedaround(z,ang); + ahangle:=20; ahlength:=3platsep; + picture cur; cur:=nullpicture; + addto cur contour arrowhead z--(z+(3platsep,0)); + + draw cur rotatedaround(z,ang) withpen line; + + putlabel(i@#.s,i@#.d,.5platsep,.5platsep,ang,name,val); + + ahangle:=45; ahlength:=4; +enddef; + +%%%<--- Mesh current (corriente de malla) --->%%% + +newinternal cw, ccw; +cw:=0; ccw:=1; + +def imesh(expr c,wd,ht,dire,ang,name)= + save im,r; picture im; numeric r; + ahlength:=3platsep; ahangle:=20; + if ht > wd: r=.2wd elseif ht < wd: r=.2ht fi; + im:=nullpicture; + if dire=cw: + addto im doublepath (xpart c - .5wd, ypart c - .5ht) + --(xpart c - .5wd, ypart c + .5ht-r){up} + ..{right}(xpart c - .5wd + r, ypart c + .5ht) + --(xpart c + .5wd - r, ypart c + .5ht){right} + ..{down}(xpart c + .5wd,ypart c + .5ht - r) + --(xpart c + .5wd,ypart c - .5ht + r){down} + ..{left}(xpart c + .5wd - r,ypart c - .5ht) + --(xpart c - .25wd, ypart c - .5ht); + addto im contour arrowhead (xpart c - .5wd, ypart c - .5ht) + --(xpart c - .5wd, ypart c + .5ht-r){up} + ..{right}(xpart c - .5wd + r, ypart c + .5ht) + --(xpart c + .5wd - r, ypart c + .5ht){right} + ..{down}(xpart c + .5wd,ypart c + .5ht - r) + --(xpart c + .5wd,ypart c - .5ht + r){down} + ..{left}(xpart c + .5wd - r,ypart c - .5ht) + --(xpart c - .25wd, ypart c - .5ht); + elseif dire=ccw: + addto im doublepath (xpart c + .5wd, ypart c - .5ht) + --(xpart c + .5wd, ypart c + .5ht-r){up} + ..{left}(xpart c + .5wd - r, ypart c + .5ht) + --(xpart c - .5wd + r, ypart c + .5ht){left} + ..{down}(xpart c - .5wd,ypart c + .5ht - r) + --(xpart c - .5wd,ypart c - .5ht + r){down} + ..{right}(xpart c - .5wd + r,ypart c - .5ht) + --(xpart c + .25wd, ypart c - .5ht); + addto im contour arrowhead (xpart c + .5wd, ypart c - .5ht) + --(xpart c + .5wd, ypart c + .5ht-r){up} + ..{left}(xpart c + .5wd - r, ypart c + .5ht) + --(xpart c - .5wd + r, ypart c + .5ht){left} + ..{down}(xpart c + .5wd,ypart c + .5ht - r) + --(xpart c - .5wd,ypart c - .5ht + r){down} + ..{right}(xpart c - .5wd + r,ypart c - .5ht) + --(xpart c + .25wd, ypart c - .5ht); + fi; + + if labeling=rotatelabel: + addto im also thelabel(latex("$" & name & "$"),c); + elseif labeling=norotatelabel: + addto im also thelabel(latex("$" & name & "$") rotatedaround(c,-ang),c); + fi; + + draw im rotatedaround (c,ang) withpen line; +enddef; + +%%%<--- Reostatos --->%%% + +newinternal rheolth, Rrheo, Lrheo; +rheolth:=2mm; Rrheo:=1; Lrheo:=2; + +vardef rheostat@#(expr z,type,ang)= + save reo; picture reo; reo:=nullpicture; + pair rh@#.i, rh@#.s, rh@#.r; + rh@#.i:=z; rh@#.s:=(z+(0,6rheolth)) rotatedaround(z,ang); + rh@#.r:=(z+(3rheolth,6rheolth)) rotatedaround(z,ang); + + ahangle:=20; ahlength:=rheolth; + + if type=Lrheo: + addto reo doublepath (z+(6rheolth,-3rheolth))--(z+(4rheolth,-3rheolth)) + --(z+(4rheolth,-.7rheolth)); + addto reo contour arrowhead (z+(6rheolth,-3rheolth))--(z+(4rheolth,-3rheolth)) + --(z+(4rheolth,-.9rheolth)); + + addto reo doublepath z--(z+(rheolth,0)){down}.. for i=2 upto 4: + {up}(z+(i*rheolth,0)){down}.. endfor {up}(z+(5rheolth,0))--(z+(6rheolth,0)); + + reo:=reo rotatedaround(z,90); + elseif type=Rrheo: + addto reo doublepath (z+(6rheolth,-3rheolth))--(z+(4rheolth,-3rheolth)) + --(z+(4rheolth,-.7rheolth)); + addto reo contour arrowhead (z+(6rheolth,-3rheolth))--(z+(4rheolth,-3rheolth)) + --(z+(4rheolth,-.9rheolth)); + + addto reo doublepath z--(z+(1.5rheolth,0))--(z+(1.75rheolth,.75rheolth))-- + for i=.5 step .5 until 2.5: (z+((1.75+i)*rheolth,((-1)**(2i))*.75rheolth))-- + endfor (z+(4.5rheolth,0))--(z+(6rheolth,0)) withpen line; + + reo:=reo rotatedaround(z,90); + fi; + draw reo rotatedaround(z,ang) withpen line; +enddef; + +% Definiciones de las longitudes de centrado, +% las hago como macros para que cambien de +% valor cuando lo hagan las dimensiones +% caracter'isticas de cada s'imbolo. + +def res = 3.5rstlth enddef; % 1 +def ind = 3coil enddef; % 2 +def cap = 3.5platsep enddef; % 3 +def sac = ssize enddef; % 4 +def sv = ssize enddef; % 5 +def si = ssize enddef; % 6 +def sdc = .5ssize enddef; % 7 +def mot = ssize enddef; % 8 +def gen = ssize enddef; % 9 +def tra = 4coil enddef; %10 +def ins = ssize enddef; %11 +def dio = 1.5diodeht enddef; %12 +def bjt = .5bjtlth enddef; %13 +def imp = .75implth enddef; %14 +def lam = ssize enddef; %15 +def swt = 1.2ssep enddef; %16 +def bat = .9ssize enddef; %17 +def cur = 1.5platsep enddef; %18 + +%% END %%
\ No newline at end of file diff --git a/Master/texmf-dist/metapost/metaobj/connections.mp b/Master/texmf-dist/metapost/metaobj/connections.mp new file mode 100644 index 00000000000..3b791cf593d --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/connections.mp @@ -0,0 +1,512 @@ +input metaobj + +beginfig(1); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a)(b); +endfig; + +clearObj a,b; + +beginfig(2); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a.c)(b.c); +endfig; + +clearObj a,b; + +beginfig(3); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a)(b) "linewidth(1mm)", "linestyle(dashed evenly)"; +endfig; + +clearObj a,b; + +beginfig(4); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a)(b) "posA(n)"; +endfig; + +clearObj a,b; + +beginfig(5); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a)(b) "offsetA((1cm,0))"; +endfig; + +clearObj a,b; + +beginfig(6); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a)(b) "doubleline(true)", "arrows(draw)"; +endfig; + +clearObj a,b; + +beginfig(7); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncline(a)(b) "nodesepB(10mm)", "arrows(draw)"; +endfig; + +clearObj a,b; + +beginfig(11); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nccurve(a)(b) "angleA(0)"; +endfig; + +clearObj a,b; + +beginfig(12); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nccurve(a)(b) "angleA(-30)", "angleB(80)", "linecolor(red)", + "linewidth(1mm)", "doubleline(true)", "linestyle(dashed withdots)"; +endfig; + +clearObj a,b; + +beginfig(13); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nccurve(a)(b) "angleA(-30)", "angleB(80)", "linecolor(red)", + "linewidth(3pt)","linestyle(dashed withdots)", + "linetension(2)"; +endfig; + +clearObj a,b; + +beginfig(21); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncbar(a)(b) "angleA(-50)", "linecolor(blue)", + "linewidth(1pt)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(22); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncbar(a)(b) "angleA(90)", "linecolor(blue)", + "linewidth(1pt)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(31); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncangle(a)(b) "angleA(90)", "angleB(80)", "linecolor(blue)", + "linewidth(1pt)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(32); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncangle(a)(b) "angleA(0)", "angleB(50)", "linecolor(blue)", + "linewidth(1pt)","armA(3cm)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(41); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncangles(a)(b) "angleA(0)", "angleB(50)", "linecolor(blue)", + "linewidth(1pt)","armA(3cm)","armB(2cm)"; +endfig; + +clearObj a,b; + + +beginfig(42); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncangles(a)(b) "angleA(0)", "angleB(50)", "linecolor(blue)", + "linewidth(1pt)","armA(3cm)","armB(2cm)","offsetA((0,1cm))"; +endfig; + +clearObj a,b; + +beginfig(43); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncangles(a)(b) "angleA(90)", "angleB(50)", "linecolor(blue)", + "linewidth(1pt)","armA(3cm)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(51); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncdiag(a)(b) "angleA(90)", "angleB(50)", "linecolor(blue)", + "linewidth(1pt)","armA(3cm)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(52); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncdiag(a)(b) "angleA(0)", "angleB(90)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(61); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncdiagg(a)(b) "angleA(90)", "angleB(50)", "linecolor(blue)", + "linewidth(1pt)","armA(3cm)"; +endfig; + +clearObj a,b; + +beginfig(62); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncdiagg(a)(b) "angleA(0)", "angleB(90)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)"; +endfig; + +clearObj a,b; + +beginfig(71); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(b) "angleA(0)", "angleB(90)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(72); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(a) "angleA(0)", "angleB(90)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)","armB(2cm)"; +endfig; + +clearObj a,b; + +beginfig(73); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(b) "angleA(0)", "angleB(90)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)","armB(1cm)"; +endfig; + +clearObj a,b; + +beginfig(74); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(b) "angleA(0)", "angleB(180)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)","armB(1cm)"; +endfig; + +clearObj a,b; + +beginfig(75); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(b) "angleA(0)", "angleB(-100)", "linecolor(blue)", + "linewidth(1pt)","armA(2cm)","armB(1cm)"; +endfig; + +clearObj a,b; + +beginfig(76); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(a) "angleA(0)", "angleB(0)", "linecolor(blue)", + "linewidth(1pt)","armA(1cm)","armB(1cm)","loopsize(1cm)"; +endfig; + +clearObj a,b; + +beginfig(77); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncloop(a)(a) "angleA(0)", "angleB(0)", "linecolor(blue)", + "linewidth(1pt)","armA(1cm)","armB(1cm)","loopsize(1cm)", + "offsetA((0,2mm))","offsetB((0,-3mm))"; +endfig; + +clearObj a,b; + +beginfig(81); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nccircle(a) "angleA(0)", "linecolor(blue)","linewidth(1pt)"; +endfig; + +clearObj a,b; + +beginfig(101); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncbox(a)(b) "linecolor(blue)", + "linewidth(1pt)","nodesepA(1cm)","nodesepB(1cm)"; +endfig; + +clearObj a,b; + +beginfig(102); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncbox(a)(b) "linecolor(blue)", + "linewidth(1pt)","nodesepA(1cm)","nodesepB(1cm)", + "boxsize(1cm)"; +endfig; + +clearObj a,b; + +beginfig(103); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncbox(a)(b) "linecolor(blue)", + "linewidth(1pt)","nodesepA(1cm)","nodesepB(1cm)", + "boxsize(1cm)","linearc(3mm)"; +endfig; + +clearObj a,b; + +beginfig(111); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncarcbox(a)(b) "arcangleA(0)", "linecolor(blue)", + "linewidth(1pt)","nodesepA(1cm)","nodesepB(1cm)"; +endfig; + +clearObj a,b; + +beginfig(112); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncarcbox(a)(b) "arcangleA(-30)", "linecolor(blue)", + "linewidth(1pt)","nodesepA(1cm)","nodesepB(1cm)", + "boxsize(1cm)"; +endfig; + +clearObj a,b; + +beginfig(121); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncarc(a)(b); +endfig; + +clearObj a,b; + +beginfig(122); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncarc(a)(b); + ncarc(b)(a); +endfig; + +clearObj a,b; + +beginfig(123); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + ncarc(a)(b) "arcangleA(50)"; + ncarc(b)(a); +endfig; + +clearObj a,b; + +beginfig(131); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nczigzag(a)(b); +endfig; + +clearObj a,b; + +beginfig(132); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nczigzag(a)(b) "angleA(-90)","angleB(120)","linetension(0.8)", + "coilwidth(2mm)","linearc(.1mm)"; +endfig; + +clearObj a,b; + +beginfig(141); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nccoil(a)(b); +endfig; + +clearObj a,b; + +beginfig(142); + newCircle.a(btex start etex); + newCircle.b(btex end etex); + a.c=origin; + b.c-a.c=(3cm,2cm); + drawObj(a,b); + nccoil(a)(b) "doubleline(true)","coilwidth(2mm)", + "angleA(0)", "arrows(-)","linewidth(1pt)"; +endfig; + +clearObj a,b; + +beginfig(200); + newBox.a("") "dx(3cm)", "dy(2cm)", "framecolor(blue)"; + addUserPath.a(a.nw--a.se); + addUserPath.a(a.nw{right}..a.se) "linecolor(red)"; + addUserPath.a(fullcircle scaled 1cm shifted a.c) "arrows(-)"; + addUserPath.a(fullcircle scaled 1cm shifted a.ne) "arrows(-)", + "pathfilled(true)","pathfillcolor((1,0,1))"; + addUserPath.a(fullcircle scaled 1cm shifted a.sw) "arrows(-)", + "pathfilled(true)","pathfillcolor((1,0,1))", + "linecolor((1,0,1))"; + a.c=origin; + drawObj(a); +endfig; + +beginfig(201); + xscaleObj(a,.5); + a.c=origin-(0,6cm); + drawObj(a); +endfig; + +clearObj a; + + +end diff --git a/Master/texmf-dist/metapost/metaobj/metaobj.mp b/Master/texmf-dist/metapost/metaobj/metaobj.mp new file mode 100644 index 00000000000..ea7401c58ef --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/metaobj.mp @@ -0,0 +1,7378 @@ +% metaobj.mp 0.83 +% D. Roegel (roegel@loria.fr) +% January 15 - June 14, 2001 +% November 13, 2001 +% December 5, 2001 +% December 23, 2002 +% +% MetaPost bug: +% ------------ +% With this file, I discovered a bug in the linux/web2c 7.3.1 +% implementation of metapost. There is a memory leak with +% respect to strings. Apparently, if you increase |pool_size| +% and recreate the |.mem|, you can avoid it, but I am not +% sure the problem is really gone. +% I mentionned this problem on the metafont mailing list on January 26, 2001. +% +% History: +% +% January 15, 2001: start of the package +% January 2001: development of most of +% the low-level object functions +% including cloning, +% as well as many classes of objects, +% including trees and the option mechanism +% January 26, 2001: metapost bug discovered +% February 2001: code improved +% March-May 2001: paths and labels, +% addition of many of PSTricks' features +% May 29, 2001: first private release (0.5) +% with a 120 pages documentation +% and 225 KB of core code. +% May 31, 2001: new option pathfilled for paths +% 0.51 +% June 5, 2001: coil and zigzag connections, option shortcuts +% (arm for armA and armB, etc.), arrows shortcuts +% (-, ->, etc.) +% June 6, 2001: flip and treeflip options, linetension split +% into linetensionA and linetensionB +% June 7, 2001: define_global_pair_option +% framestyle option +% ObjColor, ObjString, ObjBoolean and ObjTransform +% Second private release (0.51) +% 0.52 June 8, 2001: shadowcolor option +% June 12, 2001: general shadows for all objects, +% and simplification of the shadow mechanism for Box +% 0.60 June 13, 2001: boxheight and boxdepth parameters for ncbox +% and ncarcbox; addUserPath,addStandardPath,ObjPath; +% 0.80 June 14, 2001: addition of |unfill| in objects +% June 14, 2001: first released version on CTAN +% 0.81 Nov. 13, 2001: bug correction: contrary to what is written above, +% ObjColor, ObjString, ObjBoolean and ObjTransform +% were not correctly implemented. The field +% containing their list (for instance booleanlist_) +% was not declared. (Bug reported by +% Marc van Dongen, dongen@cs.ucc.ie, +% November 5, 2001.) +% 0.82 Dec. 5, 2001: for compatibility with ConTeXt, the |.exp| +% extensions were renamed into |.expl| +% (Bug reported by Eckhart Guthöhrlein, +% eckhart_guthoehrlein@public.uni-hamburg.de, +% July 3, 2001) +% 0.83 Dec. 23, 2002: in addPath, an incorrect use of infinity was +% replaced by length (infinity can't be used to +% get the end of a cyclic path, see metapost manual) +% (bug noticed by Jan Holfert (jan.holfert@gmx.net), +% comp.text.tex, 2002-05-13 15:00:07 PST, +% but never reported to me since); +% all other such misuses (in five other macros) +% have been corrected. +% +% +% The code has a lot of formatting for the mft program, but mft (even +% with Ulrick Vieth's changes) can't be used, because metaobj's code +% has too many idiosyncrasies. And besides, mft overflows anyway... + +% Don't load this package twice: +if known metaobj_version: expandafter endinput; fi; + +numeric metaobj_version;string metaobj_date; +metaobj_version=0.83; +metaobj_date="2002/12/23"; +% The banner: +message "******* metaobj " & decimal (metaobj_version) & + " (c) D. Roegel (" & metaobj_date & ") *******";message ""; + +tracingstats:=1; + +% This helps simplifying the code. +def quote(expr s)= + ditto & s & ditto +enddef; + +% Compatibility with |boxes.mp|: +def boxit=newBox enddef; +def circleit=newEllipse enddef; + +% Compatibility with |rboxes.mp| (which includes |boxes.mp|): +def rboxit=newRBox enddef; + +% We also define |drawboxes|, |drawboxed|, |drawunboxed|, more or less +% similar to the ones in |boxes.mp|. +% The corresponding functions in |boxes.mp| also do |fixsize(t); fixpos(t);| + +def drawboxed(text t) = % Draw each box + forsuffixes s=t: + if unknown s.c: s.c=origin;fi; + drawObj(s); + draw BpathObj(s); + endfor +enddef; + +def drawunboxed(text t) = % Draw contents of each box + forsuffixes s=t: + if unknown s.c: s.c=origin;fi; + drawObj(s); + endfor +enddef; + +def drawboxes(text t) = % Draw boundary path for each box + forsuffixes s=t: + if unknown s.c: s.c=origin;fi; + draw BpathObj(s); + endfor +enddef; + +%--------------------------------------------------------------------- +% First, let's borrow two definitions from |boxes.mp|. We just give +% them different names to avoid conflicts. + +% (from |str_prefix| in |boxes.mp|) +% 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; + +% (from |generisize| in |boxes.mp|) +% 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; + +% We also use |pathsel__| when constructing an ellipse. +% (from |pathsel_| in |boxes.mp|) +vardef pathsel__(expr a_,b_)(expr dhi)(expr circmargin)(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; + +%--------------------------------------------------------------------- + +boolean show_object_names,show_corners,show_empty_boxes; +show_object_names=false;show_corners=false; +show_empty_boxes=false; + +let obj=scantokens; % This is for clarity and should only be used + % when the argument of |scantokens| is a suffix + % representing an object. Otherwise, use |sc_|. +def Obj(expr n)=obj(iname_[n]) enddef; + +% A few definitions to simplify the code +let sc_=scantokens; +% |currentObjname| is a string representing the current object +def sco_(expr s)=sc_(currentObjname&s) enddef; + +def setcurrentobjname_(expr n)= + save currentObjname; + string currentObjname; + currentObjname=n; +enddef; + +% An array of class names. +string Classes_[]; +numeric nClasses_; % Number of different instanciated classes. +nClasses_=0; + +numeric ClassName_[]; % The class name of an object. + % This is an index into the |Classes_| array. + +% This array records the name of an object (not its class) +string iname_[]; +% This function accesses the internal name. +def internalname_(expr n)=iname_[n] enddef; + +def objClassName_(expr n)= Classes_[ClassName_[n]] enddef; + +% Objects can have shortcut names; these are names defined +% by the user and which will lead to the object numbers. +% We use two arrays. The first has the shortcuts, +% the second has the object numbers. + +string oname_[]; +numeric ovalue_[]; +numeric nshortcuts_; +nshortcuts_=0; + +vardef addShortCut_(expr oname,ovalue)= + save found;boolean found;found=false; + for i:=1 upto nshortcuts_: + if oname_[i]=oname: + ovalue_[i]:=ovalue; + found:=true; + fi; + exitif found; + endfor; + if not found: + nshortcuts_:=nshortcuts_+1; + oname_[nshortcuts_]=oname; + ovalue_[nshortcuts_]:=ovalue; + fi; +enddef; + +% This function returns the number of an object, given its shortcut. +vardef objValue_(expr oname)= + save val;numeric val; + hide( + for i:=1 upto nshortcuts_: + if oname_[i]=oname: + val:=ovalue_[i]; + fi; + exitif known val; + endfor; + ) + val +enddef; + +def nameToSuffixString_(expr s)= + iname_[objValue_(s)] +enddef; + +def nameToSuffix_(expr s)= + obj(nameToSuffixString_(s)) +enddef; + +let O_=nameToSuffix_; + +vardef addclass_(expr n,clname)= + save i,j; + if nClasses_>0: + % first, see if |clname| is a known class name + for i:=0 upto nClasses_-1:j:=i; + exitif clname=Classes_[i]; + endfor; + if clname=Classes_[j]: + ClassName_[n]=j; + else: % it is a new class name + %createClassTest(clname); % we call it elsewhere + ClassName_[n]=nClasses_; + Classes_[nClasses_]=clname; + nClasses_:=nClasses_+1; + fi; + else: % it is the first class name + %createClassTest(clname); % we call it elsewhere + ClassName_[n]=nClasses_; + Classes_[nClasses_]=clname; + nClasses_:=nClasses_+1; + fi; +enddef; + +def createClassTest(expr clname)= + sc_ ("def is" & clname & + "(suffix n)= (objClassName_(n)=" & + ditto & clname & ditto & ") enddef;") +enddef; + + +% This is sometimes useful +vardef whateverstring = save ?; string ?; ? enddef; +def whateverpair = (whatever,whatever) enddef; + + +% We need an array to store option function names whose parameter +% is a string. For instance, when the option is "drawfunction(mydraw)", +% the string |"drawfunction"| is in the array and makes it possible +% to extract |"mydraw"| without calling the function |drawfunction|. +% This is not true of all option functions. Those having numeric +% parameters do not need a special treatment. + +string opfunc_[]; +numeric nopfunc_;nopfunc_=0; + +% This function adds a string to the array. +% |addOptionFunction| should be called where the option functions +% are defined. +def addOptionFunction(expr s)= + nopfunc_:=nopfunc_+1; + opfunc_[nopfunc_]=s; +enddef; + +% This function checks if a string is in the array: +vardef isOpFunc_(expr s)= + save b;boolean b; + hide( + b=false; + for i:=1 upto nopfunc_: + if opfunc_[i]=s:b:=true;fi; + exitif b; + endfor; + ) + b +enddef; + +% This function takes a string such as |"drawfunction(mydraw)"| +% and replaces it with |"drawfunction("mydraw")"| +% if the function name (the first part, here |"drawfunction"|) +% is in the |opfunc_| array. +% The argument of the function can have parentheses, but they must +% be balanced. For instance, we can have |"color((0,1,1))"|. +% The argument can also contain spaces. + +vardef correctOption_(expr s)= + save a,b,c,l;string c;l=0; % parenthesis depth + for i:=0 upto length(s)-1: + c:=substring(i,i+1) of s; + if (c="(") and (l=0): a:=i; + elseif (c=")") and (l=1): b:=i; + fi; + if c="(": l:=l+1;fi; + if c=")": l:=l-1;fi; + endfor; + if isOpFunc_(substring(0,a) of s): + (substring(0,a+1) of s & + ditto & substring(a+1,b) of s & ditto + & substring(b,infinity) of s) + else: s + fi +enddef; + +% Apply a linear transformation to object |n|. +% The last parameter is of type |transform|. +% Fixed objects can be transformed, but they are untied. +vardef transformObj(suffix n)(expr $)= + save p_,q_,i; pair p_[],q_[]; + memorizePoints_(n,$); + % update the current transformation: + n.ctransform_:=n.ctransform_ transformed $; + % update the transformations for the non-standard labels + % (such labels can be added to an object, even after several + % transformations have been applied to it) + if known n.ipic_.transf_.n_: + for i:=1 upto n.ipic_.transf_.n_: + n.ipic_.transf_[i]:=n.ipic_.transf_[i] transformed $; + endfor; + fi; + % |message "transforming a box of type " & objClassName_(n);| + begingroup + save tie_function_; % used in the |subobjties_| strings + for i:=1 upto n.nsubobjties_: + % we define the function |tie_function_|: + sc_ n.subobjties_[i]; + % and we call it: + sc_ "tie_function_".n($); + endfor; + endgroup; +enddef; + +% streamlined version: |n| is a number representing an object +vardef transform_Obj(expr n)(expr $)= + hide(transformObj(obj(iname_[n]))($)) n +enddef; + +% rotate object |n| by angle |$| around the origin +def rotateObj(suffix n)(expr $)= + transformObj(n)(identity rotated $); +enddef; + +% streamlined version: |n| is a number representing an object +vardef rotate_Obj(expr n)(expr $)= + hide(rotateObj(obj(iname_[n]))($)) n +enddef; + +% scale object |n| by |$| +def scaleObj(suffix n)(expr $)= + transformObj(n)(identity scaled $); +enddef; + +% streamlined version: |n| is a number representing an object +vardef scale_Obj(expr n)(expr $)= + hide(scaleObj(obj(iname_[n]))($)) n +enddef; + +% xscale object |n| by |$| +def xscaleObj(suffix n)(expr $)= + transformObj(n)(identity xscaled $); +enddef; + +% streamlined version: |n| is a number representing an object +vardef xscale_Obj(expr n)(expr $)= + hide(xscaleObj(obj(iname_[n]))($)) n +enddef; + +% yscale object |n| by |$| +def yscaleObj(suffix n)(expr $)= + transformObj(n)(identity yscaled $); +enddef; + +% streamlined version: |n| is a number representing an object +vardef yscale_Obj(expr n)(expr $)= + hide(yscaleObj(obj(iname_[n]))($)) n +enddef; + +% reflect object |n| around the line defined by the two points |$| and |$$| +def reflectObj(suffix n)(expr $,$$)= + transformObj(n)(identity reflectedabout($,$$)); +enddef; + +% streamlined version: |n| is a number representing an object +vardef reflect_Obj(expr n)(expr $,$$)= + hide(reflectObj(obj(iname_[n]))($,$$)) n +enddef; + +% slant object |n| +def slantObj(suffix n)(expr $)= + transformObj(n)(identity slanted $); +enddef; + +% streamlined version: |n| is a number representing an object +vardef slant_Obj(expr n)(expr $)= + hide(slantObj(obj(iname_[n]))($)) n +enddef; + +def declarestring_(expr s)(text l)= + for $:=l: + sc_("string " & s & "." & $); + endfor; +enddef; + +% |s| is an object; this function returns true if |s| has not been used +% as a prefix before. +def isNewPrefix(suffix s)= + (not string s.pointlist_) +enddef; + +% returns |true| if |v| is of type |t|, where both |t| and |v| +% are strings +def isOfType(expr t,v)= + (sc_(t & " " & v)) +enddef; + +% returns a string representing the type of |v| +def TypeOf(expr v)= + if numeric v:"numeric" + elseif boolean v:"boolean" + elseif pair v:"pair" + elseif string v:"string" + elseif color v:"color" + elseif transform v:"transform" + fi +enddef; + +% |n| is the object and |s| its class +def assignObj(suffix n)(expr s)= + n=incr(nObj_); % new object number + iname_[n]=str n; % the number and the associated string are recorded + % so that we can go from the number to the name + % (and hence to the object) + addclass_(n,s); % |n|'s class is memorized too + % memorize a shortcut, if there is one: + if known o_name_val: + addShortCut_(o_name_val,n); + o_name_val:=whateverstring; + else: + % we memorize the standard shortcut, which is |str n|, but only + % if the object was given a name explicitely: + if not streamlined_ and memorizeShortcuts: + addShortCut_(str n,n); + fi; + fi; + % reset |streamlined_| + streamlined_:=false; + save gen_n_;string gen_n_;gen_n_=generisize_(str n); + if not string n.pointlist_: + declarestring_(gen_n_)( + "pointlist_", % list of points + "pairlist_", % list of pairs (non movable points) + "pointarraylist_", % list of arrays + "subarraylist_", % list of arrays of subobjects + "stringarraylist_",% list of arrays of strings + "colorarraylist_", % list of arrays of colors + "picturearraylist_",% list of arrays of pictures + "transformarraylist_",% list of arrays of transforms + "booleanarraylist_",% list of arrays of booleans + "numericarraylist_", % list of arrays of numerics + "pairarraylist_", % list of arrays of pairs + "points_in_arrayslist_", % list of all points of all arrays + "picturelist_", % list of pictures + "numericlist_", % list of numerics (useful for duplication) + "booleanlist_", % list of booleans (ditto) + "colorlist_", % list of colors (ditto) + "stringlist_", % list of strings (ditto) + "transformlist_", % list of transforms (ditto) + "sublist_", % list of subobjects + "subobjties_[]", % subobj tying equations (1 string/subobject) + "code_", % the code of an object + "extra_code_"); % the extra code of an object + expandafter numeric sc_(gen_n_).nsubobjties_; + % number of subobjties + expandafter transform sc_(gen_n_).ctransform_; + % current transform of that object + fi; + % initialize the lists: + forsuffixes $=pointlist_,pairlist_,pointarraylist_,subarraylist_, + stringarraylist_,colorarraylist_,picturearraylist_,transformarraylist_, + booleanarraylist_,numericarraylist_,pairarraylist_,points_in_arrayslist_, + picturelist_,numericlist_,booleanlist_,colorlist_,stringlist_, + transformlist_,sublist_,code_,extra_code_: + n$:=""; + endfor; + n.nsubobjties_=0; + n.ctransform_:=identity; + setcurrentobjname_(str n); +enddef; + +numeric nObj_; % number of instanciated objects ($\geq$|nClasses_|) + % and also last instanciated object +nObj_=0; + +% There is no box with the number 0 and we reserve this number +% for the ``null box'' which is useful in certain places, such as matrices: +newinternal nb; +nb:=0; + +% In order to refresh a |numeric| n: |n:=whatever;| +% (suggested by Bogus\l aw Jackowski on Jan 15, 2001 on the metafont list +% in answer to a question I had asked) + +def refresh_(text v)= + if numeric v: v:=whatever; + elseif pair v: v:=whateverpair; + else: message "refresh_ is not defined for this type"; + fi; +enddef; + +def refreshObjVars_(suffix n)(text v)= + forsuffixes $=v:refresh_(n$);endfor; +enddef; + +% This function makes it possible to declare pictures in an object. +% There can be several |ObjPicture| declarations in an object. +% (this is similar to |ObjPoint|) +vardef ObjPicture text l= + forsuffixes $=l: + if not isOfType("picture",currentObjname & "." & str $): + sc_ ("picture " & generisize_(currentObjname) & "." & str $); + fi; + endfor; + forsuffixes $=l: + if sco_(".picturelist_")="": + sco_(".picturelist_"):=str $; + else: + sco_(".picturelist_"):=sco_(".picturelist_") & "," & str $; + fi; + endfor; +enddef; + +% Give a value to a picture variable and center the picture +% around the origin. All pictures will be centered around the origin +% and everytime we draw one (see |drawPicture|), we transform it. +% Pictures cannot be floating. +def setPicture(text v)(expr val)= + sco_("." & str v)=val; + sco_("." & str v):= + sco_("." & str v) shifted -.5[urcorner(val),llcorner(val)]; +enddef; + +vardef drawPicture@#(suffix p) text options= + draw @#p transformed @#ctransform_ shifted @#p.off options + withcolor OptionValue.@#("picturecolor"); +enddef; + +% |ObjNumeric|, |ObjPair|, |ObjColor|, |ObjString| and |ObjTransform| +% are all created on the same model, using |defineObjType_|. + +vardef defineObjType_(expr type,name)= + sc_( + "vardef Obj" & name & " text l=" & + "forsuffixes $=l:" & + "if not isOfType(" & quote(type) & + ",currentObjname & " & quote(".") & "& str $):" & + "sc_ (" & quote(type&" ") & " & generisize_(currentObjname) & " & + quote(".") & " & str $);" & + "fi;" & + "endfor;" & + "forsuffixes $=l:" & + "if sco_(" & quote("." & type &"list_") & ")=" & quote("") & ":" & + "sco_(" & quote("." & type &"list_") & "):=str $;" & + "else:" & + "sco_(" & quote("." & type &"list_") & "):=sco_(" & + quote("." & type &"list_") & ") & " & quote(",") & " & str $;" & + "fi;" & + "endfor;" & + "enddef;" + ); + sc_( + "def set" & name & "(text v)(expr val)=sco_(" & + quote(".") & " & str v):=val;enddef;" + ); +enddef; + +% |defineObjType_("numeric","Numeric");| + +% This function makes it possible to declare numerical values +% as part of an object. +% There can be several |ObjNumeric| declarations in an object. +% (this is similar to |ObjPoint|) +% It defines both |ObjNumeric| and |setNumeric|. +defineObjType_("numeric","Numeric"); + +% This function makes it possible to declare pairs in an object. +% There can be several |ObjPair| declarations in an object +% Contrary to the points of |ObjPoint|, these are points +% that will not move with the object. +% They can be used for special purposes, for instance to store path data. +defineObjType_("pair","Pair"); + +defineObjType_("color","Color"); +defineObjType_("boolean","Boolean"); +defineObjType_("string","String"); +defineObjType_("transform","Transform"); + +def BpathObj(suffix n)= + sc_ ("Bpath" & objClassName_(n))(n) +enddef; + +def StandardBpath(suffix n)= (n.inw--n.isw--n.ise--n.ine--cycle) enddef; + +def BboxObj(suffix n)=(bbox(BpathObj(n))) enddef; + +% Computes the real bounding box, without looking at the Bpath. +% The object must be attached. +% |bboxmargin| is used by |bbox|. +def rBboxObj(suffix n)= + bbox(image(drawObj(n))) +enddef; + +% This is like |decimal| but adds a "+" if the number is positive +def signeddecimal expr d= + (if d>=0: "+" & decimal d else: decimal d fi) +enddef; + +% min/max xpart/ypart of a list of points +def minmaxval(text f)(text xy)(expr pa,pb,pc,pd,pe,pf,pg,ph)= + f(xy(pa),xy(pb),xy(pc),xy(pd),xy(pe),xy(pf),xy(pg),xy(ph)) +enddef; + +% Minimum xval of points |pa|, |pb|, ... +def xminval(expr pa,pb,pc,pd,pe,pf,pg,ph)= + minmaxval(min)(xpart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef; +% Maximum xval of points |pa|, |pb|, ... +def xmaxval(expr pa,pb,pc,pd,pe,pf,pg,ph)= + minmaxval(max)(xpart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef; +% Minimum yval of points |pa|, |pb|, ... +def yminval(expr pa,pb,pc,pd,pe,pf,pg,ph)= + minmaxval(min)(ypart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef; +% Maximum yval of points |pa|, |pb|, ... +def ymaxval(expr pa,pb,pc,pd,pe,pf,pg,ph)= + minmaxval(max)(ypart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef; + +% Combines two real bounding boxes: both |bba| and |bbb| +% are paths. Only points 0 through 3 of each path are examined. +% This function is currently not used. +vardef combineTwoBBs(expr bba,bbb)= + save xm,ym,xM,yM; + hide( + xm=xminval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba, + point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb); + ym=yminval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba, + point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb); + xM=xmaxval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba, + point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb); + yM=ymaxval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba, + point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb); + ) + ((xm,ym)--(xM,ym)--(xM,yM)--(xm,yM)--cycle) +enddef; + +% |drawObj| takes a list of suffixes as parameters +def drawObj(text l)= + forsuffixes $:=l: + if show_object_names: + % the name of the object is displayed at the upper right corner + label(str $,$ne); + fi; + if show_corners: + label("ne",$ne);label("se",$se);label("nw",$nw);label("sw",$sw); + fi; + % we must check if there is a specialized version of |drawObj| + % for the current object, and call it if necessary. + % We do it in such a way that it doesn't force a default + % declaration on the object. + if known sc_(str $).option_drawObj_: + sc_ (OptionValue$("drawObj"))($); + else: + sc_ ("draw" & objClassName_($))($); + fi; + drawLabels$; + endfor; +enddef; + +% streamlined version: |n| is a number representing an object; +% contrary to other streamlined functions, this one does not return +% an object identification. +% |n| can also be a string shortcut for an object. +vardef draw_Obj(expr n)= + if string n: + drawObj(O_(n)); + else: + drawObj(obj(iname_[n])); + fi; +enddef; + +% This function can only be used when the bounding path is continuous; +% if it is not the case, the |draw...| function for the object must be adapted. +def drawFramedOrFilledObject_(suffix n)= + if OptionValue.n("framed"): + % the shadow is the shadow of the frame, and we only show a shadow + % if there is a frame + if OptionValue.n("shadow"): + fill (BpathObj(n) shifted (1mm,-1mm)) + withcolor OptionValue.n("shadowcolor"); + fi; + % this removes most of the shadow + unfill BpathObj(n); + fi; + if OptionValue.n("filled"): + fill BpathObj(n) withcolor OptionValue.n("fillcolor"); + fi; + if OptionValue.n("framed"): + pickup pencircle scaled OptionValue.n("framewidth"); + draw BpathObj(n) withcolor OptionValue.n("framecolor") + sc_(OptionValue.n("framestyle")); + pickup defaultpen; + fi; +enddef; + +% This returns a picture corresponding to the drawing of object |n| +def pictureObj(suffix n)= + image(drawObj(n)) +enddef; + +vardef memorizePoints_(suffix n)(expr $$)= + save i,tmp,varlist_;string tmp,varlist_; + % The array |p_[]| is not declared here, because it is also used elsewhere + % (when the |.subobjties_| string is evaluated in |transformObj|) + % We memorize all the points declared with |ObjPoint| and those + % that are part of arrays. At this point, we have two strings and + % we merely concatenate them: + if n.pointlist_="":varlist_=n.points_in_arrayslist_; + else: + if n.points_in_arrayslist_<>"": + varlist_=n.pointlist_ & "," & n.points_in_arrayslist_; + else: varlist_=n.pointlist_; + fi; + fi; + i=0; + if varlist_<>"": + forsuffixes $=sc_(varlist_): + i:=i+1;p_[i]=n$; + endfor; + fi; + refreshObjVars_(n)(sc_(varlist_)); + i:=0; + if varlist_<>"": + forsuffixes $=sc_(varlist_):i:=i+1; + if i>1: % equation |$-tmp=(p_[i]-p_1) transformed $$| + sc_ (str n & "." & str $ & "-" & tmp)= + (p_[i]-p_1) transformed $$; + else: tmp=str n & "." & str $; + fi; + endfor; + fi; +enddef; + +% This function makes it possible to declare points in an object. +% There can be several |ObjPoint| declarations in an object +% These are points that will move with the object. +% Pairs that do not move can be declared with |ObjPair|. +vardef ObjPoint text l= + forsuffixes $=l: + if not isOfType("pair",currentObjname & "." & str $): + sc_ ("pair " & generisize_(currentObjname) & "." & str $); + fi; + endfor; + forsuffixes $=l: + if sco_(".pointlist_")="": + sco_(".pointlist_"):=str $; + else: + sco_(".pointlist_"):=sco_(".pointlist_") & "," & str $; + fi; + endfor; +enddef; + +% We take as a convention that all objects have a minimal interface +% similar to the one given by |boxes.mp|. This does considerably +% facilitate reusability. In is not mandatory though. +% If you want the standard points, add |StandardPoints| as part of your object +% points (before the |ObjCode| section). You still have to use them in the +% equations, but it is also a good idea to include a few standard +% equations with |StandardEquations| (this is a string). +% Better though, is to write |StandardInterface| at the +% beginning of your object and use only inner points in the equations +% and drawing functions. +% +% The standard interface has the points ne,nw,se,sw,n,s,e,w,c; + +def StandardPoints= + ne,nw,sw,se,n,s,e,w,c +enddef; + +% Drawings should not refer to the ``Standard Points,'' because it makes +% the drawings sensitive to bounding box changes. +% Instead, they should refer +% to their Inner variants, which are initially equal to them, +% as per the StandardInnerEquations +def StandardInnerPoints= + ine,inw,isw,ise,in,is,ie,iw,ic +enddef; + +vardef isStandardPoint@#= + ( + (str @#="ne") or (str @#="nw") or (str @#="sw") or (str @#="se") or + (str @#="n") or (str @#="s") or (str @#="e") or (str @#="w") or + (str @#="c") + ) +enddef; + +vardef StandardEquationsRaw@#= + @#se-@#sw=@#ne-@#nw; % parallelogram equation + @#n=.5[@#ne,@#nw]; % North + @#s=.5[@#se,@#sw]; % South + @#e=.5[@#ne,@#se]; % East + @#w=.5[@#nw,@#sw]; % West + @#c=.5[@#n,@#s]; % Center +enddef; + +% These are the equations connecting the outer bounding box +% (i.e. the interface) to the inner bounding box (the interface +% as seen from the inside) +def StandardInnerEquations= + ("@#ine=@#ne;@#inw=@#nw;@#isw=@#sw;@#ise=@#se;@#in=@#n;@#is=@#s;" & + "@#ie=@#e;@#iw=@#w;@#ic=@#c;") +enddef; + + +% It is important that this be a string, because there is a +% |sc_(PureStandardEquations)| somewhere. +def PureStandardEquations= + ("@#se-@#sw=@#ne-@#nw;" & % parallelogram equation + "xpart(@#se-@#ne)=0;" & + "ypart(@#se-@#sw)=0;" & + "@#n=.5[@#ne,@#nw];" & % North + "@#s=.5[@#se,@#sw];" & % South + "@#e=.5[@#ne,@#se];" & % East + "@#w=.5[@#nw,@#sw];" & % West + "@#c=.5[@#n,@#s];" ) % Center +enddef; + +def StandardEquations= + (PureStandardEquations & StandardInnerEquations) +enddef; + +% This is the minimum set of equations for standard points, +% assuming only the middle relations. It is convenient if +% you want to control completely where the corners of the +% object are. This is for instance used in the |RandomBox| class. +def MinimumStandardEquations= + ("@#n=.5[@#ne,@#nw];" & % North + "@#s=.5[@#se,@#sw];" & % South + "@#e=.5[@#ne,@#se];" & % East + "@#w=.5[@#nw,@#sw];" & % West + "@#c=.5[@#n,@#s];" % Center + & StandardInnerEquations) +enddef; + +def StandardNumerics= + dx,dy +enddef; + +def StandardInterface= + ObjPoint StandardPoints,StandardInnerPoints; + ObjNumeric StandardNumerics; +enddef; + +% Normally, the user can specify that a certain point in +% a certain subobject is tied (that is, is bound to it +% linearly, modulo the linear transformations) to +% a certain point in the main object. +% This is done with |tiePointToSubpoint(sw,sub,A)| +% for instance. If we assume that the first point of the +% main object (first in the point declarations) +% is always defined, and that this is the same for +% the subobjects, we can automatically tie all those +% pairs of points. The user will actually seldom +% need more. And what would that be anyway? +% If there are no subobjects, this function does nothing. +vardef StandardTies= + save mainfirst,subfirst,co; + string mainfirst,subfirst,co; + co=currentObjname; + mainfirst=firstPointOf_(co); + % we loop over all subobjects + % first, regular subobjects: + if sc_(co).sublist_<>"": + forsuffixes $:=sc_(sc_(co).sublist_): + subfirst:=firstPointOf_(sc_(co)$); + sc_("tiePointToSubpoint(" & mainfirst & "," & + str $ & "," & subfirst & ")"); % ties |$subfirst| to |mainfirst| + endfor; + fi; + % then arrays of subobjects: + if sc_(co).subarraylist_<>"": + forsuffixes $:=sc_(sc_(co).subarraylist_): + for i:=1 upto sc_(co)$n_: + % we check that the subobject is defined (in certain case, + % such as matrices, there can be holes) + if known sc_(co)$[i]: + subfirst:=firstPointOf_(sc_(co)$[i]); + sc_("tiePointToSubpoint(" & mainfirst & "," & + str $ & decimal i & "," & subfirst & ")"); + % ties |$subfirst| to |mainfirst| + fi; + endfor; + endfor; + fi; +enddef; + +% In order to extract the first point of an object, +% we go through its |pointlist_| string, and exit +% as soon as we have a suffix. In case this string is empty +% (that's very unlikely), we go through |points_in_arrayslist_|. +% If both are empty, there is no first point and we return an empty string. +% |n| is a suffix in string form. +vardef firstPointOf_(expr n)= + save first_;string first_; + hide( + forsuffixes $:=sc_(sc_(n).pointlist_): + first_:=str $; + exitif first_<>""; + endfor; + if first_="": + forsuffixes $:=sc_(sc_(n).points_in_arrayslist_): + first_:=str $; + exitif first_<>""; + endfor; + fi;) + first_ +enddef; + +% This function finds the internal index of a point, where +% the |ObjPoint|s come first, then the points defined in an |ObjPointArray|. +% For instance, if |ObjPoint a,b,c| and |ObjPointArray(po)(7)|, +% the index of |a| is 1, the index of |b| is 2, the index of |c| is 3, +% the index of |po1| is 4, the index of |po2| is 5, etc. +% |n| is the object. +vardef indexOfPoint(suffix n)(text v)= + save i_,j_,found_; % |v| can't be |i_| or |j_| + hide( + boolean found_;found_=false; + j_:=0; + if n.pointlist_<>"": + forsuffixes i_:=sc_(n.pointlist_): + j_:=j_+1; + if str i_=str v:found_:=true;fi; + exitif found_; + endfor; + fi; + if not found_: + if n.points_in_arrayslist_<>"": + for i_:=sc_(n.points_in_arrayslist_): + j_:=j_+1; + if str i_=str v:found_:=true;fi; + exitif found_; + endfor; + fi; + fi; + if not found_:j_:=0;fi; + ) j_ +enddef; + +% This function needs to be called when points are added to an array +vardef addPointToPointArray@#(suffix a)= + save co;string co;co=str @#; + @#a.n_:=@#a.n_+1; + if sco_(".points_in_arrayslist_")="": + sco_(".points_in_arrayslist_"):=str a & decimal @#a.n_; + else: + sco_(".points_in_arrayslist_"):= + sco_(".points_in_arrayslist_") & "," & str a & decimal @#a.n_; + fi; +enddef; + +% These are points that will move with the object. +% Pairs that do not move can be declared with |ObjPairArray|. +vardef ObjPointArray(suffix a)(expr n)= + save co;string co;co=currentObjname; + if not isOfType("pair",co & "." & str a & "1"): + sc_ ("pair " & generisize_(co) & "." & str a & "[]"); + fi; + sco_("." & str a & ".n_"):=n; + if sco_(".pointarraylist_")="": + sco_(".pointarraylist_"):= str a; + else: + sco_(".pointarraylist_"):=sco_(".pointarraylist_") &","& str a; + fi; + for i:=1 upto n: + if sco_(".points_in_arrayslist_")="": + sco_(".points_in_arrayslist_"):=str a & decimal i; + else: + sco_(".points_in_arrayslist_"):= + sco_(".points_in_arrayslist_") & "," & str a & decimal i; + fi; + endfor; +enddef; + + +% For pairs: +% |name| can be |"Pair"| +% |type| |"pair"| +% |var| |"pairarraylist_"| +% This creates a function |ObjPairArray| storing the pairs +% in the |"pairarraylist_"| variable of the current object. +% The first parameter of |ObjPairArray| is the name of the array +% and the second parameter is its size. The function created memorizes +% the size of the array. +% The size can be modified afterwards, but only as many elements +% as were announced will be manipulated in automatic operations +% such as |duplicateObj|. +vardef defineArrayFunction(expr name)(expr type)(expr var)= + save tmp;string tmp; + tmp="vardef Obj" & name & "Array(suffix a)(expr n)=" & + "save co;string co;co=currentObjname;" & + "if not isOfType(" & quote(type) &",co & " & quote(".") & + " & str a & " & quote("1") & "):" & + "sc_ (" & quote(type & " ") & " & generisize_(co) & " & + quote(".") & " & str a & " & quote("[]") & ");" & + "fi;" & + "sco_(" & quote(".") & " & str a & " & + quote(".n_") & "):=n;" & + "if sco_(" & quote("." & var) & ")=" & quote("") & ":" & + "sco_(" & quote("." & var) & "):= str a;" & + "else:" & + "sco_(" & quote("." & var) & "):=" & + "sco_(" & quote("." & var) & ") & " & + quote(",") & " & str a;" & + "fi;" & + "enddef;"; + sc_ tmp; +enddef; + +defineArrayFunction("Numeric")("numeric")("numericarraylist_"); +defineArrayFunction("String")("string")("stringarraylist_"); +defineArrayFunction("Sub")("string")("subarraylist_"); +defineArrayFunction("Pair")("pair")("pairarraylist_"); +defineArrayFunction("Color")("color")("colorarraylist_"); +defineArrayFunction("Picture")("picture")("picturearraylist_"); +defineArrayFunction("Transform")("transform")("transformarraylist_"); +defineArrayFunction("Boolean")("boolean")("booleanarraylist_"); + +% |t| is a list of strings, representing the object code, +% including equations (see examples) +vardef ObjCode text l= + save s_,mac_,i_; % notice that we don't have to say that |s_| is a string! + string mac_;mac_=""; + % The problem with object code and the equations it contains + % is that they contain the name of the object, + % but as given in the new... macro. + % We only have the formal parameter name! + % We must assume that it is `|@#|'. Maybe in the future, we will + % guess it from the equations. Hope is not lost! + % We now define locally (just in this |ObjCode| macro) + % a macro having `|@#|' as a suffix parameter: + % The macro looks like: + % |vardef code_function_@#= <the equations> enddef;| + + for s_:=l:mac_:=mac_&s_ & ";"; endfor; + % we store the equations in the object; this is useful when an + % object gets duplicated: + sco_(".code_"):=mac_; + begingroup; % we want the |vardef| macro only defined locally; + % we don't need it later + save code_function_; + mac_:="vardef code_function_@#=" & mac_ & " enddef;"; + sc_ mac_; % this defines the macro + % we call it with + sc_ ("code_function_." & currentObjname); + endgroup; +enddef; + +% This function adds equations to an already existing object. +% These equations should only define new points, not alter +% previously defined points. +vardef addObjCode@# text l= + save mac;string mac;mac=""; + for s:=l:mac:=mac&s & ";"; endfor; + @#code_:=@#code_ & mac; +enddef; + +vardef addObjExtraCode@# text l= + save mac;string mac;mac=""; + for s:=l:mac:=mac&s & ";"; endfor; + @#extra_code_:=@#extra_code_ & mac; +enddef; + +% |sub| is a field name and |t| is the subobject name +% we could even use the same name for boths +def SubObject(suffix sub)(suffix t)= + if expandafter not expandafter string sco_("." & str sub): + sc_ ("string " & generisize_(currentObjname) & "." & str sub); + fi; + sco_("." & str sub)=str t; + if sco_(".sublist_")="": + sco_(".sublist_"):=str sub; + else: + sco_(".sublist_"):=sco_(".sublist_") & "," & str sub; + fi; +enddef; + +def SubObjectOfArray(suffix sub)(suffix t)= + sco_("." & str sub)=str t; +enddef; + +% Point |b| of subobject |sub| (of the current object) +% is tied to point |a| of the current object. +% This means that we memorize an equation. +vardef tiePointToSubpoint(suffix a,sub,b)= + save co,n,j;string co;co=currentObjname; + obj(co).nsubobjties_:=obj(co).nsubobjties_+1; + n=obj(co).nsubobjties_; + % We must memorize the following code: + % |q_[n]=obj(co.sub).b;| + % |transformObj(obj(currentObjname.sub))($);| + % |co.a-obj(co.sub).b=(p_[j]-q_[n]) transformed $;| + % (where |p_[j]| is the memorized value of the current objects' "a" point) + % We have to find `|j|': + j=indexOfPoint(obj(co))(a); + % we store everything in a |vardef|, using |@#| instead of co + % (this is necessary for matters of duplication) + obj(co).subobjties_[n]:= + "vardef tie_function_@#(expr $)=" & + "q_" & decimal n & "=obj(@#" & str sub & ")." & str b &";" & + "transformObj(obj(@#" & str sub & "))($);" & + "@#" & str a & "-obj(@#" & str sub & ")." & str b & + "=(p_" & decimal j & "-q_" & decimal n & ") transformed $;" & + "enddef;"; +enddef; + +% Generation of new names (suffixes): +% All the names will start with |"_______"|. +% This initial string can be changed but it must end with |_|. +% The suffixes are generated in that order: +% |_______a|, |_______b|, |_______c|, ..., |_______z|, +% |_______aa|, |_______ab|, |_______ac|, ..., |_______az|, +% |_______ba|, ..., |_______bz|, |_______ca|, ..., +% |_______zz|, |_______aaa|, |_______aab|, etc. +% All we need to is remember the last created suffix. +% We store it in a string: +string last_obj_;last_obj_="_______"; + +vardef newobjstring_= + save l,prefix,lastchar,lastpos,lastposchar; + hide( + numeric lastpos; + string prefix,lastchar,lastposchar; + l=length(last_obj_); + lastchar=substring (l-1,l) of last_obj_; + if lastchar="_": + last_obj_:=last_obj_ & "a"; + elseif lastchar="z": + % in this case, we find the last character different from "z"; + % it is either a letter, or `|_|' + lastpos=l; + for i:=l-1 downto 1: + lastpos:=i; + lastposchar:=substring (i-1,i) of last_obj_; + exitif (lastposchar<>"z"); + endfor; + if lastposchar="_": % in this case, we have only z's + last_obj_:=last_obj_ & "a"; + else: + last_obj_:=(substring (0,lastpos-1) of last_obj_) & + char(ASCII lastposchar +1) + for i:=lastpos+1 upto l: & "a" endfor; + fi; + else: + last_obj_:= + (substring (0,l-1) of last_obj_) & char(ASCII lastchar +1); + fi; + ) + last_obj_ +enddef; + + +% We can call this function for instance with +% |duplicateArray_(n,m)("ObjStringArray")(stringarraylist_)| +vardef duplicateArray_(suffix n,m)(expr f)(suffix var)= + if m.var<>"": + forsuffixes $:=sc_(m.var): + sc_(f & "(" & str $ & ")(" & decimal m$n_ & ");"); + % we can do the previous |Obj...Array| because |assignObj| + % defined the current object + % we also fill the array: + for i:=1 upto m$n_: + n$[i]:=m$[i]; + endfor; + endfor; + fi; +enddef; + +% This creates a copy of object |m| in object |n| +% If |n| contained something, it gets either overriden (if the fields +% were common with those of |m|, or meaningless (if the fields +% were not common with those of |m|) +% The various strings are copied, and the object code is executed +% (this recreates the equations, as when the object is created by +% a constructor). The difference with the constructor is that +% no parameter is given and that we make a deep copy. +% We also copy the subobjects. +% Problem: we need new names for the subobjects. +% We solve that problem by using the ``name generator'' |newobjstring_| +% +vardef duplicateObj(suffix n,m)= + assignObj(n)(objClassName_(m)); % new number, but same type + % |n.pointlist_:=m.pointlist_;| % (see below) + % |n.pointarraylist_:=m.pointarraylist_;| % (see below) + % |n.points_in_arrayslist_:=m.points_in_arrayslist_;| % (see below) + n.code_:=m.code_; + n.extra_code_:=m.extra_code_; + % |n.picturelist_:=m.picturelist_;| % (see below) + n.nsubobjties_:=m.nsubobjties_; + for i:=1 upto n.nsubobjties_: + n.subobjties_[i]:=m.subobjties_[i]; + endfor; + + n.sublist_:=m.sublist_; % list of subobjects (this doesn't change, + % but the values of the subobjects will be new) + % create the types: + if m.pointlist_<>"": + % this also fills |n.pointlist_| + sc_ ("ObjPoint " & m.pointlist_); + fi; + if m.picturelist_<>"": + % this also fills |n.picturelist_| and creates all appropriate variables + sc_ ("ObjPicture " & m.picturelist_); + fi; + + % Duplication of numerical values: + if m.numericlist_<>"": + sc_ ("ObjNumeric " & m.numericlist_); % this also fills |n.numericlist_| + fi; + + % Duplication of boolean values: + if m.booleanlist_<>"": + sc_ ("ObjBoolean " & m.booleanlist_); % this also fills |n.booleanlist_| + fi; + + % Duplication of color values: + if m.colorlist_<>"": + sc_ ("ObjColor " & m.colorlist_); % this also fills |n.colorlist_| + fi; + + % Duplication of string values: + if m.stringlist_<>"": + sc_ ("ObjString " & m.stringlist_); % this also fills |n.stringlist_| + fi; + + % Duplication of transform values: + if m.transformlist_<>"": + sc_ ("ObjTransform " & m.transformlist_); % fills also |n.transformlist_| + fi; + + % Duplication of pairs: + if m.pairlist_<>"": + sc_ ("ObjPair " & m.pairlist_); % this also fills |n.pairlist_| + fi; + + % copy the current transformation of the object: + n.ctransform_:=m.ctransform_; + + save gen_n_;string gen_n_;gen_n_=generisize_(str n); + % we copy the options and their values: + if known m.options_: + if gen_n_=str n: + if unknown n.options_: + expandafter string sc_(gen_n_).options_; + fi; + fi; + n.options_=m.options_; + forsuffixes $:=sc_(n.options_): + % each |$| suffix starts with a |_| + if gen_n_=str n: + if expandafter unknown sc_(str n & ".option" & str $ & "_"): + sc_(TypeOf(sc_(str m & ".option" & str $ & "_")) & " " & + gen_n_ & ".option" & str $ & "_"); + fi; + fi; + n.sc_("option" & str $ & "_")=m.sc_("option" & str $ & "_"); + endfor; + fi; + + % we copy the numerical, pair and picture values if there are any + forsuffixes $$=numericlist_,booleanlist_,colorlist_,stringlist_, + transformlist_,pairlist_,picturelist_: + if n$$<>"": + forsuffixes $:=sc_(n$$):n$:=m$;endfor; + fi; + endfor; + + % the following fills |n.pointarraylist_| + % as well as |n.points_in_arrayslist_| + if m.pointarraylist_<>"": + forsuffixes $:=sc_(m.pointarraylist_): + sc_("ObjPointArray(" & str $ & ")(" & decimal m$n_ & ");"); + % we can do the previous |ObjPointArray| because |assignObj| + % defined the current object + endfor; + fi; + + % We duplicate the numeric arrays: + duplicateArray_(n,m)("ObjNumericArray")(numericarraylist_); + + % We duplicate the pair arrays (non movable points); + % this includes the structures memorizing paths: + duplicateArray_(n,m)("ObjPairArray")(pairarraylist_); + + % We duplicate the string arrays: + % it also fills |n.stringarraylist_| + duplicateArray_(n,m)("ObjStringArray")(stringarraylist_); + + % We duplicate the color, picture, transform and boolean arrays: + duplicateArray_(n,m)("ObjColorArray")(colorarraylist_); + duplicateArray_(n,m)("ObjPictureArray")(picturearraylist_); + duplicateArray_(n,m)("ObjTransformArray")(transformarraylist_); + duplicateArray_(n,m)("ObjBooleanArray")(booleanarraylist_); + + % this is similar, but for Object arrays + % it also fills |n.subarraylist_| + if m.subarraylist_<>"": + forsuffixes $:=sc_(m.subarraylist_): + sc_("ObjSubArray(" & str $ & ")(" & decimal m$n_ & ");"); + % we can do the previous |ObjSubArray| because |assignObj| + % defined the current object + % Here, we do not copy the strings, because we are doing a deep copy + endfor; + fi; + + % Copy the information on subobjects (variables) and + % call |duplicateObj| appropriately + + % First, the subobjects that are not part of arrays of subobjects: + % we go through all suffixes corresponding to subobjects + % of object |m|, and for each, we create a new name + save newsub_;string newsub_; + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_): + newsub_:=newobjstring_; + % first, create the type: + if not string n$: + sc_("string " & generisize_(str n & "." & str $)); + fi; + n$:=newsub_; + % we must now duplicate |obj(m$)| as |obj(n$)|; this will + % also choose a value for |obj(m$)| + duplicateObj(obj(n$),obj(m$)); + endfor; + fi; + % Second, the subobjects that are part of arrays of subobjects: + % we go through all arrays of subobjects + % of object |m|, and for each, we create a new name + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + % and now, we go through each element of the array: + for i:=1 upto m$n_: + % we only duplicate if there is something + % (in matrices, for instance, certain objects can be null) + if known m$[i]: + newsub_:=newobjstring_; + n$[i]:=newsub_; + duplicateObj(obj(n$[i]),obj(m$[i])); + fi; + endfor; + endfor; + fi; + + % relink everything: we take the first point of this object, + % and recreate all equations; we cannot take the code stored, + % because it is the initial code, and the duplication of a + % rotated object would then not be a rotated object + % (except if we store all transformations, but this would + % restrict us anyway to linear transformations) + save mainfirst;string mainfirst; + mainfirst=firstPointOf_(str n); + + % go through all points except the first, and relink + forsuffixes $$=pointlist_,points_in_arrayslist_: + if n$$<>"": + forsuffixes $:=sc_(n$$): + if str $<>mainfirst: + n.sc_(mainfirst)-n$=m.sc_(mainfirst)-m$; + fi; + endfor; + fi; + endfor; + + % go to all regular subobjects, and relink + + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_): + n.sc_(mainfirst)-obj(n$).obj(firstPointOf_(n$))= + m.sc_(mainfirst)-obj(m$).obj(firstPointOf_(m$)); + endfor; + fi; + + % go through all array subobjects, and relink; + % we go through all arrays of subobjects + % of object |m|, and for each, we create a new name + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + % and now, we go through each element of the array: + for i:=1 upto n$n_: + if known n$[i]: + n.sc_(mainfirst)-obj(n$[i]).obj(firstPointOf_(n$[i]))= + m.sc_(mainfirst)-obj(m$[i]).obj(firstPointOf_(m$[i])); + fi; + endfor; + endfor; + fi; +enddef; + +% Streamlined version of |duplicateObj|: |n| is a number representing an object +% This function takes a number representing an object, +% duplicates it and returns a number representing its duplication. +vardef duplicate_Obj(expr n)= + save newname_;string newname_; + hide( + % we do not set |streamlined_| to true, because it should be + % used only before a constructor is called, which is not the case here. + % first, choose a new name for the duplication: + newname_:=newobjstring_; + duplicateObj(obj(newname_),obj(iname_[n])); + ) sc_(newname_) +enddef; + +% This function merely unties all points of an object, +% but keeps the equations. Also, the subobjects remain attached +% to the main object. What it does is part of what +% |duplicateObj| does. +% |untieObj| is applied recursively. +% +% This function makes it possible to draw an object somewhere, +% to untie it and move it elsewhere, to draw it there, etc. +% We could achieve the same effect with duplication, but it would +% consume more memory. +vardef untieObj(suffix n)= + save fp,p_,q_,i; + string fp;pair p_[],q_[]; + % we first extract a point + fp=firstPointOf_(str n); + % we now go through all the points and store the differences + % with the point |fp| + i:=0; + forsuffixes $$=pointlist_,points_in_arrayslist_: + if n$$<>"": + forsuffixes $:=sc_(n$$):i:=i+1; + p_[i]=n$-n.sc_(fp); + endfor; + fi; + endfor; + + % we also store the positions of the first points of all subobjects + i:=0; + + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_):i:=i+1; + q_[i]=obj(n$).obj(firstPointOf_(n$))-n.sc_(fp); + endfor; + fi; + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + for j:=1 upto n$n_: + if known n$[j]: + i:=i+1; + q_[i]=obj(n$[j]).obj(firstPointOf_(n$[j]))-n.sc_(fp); + fi; + endfor; + endfor; + fi; + + % we refresh all points: + + save varlist_;string varlist_; + if n.pointlist_="":varlist_=n.points_in_arrayslist_; + else: + if n.points_in_arrayslist_<>"": + varlist_=n.pointlist_ & "," & n.points_in_arrayslist_; + else: varlist_=n.pointlist_; + fi; + fi; + refreshObjVars_(n)(sc_(varlist_)); + + % we untie the subobjects + + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_): + untieObj(obj(n$)); + endfor; + fi; + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + for j:=1 upto n$n_: + if known n$[j]: + untieObj(obj(n$[j])); + fi; + endfor; + endfor; + fi; + + % and we recreate the differences from the ones stored: + % (exactly the same code as above!) + i:=0; + forsuffixes $$=pointlist_,points_in_arrayslist_: + if n$$<>"": + forsuffixes $:=sc_(n$$):i:=i+1; + p_[i]=n$-n.sc_(fp); + endfor; + fi; + endfor; + + % we also attach again the subobjects + % (also exactly the same code as above!) + i:=0; + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_):i:=i+1; + q_[i]=obj(n$).obj(firstPointOf_(n$))-n.sc_(fp); + endfor; + fi; + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + for j:=1 upto n$n_: + if known n$[j]: + i:=i+1; + q_[i]=obj(n$[j]).obj(firstPointOf_(n$[j]))-n.sc_(fp); + fi; + endfor; + endfor; + fi; +enddef; + +% Draw an array of objects. |n| is the object, |a| is the array, +% and the number of elements are assumed to be |a.n_| +% If you don't want to draw all the subobjects, make your own function. + +def drawObjArray(suffix n)(suffix a)= + for i:=1 upto n.a.n_: + if known n.a[i]: % in certain cases (for instances matrices), + % we can have holes in the array + drawObj(obj(n.a[i])); + fi; + endfor; +enddef; + +% One idea for implementing |resetObj.expl| is to have the object +% constructor behave in a certain way when a flag is set. This way +% would be to refresh the variables, and to call again the equations. +% The problem with this approach is that subobjects have also to +% be reset, and this makes it necessary to give again the +% parameters of the constructor, since we don't save them, +% and since there is no constructor overloading in metapost. +% Hence, we decided to merely use the code in |ObjCode| sections. +% We first refresh the variables (only points), then call +% reset on the subobjects, then execute the memorized code. +% This constrains the user to put his code in |ObjCode|. +% (Otherwise, if |resetObj.expl| is never used, the code can just +% be given outside |ObjCode|, and not in strings.) + +vardef resetObj.expl@#= + save varlist_;string varlist_; + % refresh the points (also those in arrays) + if @#pointlist_="":varlist_=@#points_in_arrayslist_; + else: + if @#points_in_arrayslist_<>"": + varlist_=@#pointlist_ & "," & @#points_in_arrayslist_; + else: varlist_=@#pointlist_; + fi; + fi; + refreshObjVars_(@#)(sc_(varlist_)); + + % reset the current transformation: + @#ctransform_:=identity; + + % reset the label transformations + % (as can be observed, this does not place us back in the + % initial state, if labels were only added after the application + % of a transformation to an object) + if known @#ipic_.n_: + for i:=1 upto @#ipic_.n_: + @#ipic_.transf_[i]:=identity; + endfor; + fi; + + % reset all subobjects + + if @#sublist_<>"": + forsuffixes $:=sc_(@#sublist_): + resetObj.expl.obj(@#.$); + endfor; + fi; + if @#subarraylist_<>"": + forsuffixes $:=sc_(@#subarraylist_): + % and now, we go through each element of the array: + for i:=1 upto @#.$n_: + if known @#.$[i]: + resetObj.expl.obj(@#.$[i]); + fi; + endfor; + endfor; + fi; + + % call the code + begingroup; % we want the |vardef| macro only defined locally; + % we don't need it later + save code_function_; + % define the function + sc_("vardef code_function_@#=" & @#code_ & @#extra_code_ & + " enddef;"); + % call it + code_function_@#; + endgroup; + +enddef; + +% In order to find which point of an object is the most +% to the left, we search which of the four corners is such that +% all others are to its right. We return a string corresponding +% to the corner. |"sw"| for |sw|, etc. +% This function does not assume the corners to be determined, +% but it assumes that the vector between two points is known. +% |f| is |xpart| or |ypart| +% |g| is |<| or |>| +vardef findmost@#(text f)(text g)= + save found_,i,corner; + hide( + string corner;boolean found_;found_=false; + forsuffixes $:=nw,ne,sw,se: + i:=0; + forsuffixes $$:=nw,ne,sw,se: + exitif f (@#.$$-@#.$) g 0; + i:=i+1; + endfor; + if i=4:found_:=true;corner:=str $;fi; + exitif found_; + endfor; + ) + corner +enddef; + +% Recursive version of |findmost|. This function returns a numeric +% corresponding to the x or y part of a point. +% |f| is |xpart| or |ypart| and |g| is |<| or |>| +vardef findrecmost@#(text f)(text g)= + save found_,i,corner,currentsub; + hide( + numeric corner,currentsub;boolean found_;found_=false; + % first, we check the four corners of the object + forsuffixes $:=nw,ne,sw,se: + i:=0; + forsuffixes $$:=nw,ne,sw,se: + exitif f (@#.$$-@#.$) g 0; + i:=i+1; + endfor; + if i=4:found_:=true;corner:=f(@#.$);fi; + exitif found_; + endfor; + % then, we check each subobject recursively: + % and first, the regular subobjects: + if @#sublist_<>"": + forsuffixes $:=sc_(@#sublist_): + % check |obj(@#.$)|: + currentsub:=findrecmost.obj(@#.$)(f)(g); + if not (corner-currentsub g 0): + corner:=currentsub; + fi; + endfor; + fi; + % and second, the subobjects that are part of arrays of subobjects: + % we go through all arrays of subobjects of object |@#|: + if @#subarraylist_<>"": + forsuffixes $:=sc_(@#subarraylist_): + % and now, we go through each element of the array: + for i:=1 upto @#.$n_: + % check |obj(@#.$[i])|: + if known @#.$[i]: + currentsub:=findrecmost.obj(@#.$[i])(f)(g); + if not (corner-currentsub g 0): + corner:=currentsub; + fi; + fi; + endfor; + endfor; + fi; + ) + corner +enddef; + +% These functions return a string corresponding to a suffix: +vardef find_lft_most@#= findmost@#(xpart)(<) enddef; +vardef find_rt_most@#= findmost@#(xpart)(>) enddef; +vardef find_top_most@#= findmost@#(ypart)(>) enddef; +vardef find_bot_most@#= findmost@#(ypart)(<) enddef; + +% The following are recursive versions of the previous functions. +% These functions return a numeric. +vardef findrec_lft_most@#= findrecmost@#(xpart)(<) enddef; +vardef findrec_rt_most@#= findrecmost@#(xpart)(>) enddef; +vardef findrec_top_most@#= findrecmost@#(ypart)(>) enddef; +vardef findrec_bot_most@#= findrecmost@#(ypart)(<) enddef; + +%======================================================================== +% Streamlining + +% We use a boolean to keep distinguish a streamlined function, from +% a non-streamlined one. This is needed to find out if a name has been +% given explicitely to an object. +boolean streamlined_;streamlined_=false; +% This boolean is set to true, which means that every time +% an object is defined with an explicit name, the string version +% of the name can be used as a shortcut. This is sometimes useful. +% Setting the boolean to false saves some space. +boolean memorizeShortcuts;memorizeShortcuts=true; + +% Called with something like |streamline("BB")("(expr t)","suffixpar(t)");| +% where |t| represents the {\it number\/} of an object, +% the streamline function creates two variants of a constructor: +% 1) a first variant without options: +%|vardef new_BB(expr t)=| +%| save newname_;string newname_;| +%| hide(| +%| streamlined_:=true;| +%| newname_:=newobjstring_;| +%| newBB.sc_(newname_) suffixpar(t);| +%| )| +%| sc_(newname_)| +%|enddef;| + +% 2) a second variant with options: +%|vardef new_BB_(expr t)(text options)=| +%| save newname_;string newname_;| +%| hide(| +%| streamlined_:=true;| +%| newname_:=newobjstring_;| +%| newBB.sc_(newname_) suffixpar(t) options;| +%| )| +%| sc_(newname_)| +%|enddef;| + +% Called with something like +% |streamline("Tree")("(expr theroot)(text subtrees)",| +% |"suffixpar(theroot) suffixlist(subtrees)");| +% the streamline function creates the two variants: +%|vardef new_Tree(expr theroot)(text subtrees)=| +%| save newname_;string newname_;| +%| hide(| +%| streamlined_:=true;| +%| newname_:=newobjstring_;| +%| newTree.sc_(newname_) suffixpar(theroot) suffixlist(subtrees);| +%| )| +%| sc_(newname_)| +%|enddef;| +% +% and +% +%|vardef new_Tree_(expr theroot)(text subtrees)(text options)=| +%| save newname_;string newname_;| +%| hide(| +%| streamlined_:=true;| +%| newname_:=newobjstring_;| +%| newTree.sc_(newname_) suffixpar(theroot) suffixlist(subtrees)| +%| options;| +%| )| +%| sc_(newname_)| +%|enddef;| +% + +% In the above variants, |theroot| is not a suffix, but a string representing +% a suffix, as possibly returned by another |new_| call. +% Similarly, |subtree| is not a list of suffixes, but a list +% of strings representing suffixes. In one case, |suffixpar| must be specified +% in the parameters of |streamline|. In the other case, one has to write +% |suffixlist|. +% |suffixlist| transforms a list of strings into a list of suffixes. + + +% These ``streamlined'' variants do not take +% an object name; instead, they provide one by themselves; then they +% call the regular constructor, and the name of the object +% is returned as a string +% The three parameters are strings. + +vardef streamline(expr class,formalparameters,actualparameters)= + save mac;string mac; + mac="vardef new_" & class & formalparameters & + "=save newname_;string newname_;" & + "hide(streamlined_:=true;newname_:=newobjstring_;new" & + class & ".sc_(newname_)" & + actualparameters & ";)sc_(newname_) enddef;"; + sc_ mac; + % variant with options: + mac:="vardef new_" & class & "_" & formalparameters & + "(text options)=save newname_;string newname_;" & + "hide(streamlined_:=true;newname_:=newobjstring_;new" & + class & ".sc_(newname_)" & + actualparameters & " options;)sc_(newname_) enddef;"; + sc_ mac; + % we also create the "is" function: + createClassTest(class); +enddef; + +% A few definitions used above: + +def suffixpar(expr s)=(obj(iname_[s])) enddef; + +vardef concatsuffixlist_(text t)= + save tmp;string tmp; + hide( + tmp=""; + for $:=t: + if tmp<>"": + tmp:=tmp & "," & iname_[$]; + else: + tmp:=iname_[$]; + fi; + endfor; + ) + tmp +enddef; + +% From a list of numbers, produces the concatenation of the +% associated suffixes, ready for a |text| parameter +def suffixlist(text t)= + expandafter (sc_ concatsuffixlist_(t)) +enddef; + +% This function tries to find an inner point among the points of object |@#| +% It returns the point name as a string, and an empty string if there +% is no inner point. +vardef find_inner_point@#= + save inn;string inn; + hide( + inn=""; + % we first loop over the |pointlist_| array: + if @#pointlist_<>"": + forsuffixes $:=sc_(@#pointlist_): + if not isStandardPoint$:inn:=str $;fi; + exitif inn<>""; + endfor; + fi; + if inn="": + % we then loop over all points of arrays, + % that is, the |points_in_arrayslist_|: + if @#points_in_arrayslist_<>"": + forsuffixes $:=sc_(@#points_in_arrayslist_): + if not isStandardPoint$:inn:=str $;fi; + exitif inn<>""; + endfor; + fi; + fi; + ) + inn +enddef; + +% |rebindrelativeObj|: +% This function is in a certain way similar to |newBB| in that +% it provides a regular bounding box to an object. That means that +% the four corners will be where they should be: |.nw| at the top left, +% |.sw| at the bottom left, etc. +% The difference with |newBB| is that it does not create +% a new object, it only modifies the one given in parameter. +% No object layer is added. +% It should be emphasized however that there is no guarantee +% that the new bounds will contain the whole object, because +% neither the drawing instructions +% nor the subobjects are taken into account. We do not take +% the subobjects into account, because if we did, it would make it +% difficult to cheat on the bounding box. +% The new bounding box is only guaranteed to be the tightest +% containing the former corners of the current object, +% plus the shifts given in parameters. +% This function is useful when you want to pretend that +% the bounding box is different from what it is, because +% the bounding box is used to decide how much space an object +% takes when used within another object. +% This function looks complex because it is! The object we want +% to recompute may be floating and we have to preserve that; +% we have to move some points in a floating object. +% The four additionnal parameters are four dimensions, +% representing changes in size in the four directions. +% The values can be positive or negative. Positive values +% move up or towards the right, and negative values move +% down or towards the left. +vardef rebindrelativeObj(suffix n)(expr dyn,dys,dxe,dxw)= + save innerpoint,xleft,xright,ytop,ybot,i,nwi,swi,nei,sei,mac; + string innerpoint,mac; + % we define arrays of points, which will be useful below: + save p_,q_,r_;pair p_[],q_[],r_[]; +% message "*** Rebinding with parameters " & +% decimal(dyn) & "," & decimal(dys) & "," & +% decimal(dxe) & "," & decimal(dxw); + % first, we find the bounds (left, right, bottom, top) of object |n|: + % we only look at the current object and not its subobjects + % (if one wants the real bounding box, taking into account all + % visible parts, use |rebindvisibleObj|) + xleft= xpart(n.sc_(find_lft_most.n)); + xright=xpart(n.sc_(find_rt_most.n)); + ytop= ypart(n.sc_(find_top_most.n)); + ybot= ypart(n.sc_(find_bot_most.n)); + + % We distinguish two cases: either there is an inner point + % (i.e., different from the standard points of the bounding box + .c + % which we also consider part of the bounding box), + % or there is no such point. + % The standard points are those we are going to change. + innerpoint=find_inner_point.n; + if innerpoint="": % easy (but rare) case + % (It is not compulsorily an error if the object has no other points, + % it could well be a filling or space object.) + % IN THIS CASE, WE IGNORE POSSIBLE SUBOBJECTS, SINCE WE ASSUME + % THAT THEY ARE TIED TO INNER POINTS. + % Here, we have only to give new values to the standard points. + % We first compute the value of the top left corner (|p_1|) + % and the differences: + p_1=(xleft,ytop)+(dxw,dyn); + p_2=(xleft,ybot)+(dxw,dys)-p_1; + p_3=(xright,ytop)+(dxe,dyn)-p_1; + p_4=(xright,ybot)+(dxe,dys)-p_1; + % Then, we refresh the original bounding box + refreshObjVars_(n)(ne,nw,se,sw,n,s,e,w,c); + % and we could recreate the three differences: + % |n.sw-n.nw=p_2-p_1;n.ne-n.nw=p_3-p_1;n.se-n.nw=p_4-p_1;| + % however, because of the StandardEquations, we can just define + % two opposite corners: + n.se-n.nw=p_4-p_1; + % Now, either |p_1| is known, or it is not. If it is known, + % we give its value to |n.nw|: + if known p_1: n.nw:=p_1;fi; + else: % common case, more work + % first we memorize (computed (nw) - n.nw), (computed (sw) - n.sw), etc., + % that is, how much each corner is going to move to reach its + % standard position: + q_1=(xleft,ytop)-n.nw+(dxw,dyn); + q_2=(xleft,ybot)-n.sw+(dxw,dys); + q_3=(xright,ytop)-n.ne+(dxe,dyn); + q_4=(xright,ybot)-n.se+(dxe,dys); + % these four differences will be used later + + % We now memorize the differences between all points and the + % inner point; only those differences which are fully known + % will be considered (IS THIS TRUE?); + % this will allow us to accept a few non + % known (and non used) points + % WE HAVE ASSUMED THAT THE INNERPOINT IS ATTACHED INSIDE THE OBJECT + i:=0; + % First, go through the regular points: + if n.pointlist_<>"": + forsuffixes $:=sc_(n.pointlist_):i:=i+1; + p_[i]=n$-n.sc_(innerpoint); + % memorize the indexes of the points |nw|,|sw|,|ne|,|se| when they pass + if str $="nw":nwi=i;elseif str $="sw":swi=i; + elseif str $="ne":nei=i;elseif str $="se":sei=i;fi; + endfor; + fi; + % then through all other points: + if n.points_in_arrayslist_<>"": + forsuffixes $:=sc_(n.points_in_arrayslist_):i:=i+1; + p_[i]=n$-n.sc_(innerpoint); + endfor; + fi; + % we also save the value of the inner point, + % in case it is well in place: + if known n.sc_(innerpoint):p_0=n.sc_(innerpoint);fi; + + % we save the differences between the innerpoint and the first + % points of the subobjects, if there are any: + + i:=0; + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_):i:=i+1; + r_[i]=n.sc_(innerpoint)-obj(n$).obj(firstPointOf_(n$)); + endfor; + fi; + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + % and now, we go through each element of the array: + for j:=1 upto n$n_: + if known n$[j]: + i:=i+1; + r_[i]=n.sc_(innerpoint)- + obj(n$[j]).obj(firstPointOf_(n$[j])); + fi; + endfor; + endfor; + fi; + + % we refresh everything: + forsuffixes $$=pointlist_,points_in_arrayslist_: + if n$$<>"": + forsuffixes $:=sc_(n$$):refreshObjVars_(n)($);endfor; + fi; + endfor; + + % we also untie the subobjects: + + i:=0; + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_):i:=i+1; + untieObj(obj(n$)); + endfor; + fi; + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + % and now, we go through each element of the array: + for j:=1 upto n$n_: + if known n$[j]: + i:=i+1; + untieObj(obj(n$[j])); + fi; + endfor; + endfor; + fi; + + % and we redefine everything except the standard points: + i:=0; + forsuffixes $$=pointlist_,points_in_arrayslist_: + if n$$<>"": + forsuffixes $:=sc_(n$$):i:=i+1; + if not isStandardPoint$: + n$-n.sc_(innerpoint)=p_[i]; + fi; + endfor; + fi; + endfor; + + % and finally, we attach the subobjects (same code as above): + + i:=0; + if n.sublist_<>"": + forsuffixes $:=sc_(n.sublist_):i:=i+1; + r_[i]=n.sc_(innerpoint)-obj(n$).obj(firstPointOf_(n$)); + endfor; + fi; + if n.subarraylist_<>"": + forsuffixes $:=sc_(n.subarraylist_): + % and now, we go through each element of the array: + for j:=1 upto n$n_: + if known n$[j]: + i:=i+1; + r_[i]=n.sc_(innerpoint)- + obj(n$[j]).obj(firstPointOf_(n$[j])); + fi; + endfor; + endfor; + fi; + + % Now, all non standard points are bound to the inner point. + % Finally, we attach the standard points properly; + % we know where the new corners are located in the old system + % points, for instance + % |(xpart(n.sc_(lftmost)),ypart(n.sc_(topmost)))| + % corresponds to the new |n.nw|; however, if the object is floating, + % we cannot write |n.nw=(xpart(n.sc_(lftmost)),...)| + % because the latter refers to variables that do no longer exist. + % What we can do is to say + % |new(n.nw)-new(n.innerpoint)=(old(n.nw)-old(n.innerpoint))| + % |+ (old(computed nw)-old(n.nw))| + % The value of |(old(n.nw)-old(n.innerpoint))| is in the |p_| array + % The value of |old(computed nw)-old(n.nw)| has been computed above, + % before the variables were refreshed. We can just add them. + % + % Of the four following equations, we define only two, + % corresponding to opposite corners. Otherwise, there are redundant + % equations. + n.nw-n.sc_(innerpoint)=p_[nwi]+q_1; + %|n.sw-n.sc_(innerpoint)=p_[swi]+q_2;| + %|n.ne-n.sc_(innerpoint)=p_[nei]+q_3;| + n.se-n.sc_(innerpoint)=p_[sei]+q_4; + + % And finally, we define the innerpoint |p_0| if necessary + if known p_0:n.sc_(innerpoint)=p_0;fi; + fi; + + mac:="vardef code_function_@#= " & PureStandardEquations & "enddef;"; + % we want the |vardef| macro only defined locally;we don't need it later + begingroup; + save code_function_; + sc_(mac); + % determine |.n|, |.s|, etc.: + sc_ ("code_function_." & str n); + endgroup; +enddef; + +% streamlined version: |n| is a number representing an object +vardef rebindrelative_Obj(expr n)(expr dyn,dys,dxe,dxw)= + hide(rebindrelativeObj(obj(iname_[n]))(dyn,dys,dxe,dxw)) n +enddef; + +def rebindObj(suffix n)= + rebindrelativeObj(n)(0,0,0,0); +enddef; + +% streamlined version: |n| is a number representing an object +vardef rebind_Obj(expr n)= + hide(rebindObj(obj(iname_[n]))) n +enddef; + +% This function does an exact rebind, unlike the previous functions. +% It takes into account everything that is visible +vardef rebindVisibleObj(suffix n_)= + save untied,p;boolean untied;path p;untied=true; + if known n_.c:untied:=false;fi; + if untied:n_.c=origin;fi; + % first, we do a simple |rebindObj| to make sure + % that the bounding box is parallel to the axes + rebindObj(n_); + save bboxmargin; + bboxmargin:=0; + p=rBboxObj(n_); + rebindrelativeObj(n_)( + ypart((point 2 of p)-n_.n), + ypart((point 1 of p)-n_.s), + xpart((point 1 of p)-n_.e), + xpart((point 0 of p)-n_.w)); + if untied:untieObj(n_);fi; +enddef; + +% It is often useful to set the size of an object, in order +% to get proper alignments. We provide several functions. +% These functions take a length and extend in one of the four +% directions until reaching this length. It is a straightforward +% application of |rebindrelativeObj|: + +vardef extendObjRight@#(expr wd)= + rebindrelativeObj(@#)(0,0,wd-xpart(@#e-@#w),0); +enddef; + +vardef extendObjLeft@#(expr wd)= + rebindrelativeObj(@#)(0,0,0,xpart(@#e-@#w)-wd); +enddef; + +vardef extendObjUp@#(expr ht)= + rebindrelativeObj(@#)(ht-ypart(@#n-@#s),0,0,0); +enddef; + +vardef extendObjDown@#(expr ht)= + rebindrelativeObj(@#)(0,ypart(@#n-@#s)-ht,0,0); +enddef; + +% Handling of options in constructors: + +% Options are added as optional text parameters at the end of constructors. +% The options are normally strings representing function calls +% with parameters. Several options can be separated by commas. +% Each object honors its own options. +% Non honored options produce errors. + +% It is up to the object to decide if it takes options and if it +% handles them. Options are handled by a generic |ExecuteOptions| call. +% This function defines variables according to the options given. +% Later, these variables can be used to achieve various effects. + +% The |ExecuteOptions| definition must not be a |vardef| +% because some of the options +% (for instance |o_treemode|) do |save|s and the scope of +% these |save|s must be the whole constructor. +% |$$| is the object; we need it in order to define |currentObjname| +% which is used by certain options. However, local options +% (the ones only used in the constructor) do not use the object name. +def ExecuteOptions(suffix $$)(text options)= + % we don't need a |vardef| here, + % because |ExecuteOptions| is called within a |vardef| + setcurrentobjname_(str $$); + for $:=options: + % each option is a function call, so we just call it; + % if the function called does not exist, it will of course + % produce an error, but this error can clearly be diagnosed. + % We call the function |correctOption_| in order to add + % quotes in certain cases. + sc_ (correctOption_("o_" & $)); + endfor; +enddef; + +% Here are the functions that can be called; new functions can +% easily be added to handle more parameters. + +def set_local_type(expr type,name,val)= + sc_("save o_" & name & "_val;" & + type & " o_" & name & "_val;o_" & name & "_val")=val; +enddef; + +% For every option name |s|, this function defines a function |o_s| +% and calls |addOptionFunction| if the type is |"string"|. +% This call registers the option so that +% its arguments is protected. + +vardef define_local_type_option(expr type,s)= + save tmp; + string tmp; + tmp="def o_" & s & "(expr s)="; + if s="arrows": + tmp:=tmp & "set_local_type(" & quote(type) & "," & quote(s) & + ",arrows_function_(s));enddef;"; + else: + tmp:=tmp & + "set_local_type(" & quote(type) & "," & quote(s) & ",s);enddef;"; + fi; + if type="string": + tmp:=tmp & "addOptionFunction(" & quote("o_" & s) & ");"; + fi; + sc_ tmp; +enddef; + +def define_local_string_option(expr s)= + define_local_type_option("string",s); +enddef; + +def define_local_numeric_option(expr s)= + define_local_type_option("numeric",s); +enddef; + +def define_local_pair_option(expr s)= + define_local_type_option("pair",s); +enddef; + +def define_local_color_option(expr s)= + define_local_type_option("color",s); +enddef; + +def define_local_boolean_option(expr s)= + define_local_type_option("boolean",s); +enddef; + +def settodefaultifnotknown_(expr opname)(text type)(expr default)= + if expandafter unknown sc_("o_" & opname & "_val"): + expandafter save sc_("o_" & opname & "_val"); + expandafter type sc_("o_" & opname & "_val"); + sc_("o_" & opname & "_val")=default; + fi; +enddef; + +% Alignment option; the string version of the parameter is put +% into the current object |option_align_| field. +% This definition must not be a |vardef| because +% the scope of the |save| is the whole constructor. +define_local_string_option("align"); + +define_local_string_option("Dalign"); +define_local_string_option("Ualign"); +define_local_string_option("Lalign"); +define_local_string_option("Ralign"); + +vardef define_global_type_option(expr type,opname)= + save tmp;string tmp; + tmp="def o_" & opname & "(expr s)=" & + "global_" & type & "_option_(" & ditto & opname & ditto & + ")(s);enddef;"; + if type="string": + tmp:=tmp & + "addOptionFunction(" & ditto & "o_" & opname & ditto & ");"; + fi; + sc_(tmp); +enddef; + +def define_global_string_option(expr opname)= + define_global_type_option("string",opname); +enddef; + +def define_global_boolean_option(expr opname)= + define_global_type_option("boolean",opname); +enddef; + +def define_global_color_option(expr opname)= + define_global_type_option("color",opname); +enddef; + +def define_global_numeric_option(expr opname)= + define_global_type_option("numeric",opname); +enddef; + +def define_global_pair_option(expr opname)= + define_global_type_option("pair",opname); +enddef; + +% The parameter of |halign| or |valign| +% is a list of alignment options, for instance |"clrccl"| +% It is used for matrix columns. + +define_global_string_option("halign"); +define_global_string_option("valign"); + +% Filling option; the parameter is put +% into the current object |option_filled_| field for later use. +define_global_boolean_option("filled"); + +% Color filling option +define_global_color_option("fillcolor"); + +% Framing options. +define_global_boolean_option("framed"); +define_global_color_option("framecolor"); +define_global_string_option("framestyle"); + +% Picture option +define_global_color_option("picturecolor"); + +% Shadow options +define_global_boolean_option("shadow"); +define_global_color_option("shadowcolor"); + +% Fitting option. Usually, the default is for a frame to fit +% its contents. This options makes it possible to have regular frames +% around objects that have different widths and heights. +define_global_boolean_option("fit"); + +% Tree direction option. +% This definition must not be a |vardef| because +% the scope of the |save| is the whole constructor. +% The name |treemode| was chosen for compatibility with PSTricks. +define_local_string_option("treemode"); + +% PSTricks compatibility: +% This corresponds to PSTricks |treenodesize|; +% we took a different name, because we have two variants: +define_local_numeric_option("treenodehsize"); +define_local_numeric_option("treenodevsize"); + +define_local_numeric_option("matrixnodehsize"); +define_local_numeric_option("matrixnodevsize"); + +% |HBox| and |VBox| versions of the |"treenodehsize"|/|"treenodevsize"| option: +define_local_numeric_option("elementsize"); + +define_local_boolean_option("flip"); +define_local_boolean_option("treeflip"); + +define_local_boolean_option("hideleaves"); + +% draw functions for connections +define_local_string_option("cdraw"); + +% This is a list of all the stored options of a path. +% This list is defined so that it is easy to loop +% over all options. +def pathoptions_= + _draw_,_connect_,posA,posB,armA,armB,offsetA,offsetB, + name,linecolor,border,bordercolor,linestyle,doubleline,doublesep, + arrows,angleA,angleB,arcangleA,arcangleB,linewidth,nodesepA,nodesepB, + loopsize,linearc,linetensionA,linetensionB, + visible,boxsize,boxheight,boxdepth,pathfilled,pathfillcolor, + coilarmA,coilarmB,coilheight,coilwidth,coilaspect,coilinc +enddef; + +% default values for curves: +numeric curve_linewidth_default, + curve_arcangleA_default,curve_arcangleB_default, + curve_armA_default,curve_armB_default,curve_loopsize_default, + curve_linetensionA_default,curve_linetensionB_default, + curve_linearc_default, + curve_border_default,curve_nodesepA_default,curve_nodesepB_default, + curve_boxsize_default,curve_boxheight_default,curve_boxdepth_default, + curve_doublesep_default, + curve_coilarmA_default,curve_coilarmB_default, + curve_coilheight_default,curve_coilwidth_default, + curve_coilaspect_default,curve_coilinc_default; +curve_linewidth_default=.5bp; +curve_arcangleA_default=10; +curve_arcangleB_default=10; +curve_armA_default=5mm; +curve_armB_default=5mm; +curve_loopsize_default=0.25cm; +curve_linearc_default=0cm; +curve_linetensionA_default=1; +curve_linetensionB_default=1; +curve_border_default=0pt; +curve_nodesepA_default=0pt; +curve_nodesepB_default=0pt; +curve_boxsize_default=5mm; +curve_boxheight_default=-1pt; % means that there is no default +curve_boxdepth_default=-1pt; % means that there is no default +curve_doublesep_default=1pt; +curve_coilarmA_default=5mm; % same as in PSTricks +curve_coilarmB_default=5mm; % same as in PSTricks +curve_coilheight_default=1; % same as in PSTricks +curve_coilwidth_default=1cm; % same as in PSTricks +curve_coilaspect_default=45; % same as in PSTricks +curve_coilinc_default=90; % 20 is better when |coilaspect|=0 + % (the PSTricks default is 10, but it seems unnecessary in most cases) + +boolean curve_visible_default,curve_doubleline_default, + curve_pathfilled_default; +curve_visible_default=true; +curve_doubleline_default=false; +curve_pathfilled_default=false; + + +color curve_linecolor_default,curve_bordercolor_default, + curve_pathfillcolor_default; +curve_linecolor_default=black; +curve_bordercolor_default=white; +curve_pathfillcolor_default=black; + +string curve_linestyle_default,curve_arrows_default, + curve_posA_default,curve_posB_default; +pair curve_offsetA_default,curve_offsetB_default; +curve_linestyle_default=""; +curve_arrows_default="drawarrow"; +curve_posA_default="ic"; +curve_posB_default="ic"; +curve_offsetA_default=(0,0); +curve_offsetB_default=(0,0); + +% curve options shortcuts table +string curve_options_shortcuts_[]; +numeric ncurve_options_shortcuts_; +ncurve_options_shortcuts_=0; + +vardef isCurveOptionShortcut(expr opname)= + save r;boolean r;r=false; + hide( + for i:=0 upto ncurve_options_shortcuts_-1: + if curve_options_shortcuts_[i]=opname:r:=true;fi; + exitif r; + endfor; + ) + r +enddef; + +def setCurveDefaultOption(expr name,value)= + if isCurveOptionShortcut(name): + sc_("curve_" & name & "A_default"):=value; + sc_("curve_" & name & "B_default"):=value; + elseif name="arrows": + sc_("curve_" & name & "_default"):=arrows_function_(value); + else: + sc_("curve_" & name & "_default"):=value; + fi; +enddef; + +% For all options for which there are two versions (A and B), +% we define special shortcuts, as does PSTricks. +% We also memorize the shortcuts, because they are needed in +% |setCurveDefaultOption|. + +def define_path_option_shortcut(expr s)= + scantokens("def o_" & s & + "( expr l)=o_" & s & "A(l);o_" & s & "B(l);enddef;"); + curve_options_shortcuts_[ncurve_options_shortcuts_]=s; + ncurve_options_shortcuts_:=ncurve_options_shortcuts_+1; +enddef; + +define_path_option_shortcut("linetension"); +define_path_option_shortcut("coilarm"); +define_path_option_shortcut("pos"); +define_path_option_shortcut("offset"); +define_path_option_shortcut("arm"); +define_path_option_shortcut("angle"); +define_path_option_shortcut("arcangle"); +define_path_option_shortcut("nodesep"); + +% Arrows functions: these functions should be similar to |draw|. +% They can be parameters to the |"arrows"| option. + +def rdrawarrow = drawarrow reverse enddef; + +% This is the default value for connections. +% |p| is a path to be drawn. +% |n| is a suffix for an array of stored parameters +% |i| is the index in this array +% If the suffix is empty, we use locally stored values. +vardef cdraw_default(suffix n)(expr i)(expr p)= + save colorcmd,p_;string colorcmd;path p_;colorcmd=""; + p_=p; + p_:=cutpathends_(p_,if known o_nodesepB_val: o_nodesepB_val + else: curve_nodesepB_default fi, + if known o_nodesepA_val: o_nodesepA_val + else: curve_nodesepA_default fi); + if str n="": + if CLOV_("border")>0: + pickup pencircle scaled CLOV_("border"); + % we cut the ends of the path in order to avoid + % the end nodes to be erased; the standard setting + % should work in most cases, except when the path + % reaches the node under a small angle; we should then + % add options to define how much of the path we cut. + draw cutpathends_(p,2*CLOV_("border"),2*CLOV_("border")) + withcolor CLOV_("bordercolor"); + fi; + pickup pencircle scaled CLOV_("linewidth"); + if CLOV_("linecolor")<>black: + colorcmd:="withcolor " & colortostring(CLOV_("linecolor")); + fi; + if CLOV_("doubleline"): + sc_(CLOV_("arrows") & "_double") + (p_)(CLOV_("doublesep"))(CLOV_("linewidth")) + sc_(CLOV_("linestyle")) + sc_(colorcmd); + else: + sc_(CLOV_("arrows")) + (p_) + sc_(CLOV_("linestyle")) + sc_(colorcmd); + fi; + else: + if n.border[i]>0: + pickup pencircle scaled n.border[i]; + % we cut the ends of the path in order to avoid + % the end nodes to be erased; the standard setting + % should work in most cases, except when the path + % reaches the node under a small angle; we should then + % add options to define how much of the path we cut. + draw cutpathends_(p,2*n.border[i],2*n.border[i]) + withcolor n.bordercolor[i]; + fi; + pickup pencircle scaled n.linewidth[i]; + if n.linecolor[i]<>black: + colorcmd:="withcolor " & colortostring(n.linecolor[i]); + fi; + if n.doubleline[i]: + sc_(n.arrows[i] & "_double") + (p_)(n.doublesep[i])(n.linewidth[i]) + sc_(n.linestyle[i]) + sc_(colorcmd); + else: + sc_(n.arrows[i]) + (p_) + sc_(n.linestyle[i]) + sc_(colorcmd); + fi; + fi; + pickup pencircle scaled curve_linewidth_default; +enddef; + +% color for connections +% We don't name it |color|, because at some point we would need +% to do a |sc_("color")| which would fail. +define_local_color_option("linecolor"); + +% border color (PSTricks compatibility) +define_local_color_option("bordercolor"); + +% size of border (PSTricks compatibility) +define_local_numeric_option("border"); + +% option for the path array |_path_|; this option makes +% it possible to use a different array with |nccurve| and similar +% functions. +define_local_string_option("patharray"); + +% connections within trees +define_global_string_option("edge"); + +% fan options: +define_global_string_option("fanlinestyle"); + +define_global_boolean_option("pointedfan"); +define_global_numeric_option("fanlinearc"); + +% angles for connections (PSTricks compatibility) +define_local_numeric_option("angleA"); +define_local_numeric_option("angleB"); +define_local_numeric_option("arcangleA"); +define_local_numeric_option("arcangleB"); + +% separations for connections (PSTricks compatibility) +define_local_numeric_option("nodesepA"); +define_local_numeric_option("nodesepB"); + +% parameters for |ncbox| and |ncarcbox|: size of boxes (PSTricks compatibility) +define_local_numeric_option("boxsize"); +define_local_numeric_option("boxheight"); +define_local_numeric_option("boxdepth"); + +% parameter for |ncloop| +define_local_numeric_option("loopsize"); + +% smoothness of connections +define_local_numeric_option("linearc"); + +% coil/zigzag connections: +define_local_numeric_option("coilarmA"); +define_local_numeric_option("coilarmB"); +define_local_numeric_option("coilheight"); +define_local_numeric_option("coilwidth"); +define_local_numeric_option("coilaspect"); +define_local_numeric_option("coilinc"); + +% visibility of connections +% (a connection can be invisible and be used for other purposes, +% such as label positionning or computation of intersections) +define_local_boolean_option("visible"); + +define_local_boolean_option("pathfilled"); +define_local_color_option("pathfillcolor"); + +% tensions of connection (only |nccurve|) +define_local_numeric_option("linetensionA"); +define_local_numeric_option("linetensionB"); + +% thickness for connections +define_local_numeric_option("linewidth"); + +% style for connections +define_local_string_option("linestyle"); + +% double lines: +define_local_boolean_option("doubleline"); +define_local_numeric_option("doublesep"); + + +% positions for connections +define_local_string_option("posA"); +define_local_string_option("posB"); + +% offsets for connections +define_local_pair_option("offsetA"); +define_local_pair_option("offsetB"); + +% arms for connections +define_local_numeric_option("armA"); +define_local_numeric_option("armB"); + +% names for connections +define_local_string_option("name"); + +% Label options: +define_local_numeric_option("labrotate"); +define_local_numeric_option("labangle"); +define_local_numeric_option("labpos"); +define_local_pair_option("labshift"); +% this is like the labshift option, but will use the +% |laboff| definition used by |label| +define_local_string_option("labdir"); +define_local_color_option("labcolor"); +define_local_boolean_option("laberase"); +define_local_string_option("labpoint"); +define_local_string_option("labcard"); +define_local_string_option("labpathname"); +define_local_numeric_option("labpathid"); + + +% Internal horizontal separation. +define_local_numeric_option("hsep"); + +% Internal vertical separation. +define_local_numeric_option("vsep"); + +define_local_numeric_option("hbsep"); +define_local_numeric_option("vbsep"); + +% External horizontal separation +define_local_numeric_option("dx"); + +% External vertical separation +define_local_numeric_option("dy"); + +% Rotation angle +define_local_numeric_option("rotangle"); + +% How much the start of a line is shifted right +define_local_numeric_option("lstartdx"); + +% How much the end of a line is shifted right +define_local_numeric_option("lenddx"); + +define_global_numeric_option("rule"); +define_local_numeric_option("lrsep"); +define_local_numeric_option("rrsep"); + +% Line width for draws +define_global_numeric_option("framewidth"); + +% radius for corners of rounded corners +define_global_numeric_option("rbox_radius"); + +% Circle margin +define_local_numeric_option("circmargin"); + +% Polygon margin +define_local_numeric_option("polymargin"); + +define_local_numeric_option("angle"); + +% Draw arrow function option; +% the parameter is a string representing a draw function +% We first define a conversion function: + +def arrows_function_(expr s)= + if ((substring(0,1) of s >= "A") and (substring(0,1) of s <= "Z")) or + ((substring(0,1) of s >= "a") and (substring(0,1) of s <= "z")): + s + elseif s="-": "draw" + elseif s="->": "drawarrow" + elseif s="<-": "rdrawarrow" + % other cases can easily be added here + else: "draw" % default + fi +enddef; + +define_local_string_option("arrows"); + +% This is an option to locally redefine the main drawing function +% of the object. +define_global_string_option("drawObj"); + +def global_option_(expr name)(expr s)= + global_string_option_(name)(s); +enddef; + +def global_boolean_option_(expr name)(expr s)= + global_type_option_("boolean")(name)(s); +enddef; + +def global_string_option_(expr name)(expr s)= + global_type_option_("string")(name)(s); +enddef; + +def global_numeric_option_(expr name)(expr s)= + global_type_option_("numeric")(name)(s); +enddef; + +def global_color_option_(expr name)(expr s)= + global_type_option_("color")(name)(s); +enddef; + +% This is for options that are attached to an object, +% and that are not local only to its constructor. +def global_type_option_(expr type)(expr name)(expr s)= + if not isOfType(type,currentObjname & ".option_" & name & "_"): + sc_(type) + obj(generisize_(currentObjname)).sc_("option_" & name & "_"); + fi; + if not string obj(currentObjname).options_: + expandafter string obj(generisize_(currentObjname)).options_; + fi; + if unknown obj(currentObjname).options_: + obj(currentObjname).options_="_" & name; + % we added a |_| so that the tag becomes unknown + % for we can then traverse the |options_| with a |forsuffixes| + % in |duplicateObj| + % (we should make this more robust) + else: + obj(currentObjname).options_:=obj(currentObjname).options_& ",_" & name; + fi; + obj(currentObjname).sc_("option_" & name & "_")=s; +enddef; + +% This is a general function to test options: +% |@#| is the object name. |opname| is the option name +% and |opvalue| is the option value. + +vardef Option@#(expr opname,opvalue)= + (OptionValue@#(opname)=opvalue) +enddef; + +% This function finds the value of a parameter for an object. +% An option is either stored in the object (when it is local, but meant +% to be used later, not in the constructor), +% or local in the object, but for an immediate use (i.e., it won't be +% available after the creation), or global to the class. +% In the first case, we check the variable +% |@#sc_("option_" & opname & "_")| +% (the type of the option is irrelevant here) +% In the second case, we check |sc_("o_" & opname & "_val")| +% (the type of the option is irrelevant here) +% In the third case, we check the global value +% |sc_(clname & "_" opname)| +% (the type of the option is irrelevant here) +vardef OptionValue@#(expr opname)= + (if known (@#sc_("option_" & opname & "_")): + (@#sc_("option_" & opname & "_")) + elseif known (sc_("o_" & opname & "_val")): + (sc_("o_" & opname & "_val")) + elseif known (sc_(objClassName_(@#) & "_" & opname)): + (sc_(objClassName_(@#) & "_" & opname)) + else: + whatever + fi + ) +enddef; + +% This function only looks at local options and does not +% take an object into account. It is suitable for the options +% of a draw command. Moreover, the last parameter is a default +% value. +vardef LocalOptionValue(expr opname,default)= + (if known (sc_("o_" & opname & "_val")): + (sc_("o_" & opname & "_val")) + else: + default + fi + ) +enddef; + +% Constructions such as |LocalOptionValue("posA",curve_posA_default)| +% are quite common. We therefore introduce a shortcut: +def CLOV_(expr opname)= + sc_("LocalOptionValue(" & + quote(opname) & ",curve_" & opname & "_default)") +enddef; + +% This function defines default global values for classes. +% This works for numerical, string or color values. +% |setObjectDefaultOption("HBox")("hsep")(5mm)| +def setObjectDefaultOption(expr clname)(expr var)(expr val)= + if numeric val: + sc_(clname & "_" & var):=val; + elseif string val: + sc_("string " & clname & "_" & var & ";"); + sc_(clname & "_" & var):=val; + elseif color val: + sc_("color " & clname & "_" & var & ";"); + sc_(clname & "_" & var):=val; + elseif boolean val: + sc_("boolean " & clname & "_" & var & ";"); + sc_(clname & "_" & var):=val; + fi; +enddef; + +% |clearObj a,b| makes it possible to reuse the objects |a| and |b| +% If this function is called within |beginfig|/|endfig|, it only +% clears the object until the end of the environment. +let clearObj=save; + +let showObj=showvariable; + +% n is the number of an object +def show_Obj(expr n)= + sc_("showObj " & iname_[n]); +enddef; + + +% Handling of paths in objects: + +% This function adds a point to an object's point array. +% |p| is the point and |a| is the array of object |@#|. +% This function is used when a path is attached to an object. +vardef addPointToArray@#(expr p)(suffix a)= + @#a.n_:=@#a.n_+1; + @#a[@#a.n_]:=p; + % The relative position of the point is memorized as an equation, + % so that we can conveniently reset the object later, and not loose + % the points. + addObjExtraCode@# "@#" & str a & decimal(@#a.n_) & "-@#c=(" & + decimal(xpart(p-@#c)) & "," & decimal(ypart(p-@#c)) & ");"; + if @#points_in_arrayslist_="": + @#points_in_arrayslist_:=str a & decimal(@#a.n_); + else: + @#points_in_arrayslist_:=@#points_in_arrayslist_ & "," & str a & decimal(@#a.n_); + fi; +enddef; + +def cutpathends_(expr p,a,b)= + if (a=0) and (b=0):p + else: + p cutafter (p intersectionpoint + (fullcircle scaled a shifted (point (length(p)) of p))) + cutbefore (p intersectionpoint + (fullcircle scaled b shifted (point 0 of p))) + fi +enddef; + + +% This function adds a path to an object. +% The path is |p| and the object is |@#|. +% |n| is the name of the path within the object. +% It must have been defined with |addPathArray|. +vardef addPath@#(suffix n)(expr i)(text p)= + save p_,untied;path p_;boolean untied;untied=true; + if known @#c:untied:=false;fi; + % we temporarily tie the object if necessary + if untied:@#c=origin;fi; + % only then can we store the path: + p_=p; + % Now, we slightly modify the path in order to take the |nodesepA| + % and |nodesepB| parameters into account: + p_:=cutpathends_(p_,if known o_nodesepB_val: o_nodesepB_val + else: curve_nodesepB_default fi, + if known o_nodesepA_val: o_nodesepA_val + else: curve_nodesepA_default fi); + setcurrentobjname_(str @#); + % if the |ip_| array does not yet exist, create it: + if not pair @#n.ip_1: + ObjPointArray(n.ip_)(0); + else: + % if it does already exist, we only initialize it once: + if unknown @#n.ip_.n_: + ObjPointArray(n.ip_)(0); + fi; + fi; + xpart(@#n[i])=@#n.ip_.n_+1; + % we add each point of the path |p_| to the |ip_| array: + for j:=0 upto length p_-1: + addPointToArray@#(point j of p_)(n.ip_); + addPointToArray@#(postcontrol j of p_)(n.ip_); + addPointToArray@#(precontrol (j+1) of p_)(n.ip_); + endfor; + addPointToArray@#(point (length(p_)) of p_)(n.ip_); + ypart(@#n[i])=length p_; + % if the object was initially untied, we untie it + if untied:untieObj(@#);fi; +enddef; + +% This function removes the paths from an array: +vardef deletePaths@#(suffix n)= + @#extra_code_:=""; + for i:=1 upto @#n.ip_.n_: + @#n[i]:=(whatever,whatever); + endfor; + % reset |ip_| + @#n.ip_.n_:=0; + % remove |ip_1|, ... from |points_in_arrayslist|: + save newpoints_in_arrayslist_; + string newpoints_in_arrayslist_;newpoints_in_arrayslist_:=""; + forsuffixes $:=sc_(@#points_in_arrayslist_): + if (substring(0,length(str n & ".ip_")) of (str$))<>(str n & ".ip_"): + if newpoints_in_arrayslist_="": + newpoints_in_arrayslist_:=str$; + else: + newpoints_in_arrayslist_:=newpoints_in_arrayslist_ & "," & str$; + fi; + fi; + endfor; + @#points_in_arrayslist_:=newpoints_in_arrayslist_; + message "@#points_in_arrayslist_=" & @#points_in_arrayslist_; +enddef; + +% This function defines an array of paths within an object. +% |p| is the array name, |n| the size of the array +% and |@#| is the object. +vardef addPathArray@#(suffix p)(expr n)= + setcurrentobjname_(str @#); + ObjPairArray(p)(n); +enddef; + +vardef addPathVariables@#(suffix p)= + setcurrentobjname_(str @#); + addPathArray@#(p)(0); % this is a standard array for paths added to + % an object + forsuffixes $=_draw_,_connect_,posA,posB,name,linestyle,arrows: + ObjStringArray(p$)(0); + endfor; + forsuffixes $=angleA,angleB,arcangleA,arcangleB,nodesepA,nodesepB, + loopsize,linearc,linetensionA,linetensionB,linewidth, + armA,armB,border,boxsize,boxheight,boxdepth, + doublesep,coilarmA,coilarmB,coilheight,coilwidth,coilaspect,coilinc: + ObjNumericArray(p$)(0); + endfor; + ObjBooleanArray(p.visible)(0); + ObjBooleanArray(p.pathfilled)(0); + ObjColorArray(p.pathfillcolor)(0); + ObjBooleanArray(p.doubleline)(0); + ObjPairArray(p.offsetA)(0); + ObjPairArray(p.offsetB)(0); + ObjColorArray(p.linecolor)(0); + ObjColorArray(p.bordercolor)(0); +enddef; + +def increment_pathparameters_(suffix p)(suffix $)= + $p.n_:=$p.n_+1; + $p._draw_[$p.n_]:=LocalOptionValue("cdraw","cdraw_default"); + $p.visible[$p.n_]:=CLOV_("visible"); + $p.pathfilled[$p.n_]:=CLOV_("pathfilled"); + $p.pathfillcolor[$p.n_]:=CLOV_("pathfillcolor"); + $p.border[$p.n_]:=CLOV_("border"); + $p.bordercolor[$p.n_]:=CLOV_("bordercolor"); + $p.linewidth[$p.n_]:=CLOV_("linewidth"); + $p.linecolor[$p.n_]:=CLOV_("linecolor"); + $p.nodesepA[$p.n_]:=CLOV_("nodesepA"); + $p.nodesepB[$p.n_]:=CLOV_("nodesepA"); + $p.arrows[$p.n_]:=CLOV_("arrows"); + $p.linestyle[$p.n_]:=CLOV_("linestyle"); + $p.doubleline[$p.n_]:=CLOV_("doubleline"); + forsuffixes $$=_draw_,visible,border,bordercolor,linewidth,linecolor, + arrows,linestyle,nodesepA,nodesepB,doubleline,pathfilled,pathfillcolor: + $p$$n_:=$p.n_; + endfor; +enddef; + +% This is a function simplifying the use of |addPath| +vardef addUserPath@#(text p) text options= + ExecuteOptions()(options); + if unknown @#_upath_.n_: + addPathVariables@#(_upath_); + fi; + increment_pathparameters_(_upath_)(@#); + addPath@#(_upath_,@#_upath_.n_,p); +enddef; + +vardef addStandardPath@#(text p) text options= + ExecuteOptions()(options); + if unknown @#_spath_.n_: + addPathVariables@#(_spath_); + fi; + increment_pathparameters_(_spath_)(@#); + addPath@#(_spath_,@#_spath_.n_,p); +enddef; + +def ObjPath(text p) text options= + addStandardPath.sc_(currentObjname)(p) options; +enddef; + +% The |Path| function reconstructs a path from a path |p[j]| +% and an object reference |@#|. +vardef Path@#(suffix p)(expr j)= + ( + for i:=0 upto ypart(@#p[j])-1: + @#p.ip_[xpart(@#p[j])+i*3].. + controls @#p.ip_[xpart(@#p[j])+i*3+1] and + @#p.ip_[xpart(@#p[j])+i*3+2].. + endfor + @#p.ip_[xpart(@#p[j])+ypart(@#p[j])*3] + ) +enddef; + +% The |drawMemorizedPaths_| function draws paths that have been memorized. +% It must be called explicitely in the draw function of an object. +% It uses the value of the |cdraw| option to draw the memorized path. +% This makes it possible to change the color, the style, etc. +% There are two kinds of paths attached to an object: the standard ones, +% in the |_spath_| array, and the user ones in the |_upath_| array. +% For instance, the standard paths of a tree are the connections between +% the root and the subtrees. +def drawMemorizedPaths_(suffix n)= + forsuffixes $=_spath_,_upath_: + if known n$n_: + for i:=1 upto n$n_: + % fans are not drawn here + if n$arrows[i]<>"fandraw": + if n$visible[i]: + if n$pathfilled[i]: + fill Path.n($,i)--cycle withcolor n$pathfillcolor[i]; + fi; + sc_(n$_draw_[i])(n$)(i)(Path.n($,i)); + fi; + fi; + endfor; + fi; + endfor; +enddef; + +% The following function is useful for classes which contain +% an object or a picture: +def StandardObjectOrPictureContainerSetup(expr v)= + if (picture v) or (string v): + ObjPoint p.off; + ObjPicture p; + if picture v: + setPicture(p)(v); % initialize the picture + elseif string v: + if v="": + setPicture(p)(nullpicture); + else: + % borrowed from |boxes.mp| + setPicture(p)(v infont defaultfont scaled defaultscale); + fi; + fi; + elseif numeric v: + SubObject(sub,Obj(v)); + else: + errmessage "Parameter of StandardObjectOrPictureContainerSetup should be picture, a string or an object."; + fi; + ObjNumeric a,b; + (obj(currentObjname)a,obj(currentObjname)b) = + if numeric v: % object + .5*(obj(obj(currentObjname)sub)ne-obj(obj(currentObjname)sub)sw) + elseif (picture v) or (string v): + .5*(urcorner obj(currentObjname)p - llcorner obj(currentObjname)p) + fi; +enddef; + +def drawPictureOrObject(suffix n)= + if known n.p: + if urcorner(n.p)-llcorner(n.p)<>(0,0): + drawPicture.n(p); + fi; + else: + drawObj(obj(n.sub)); + fi; +enddef; + +% Node connections: + +def patharray_suffix_= + sc_(LocalOptionValue("patharray","_upath_")) +enddef; + +def sign_(expr n)= + if n>=0:1 else:-1 fi +enddef; + +% This function is used when certain paths have to be smoothed +% |p| is the path and |r| is the radius used where a sharp edge +% is rounded. +vardef smoothen(expr p,r)= + save q,qq,anglechange;path q;pair qq[]; + hide( + if r>0: + q=point 0 of p; + for i:=1 upto length(p)-1: + qq0:=(whatever,whatever);qq1:=(whatever,whatever); + qq2:=(whatever,whatever);qq3:=(whatever,whatever); + if (point (i+1) of p=point i of p) or + (point (i-1) of p=point i of p): + anglechange:=0; + else: + anglechange:=angle(point (i+1) of p-point i of p) + -angle(point i of p-point (i-1) of p); + fi; + if anglechange>180: anglechange:=anglechange-360;fi; + if anglechange<-180: anglechange:=anglechange+360;fi; + if abs(anglechange)>1: + % first, we compute the center of the arc + qq0=whatever[point (i-1) of p,point i of p] + +r*dir(angle(point i of p-point (i-1) of p) + +sign_(anglechange)*90) + =whatever[point i of p,point (i+1) of p] + +r*dir(angle(point (i+1) of p-point i of p) + +sign_(anglechange)*90); + % |qq1| and |qq2| are the points where the arc touches + % the original curve + qq1=whatever[point (i-1) of p,point i of p] + =whatever[qq0,qq0+(point i of p-point (i-1) of p) rotated 90]; + qq2=whatever[point i of p,point (i+1) of p] + =whatever[qq0,qq0+(point (i+1) of p-point i of p) rotated 90]; + qq3=qq0+r*unitvector(qq1+qq2-2qq0); + q:=q & ((point (length(q)) of q)--qq1.. + qq3..{point (i+1) of p-point i of p}qq2); + else: + q:=q & (point (length(q)) of q--point i of p); + fi; + endfor; + q:=q & (point (length(q)) of q--point (length(p)) of p); + else: + q:=p; + fi; + ) + q +enddef; + +% Generic part in the handling of node connections. +% |vardef| can't be used +% The object is |$| (if there is no object, |$| is empty) +% |n| and |m| are either objects (if they are numerics) or points +% (if they are pairs) +def nc_(suffix $)(suffix n,m)(expr f) text options = + % this next line is actually only relevant when |$| is non-empty; + % but if it is empty, the line is harmless. + o_patharray("_upath_"); + % The first parameter is not used, because we have only local options + % (non-local options have only a meaning for object constructors) + ExecuteOptions()(options); + nc__($)(n,m)(f)(patharray_suffix_); +enddef; + +% The object is |$| +% |n| and |m| are either objects (if they are numerics) or points +% (if they are pairs) +def nc__(suffix $)(suffix n,m)(expr f)(suffix p)= + if str $ <> "": + if unknown $p.n_: + addPathVariables$(p); + fi; + $p.n_:=$p.n_+1; + % the next four lines must occur before the variables get a value, + % because we want to memorize the initial state + $p.angleA[$p.n_]:=o_angleA_val; + $p.angleB[$p.n_]:=o_angleB_val; + $p.nodesepA[$p.n_]:=o_nodesepA_val; + $p.nodesepB[$p.n_]:=o_nodesepB_val; + fi; + if unknown o_angleA_val: + save o_angleA_val;numeric o_angleA_val; + if numeric n: + o_angleA_val= + angle(m.sc_(CLOV_("posB"))-n.sc_(CLOV_("posA"))); + else: + o_angleA_val=angle(m-n); + fi; + fi; + if unknown o_angleB_val: + save o_angleB_val;numeric o_angleB_val; + if numeric n: + o_angleB_val= + angle(m.sc_(CLOV_("posB"))-n.sc_(CLOV_("posA"))); + else: + o_angleB_val=angle(m-n); + fi; + fi; + + settodefaultifnotknown_("nodesepA")(numeric)(curve_nodesepA_default); + settodefaultifnotknown_("nodesepB")(numeric)(curve_nodesepB_default); + if str $ <> "": + $p._draw_[$p.n_]:=LocalOptionValue("cdraw","cdraw_default"); + $p._connect_[$p.n_]:=f; + forsuffixes $$=posA,posB,armA,armB,loopsize,visible, + linetensionA,linetensionB, + arcangleA,arcangleB,offsetA,offsetB,linewidth,linecolor,border, + bordercolor,linestyle,arrows,boxsize,boxheight,boxdepth, + doubleline,doublesep,pathfilled,pathfillcolor: + $p$$[$p.n_]:=CLOV_(str $$); + endfor; + $p.name[$p.n_]:=LocalOptionValue("name",""); + nc_inc_$(p); + fi; +enddef; + + +% Increment the size of the option arrays +vardef nc_inc_@#(suffix p)= + forsuffixes $:=pathoptions_: + @#p$n_:=@#p$n_+1; + endfor; +enddef; + +% This is the main function that distinguishes if a curve is in +% or out of an object (that is, if it will follow the object or not), +% and if it links two objects or two points. +% (That makes four different combinations.) +% |pa| is the path connecting two objects +% |pb| is the path connecting two points +% |n| can be either an object (numeric) or a point (pair). +vardef nc_core_@#(suffix n)(suffix p)(text pa)(text pb)= + + if str @# <> "": + % we are in an object (deferred curve) + if numeric n: + addPath@#(p,@#p.n_,pa); + else: + addPath@#(p,@#p.n_,pb); + fi; + else: + % we are not in an object (immediate curve) + % we draw the curve only if it is visible: + if CLOV_("visible"): + if numeric n: + sc_(LocalOptionValue("cdraw","cdraw_default")) + ()(0) % value irrelevant, but first parameter empty + (pa); + else: + sc_(LocalOptionValue("cdraw","cdraw_default")) + ()(0) % value irrelevant, but first parameter empty + (pb); + fi; + fi; + fi; +enddef; + +% This is like |nc_core_|, but the last two parameters of +% |nc_core_| are identical. +vardef nc_core_double_@#(suffix n)(suffix p)(text pa)= + nc_core_@#(n)(p)(pa)(pa); +enddef; + +vardef ncshort_@#(expr a,b)(text n)(text m)(text options)= + if string n: + save tmp;string tmp; + tmp="(" & str @# & ")(" & nameToSuffixString_(n) & "," & + nameToSuffixString_(m) & ")"; + sc_(a & "_" & tmp)(b) options; + sc_(b & "_" & tmp)(patharray_suffix_); + else: + sc_(a & "_")(@#)(n,m)(b) options; + sc_(b & "_")(@#)(n,m)(patharray_suffix_); + fi; +enddef; + +def object_(suffix n)(expr s)= + (n.sc_(CLOV_("pos" &s))+CLOV_("offset" & s)) +enddef; + +def objectpoint_(suffix n)(expr s)= + (n+CLOV_("offset" & s)) +enddef; + +% This function is useful for matrices. It returns the object at +% a given coordinate pair in a matrix. It is used by functions such +% as |mcline|. +def matpos(suffix $)(expr p)= + obj($sb[(xpart(p)-1)*$ny+ypart(p)]) +enddef; + +let mpos=matpos; + +% This function is useful for trees. It returns the object at +% a given rank in a tree. +def treepos(suffix $)(expr n)= + obj(obj($subt).sb[n]) +enddef; + +let tpos=treepos; + +% |ntreepos| is a shorthand for embedded |treepos| calls +vardef ntreepos_(suffix O)(text l)= + save list,first,result;string list,result; + hide( + first=0;list=""; + forsuffixes $=l: + if first=0: first:=$; + else: + if list="":list:=str $; + else: + list:=list & "," & str $; + fi; + fi; + endfor; + if list="": + result="treepos(" & str O & ")(" & decimal(first) & ")"; + else: + result="ntreepos(treepos(" & str O & ")(" & decimal(first) & + "))(" & list & ")"; + fi; + ) + result +enddef; + +% we can't use a |vardef| where a suffix appears, so we split +% the |ntreepos| function in two parts. +def ntreepos(suffix O)(text l)= + scantokens(ntreepos_(O)(l)) +enddef; + +def treeroot(suffix $)(text l)= + if isTree(ntreepos($)(l)): + obj(ntreepos($)(l)root) + else: + ntreepos($)(l) + fi +enddef; + +def setupobjectfunction(suffix n)= + save f; + if numeric n: + let f=object_; + else: + let f=objectpoint_; + fi; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs) +vardef nccurve@#(text n)(text m) text options = + ncshort_@#("nc","nccurve")(n)(m)(options); +enddef; + +% ``reverse'' |nccurve| +vardef rnccurve@#(text n)(text m) text options = + ncshort_@#("nc","nccurve")(m)(n)(options); +enddef; + +vardef nccurve_(suffix $)(suffix n,m)(suffix p)= + nc_core_$(n)(p) + (object_(n)("A"){dir(o_angleA_val)} + ..tension CLOV_("linetensionA") and CLOV_("linetensionB") + ..{dir(o_angleB_val)}object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m)) + (objectpoint_(n)("A"){dir(o_angleA_val)} + ..tension CLOV_("linetensionA") and CLOV_("linetensionB") + ..{dir(o_angleB_val)}objectpoint_(m)("B")); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mccurve@#(expr ai,aj,bi,bj) text options= + nccurve@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tccurve@#(text ai)(text bi) text options= + nccurve@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs) +vardef ncline@#(text n)(text m) text options = + ncshort_@#("nc","ncline")(n)(m)(options); +enddef; + +% ``reverse'' |ncline| +vardef rncline@#(text n)(text m) text options = + ncshort_@#("nc","ncline")(m)(n)(options); +enddef; + +vardef ncline_(suffix $)(suffix n,m)(suffix p)= + nc_core_$(n)(p) + (object_(n)("A")..object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m)) + (objectpoint_(n)("A")..objectpoint_(m)("B")); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcline@#(expr ai,aj,bi,bj) text options= + ncline@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcline@#(text ai)(text bi) text options= + ncline@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs) +vardef ncarc@#(text n)(text m) text options = + ncshort_@#("nc","ncarc")(n)(m)(options); +enddef; + +% ``reverse'' |ncarc| +vardef rncarc@#(text n)(text m) text options = + ncshort_@#("nc","ncarc")(m)(n)(options); +enddef; + +vardef ncarc_(suffix $)(suffix n,m)(suffix p)= + nc_core_$(n)(p) + (object_(n)("A"){dir(o_angleA_val+CLOV_("arcangleA"))} + ..{dir(o_angleB_val-CLOV_("arcangleB"))}object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m)) + (objectpoint_(n)("A"){dir(o_angleA_val+CLOV_("arcangleA"))} + ..{dir(o_angleB_val-CLOV_("arcangleB"))}objectpoint_(m)("B")); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcarc@#(expr ai,aj,bi,bj) text options= + ncarc@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcarc@#(text ai)(text bi) text options= + ncarc@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncangle@#(text n)(text m) text options = + ncshort_@#("nc","ncangle")(n)(m)(options); +enddef; + +% ``reverse'' |ncangle| +vardef rncangle@#(text n)(text m) text options = + ncshort_@#("nc","ncangle")(m)(n)(options); +enddef; + +vardef ncangle_(suffix $)(suffix n,m)(suffix p)= + % we have to find two additional points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap;pair ap[]; + setupobjectfunction(n); + f(m)("B")-ap1=CLOV_("armB")*dir(CLOV_("angleB")); + ap2=f(n)("A")+whatever*dir(CLOV_("angleA")); + ap1=ap2+whatever*dir(CLOV_("angleA")+90); + nc_core_$(n)(p) + (smoothen(object_(n)("A")--ap2--ap1--object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc"))) + (smoothen(objectpoint_(n)("A")--ap2--ap1--objectpoint_(m)("B")) + (CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcangle@#(expr ai,aj,bi,bj) text options= + ncangle@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcangle@#(text ai)(text bi) text options= + ncangle@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncangles@#(text n)(text m) text options = + ncshort_@#("nc","ncangles")(n)(m)(options); +enddef; + +% ``reverse'' |ncangles| +vardef rncangles@#(text n)(text m) text options = + ncshort_@#("nc","ncangles")(m)(n)(options); +enddef; + +vardef ncangles_(suffix $)(suffix n,m)(suffix p)= + % we have to find additional points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap;pair ap[]; + setupobjectfunction(n); + ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA")); + f(m)("B")-ap2=CLOV_("armB")*dir(CLOV_("angleB")); + ap3=ap1+whatever*dir(CLOV_("angleA")+90); + ap2=ap3+whatever*dir(CLOV_("angleA")); + nc_core_$(n)(p) + (smoothen(object_(n)("A")--ap1--ap3--ap2--object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc"))) + (smoothen(objectpoint_(n)("A")--ap1--ap3--ap2--objectpoint_(m)("B")) + (CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcangles@#(expr ai,aj,bi,bj) text options= + ncangles@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcangles@#(text ai)(text bi) text options= + ncangles@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncdiag@#(text n)(text m) text options = + ncshort_@#("nc","ncdiag")(n)(m)(options); +enddef; + +% ``reverse'' |ncdiag| +vardef rncdiag@#(text n)(text m) text options = + ncshort_@#("nc","ncdiag")(m)(n)(options); +enddef; + +vardef ncdiag_(suffix $)(suffix n,m)(suffix p)= + % we have to find two additional points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap;pair ap[]; + setupobjectfunction(n); + ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA")); + f(m)("B")-ap2=CLOV_("armB")*dir(CLOV_("angleB")); + nc_core_$(n)(p) + (smoothen(object_(n)("A")--ap1--ap2--object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc"))) + (smoothen(objectpoint_(n)("A")--ap1--ap2--objectpoint_(m)("B")) + (CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcdiag@#(expr ai,aj,bi,bj) text options= + ncdiag@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcdiag@#(text ai)(text bi) text options= + ncdiag@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncdiagg@#(text n)(text m) text options = + ncshort_@#("nc","ncdiagg")(n)(m)(options); +enddef; + +% ``reverse'' |ncdiagg| +vardef rncdiagg@#(text n)(text m) text options = + ncshort_@#("nc","ncdiagg")(m)(n)(options); +enddef; + +vardef ncdiagg_(suffix $)(suffix n,m)(suffix p)= + % we have to find an additional point; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap;pair ap; + setupobjectfunction(n); + ap-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA")); + nc_core_$(n)(p) + (smoothen(object_(n)("A")--ap--object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc"))) + (smoothen(objectpoint_(n)("A")--ap--objectpoint_(m)("B")) + (CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcdiagg@#(expr ai,aj,bi,bj) text options= + ncdiagg@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcdiagg@#(text ai)(text bi) text options= + ncdiagg@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncbar@#(text n)(text m) text options = + ncshort_@#("nc","ncbar")(n)(m)(options); +enddef; + +% ``reverse'' |ncbar| +vardef rncbar@#(text n)(text m) text options = + ncshort_@#("nc","ncbar")(m)(n)(options); +enddef; + +vardef ncbar_(suffix $)(suffix n,m)(suffix p)= + % we have to find additional points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap,posap;pair ap[];numeric posap; + setupobjectfunction(n); + % we use different arms, but the same angles (see PSTricks documentation): + ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA")); + ap2-f(m)("B")=CLOV_("armB")*dir(CLOV_("angleA")); + ap3=posap[f(n)("A"),ap1]=whatever[ap2,ap2+(ap2-f(m)("B")) rotated 90]; + ap4=whatever[f(m)("B"),ap2]=whatever[ap1,ap1+(ap1-f(n)("A")) rotated 90]; + if posap<1: + ap5=ap1;ap6=ap4; + else: + ap5=ap3;ap6=ap2; + fi; + nc_core_$(n)(p) + (smoothen(object_(n)("A")--ap5--ap6--object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc"))) + (smoothen(objectpoint_(n)("A")--ap5--ap6--objectpoint_(m)("B")) + (CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcbar@#(expr ai,aj,bi,bj) text options= + ncbar@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcbar@#(text ai)(text bi) text options= + ncbar@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncloop@#(text n)(text m) text options = + ncshort_@#("nc","ncloop")(n)(m)(options); +enddef; + +% ``reverse'' |ncloop| +vardef rncloop@#(text n)(text m) text options = + ncshort_@#("nc","ncloop")(m)(n)(options); +enddef; + +vardef ncloop_(suffix $)(suffix n,m)(suffix p)= + % we have to find additionnal points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap,posap;pair ap[];numeric posap; + setupobjectfunction(n); + ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA")); + f(m)("B")-ap2=CLOV_("armB")*dir(CLOV_("angleB")); + ap3-ap1=CLOV_("loopsize")*unitvector((ap1-f(n)("A")) rotated 90); + ap4=whatever[ap3,ap3+(ap2-f(m)("B"))] + =whatever[ap2,ap2+(ap2-f(m)("B")) rotated 90]; + nc_core_$(n)(p) + (smoothen(object_(n)("A")--ap1--ap3--ap4--ap2--object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc"))) + (smoothen(objectpoint_(n)("A")--ap1--ap3--ap4--ap2--objectpoint_(m)("B")) + (CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcloop@#(expr ai,aj,bi,bj) text options= + ncloop@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcloop@#(text ai)(text bi) text options= + ncloop@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |firstpart| returns the time elapsed between the beginning of |p| +% and the point where the distance to the origin (on |p|) is |d| + +def firstpart_(expr d,p)= + arctime(d/arclength(p),p) +enddef; + +% Cut a path |p| in pieces of approximate arclength |d| +% (this is actually a macro I wrote in April 1995) +vardef divide_equally_(expr p,d)= + save a,q,v; + numeric a; + path q,v; + hide( + v=p; + q=point 0 of v; + forever: + a:=firstpart_(d,v); + q:=q{direction 0 of v}..{direction a of v}(point a of v); + exitif abs(a-length(v))<.1mm; + v:=subpath(a,length(v)) of v; + endfor; + ) + q +enddef; + +vardef zigzagit__(expr p)= + save n,q,r,zz;path q,r;pair zz[]; + hide( + n=floor(arclength(p)/(CLOV_("coilwidth")*CLOV_("coilheight"))+0.5); + % we now divide |p| in |n| pieces + q=divide_equally_(p,arclength(p)/n); + % here, we must now introduce additional points + for i:=0 upto length(q)-1: + zz[i*3]=point i of q; + zz[i*3+1]=.25[point i of q,point (i+1) of q] + +CLOV_("coilwidth")/2 + *(unitvector((point (i+1) of q)-(point i of q)) rotated 90); + zz[i*3+2]=.75[point i of q,point (i+1) of q] + +CLOV_("coilwidth")/2 + *(unitvector(point (i+1) of q-point i of q) rotated -90); + endfor; + zz[length(q)*3]=point (length(q)) of q; + % when joining the points, we must take care not to introduce + % additional angles, in case |p| was not a straight line + r=zz[0]--zz[1] for i:=1 upto length(q)-1: -- zz[3*i-1]--zz[3*i+1] endfor + --zz[3*(length(q)-1)+2]--zz[3*length(q)]; + ) + r +enddef; + +% coil function +def coilf_(expr q,i)= + ( + if i>0: + (arcpoint (i/n,q) + +((.5CLOV_("coilwidth") + *(sind(frac(i)*360), + 2*newcoilheight*i + +cosd(frac(i)*360)*sind(CLOV_("coilaspect")))) + -(0,.5CLOV_("coilwidth")*sind(CLOV_("coilaspect"))+(i/n)*arclength(q))) + rotated (angle(arcdirection (i/n,q))-90) + ) + else: + (arcpoint (0,q) + +((.5CLOV_("coilwidth") + *(0,sind(CLOV_("coilaspect")))) + -(0,.5CLOV_("coilwidth")*sind(CLOV_("coilaspect")))) + rotated (angle(arcdirection (0,q))-90) + ) + fi + ) +enddef; + +vardef coilit__(expr p)= + save n,q,newcoilheight;path q; + hide( + n=round(arclength(p)/(CLOV_("coilheight")*CLOV_("coilwidth"))); + % we slightly change the coilheight so that the coil + % turns an integer number of times + if n>0: + newcoilheight=arclength(p)/n/CLOV_("coilwidth"); + fi; + q=coilf_(p,0) + for i:=1 upto n*(360/CLOV_("coilinc")): + ..coilf_(p,i*(CLOV_("coilinc")/360)) + endfor; + ) + q +enddef; + +% This function takes two paths where the last point +% of the first path is the first point of the second path; +% it creates a path looking like |p--q|, but where the +% common point is not duplicated. +def combinepaths_(expr p,q)= + ((subpath(0,length(p)-1) of p).. + controls (postcontrol (length(p)-1) of p) and + (precontrol length(p) of p) ..q) +enddef; + +vardef zigcoil_(expr type,p)= + save na,nb; + hide( + % first, we cut two ends at lengths |coilarmA| and |coilarmB| + na=firstpart_(CLOV_("coilarmA"),p); + nb=firstpart_(CLOV_("coilarmB"),reverse p); + ) + % we merge three paths, but we take care that no double points are added; + % the double points would make it difficult to smooth the curve afterwards + combinepaths_( + combinepaths_(subpath (0,na) of p, + scantokens(type)(subpath (na,length(p)-nb) of p)), + subpath (length(p)-nb,length(p)) of p) +enddef; + +vardef zigzagit(expr p)= + zigcoil_("zigzagit__",p) +enddef; + +vardef coilit(expr p)= + zigcoil_("coilit__",p) +enddef; + +def frac(expr i)= + (i-floor(i)) +enddef; + +% function giving the time with respect to arclength: +% arctime 0 of p=beginning +% arctime 1 of p=end +% +vardef arctime(expr i,p)= + save t; + hide( + if i=0: t=0; + elseif i=1: t=length(p); + else: + save d,min,max; + d=i*arclength(p); + min=0;max=length(p); + forever: + t:=(min+max)/2; + if arclength(subpath(0,t) of p)<d: + min:=t; + else: + max:=t; + fi; + exitif arclength(subpath(min,max) of p)<.1mm; + endfor; + fi; + ) + t +enddef; + +def arcpoint(expr i,p)= + (point arctime(i,p) of p) +enddef; + +def arcdirection(expr i,p)= + (direction arctime(i,p) of p) +enddef; + + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef nccoil@#(text n)(text m) text options = + ncshort_@#("nc","nccoil")(n)(m)(options); +enddef; + +% ``reverse'' |nccoil| +vardef rnccoil@#(text n)(text m) text options = + ncshort_@#("nc","nccoil")(m)(n)(options); +enddef; + +vardef nccoil_(suffix $)(suffix n,m)(suffix p)= + setupobjectfunction(n); + nc_core_$(n)(p) + (coilit(object_(n)("A"){dir(o_angleA_val)} + ..tension CLOV_("linetensionA") and CLOV_("linetensionB") + ..{dir(o_angleB_val)}object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m))) + (coilit(objectpoint_(n)("A"){dir(o_angleA_val)} + ..tension CLOV_("linetensionA") and CLOV_("linetensionB") + ..{dir(o_angleB_val)}objectpoint_(m)("B"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mccoil@#(expr ai,aj,bi,bj) text options= + nccoil@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tccoil@#(text ai)(text bi) text options= + nccoil@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef nczigzag@#(text n)(text m) text options = + ncshort_@#("nc","nczigzag")(n)(m)(options); +enddef; + +% ``reverse'' |nczigzag| +vardef rnczigzag@#(text n)(text m) text options = + ncshort_@#("nc","nczigzag")(m)(n)(options); +enddef; + +vardef nczigzag_(suffix $)(suffix n,m)(suffix p)= + setupobjectfunction(n); + nc_core_$(n)(p) + (smoothen(zigzagit(object_(n)("A"){dir(o_angleA_val)} + ..tension CLOV_("linetensionA") and CLOV_("linetensionB") + ..{dir(o_angleB_val)}object_(m)("B") + cutbefore BpathObj(n) cutafter BpathObj(m)))(CLOV_("linearc"))) + (smoothen(zigzagit(objectpoint_(n)("A"){dir(o_angleA_val)} + ..tension CLOV_("linetensionA") and CLOV_("linetensionB") + ..{dir(o_angleB_val)}objectpoint_(m)("B")))(CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mczigzag@#(expr ai,aj,bi,bj) text options= + nczigzag@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tczigzag@#(text ai)(text bi) text options= + nczigzag@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncbox@#(text n)(text m) text options = + ncshort_@#("nc","ncbox")(n)(m)("arrows(draw)",options); +enddef; + +% ``reverse'' |ncbox| +vardef rncbox@#(text n)(text m) text options = + ncshort_@#("nc","ncbox")(m)(n)("arrows(draw)",options); +enddef; + +% Compute the |boxheight| parameter +def compute_boxh(expr boxs,boxh,boxd)= + if boxh>=0: boxh + elseif boxd>=0: (2*boxs-boxd) % boxsize is half the width, + % according to PSTricks' documentation + else: boxs + fi +enddef; + +% Compute the |boxdepth| parameter +def compute_boxd(expr boxs,boxh,boxd)= + if boxd>=0: boxd + elseif boxh>=0: (2*boxs-boxh) % boxsize is half the width, + % according to PSTricks' documentation + else: boxs + fi +enddef; + +vardef ncbox_(suffix $)(suffix n,m)(suffix p)= + % we have to find additional points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap,boxh,boxd;pair ap[]; + setupobjectfunction(n); + boxh=compute_boxh(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth")); + boxd=compute_boxd(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth")); + f(n)("A")-ap1=CLOV_("nodesepA")*unitvector(f(m)("B")-f(n)("A")); + ap5-ap1=boxh*unitvector(dir(90+angle(f(m)("B")-f(n)("A")))); + ap1-ap2=boxd*unitvector(dir(90+angle(f(m)("B")-f(n)("A")))); + ap4-ap3=ap5-ap2; + ap4-ap5=(CLOV_("nodesepA") + +CLOV_("nodesepB") + +arclength(f(n)("A")--f(m)("B")))*unitvector(f(m)("B")-f(n)("A")); + % we set nodesepA and nodesepB to 0 because they are used with another + % meaning in |addPath| (I am just following what PSTricks does.) + o_nodesepA_val:=0; + o_nodesepB_val:=0; + nc_core_double_$(n)(p) + (smoothen(ap1--ap2--ap3--ap4--ap5--ap1)(CLOV_("linearc"))); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcbox@#(expr ai,aj,bi,bj) text options= + ncbox@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcbox@#(text ai)(text bi) text options= + ncbox@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source subobject, |m| is the target. +% We also distinguish the case when |n| and |m| are objects +% and when they are points (numerics vs pairs). +vardef ncarcbox@#(text n)(text m) text options = + ncshort_@#("nc","ncarcbox")(n)(m)("arrows(draw)",options); +enddef; + +% ``reverse'' |ncarcbox| +vardef rncarcbox@#(text n)(text m) text options = + ncshort_@#("nc","ncarcbox")(m)(n)("arrows(draw)",options); +enddef; + +vardef ncarcbox_(suffix $)(suffix n,m)(suffix p)= + % we have to find additional points; we must be careful + % not to use assignments, because |n.c| and |m.c| + % may be floating: + save ap,boxh,boxd;pair ap[]; + setupobjectfunction(n); + boxh=compute_boxh(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth")); + boxd=compute_boxd(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth")); + ap20=unitvector(dir(90+angle(f(m)("B")-f(n)("A"))+CLOV_("arcangleA"))); + ap21=-ap24=ap20 rotated -90; + ap22=-ap25=ap21 rotated (-2*CLOV_("arcangleA")); + ap23=ap20 rotated (-2*CLOV_("arcangleA")); + ap1-f(n)("A")=boxh*ap20; + f(n)("A")-ap2=boxd*ap20; + ap5-f(m)("B")=boxh*ap23; + f(m)("B")-ap4=boxd*ap23; + ap1-ap11=ap2-ap12=ap21*CLOV_("nodesepA"); + ap15-ap5=ap14-ap4=ap22*CLOV_("nodesepB"); + if CLOV_("arcangleA")=0: + % normally, one would use |ncbox| instead of |ncarcbox| in this case, + % but we make sure it works anyway + ap6=.5[ap1,ap5]; + ap3=.5[ap2,ap4]; + else: + if abs(CLOV_("arcangleA"))=90: + ap0=.5[ap1,ap5]; + else: + ap0=whatever[ap1,ap2]=whatever[ap5,ap4]; + fi; + ap6-ap0=(ap1-ap0) rotated (.5*(angle(ap5-ap0)-angle(ap1-ap0))); + ap3-ap0=(ap2-ap0) rotated (.5*(angle(ap5-ap0)-angle(ap1-ap0))); + fi; + % we set nodesepA and nodesepB to 0 because they are used with another + % meaning in |addPath| (I am just following what PSTricks does.) + o_nodesepA_val:=0; + o_nodesepB_val:=0; + nc_core_double_$(n)(p) + (ap11{ap21}..ap1{ap21}..ap6..{ap22}ap5..ap15{ap22}..{ap25}ap14.. + {ap25}ap4..ap3..{ap24}ap2{ap24}..{ap24}ap12..{ap21}ap11); +enddef; + +% variant for matrices: +% We connect two nodes of the matrix |@#|. +% This cannot be used to connect nodes that are not in the same +% matrix. It is simpler to name the nodes in order to achieve +% trans-connections. +vardef mcarcbox@#(expr ai,aj,bi,bj) text options= + ncarcbox@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options; +enddef; + +% variant for trees: +% We connect two nodes of the tree |@#|. +% This cannot be used to connect nodes that are not in the same tree. +% It is simpler to name the nodes in order to achieve trans-connections. +vardef tcarcbox@#(text ai)(text bi) text options= + ncarcbox@#(ntreepos(@#)(ai))(ntreepos(@#)(bi)) options; +enddef; + +% |@#| is the object to which a line is added +% |n| is the source and target subobject +% we could also distinguish the case when |n| is an object +% and when it is a point (numerics vs pairs) +vardef nccircle@#(text n) text options = + o_patharray("_upath_"); + % The first parameter is not relevant since we have only local options + ExecuteOptions()(options); + if string n: + save tmp;string tmp; + tmp="(" & str @# & ")(" & nameToSuffixString_(n) & ")"; + sc_("nccircle_" & tmp)(patharray_suffix_); + else: + nccircle_(@#)(n)(patharray_suffix_); + fi; +enddef; + +% |n| is either an object (if numeric) or a point (if it is a pair) +vardef nccircle_(suffix $)(suffix n)(suffix p)= + if str $<>"": + if unknown $p.n_: + addPathVariables$(p); + fi; + fi; + settodefaultifnotknown_("angleA")(numeric)(0); + settodefaultifnotknown_("linewidth")(numeric)(curve_linewidth_default); + settodefaultifnotknown_("nodesepA")(numeric)(0); + settodefaultifnotknown_("nodesepB")(numeric)(0); + if str $ <>"": + $p.n_:=$p.n_+1; + $p._draw_[$p.n_]:=LocalOptionValue("cdraw","cdraw_default"); + $p.name[$p.n_]:=LocalOptionValue("name",""); + $p._connect_[$p.n_]:="nccircle"; + $p.arrows[$p.n_]:=CLOV_("arrows"); + $p.visible[$p.n_]:=CLOV_("visible"); + $p.pathfilled[$p.n_]:=false; + $p.pathfillcolor[$p.n_]:=black; + $p.angleA[$p.n_]:=o_angleA_val; + $p.angleB[$p.n_]:=o_angleB_val; + $p.linewidth[$p.n_]:=o_linewidth_val; + $p.nodesepA[$p.n_]:=o_nodesepA_val; + $p.nodesepB[$p.n_]:=o_nodesepB_val; + nc_inc_$(p); + fi; + + % we have to find one additional point; we must be careful + % not to use assignments, because |n.c| may be floating: + save ap;pair ap; + if numeric n: + ap=n.c+2cm*dir(90+o_angleA_val); % 2cm should be a parameter + else: + ap=n+2cm*dir(90+o_angleA_val); % 2cm should be a parameter + fi; + nc_core_$(n)(p) + (n.c{dir(o_angleA_val)}..ap..n.c + cutbefore BpathObj(n) cutafter BpathObj(n)) + (n{dir(o_angleA_val)}..ap..n); +enddef; + +% variant for matrices: +vardef mccircle@#(expr ai,aj) text options= + nccircle@#(matpos(@#)((ai,aj))) options; +enddef; + +%==================================================================== +% Labels + +% Labels are pictures. We use an internal array |ipic_| in order +% to store the labels that are not the standard labels (such +% as the contents of a circle, etc.) + +% This should be common to all labels +def objlabel_(suffix $)(expr p) text options = + ExecuteOptions($)(options); + if unknown $ipic_1: + ObjPictureArray(ipic_)(0); + ObjPointArray(ipic_.off_)(0); + ObjTransformArray(ipic_.transf_)(0); + ObjColorArray(ipic_.col_)(0); + ObjBooleanArray(ipic_.erase_)(0); + fi; + $ipic_.n_:=$ipic_.n_+1; + % we give default values to the options, in case they don't have any + settodefaultifnotknown_("labrotate")(numeric)(0); + settodefaultifnotknown_("labpos")(numeric)(0.5); + settodefaultifnotknown_("labcolor")(color)(black); + settodefaultifnotknown_("labpoint")(string)("ic"); + settodefaultifnotknown_("laberase")(boolean)(false); + % picture: + $ipic_[$ipic_.n_]=p; + $ipic_[$ipic_.n_]:=$ipic_[$ipic_.n_] + shifted -.5[urcorner(p),llcorner(p)] rotated o_labrotate_val; + % transformation + $ipic_.transf_.n_:=$ipic_.transf_.n_+1; + $ipic_.transf_[$ipic_.transf_.n_]=identity; + % we also store the color: + $ipic_.col_.n_:=$ipic_.col_.n_+1; + $ipic_.col_[$ipic_.col_.n_]=o_labcolor_val; + $ipic_.erase_.n_:=$ipic_.erase_.n_+1; + $ipic_.erase_[$ipic_.erase_.n_]=o_laberase_val; +enddef; + +% This is used in |ObjLabel| +% the shift uses values defined in |plain.mp| +% (labeloffset, laboff, etc.); see the code for |thelabel|. +def labshift_(suffix $)= + (2 % 2 instead of 1 in the original code + *labeloffset*laboff.sc_(o_labdir_val) + - + (labxf.sc_(o_labdir_val)*(lrcorner $ipic_[$ipic_.off_.n_]) + + labyf.sc_(o_labdir_val)*(ulcorner $ipic_[$ipic_.off_.n_]) + + (1-labxf.sc_(o_labdir_val)-labyf.sc_(o_labdir_val)) + *(llcorner $ipic_[$ipic_.off_.n_]) + ) + ) +enddef; + +% not used +def opposite_(expr c)= + if c="n": "s" + elseif c="s": "n" + elseif c="e": "w" + elseif c="w": "e" + elseif c="ne": "sw" + elseif c="nw": "se" + elseif c="sw": "ne" + else: "nw" + fi +enddef; + +% +def cardtodir_(expr c)= + if c="n": "top" + elseif c="s": "bot" + elseif c="e": "rt" + elseif c="w": "lft" + elseif c="ne": "urt" + elseif c="nw": "ulft" + elseif c="sw": "llft" + else: "lrt" + fi +enddef; + +% This adds the picture |p| on point |a| of object |@#|. +% Two options are recognized: |labshift| and |labrotate|. +vardef ObjLabel@#(expr p) text options = + objlabel_(@#)(p) options; + % offset: + addPointToPointArray@#(ipic_.off_); + save tmpoff;pair tmpoff; + if unknown o_labpathname_val and unknown o_labpathid_val: + if unknown o_labcard_val: + settodefaultifnotknown_("labshift")(pair)((0,0)); + tmpoff=@#sc_(o_labpoint_val)+o_labshift_val; + else: + % The |labcard| option is handled like the |labdir| option, + % but from the |labcard| point of the object. For instance, + % |labcard(s)| will be handled like a |labdir(bot)| on point |s| + % of the object. We use |cardtodir_| to transform a cardinal point + % into a direction. + settodefaultifnotknown_("labdir")(string)(cardtodir_(o_labcard_val)); + tmpoff=@#sc_(o_labcard_val); + fi; + else: + tmpoff=objpathlabel_(@#); + if known o_labangle_val: + @#ipic_[@#ipic_.n_]:=@#ipic_[@#ipic_.n_] rotated o_labangle_val; + fi; + fi; + if known o_labdir_val: + @#ipic_.off_[@#ipic_.off_.n_]=tmpoff+labshift_(@#); + else: + @#ipic_.off_[@#ipic_.off_.n_]=tmpoff; + fi; +enddef; + +% This function places a label at a place +% that is the value of the expression |t|. +vardef ObjComputedLabel@#(expr p)(text t) text options = + objlabel_(@#)(p) options; + % offset: + addPointToPointArray@#(ipic_.off_); + @#ipic_.off_[@#ipic_.off_.n_]=t; +enddef; + +% |pathid| is a path index in the standard or user path arrays. +% We distinguish the two cases with the sign of |pathid|. +% The |labpos| option will be the parameter of the path. +vardef objpathlabel_(suffix $)= + save pathn,tmpoff;numeric pathn;pair tmpoff; + hide( + if known o_labpathid_val: pathn=o_labpathid_val; + else: + % we search in the path arrays for a path of that name; + % this will give us its index: + forsuffixes $$=_upath_,_spath_: + if known $.$$n_: + for i:=1 upto $.$$n_: + if $.$$name[i]=o_labpathname_val: + if str $$="_upath_": + pathn=-i; + else: + pathn=i; + fi; + fi; + exitif $.$$name[i]=o_labpathname_val; + endfor; + fi; + endfor; + fi; + save untied;boolean untied;untied=true; + if known $c:untied:=false;fi; + % we temporarily tie the object if necessary + if untied:$c=origin;fi; + if pathn>0: + tmpoff=point (o_labpos_val*length(Path$(_spath_,pathn))) + of Path$(_spath_,pathn); + if known o_labangle_val: + o_labangle_val:=o_labangle_val + +angle(direction (o_labpos_val*length(Path$(_spath_,pathn))) + of Path$(_spath_,pathn)); + fi; + else: + tmpoff=point (o_labpos_val*length(Path$(_upath_,-pathn))) + of Path$(_upath_,-pathn); + if known o_labangle_val: + o_labangle_val:=o_labangle_val + +angle(direction (o_labpos_val*length(Path$(_upath_,-pathn))) + of Path$(_upath_,-pathn)); + fi; + fi; + % if the object was initially untied, we untie it + if untied:untieObj($);fi; + ) tmpoff +enddef; + +% Draw the non-standard labels of object |@#|: +vardef drawLabels@#= + if known @#ipic_.n_: + for i:=1 upto @#ipic_.n_: + if @#ipic_.erase_[i]: + unfill bbox(@#ipic_[i] transformed @#ipic_.transf_[i] + shifted @#ipic_.off_[i]); + fi; + draw @#ipic_[i] transformed @#ipic_.transf_[i] shifted @#ipic_.off_[i] + withcolor @#ipic_.col_[i]; + endfor; + fi; +enddef; + +%==================================================================== +% Line styles + +% This is adapted from the definition of |double| in |feynmp.mp|: +def draw_double(expr p)(expr sep)(expr lwidth) text s = + save oldpen; + pen oldpen; + oldpen := currentpen; + pickup pencircle scaled (2lwidth+sep); + % we use |cutdraw|, otherwise the ends are closed because + % |undraw| will only remove some inner part + cutdraw(p) s; + pickup pencircle scaled sep; + undraw p; + pickup oldpen; +enddef; + +def drawarrow_double(expr p)(expr sep)(expr lwidth) text s = + save oldpen; + pen oldpen; + oldpen := currentpen; + pickup pencircle scaled (2lwidth+sep); + drawarrow(p) s; + pickup pencircle scaled sep; + undraw p; + pickup oldpen; +enddef; + +def rdrawarrow_double(expr p)(expr sep)(expr lwidth) text s = + drawarrow_double(reverse p)(sep)(lwidth) s; +enddef; + +%==================================================================== +% Trees + +% A tree can be thought of as a root and a (possibly empty) list of subtrees. +% One could think of creating an object for the root and putting +% subobjects for all subtrees. However, doing so is not a good thing, +% because one has at the same place the shape of the root and +% the links to subtrees. So, if one wants to change the shape of +% the root (and possibly other nodes), one has either +% - to make a copy of the function defining the object +% and to change the shape (points, equations, paths), or +% - to make a copy of another function defining the desired shape +% and add what is relevant to subtrees +% But, there is a better way: one can define a generic ``tree node'' +% object, having not only the usual subtrees as its subobjects, +% but also the root. Then, changing the shape of the root becomes +% independent of the rest of tree (assuming the interface conventions +% are respected, of course). The tree node object can even be +% parameterized more, for instance by a function deciding the layout +% of the subtrees (packed or not, considering only the bounding box, +% or looking inside, etc.) + +% Tree: Generic Trees +% |@#| is a name for an object (must be a suffix) +% |@#| will be the number of the object, but will also be used +% as a prefix for other variables. +vardef newTree@#(suffix theroot)(text subtrees) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"Tree"); + StandardInterface; + save n,eq;numeric n;string eq; + n=0; + forsuffixes $:=subtrees:n:=n+1;endfor; + ObjNumeric nst; + setNumeric(nst)(n); + % The |_spath_| variables are for connections + % between the root and the subtrees + addPathVariables@#(_spath_); + SubObject(subt,obj(newobjstring_)); + if Option@#("treemode","L"): + % We put the subtrees in an |VBox| object + % and we use this non-documented construction to pass an option, + % because we can't pass the option the usual way, at least not simply: + begingroup; + o_flip(OptionValue@#("treeflip")); + o_align(OptionValue@#("Lalign")); + o_vbsep(OptionValue@#("vbsep")); + o_elementsize(OptionValue@#("treenodevsize")); + newVBox.obj(@#subt)(subtrees); + endgroup; + elseif Option@#("treemode","R"): + % We put the subtrees in an |VBox| object: + begingroup; + o_flip(OptionValue@#("treeflip")); + o_align(OptionValue@#("Ralign")); + o_vbsep(OptionValue@#("vbsep")); + o_elementsize(OptionValue@#("treenodevsize")); + newVBox.obj(@#subt)(subtrees); + endgroup; + elseif Option@#("treemode","U"): + % We put the subtrees in an |HBox| object: + begingroup; + o_flip(OptionValue@#("treeflip")); + o_align(OptionValue@#("Ualign")); + o_hbsep(OptionValue@#("hbsep")); + o_elementsize(OptionValue@#("treenodehsize")); + newHBox.obj(@#subt)(subtrees); + endgroup; + else: % default case + % We put the subtrees in an |HBox| object: + begingroup; + o_flip(OptionValue@#("treeflip")); + o_align(OptionValue@#("Dalign")); + o_hbsep(OptionValue@#("hbsep")); + o_elementsize(OptionValue@#("treenodehsize")); + newHBox.obj(@#subt)(subtrees); + endgroup; + fi; + + % The root is also a subobject: + SubObject(root,theroot); + % we now build the equations: + % CURRENTLY, WE ASSUME THAT THE SUBTREES ARE LARGER THAN THE ROOT, + % BUT IT SHOULD BE MADE MORE GENERAL + % (right now, nothing here depends on the width of the root) + % (the tree can still be built, but it can happen that the root + % protrudes) + % 1 horizontal equation: the root is in the middle of the tree + % |xpart(root.c)=xpart(subt.c)| + % 2 horizontal equation: horizontal space at the edges + % |xpart(subt.w-@#w)=xpart(@#e-subt.e)=0mm;| + % 3 vertical equation: vertical distance between root and subtrees + % |ypart(root.s-subt.n)=1cm;| + % 4 vertical equation: vertical space at the top + % |ypart(@#n-root.n)=0mm;| + % 5 vertical equation: vertical space at the bottom + % |ypart(subt.s-@#s)=0mm;| + if Option@#("treemode","L") or Option@#("treemode","R"): + % 1: |ypart(root.c)=ypart(subt.c)| + eq:="ypart(obj(@#root).c)=ypart(obj(@#subt).c);"; + % 2: |ypart(subt.s-@#s)=ypart(@#n-subt.n)=5mm;| + eq:=eq & "ypart(obj(@#subt).s-@#s)=ypart(@#n-obj(@#subt).n)=" & + decimal (OptionValue@#("dy")) & ";"; + if Option@#("treemode","L"): + % 3: |xpart(root.w-subt.e)=1cm;| + if OptionValue@#("treenodehsize")>0: + eq:=eq & "xpart(obj(@#root).e-obj(@#subt).e)=" & + decimal + (OptionValue@#("hsep")+OptionValue@#("treenodehsize")) & ";"; + else: + eq:=eq & "xpart(obj(@#root).w-obj(@#subt).e)=" & + decimal (OptionValue@#("hsep")) & ";"; + fi; + % 4: |xpart(@#e-root.e)=0mm;| + eq:=eq & "xpart(@#e-obj(@#root).e)=" & + decimal (OptionValue@#("dx")) & ";"; + % 5: |xpart(subt.w-@#w)=0mm;| + eq:=eq & "xpart(obj(@#subt).w-@#w)=" & + decimal (OptionValue@#("dx")) & ";"; + else: % R + % 3: |xpart(subt.w-root.e)=1cm;| + if OptionValue@#("treenodehsize")>0: + eq:=eq & "xpart(obj(@#subt).w-obj(@#root).w)=" & + decimal + (OptionValue@#("hsep")+OptionValue@#("treenodehsize")) & ";"; + else: + eq:=eq & "xpart(obj(@#subt).w-obj(@#root).e)=" & + decimal (OptionValue@#("hsep")) & ";"; + fi; + % 4: |xpart(root.w-@#w)=0mm;| + eq:=eq & "xpart(obj(@#root).w-@#w)=" & + decimal (OptionValue@#("dx")) & ";"; + % 5: |xpart(@#e-subt.e)=0mm;| + eq:=eq & "xpart(@#e-obj(@#subt).e)=" & + decimal (OptionValue@#("dx")) & ";"; + fi; + else: % includes default case + % 1: |xpart(root.c)=xpart(subt.c)| + eq:="xpart(obj(@#root).c)=xpart(obj(@#subt).c);"; + % 2: |xpart(subt.w-@#w)=xpart(@#e-subt.e)=5mm;| + eq:=eq & "xpart(obj(@#subt).w-@#w)=xpart(@#e-obj(@#subt).e)=" & + decimal (OptionValue@#("dx")) & ";"; + if Option@#("treemode","U"): + % 3: |ypart(subt.s-root.n)=1cm;| + if OptionValue@#("treenodevsize")>0: + eq:=eq & "ypart(obj(@#subt).s-obj(@#root).s)=" & + decimal + (OptionValue@#("vsep")+OptionValue@#("treenodevsize")) & ";"; + else: + eq:=eq & "ypart(obj(@#subt).s-obj(@#root).n)=" & + decimal (OptionValue@#("vsep")) & ";"; + fi; + % 4: |ypart(root.s-@#s)=0mm;| + eq:=eq & "ypart(obj(@#root).s-@#s)=" & + decimal (OptionValue@#("dy")) & ";"; + % 5: |ypart(@#n-subt.n)=0mm;| + eq:=eq & "ypart(@#n-obj(@#subt).n)=" & + decimal (OptionValue@#("dy")) & ";"; + else: % default case + % 3: |ypart(root.s-subt.n)=1cm;| + if OptionValue@#("treenodevsize")>0: + eq:=eq & "ypart(obj(@#root).n-obj(@#subt).n)=" & + decimal + (OptionValue@#("vsep")+OptionValue@#("treenodevsize")) & ";"; + else: + eq:=eq & "ypart(obj(@#root).s-obj(@#subt).n)=" & + decimal (OptionValue@#("vsep")) & ";"; + fi; + % 4: |ypart(@#n-root.n)=0mm;| + eq:=eq & "ypart(@#n-obj(@#root).n)=" & + decimal (OptionValue@#("dy")) & ";"; + % 5: |ypart(subt.s-@#s)=0mm;| + eq:=eq & "ypart(obj(@#subt).s-@#s)=" & + decimal (OptionValue@#("dy")) & ";"; + + fi; + fi; + + ObjCode StandardEquations,eq; +% |"xpart(@#n)=xpart(@#s);ypart(@#ne)=ypart(@#nw);";| + StandardTies; + + if OptionValue@#("hideleaves"): + hideTreeLeaves(@#); + fi; + + memorizeConnections_@#(true); +enddef; + +% |t| is the tree, |n| is the child number, |par| is the parameter +% |val| is the new value +def setTreeEdge(suffix t)(expr n)(suffix par)(expr val)= + t._spath_.par[n]:=val; +enddef; + +% This function memorizes the connections between the root and the +% subtrees; it is also used when a subtree is replaced by another one, +% or when the number of subtrees changes. +% The value of |fromoptions| determines +% whether we take the connection information +% from the options, or from a memorized structure +vardef memorizeConnections_@#(expr fromoptions)= + % we memorize the connection paths: + for i:=1 upto @#nst: + % only connections to non empty boxes + if not isEmptyBox(obj(obj(@#subt).sb[i])): + if not(isHFan(Obj(TreeRootObj_(obj(obj(@#subt).sb[i]))))) and + not(isVFan(Obj(TreeRootObj_(obj(obj(@#subt).sb[i]))))): + % the next call will inherit the options of |Tree| that are + % relevant to the |edge| argument, such as |cdraw|: + if OptionValue@#("edge")<>"none": + if fromoptions: + sc_(connectionCommand_@#(i,true)); + else: + % we use the |pp| variable which is defined in + % |replaceTreeElement.expl|: + sc_(connectionCommand_@#(i,false)); + fi; + fi; + else: + ncfan@#(obj(@#root))(Obj(TreeRootObj_(obj(obj(@#subt).sb[i]))))(i); + fi; + fi; + endfor; +enddef; + +% |n| is the fan object and |i| is the rank in the subtrees +vardef fanconnection_@#(suffix root,n,a,b)(expr i)= + if OptionValue.n("pointedfan"): + addPath@#(_spath_,i, + smoothen(((.5[n.a,n.b]--root.ic) intersectionpoint BpathObj(root)) + --n.a--.5[n.a,n.b], + OptionValue.n("fanlinearc")) + & smoothen(.5[n.a,n.b]--n.b-- + ((.5[n.a,n.b]--root.ic) intersectionpoint BpathObj(root)), + OptionValue.n("fanlinearc"))); + else: + addPath@#(_spath_,i, + smoothen(((n.a--root.ic) intersectionpoint BpathObj(root))--n.a + --.5[n.a,n.b], + OptionValue.n("fanlinearc")) + & smoothen(.5[n.a,n.b]--n.b-- + ((n.b--root.ic) intersectionpoint BpathObj(root)), + OptionValue.n("fanlinearc"))); + fi; + @#_spath_.n_:=@#_spath_.n_+1; + % the value |"fandraw"| allows us to detect that the memorized path + % corresponds to a fan + @#_spath_.arrows[@#_spath_.n_]:="fandraw"; +enddef; + + +vardef ncfan@#(suffix n)(suffix m)(expr i)= + if isHFan(m): + fanconnection_@#(n,m,ie,iw)(i); + elseif isVFan(m): + fanconnection_@#(n,m,in,is)(i); + fi; +enddef; + +% temporary +def fandraw = draw enddef; + +% This function builds a complex connection command from options. +% The result is a string. +vardef connectionCommand_@#(expr i,fromoptions)= + save cmd;string cmd; + hide( + if fromoptions: + cmd=OptionValue@#("edge"); + else: + cmd=pp._connect_[i]; + fi; + cmd:=cmd & "." & str @# & "(obj(" & + str @# & ".root))(Obj(TreeRootObj_(obj(obj(" & str @# & ".subt).sb[" & + decimal i & "]))))" & + " " & quote("patharray(_spath_)") + optionCase_("angleA",i,fromoptions)(decimal)(@#) + optionCase_("angleB",i,fromoptions)(decimal)(@#) + optionCase_("arcangleA",i,fromoptions)(decimal)(@#) + optionCase_("arcangleB",i,fromoptions)(decimal)(@#) + optionCase_("linewidth",i,fromoptions)(decimal)(@#) + optionCase_("nodesepA",i,fromoptions)(decimal)(@#) + optionCase_("nodesepB",i,fromoptions)(decimal)(@#) + optionCase_("loopsize",i,fromoptions)(decimal)(@#) + optionCase_("boxsize",i,fromoptions)(decimal)(@#) + optionCase_("boxheight",i,fromoptions)(decimal)(@#) + optionCase_("boxdepth",i,fromoptions)(decimal)(@#) + optionCase_("visible",i,fromoptions)(booleantostring)(@#) + optionCase_("pathfilled",i,fromoptions)(booleantostring)(@#) + optionCase_("pathfillcolor",i,fromoptions)(colortostring)(@#) + optionCase_("linearc",i,fromoptions)(decimal)(@#) + optionCase_("linetensionA",i,fromoptions)(decimal)(@#) + optionCase_("linetensionB",i,fromoptions)(decimal)(@#) + optionCase_("coilarmA",i,fromoptions)(decimal)(@#) + optionCase_("coilarmB",i,fromoptions)(decimal)(@#) + optionCase_("coilheight",i,fromoptions)(decimal)(@#) + optionCase_("coilwidth",i,fromoptions)(decimal)(@#) + optionCase_("coilaspect",i,fromoptions)(decimal)(@#) + optionCase_("coilinc",i,fromoptions)(decimal)(@#) + optionCase_("posA",i,fromoptions)()(@#) + optionCase_("posB",i,fromoptions)()(@#) + optionCase_("armA",i,fromoptions)(decimal)(@#) + optionCase_("armB",i,fromoptions)(decimal)(@#) + optionCase_("offsetA",i,fromoptions)(pairtostring)(@#) + optionCase_("offsetB",i,fromoptions)(pairtostring)(@#) + optionCase_("name",i,fromoptions)()(@#) + optionCase_("linecolor",i,fromoptions)(colortostring)(@#) + optionCase_("border",i,fromoptions)(decimal)(@#) + optionCase_("bordercolor",i,fromoptions)(colortostring)(@#) + optionCase_("linestyle",i,fromoptions)()(@#) + optionCase_("doubleline",i,fromoptions)(booleantostring)(@#) + optionCase_("doublesep",i,fromoptions)(decimal)(@#) + optionCase_("arrows",i,fromoptions)()(@#); + ) + cmd +enddef; + +def pairtostring(expr p)= + "(" & decimal (xpart(p)) & "," & decimal(ypart(p)) & ")" +enddef; + +def booleantostring(expr b)= + if b:"true" else: "false" fi +enddef; + +def colortostring(expr p)= + "(" & decimal(redpart(p)) & "," & decimal(greenpart(p)) & "," & + decimal(bluepart(p)) & ")" +enddef; + +def optionCase_(expr opname,i,fromoptions)(text type)(suffix $)= + if fromoptions: + if expandafter known sc_("o_" & opname & "_val"): + & "," & quote(opname &"(" & type (OptionValue$(opname)) & ")") + fi + else: + if known pp.sc_(opname)[i]: + & "," & quote(opname & "(" & type (pp.sc_(opname)[i]) & ")") + fi + fi +enddef; + +streamline("Tree")("(expr theroot)(text subtrees)", + "suffixpar(theroot)suffixlist(subtrees)"); + +% useful shortcuts: +def T =newTree enddef; +def _T =new_Tree enddef; +def T_=new_Tree_ enddef; + +def BpathTree(suffix n)= StandardBpath(n) enddef; + +% This returns the internal number of the root object +% In order to get the appropriate suffix, one should apply |Obj| +% to the result. +def TreeRootObj_(suffix sb)= + (if isBB(sb): TreeRootObj_(obj(sb.sub)) + elseif isTree(sb): TreeRootObj_(obj(sb.root)) + else: sb + fi + ) +enddef; + +% CHOOSE A BETTER NAME +% This returns the center of the root object +def TreeRoot_(suffix sb)= + Obj(TreeRootObj_(sb)).ic +enddef; + +% This returns the bounding path of the root object +def TreeRootPath_(suffix sb)= + BpathObj(Obj(TreeRootObj_(sb))) +enddef; + +vardef drawTree(suffix n)= + drawFramedOrFilledObject_(n); +% pickup pencircle scaled 2pt; +% draw n.nw--n.ne--n.se--n.sw--cycle withcolor red; +% pickup pencircle scaled .4pt; + drawMemorizedPaths_(n); + drawObj(obj(n.subt)); + % and draw connections (this should be parameterized too) + for i:=1 upto n.nst: + % only connections to non empty boxes: + if not isEmptyBox(obj(obj(n.subt).sb[i])): + if isHFan(Obj(TreeRootObj_(obj(obj(n.subt).sb[i])))) or + isVFan(Obj(TreeRootObj_(obj(obj(n.subt).sb[i])))): + drawfan_(n,Obj(TreeRootObj_(obj(obj(n.subt).sb[i]))))(i,false); + else: + % drawn by |drawMemorizedPaths_| + fi; + fi; + endfor; + % |unfill| is necessary to cut points of fans + unfill BpathObj(obj(n.root)); + drawObj(obj(n.root)); +enddef; + +setObjectDefaultOption("Tree")("treemode")("D"); % default is top-down +setObjectDefaultOption("Tree")("treeflip")(false); +setObjectDefaultOption("Tree")("treenodehsize")(-1pt); % like PSTricks +setObjectDefaultOption("Tree")("treenodevsize")(-1pt); % like PSTricks +setObjectDefaultOption("Tree")("dx")(0mm); % left/right margins +setObjectDefaultOption("Tree")("dy")(0mm); % top/down margins +% internal horizontal separation between root and subtrees +setObjectDefaultOption("Tree")("hsep")(1cm); +% internal vertical separation between root and subtrees +setObjectDefaultOption("Tree")("vsep")(1cm); +% the next two options are passed to |newHBox| or |newVBox| +% and concern the separation between subtrees: +setObjectDefaultOption("Tree")("hbsep")(1cm); +setObjectDefaultOption("Tree")("vbsep")(1cm); +setObjectDefaultOption("Tree")("hideleaves")(false); % leaves are in the bb +setObjectDefaultOption("Tree")("edge")("ncline"); +% we don't have a default for |cdraw|, which means |ncline|, |ncangle|, ...'s +% default will be used +setObjectDefaultOption("Tree")("framed")(false); +setObjectDefaultOption("Tree")("filled")(false); +setObjectDefaultOption("Tree")("fillcolor")(black); +setObjectDefaultOption("Tree")("framewidth")(.5bp); +setObjectDefaultOption("Tree")("framecolor")(black); +setObjectDefaultOption("Tree")("framestyle")(""); +setObjectDefaultOption("Tree")("Dalign")("top"); +setObjectDefaultOption("Tree")("Ualign")("bot"); +setObjectDefaultOption("Tree")("Lalign")("right"); +setObjectDefaultOption("Tree")("Ralign")("left"); +setObjectDefaultOption("Tree")("shadow")(false); % no shadow by default +setObjectDefaultOption("Tree")("shadowcolor")(black); + +% Declaration of a few arrays. +% This must be a |def| and not a |vardef|: +def declare_pp_variables_= + save pp; + string pp._draw_[],pp._connect_[],pp.posA[],pp.posB[],pp.name[], + pp.linestyle[],pp.arrows[]; + numeric pp.angleA[],pp.angleB[],pp.arcangleA[],pp.arcangleB[], + pp.linewidth[],pp.border[],pp.nodesepA[],pp.nodesepB[], + pp.loopsize[],pp.boxsize[],pp.boxheight[],pp.boxdepth[], + pp.linearc[],pp.linetensionA[],pp.linetensionB[], + pp.armA[],pp.armB[],pp.doublesep[], + pp.coilarmA[],pp.coilarmB[],pp.coilheight[],pp.coilwidth[], + pp.coilaspect[],pp.coilinc[], + pp.n_; + boolean pp.visible[],pp.doubleline[],pp.pathfilled[]; + color pp.linecolor[],pp.bordercolor[],pp.pathfillcolor[]; + pair pp.offsetA[],pp.offsetB[]; +enddef; + +vardef resetPathArray@#(suffix $$)= + % reset the user arrays: + if known @#.$$n_: + @#.$$n_:=0; + forsuffixes $:=pathoptions_: + @#.$$.$n_:=0; + endfor; + deletePaths@#($$); + fi; +enddef; + +% This function either replaces a subtree or adds a subtree at the end +% of the subtrees. +% This function always resets the tree. +vardef replaceTreeElement.expl@#(expr i)(suffix rep)= + resetObj.expl@#; + + if isHBox(obj(@#subt)): + replaceHBoxElement.expl.obj(@#subt)(i)(rep); + else: + replaceVBoxElement.expl.obj(@#subt)(i)(rep); + fi; + if i=@#nst+1: + @#nst:=@#nst+1; + % extend the path parameters + % we use the same parameters as those for the last connection + if OptionValue@#("edge")<>"none": + @#_spath_.n_:=@#_spath_.n_+1; + forsuffixes $:=pathoptions_: + @#_spath_$[@#_spath_.n_]:=@#_spath_$[@#_spath_.n_-1]; + endfor; + fi; + fi; + + if OptionValue@#("edge")<>"none": + % memorize the path parameters in a local array: + declare_pp_variables_; + pp.n_=@#_spath_.n_; + for j:=1 upto pp.n_: + forsuffixes $:=pathoptions_: + pp$[j]=@#_spath_$[j]; + endfor; + endfor; + + % reset the standard arrays: + resetPathArray@#(_spath_); + fi; + + % reset the user arrays: + resetPathArray@#(_upath_); + + resetObj.expl@#; + + % recreate the standard paths from the memorized information + memorizeConnections_@#(false); + +enddef; + +% This function deletes a subtree. +% This function always resets the tree. +vardef deleteTreeElement.expl@#(expr i)= + resetObj.expl@#; + if isHBox(obj(@#subt)): + deleteHBoxElement.expl.obj(@#subt)(i); + else: + deleteVBoxElement.expl.obj(@#subt)(i); + fi; + @#nst:=@#nst-1; + + if OptionValue@#("edge")<>"none": + % memorize the path parameters in a local array: + declare_pp_variables_; + pp.n_=@#_spath_.n_-1; + % first part (before the removed element) + for j:=1 upto i-1: + forsuffixes $:=pathoptions_: + pp$[j]=@#_spath_$[j]; + endfor; + endfor; + + % second part (after the removed element) + for j:=i upto pp.n_: + forsuffixes $:=pathoptions_: + pp$[j]=@#_spath_$[j+1]; + endfor; + endfor; + + % reset the standard arrays: + resetPathArray@#(_spath_); + fi; + + % reset the user arrays: + resetPathArray@#(_upath_); + + resetObj.expl@#; + + % recreate the standard paths from the memorized information + memorizeConnections_@#(false); + +enddef; + +% This function sets the bounding box of a tree to its root. +% It will be more general later. +def hideTreeLeaves(suffix $)= + % we have merely to give the right shifts as parameters of + % |rebindrelativeObj|: + rebindrelativeObj($)(ypart(obj($root).n-$n),ypart(obj($root).s-$s), + xpart(obj($root).e-$e),xpart(obj($root).w-$w)); +enddef; + +% streamlined version +vardef hideTreeLeaves_(expr n)= + % we have merely to give the correct shifts as parameters of + % |rebindrelativeObj|: + rebindrelative_Obj(obj(iname_[n])) + (ypart(obj(obj(iname_[n]).root).n-obj(iname_[n]).n), + ypart(obj(obj(iname_[n]).root).s-obj(iname_[n]).s), + xpart(obj(obj(iname_[n]).root).e-obj(iname_[n]).e), + xpart(obj(obj(iname_[n]).root).w-obj(iname_[n]).w) + ) +enddef; + +%===================================================================== +% A fan is an object normally only used in trees. It is directly +% inspired of PSTricks' fans. +% This object is actually very similar to a HRazor or VRazor. +% It only behaves like a fan in a Tree context. + +vardef newHFan@#(expr dx,dy) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"HFan"); + StandardInterface; + ObjCode StandardEquations, + "@#ise-@#isw=(" & decimal dx & ",0)", + "@#ine-@#ise=(0," & decimal dy & ")"; +enddef; + +streamline("HFan")("(expr dx,dy)","(dx,dy)"); + +% won't be used +def BpathHFan(suffix n)=StandardBpath(n) enddef; + +% This is not used, but the parent calls |drawfan_| +def drawHFan(suffix n)= + % empty, because the fan is drawn by the parent + %draw n.ise--n.isw; + drawMemorizedPaths_(n); +enddef; + +% |forceedge| is a boolean that can override the option value |"edge"| +def drawfan_(suffix n,fan)(expr i,forceedge)= + if (OptionValue.fan("edge")="yes") or forceedge: + if OptionValue.fan("filled"): + fill Path.n(_spath_,i)--cycle withcolor OptionValue.fan("fillcolor"); + else: + if OptionValue.fan("fanlinestyle")<>"": + draw Path.n(_spath_,i) + scantokens(OptionValue.fan("fanlinestyle")) + withcolor OptionValue.fan("fillcolor"); + else: + draw Path.n(_spath_,i) withcolor OptionValue.fan("fillcolor"); + fi; + fi; + fi; +enddef; + +vardef drawfan@#(suffix fan)(expr i)= + drawfan_(@#,fan)(i,true); +enddef; + +setObjectDefaultOption("HFan")("filled")(false); +setObjectDefaultOption("HFan")("edge")("yes"); +setObjectDefaultOption("HFan")("pointedfan")(true); +setObjectDefaultOption("HFan")("fanlinestyle")(""); +setObjectDefaultOption("HFan")("fanlinearc")(0); +setObjectDefaultOption("HFan")("fillcolor")(black); + +%===================================================================== + +vardef newVFan@#(expr dx,dy) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"VFan"); + StandardInterface; + ObjCode StandardEquations, + "@#ise-@#isw=(" & decimal dx & ",0)", + "@#ine-@#ise=(0," & decimal dy & ")"; +enddef; + +streamline("VFan")("(expr dx,dy)","(dx,dy)"); + +% won't be used +def BpathVFan(suffix n)=StandardBpath(n) enddef; + +% This is not used, but the parent calls |drawfan_| +def drawVFan(suffix n)= + % empty, because the fan is drawn by the parent + %draw n.ine--n.ise; + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("VFan")("filled")(false); +setObjectDefaultOption("VFan")("edge")("yes"); +setObjectDefaultOption("VFan")("pointedfan")(true); +setObjectDefaultOption("VFan")("fanlinestyle")(""); +setObjectDefaultOption("VFan")("fanlinearc")(0); +setObjectDefaultOption("VFan")("fillcolor")(black); + +%------------------------------------------------------------------------- + +% PTree: Proof Trees +% |@#| is a name for an object (must be a suffix) +% |@#| will be the number of the object, but will also be used +% as a prefix for other variables. +% |left| and |right| are the rule names (they are pictures) +% |conclusion| is a picture too. +% Even though this object seems simple, its code is quite complex +% because we try to cover all special cases. +% However, we assume that there is at least either a conclusion +% or one subtree. Calling this function with no subtrees and +% no conclusion will produce an error. +vardef newPTree@#(expr conclusion)(text subtrees)(expr left,right) + text options= + ExecuteOptions(@#)(options); + assignObj(@#,"PTree"); + % parameters that should be options: + save vdist,rdistl,rdistr,dist_n,dist_s,dist_e,dist_w; + % vertical distance between premisses and conclusion: + vdist=OptionValue@#("vsep"); + % rule distance left + rdistl=OptionValue@#("lrsep"); + % rule distance right + rdistr=OptionValue@#("rrsep"); + % distances around the proof: + dist_n=dist_s=OptionValue@#("dy"); + dist_e=dist_w=OptionValue@#("dx"); + StandardInterface; + ObjPoint ledge,redge, % a |PTree| has two additionnal points that + % are useful for a fine positionning of the + % horizontal line (actually, we could do without them, + % by analyzing the structure of the tree, but this + % is a first attempt) + lstart,lend; % These are the points where the line starts and + % where it ends. These variables are not really + % necessary, but having them is convenient. + save n,i,eq,spl,spr;numeric n,i,spl,spr;string eq; + % we count the number of subtrees: + n=0; + forsuffixes $:=subtrees: + % we have to be careful because there is always at least one loop, + % even if |subtrees| is empty (because an empty suffix is a valid suffix): + if length(str $)>0:n:=n+1;fi; + endfor; + ObjNumeric nst; + % the number of subtrees is stored in the object + setNumeric(nst)(n); + i=0; + SubObject(subt,obj(newobjstring_)); + if not numeric conclusion: + SubObject(conc,obj(newobjstring_)); + fi; + if not numeric left: + SubObject(lr,obj(newobjstring_)); + fi; + if not numeric right: + SubObject(rr,obj(newobjstring_)); + fi; + % We put the subtrees in an HBox object except if there are no subtrees: + if n>0: + begingroup; + % we define options passed to |newHBox| + o_hbsep(OptionValue@#("hsep")); + if Option@#("treemode","U"): + o_align("top"); + else: + o_align("bot"); + fi; + newHBox.obj(@#subt)(subtrees); + endgroup; + else: + newEmptyBox.obj(@#subt)(0,0); + fi; + % + if string conclusion:if conclusion="": newEmptyBox.obj(@#conc)(0,0); + else:newBox.obj(@#conc)(conclusion) "framed(false)";fi; + elseif picture conclusion:newBox.obj(@#conc)(conclusion) "framed(false)"; + else: % object + SubObject(conc,Obj(conclusion)); + fi; + if string left:if left="": newEmptyBox.obj(@#lr)(0,0); + else:newBox.obj(@#lr)(left) "framed(false)";fi; + elseif picture left:newBox.obj(@#lr)(left) "framed(false)"; + else: % object + SubObject(lr,Obj(left)); + fi; + if string right:if right="": newEmptyBox.obj(@#rr)(0,0); + else:newBox.obj(@#rr)(right) "framed(false)";fi; + elseif picture right:newBox.obj(@#rr)(right) "framed(false)"; + else: % object + SubObject(rr,Obj(right)); + fi; + % We now build the equations: here are the equations for a top-down tree + % (the conclusion being under the subtrees) + % 1 horizontal equation: the conclusion is in the middle + % of the last line of the subtree + % |xpart(conc.c)=xpart(.5[subt.ledge,subt.redge])| + % 2 vertical equation: vertical distance between root and subtrees + % |ypart(subt.s-conc.n)=vdist;| % depends on option + % 3 vertical equation: vertical space at the top + % |ypart(@#n-subt.n)=dist_n;| % depends on option + % 4 vertical equation: vertical space at the bottom + % |ypart(conc.s-@#s)=dist_s;| % depends on option + % 5 Edges: + % |@#ledge=conc.sw;@#redge=conc.se;| % depends on option + % 6 Start and end of the line: + % |ypart(@#lstart)=ypart(@#lend)=.5[ypart(subt.s),ypart(conc.n)]| + % |xpart(@#lstart)=min(xpart(subt.ledge),xpart(conc.w))| + % |xpart(@#lend)=max(xpart(subt.redge),xpart(conc.e))| + % 7 horizontal space at right of subtree + % |max(xpart(@#lend)+wd(@#rr)+rdistr-xpart(subt.e),0)| + % 8 horizontal space at left of subtree + % |min(xpart(@#lstart)-wd(@#lr)-rdistl-xpart(subt.w),0)| + % 9 Attachment of the rules: + % |@#lstart-(rdistl,0)=@#lr.e| + % |@#lend=@#rr.w-(rdistr,0)| + % + % Left and right edges of the subtree are actually not defined, + % because it is an |HBox|. But even the components of the |HBox| + % may lack these features if we are at the top of the proof tree. + % So, what we do is that we compute the positions of the edges + % with respect to the |.s| point of the subtree. + save subledge,subredge;pair subledge,subredge; + if not isEmptyBox(obj(@#subt)): + if isPTree(obj(obj(@#subt).sb[1])): + subledge=obj(obj(@#subt).sb[1]).ledge-obj(@#subt).s; + else: + subledge=obj(obj(@#subt).sb[1]).sw-obj(@#subt).s; + fi; + if isPTree(obj(obj(@#subt).sb[@#nst])): + subredge=obj(obj(@#subt).sb[@#nst]).redge-obj(@#subt).s; + else: + subredge=obj(obj(@#subt).sb[@#nst]).se-obj(@#subt).s; + fi; + else: % if the subtree is empty, we use the edges of the conclusion + % with respect to the |.n| point of the conclusion + subledge=obj(@#conc).nw-obj(@#conc).n; + subredge=obj(@#conc).ne-obj(@#conc).n; + % see below how it is used when there are no subtrees + fi; + eq:=""; + % 1 |xpart(conc.c)=xpart(.5[subt.ledge,subt.redge])| + % |=xpart(.5[subt.s+subledge,subt.s+subredge])| + % |=.5(xpart(subt.s)+xpart(subledge),xpart(subt.s)+xpart(subredge))| + % (if for some reason conc.ledge and conc.redge exist, we replace + % conc.c by .5[conc.ledge,conc.redge]) + if (not isEmptyBox(obj(@#subt))) and (not isEmptyBox(obj(@#conc))): + eq:=eq & "xpart("; + if pair obj(@#conc).ledge and pair obj(@#conc).redge: + eq:=eq & ".5[obj(@#conc).ledge,obj(@#conc).redge]"; + else: + eq:=eq & "obj(@#conc).c"; + fi; + eq:=eq & ")=.5[xpart(obj(@#subt).s)" & (signeddecimal xpart(subledge)) & + ",xpart(obj(@#subt).s)" & (signeddecimal xpart(subredge)) & "];"; + fi; + % 2 |ypart(subt.s-conc.n)=vdist;| % depends on options + if (not isEmptyBox(obj(@#subt))) and (not isEmptyBox(obj(@#conc))): + if Option@#("treemode","U"): + eq:=eq & "ypart(obj(@#conc).s-obj(@#subt).n)=" & decimal vdist & ";"; + else: + eq:=eq & "ypart(obj(@#subt).s-obj(@#conc).n)=" & decimal vdist & ";"; + fi; + fi; + % 3 |ypart(@#n-subt.n)=dist_n;| % depends on option + if Option@#("treemode","U"): + if (not isEmptyBox(obj(@#conc))): + eq:=eq & "ypart(@#n-obj(@#conc).n)=" & decimal dist_n & ";"; + else: + eq:=eq & "ypart(@#n-obj(@#subt).n)=" & decimal (vdist/2) & ";"; + fi; + else: + if (not isEmptyBox(obj(@#subt))): + eq:=eq & "ypart(@#n-obj(@#subt).n)=" & decimal dist_n & ";"; + else: + eq:=eq & "ypart(@#n-obj(@#conc).n)=" & decimal (vdist/2) & ";"; + fi; + fi; + % 4 |ypart(conc.s-@#s)=dist_s;| % depends on option + if Option@#("treemode","U"): + if (not isEmptyBox(obj(@#subt))): + eq:=eq & "ypart(obj(@#subt).s-@#s)=" & decimal dist_s & ";"; + else: + eq:=eq & "ypart(obj(@#conc).s-@#s)=" & decimal (vdist/2) & ";"; + fi; + else: + if (not isEmptyBox(obj(@#conc))): + eq:=eq & "ypart(obj(@#conc).s-@#s)=" & decimal dist_s & ";"; + else: + eq:=eq & "ypart(obj(@#subt).s-@#s)=" & decimal (vdist/2) & ";"; + fi; + fi; + % 5 |@#ledge=conc.sw;@#redge=conc.se;| % depends on option + if (not isEmptyBox(obj(@#conc))): + if Option@#("treemode","U"): + eq:=eq & "@#ledge=obj(@#conc).nw;@#redge=obj(@#conc).ne;"; + else: + eq:=eq & "@#ledge=obj(@#conc).sw;@#redge=obj(@#conc).se;"; + fi; + else: + % |@#ledge=@#lstart; @#redge=@#lend;| + eq:=eq & "@#ledge=@#lstart;@#redge=@#lend;"; + fi; + % 6 Start and end of the line: + % |ypart(@#lstart)=ypart(@#lend)=ypart(conc.n)+vdist/2| + % |if xpart(subt.redge)-xpart(subt.ledge) > xpart(conc.e)-xpart(conc.w):| + % |xpart(@#lstart)=xpart(subt.ledge)| + % |xpart(@#lend)=xpart(subt.redge)| + % |else:| + % | xpart(@#lstart)=xpart(conc.w)| + % | xpart(@#lend)=xpart(conc.e)| + % |fi| + if Option@#("treemode","U"): + if not isEmptyBox(obj(@#conc)): + eq:=eq & "ypart(@#lstart)=ypart(@#lend)" & + "=ypart(obj(@#conc).s)-" & decimal (vdist/2) & ";"; + else: + eq:=eq & "ypart(@#lstart)=ypart(@#lend)" & + "=ypart(obj(@#subt).n)+" & decimal (vdist/2) & ";"; + fi; + else: + if not isEmptyBox(obj(@#conc)): + eq:=eq & "ypart(@#lstart)=ypart(@#lend)" & + "=ypart(obj(@#conc).n)+" & decimal (vdist/2) & ";"; + else: + eq:=eq & "ypart(@#lstart)=ypart(@#lend)" & + "=ypart(obj(@#subt).s)-" & decimal (vdist/2) & ";"; + fi; + fi; + if xpart(subredge)-xpart(subledge) > + (if pair obj(@#conc).ledge: + xpart(obj(@#conc).redge)-xpart(obj(@#conc).ledge) + else: + xpart(obj(@#conc).e)-xpart(obj(@#conc).w) + fi): + eq:=eq & "xpart(@#lstart)=xpart(obj(@#subt).c)" & + (signeddecimal xpart(subledge)) & + (signeddecimal(OptionValue@#("lstartdx"))) & ";"; + eq:=eq & "xpart(@#lend)=xpart(obj(@#subt).c)" & + (signeddecimal xpart(subredge)) & + (signeddecimal(OptionValue@#("lenddx"))) & ";"; + % 7 horizontal space at right of subtree + % |max(xpart(@#lend)+rdistr+wd(@#rr)-xpart(subt.e),0)| + % |= max(xpart(obj(@#subt).redge)+rdistr+wd(@#rr)-xpart(obj(@#subt).e),0)| + spr=xpart(obj(@#subt).s)+xpart(subredge)+rdistr + +xpart(obj(@#rr).e-obj(@#rr).w)-xpart(obj(@#subt).e); + if spr<0: spr:=0;fi;spr:=spr+dist_e; + % 8 horizontal space at left of subtree + % |min(xpart(@#lstart)-wd(@#lr)-rdistl-xpart(subt.w),0)| + % |= min(xpart(obj(@#subt).ledge)-wd(@#lr)-rdistl-xpart(obj(@#subt).w),0)| + spl=xpart(obj(@#subt).s)+xpart(subledge) + -xpart(obj(@#lr).e-obj(@#lr).w)-rdistl-xpart(obj(@#subt).w); + if spl>0:spl:=0;fi;spl:=spl-dist_w; + eq:=eq & "xpart(@#e)-xpart(obj(@#subt).e)=" & (signeddecimal spr) & ";"; + eq:=eq & "xpart(obj(@#subt).w)-xpart(@#w)=" & (signeddecimal (-spl)) & ";"; + else: + if pair obj(@#conc).ledge: + eq:=eq & "xpart(@#lstart)=xpart(obj(@#conc).ledge)" & + (signeddecimal(OptionValue@#("lstartdx"))) & ";"; + eq:=eq & "xpart(@#lend)=xpart(obj(@#conc).redge)" & + (signeddecimal(OptionValue@#("lenddx"))) & ";"; + else: + eq:=eq & "xpart(@#lstart)=xpart(obj(@#conc).w)" & + (signeddecimal(OptionValue@#("lstartdx"))) & ";"; + eq:=eq & "xpart(@#lend)=xpart(obj(@#conc).e)" & + (signeddecimal(OptionValue@#("lenddx"))) & ";"; + fi; + % 7 horizontal space at right of conclusion + % |max(xpart(@#lend)+rdistr+wd(@#rr)-xpart(conc.e),0)| + % |= max(rdistr+wd(@#rr),0)| + spr=rdistr+xpart(obj(@#rr).e-obj(@#rr).w); + if spr<0: spr:=0;fi;spr:=spr+dist_e; + % 8 horizontal space at left of conclusion + % |min(xpart(@#lstart)-wd(@#lr)-rdistl-xpart(conc.w),0)| + % |= min(-wd(@#lr)-rdistl,0)| + spl=-xpart(obj(@#lr).e-obj(@#lr).w)-rdistl; + if spl>0:spl:=0;fi;spl:=spl-dist_w; + if pair obj(@#conc).ledge: + eq:=eq & "xpart(@#e)-xpart(obj(@#conc).redge)=" & + (signeddecimal spr) & ";"; + eq:=eq & "xpart(obj(@#conc).ledge)-xpart(@#w)=" & + (signeddecimal (-spl)) & ";"; + else: + eq:=eq & "xpart(@#e)-xpart(obj(@#conc).e)=" & + (signeddecimal spr) & ";"; + eq:=eq & "xpart(obj(@#conc).w)-xpart(@#w)=" & + (signeddecimal (-spl)) & ";"; + fi; + fi; + % + % 9 Attachment of the rules: + % |@#lstart=@#lr.e| + % |@#lend=@#rr.w| + if not isEmptyBox(obj(@#lr)): + eq:=eq & "@#lstart-(rdistl,0)=obj(@#lr).e;"; + fi; + if not isEmptyBox(obj(@#rr)): + eq:=eq & "@#lend=obj(@#rr).w-(rdistr,0);"; + fi; + ObjCode StandardEquations,eq; +% |"xpart(@#n)=xpart(@#s);ypart(@#ne)=ypart(@#nw);";| + StandardTies; +enddef; + +streamline("PTree")("(expr conclusion)(text subtrees)(expr left,right)", + "suffixpar(conclusion)suffixlist(subtrees)(left,right)"); + +def BpathPTree(suffix n)= StandardBpath(n) enddef; + +% CHOOSE A BETTER NAME +def PTreeRoot_(suffix sb)= + (if isBB(sb): PTreeRoot_(obj(sb.sub)) + elseif isPTree(sb): PTreeRoot_(obj(sb.root)) + else: sb.ic + fi + ) +enddef; + +def PTreeRootPath_(suffix sb)= + (if isBB(sb): PTreeRootPath_(obj(sb.sub)) + elseif isPTree(sb): PTreeRootPath_(obj(sb.root)) + else: BpathObj(sb) + fi + ) +enddef; + +def drawPTree(suffix n)= + drawFramedOrFilledObject_(n); + if not isEmptyBox(obj(n.conc)): drawObj(obj(n.conc)); fi; + if not isEmptyBox(obj(n.subt)): drawObj(obj(n.subt)); fi; + if not isEmptyBox(obj(n.lr)): drawObj(obj(n.lr)); fi; + if not isEmptyBox(obj(n.rr)): drawObj(obj(n.rr)); fi; + if OptionValue.n("rule")>0: + pickup pencircle scaled OptionValue.n("rule"); + draw n.lstart -- n.lend; + fi; +% pickup pencircle scaled 2pt; +% draw n.ledge withcolor red; +% draw n.redge withcolor red; + pickup pencircle scaled .4pt; + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("PTree")("treemode")("D"); % default is down +setObjectDefaultOption("PTree")("dx")(0mm); % left/right margins +setObjectDefaultOption("PTree")("dy")(0mm); % top/down margins +setObjectDefaultOption("PTree")("hsep")(3mm); % internal horizontal separation + % between subtrees +setObjectDefaultOption("PTree")("vsep")(2mm); % internal vertical separation +setObjectDefaultOption("PTree")("lrsep")(2mm); % separation with left rule +setObjectDefaultOption("PTree")("rrsep")(2mm); % separation with right rule +setObjectDefaultOption("PTree")("lstartdx")(0); % positive towards the right +setObjectDefaultOption("PTree")("lenddx")(0); % positive towards the right +setObjectDefaultOption("PTree")("rule")(.5bp); % rule thickness +setObjectDefaultOption("PTree")("framed")(false); +setObjectDefaultOption("PTree")("filled")(false); +setObjectDefaultOption("PTree")("fillcolor")(black); +setObjectDefaultOption("PTree")("framewidth")(.5bp); +setObjectDefaultOption("PTree")("framecolor")(black); +setObjectDefaultOption("PTree")("framestyle")(""); +setObjectDefaultOption("PTree")("shadow")(false); % no shadow by default +setObjectDefaultOption("PTree")("shadowcolor")(black); + +% Two simplified versions, where only one rule is given: +vardef newPTreeL@#(expr conclusion)(text subtrees)(expr left) text options= + newPTree@#(conclusion)(subtrees)(left,"") options +enddef; + +vardef newPTreeR@#(expr conclusion)(text subtrees)(expr right) text options= + newPTree@#(conclusion)(subtrees)("",right) options +enddef; + +% A version with no subtrees and no rules: +vardef newAxiom@#(expr axiom) text options= + newPTree@#(axiom)("")("","") options +enddef; + +vardef newAssumption@#(expr assumption)= + newBox@#(assumption) "framed(false)", "dx(0)", "dy(0)" +enddef; + +% This is identical to |newAssumption|, but it would be confusing +% to use |newAssumption| where a conclusion occurs. +vardef newConclusion@#(expr conclusion)= + newBox@#(conclusion) "framed(false)", "dx(0)", "dy(0)" +enddef; + +%===================================================================== +% |HBox| class + +% |HBox|: Generic Horizontal Alignments +% |@#| is a name for an object (must be a suffix) +% |@#| will be the number of the object, but will also be used +% as a prefix for other variables. +vardef newHBox@#(text sublist) text options = + ExecuteOptions(@#)(options); + assignObj(@#,"HBox"); + StandardInterface; + save n,i,eq;numeric n,i;string eq; + n=0; + forsuffixes $:=sublist:n:=n+1;endfor; + ObjSubArray(sb)(n); % |n| is the number of horizontal elements + ObjNumeric nst,tallest; + setNumeric(nst)(n); + i=0; + if OptionValue@#("flip"): + forsuffixes $:=sublist:i:=i+1; + SubObjectOfArray(sb[n+1-i],$); + endfor; + else: + forsuffixes $:=sublist:i:=i+1; + SubObjectOfArray(sb[i],$); + endfor; + fi; + % we now build the equations: + % 1: horizontal equation: horizontal separation between elements + % if elementsize<0: + % |xpart(sb[2].w-sb[1].e)=xpart(sb[3].w-sb[2].e)=...| + % |=xpart(sb[n].w-sb[n-1].e)=5mm;| + % if elementsize>=0: + % |xpart(sb[2].c-sb[1].c)=xpart(sb[3].c-sb[2].c)=...| + % |=xpart(sb[n].c-sb[n-1].c)=hbsep+elementsize;| + % + % 2: horizontal equation: horizontal space at the edges + % |xpart(sb[1].w-@#w)=xpart(@#e-sb[n].e)=0mm;| + % 3: vertical equation: elements are lined up at the top + % |ypart(sb[1].n)=ypart(sb[2].n)=...=ypart(sb[n].n)| + % or at the bottom (default) (depending on the options) + % |ypart(sb[1].s)=ypart(sb[2].s)=...=ypart(sb[n].s)| + % or at the center + % |ypart(sb[1].c)=ypart(sb[2].c)=...=ypart(sb[n].c)| + % 4: vertical equation: vertical space at the top + % |ypart(@#n-sb[i].n)=0mm;| where |sb[i]| is the tallest + % 5: vertical equation: vertical space at the bottom + % |ypart(sb[i].s-@#s)=0mm;| where |sb[i]| is the tallest + % 1: + if OptionValue@#("elementsize")<0: + eq:="if @#sb.n_>1:" & + "xpart(obj(@#sb[2]).w-obj(@#sb[1]).e) " & + "if @#sb.n_>2:" & + "for i:=3 upto @#sb.n_: " & + "=xpart(obj(@#sb[i]).w-obj(@#sb[i-1]).e)" & + "endfor " & + "fi" & + "=" & decimal(OptionValue@#("hbsep")) & ";" & + "fi;"; + else: + eq:="if @#sb.n_>1:" & + "xpart(obj(@#sb[2]).c-obj(@#sb[1]).c) " & + "if @#sb.n_>2:" & + "for i:=3 upto @#sb.n_: " & + "=xpart(obj(@#sb[i]).c-obj(@#sb[i-1]).c)" & + "endfor " & + "fi" & + "=" & + decimal(OptionValue@#("hbsep")+OptionValue@#("elementsize")) & ";" & + "fi;"; + fi; + % 2: |xpart(sb[1].w-@#w)=xpart(@#e-sb[n].e)=5mm;| + if OptionValue@#("elementsize")<0: + eq:=eq & "xpart(obj(@#sb[1]).w-@#w)" & + "=xpart(@#e-obj(@#sb[@#sb.n_]).e)=" & + decimal(OptionValue@#("dx")) & ";"; + else: + eq:=eq & "xpart(obj(@#sb[1]).c-@#w)" & + "=xpart(@#e-obj(@#sb[@#sb.n_]).c)=" & + decimal(OptionValue@#("dx")+.5*OptionValue@#("elementsize")) & ";"; + fi; + % The next equation depends on an option: + save alignsuffix;string alignsuffix; alignsuffix="s"; + if Option@#("align","top"):alignsuffix:="n"; + elseif Option@#("align","center"):alignsuffix:="c"; + fi; + + % 3: |ypart(sb[1].alignsuffix)=ypart(sb[2].alignsuffix)=...| + % |=ypart(sb[n].alignsuffix)| + eq:=eq & "if @#sb.n_>1:" & + "ypart(obj(@#sb[1])." & alignsuffix & ")" & + "for i:=2 upto @#sb.n_: " & + "=ypart(obj(@#sb[i])." & alignsuffix & ")" & + "endfor;" & + "fi;"; + % first, we compute the tallest subtree: + setTallest@#; + % 4: |ypart(@#n-sb[tallest].n)=0mm;| + eq:=eq & "ypart(@#n-obj(@#sb[@#tallest]).n)=" & + decimal(OptionValue@#("dy")) & ";"; + % 5: |ypart(sb[tallest].s-@#s)=0mm;| + eq:=eq & "ypart(obj(@#sb[@#tallest]).s-@#s)=" & + decimal(OptionValue@#("dy")) & ";"; + + ObjCode StandardEquations,eq; +% |"xpart(@#n)=xpart(@#s);ypart(@#ne)=ypart(@#nw);";| + StandardTies; +enddef; + +% The result of |setTallest| must be greater than 0. +vardef setTallest@#= + save tallest_height; + @#tallest:=1;tallest_height=0; + for i:=1 upto @#nst: + if ypart(obj(@#sb[i]).n-obj(@#sb[i]).s)>tallest_height: + @#tallest:=i; + tallest_height:=ypart(obj(@#sb[i]).n-obj(@#sb[i]).s); + fi; + endfor; +enddef; + +streamline("HBox")("(text sublist)","suffixlist(sublist)"); + +def BpathHBox(suffix n)= StandardBpath(n) enddef; + +def drawHBox(suffix n)= + drawFramedOrFilledObject_(n); + drawObjArray(n)(sb); + drawMemorizedPaths_(n); +enddef; + +% Default values of |HBox|: +setObjectDefaultOption("HBox")("dx")(0mm); +setObjectDefaultOption("HBox")("dy")(0mm); +setObjectDefaultOption("HBox")("hbsep")(1mm); +setObjectDefaultOption("HBox")("elementsize")(-1pt); % like PSTricks +setObjectDefaultOption("HBox")("align")("bot"); +setObjectDefaultOption("HBox")("framed")(false); +setObjectDefaultOption("HBox")("filled")(false); +setObjectDefaultOption("HBox")("fillcolor")(black); +setObjectDefaultOption("HBox")("framewidth")(.5bp); +setObjectDefaultOption("HBox")("framecolor")(black); +setObjectDefaultOption("HBox")("framestyle")(""); +setObjectDefaultOption("HBox")("flip")(false); +setObjectDefaultOption("HBox")("shadow")(false); % no shadow by default +setObjectDefaultOption("HBox")("shadowcolor")(black); + + +% Replace an element in an |HBox| or add an element at the end of the list. +% A succeeding call to this function resets the object. +vardef replaceHBoxElement.expl@#(expr i)(suffix rep)= + setcurrentobjname_(str @#); + if (i<1) or (i>@#sb.n_+1): + errmessage "Value out of range"; + elseif i<@#sb.n_+1: + % first, we reset the object in order to be sure we have its right + % dimensions when we try to update |tallest| + resetObj.expl@#; + @#sb[i]:=str rep; + % we recompute the tallest element: + setTallest@#; + resetObj.expl@#; + else: % |i=@#sb.n_+1| + % we add |rep| at the end of the |HBox| + % first, we reset the object in order to be sure we have its right + % dimensions when we try to update |tallest| + resetObj.expl@#; + @#sb.n_:=@#sb.n_+1; + @#sb[@#sb.n_]:=str rep; + setTallest@#; % not fast, but short + resetObj.expl@#; + % we need to add one tie, and the easiest is to recreate them all: + @#nsubobjties_:=0; + StandardTies; + fi; +enddef; + +% Delete an element in an |HBox| +% A succeeding call to this function resets the object. +vardef deleteHBoxElement.expl@#(expr i)= + setcurrentobjname_(str @#); + if (i<0) or (i>@#sb.n_): + errmessage "Value out of range"; + else: + resetObj.expl@#; + for j:=i upto @#sb.n_-1: + @#sb[j]:=@#sb[j+1]; + endfor; + @#sb[@#sb.n_]:=whateverstring; + @#sb.n_:=@#sb.n_-1; + setTallest@#; + resetObj.expl@#; + % we reconstruct the standard ties + @#nsubobjties_:=0; + StandardTies; + fi; +enddef; + + +% The next class is the vertical analog of |HBox|. It would have +% been possible to merge |newHBox| and |newVBox| in something like +% |newAlign| (|xpart| becoming |ypart|, |.w| becoming |.s|, etc.) +% but we didn't do it for the sake of clarity. It is left as an +% exercise. + +%===================================================================== +% |VBox| class + +% |VBox|: Generic Vertical Alignments +% The objects are stacked up (and not down as in \TeX). +% |@#| is a name for an object (must be a suffix) +% |@#| will be the number of the object, but will also be used +% as a prefix for other variables. +vardef newVBox@#(text sublist) text options = + ExecuteOptions(@#)(options); + assignObj(@#,"VBox"); + StandardInterface; + save n,i,eq;numeric n,i;string eq; + n=0; + forsuffixes $:=sublist:n:=n+1;endfor; + ObjSubArray(sb)(n); % |n| is the number of vertical elements + ObjNumeric nst,widest; + setNumeric(nst)(n); + i=0; + if OptionValue@#("flip"): + forsuffixes $:=sublist:i:=i+1; + SubObjectOfArray(sb[n+1-i],$); + endfor; + else: + forsuffixes $:=sublist:i:=i+1; + SubObjectOfArray(sb[i],$); + endfor; + fi; + % we now build the equations: + % 1: vertical equation: vertical separation between elements + % |ypart(sb[2].s-sb[1].n)=ypart(sb[3].s-sb[2].n)=...| + % |=ypart(sb[n].s-sb[n-1].n)=5mm;| + % 2: vertical equation: vertical space at the edges + % |ypart(sb[1].s-@#s)=ypart(@#n-sb[n].n)=0mm;| + % 3: horizontal equation: elements are lined up at the left (default) + % |xpart(sb[1].w)=xpart(sb[2].w)=...=xpart(sb[n].w)| + % or at the right (depending on the options) + % |xpart(sb[1].e)=xpart(sb[2].e)=...=xpart(sb[n].e)| + % or at the center + % |xpart(sb[1].c)=xpart(sb[2].c)=...=xpart(sb[n].c)| + % 4: horizontal equation: horizontal space at the right + % |xpart(@#e-sb[i].e)=0mm;| where |sb[i]| is the widest + % 5: horizontal equation: vertical space at the left + % |xpart(sb[i].w-@#w)=0mm;| where |sb[i]| is the widest + % 1: + if OptionValue@#("elementsize")<0: + eq:="if @#sb.n_>1:" & + "ypart(obj(@#sb[2]).s-obj(@#sb[1]).n)" & + "if @#sb.n_>2:" & + "for i:=3 upto @#sb.n_: " & + "=ypart(obj(@#sb[i]).s-obj(@#sb[i-1]).n)" & + "endfor " & + "fi" & + "=" & decimal(OptionValue@#("vbsep")) & ";" & + "fi;"; + else: + eq:="if @#sb.n_>1:" & + "ypart(obj(@#sb[2]).c-obj(@#sb[1]).c)" & + "if @#sb.n_>2:" & + "for i:=3 upto @#sb.n_: " & + "=ypart(obj(@#sb[i]).c-obj(@#sb[i-1]).c)" & + "endfor " & + "fi" & + "=" & + decimal(OptionValue@#("vbsep")+OptionValue@#("elementsize")) & ";" & + "fi;"; + fi; + % 2: |ypart(sb[1].s-@#s)=ypart(@#n-sb[n].n)=5mm;| + if OptionValue@#("elementsize")<0: + eq:=eq & "ypart(obj(@#sb[1]).s-@#s)" & + "=ypart(@#n-obj(@#sb[@#sb.n_]).n)=" & + decimal(OptionValue@#("dy")) & ";"; + else: + eq:=eq & "ypart(obj(@#sb[1]).c-@#s)" & + "=ypart(@#n-obj(@#sb[@#sb.n_]).c)=" & + decimal(OptionValue@#("dy")+.5*OptionValue@#("elementsize")) & ";"; + fi; + % The next equation depends on an option: + save alignsuffix;string alignsuffix; alignsuffix="w"; % default + if Option@#("align","right"):alignsuffix:="e"; + elseif Option@#("align","center"):alignsuffix:="c"; + fi; + + % 3: |xpart(sb[1].alignsuffix)=xpart(sb[2].alignsuffix)=...| + % |=xpart(sb[n].alignsuffix)| + eq:=eq & "if @#sb.n_>1:" & + "xpart(obj(@#sb[1])." & alignsuffix & ")" & + "for i:=2 upto @#sb.n_: " & + "=xpart(obj(@#sb[i])." & alignsuffix & ")" & + "endfor;" & + "fi;"; + % first, we compute the widest subtree: + setWidest@#; + % 4: |xpart(@#e-sb[widest].e)=0mm;| + eq:=eq & "xpart(@#e-obj(@#sb[@#widest]).e)=" & + decimal(OptionValue@#("dx")) & ";"; + % 5: |xpart(sb[widest].w-@#w)=0mm;| + eq:=eq & "xpart(obj(@#sb[@#widest]).w-@#w)=" & + decimal(OptionValue@#("dx")) & ";"; + ObjCode StandardEquations,eq; +% |"ypart(@#n)=ypart(@#s);xpart(@#ne)=xpart(@#nw);";| + StandardTies; +enddef; + +% The result of |setWidest| must be greater than 0. +vardef setWidest@#= + save widest_width;@#widest:=1;widest_width=0; + for i:=1 upto @#nst: + if xpart(obj(@#sb[i]).e-obj(@#sb[i]).w)>widest_width: + @#widest:=i; + widest_width:=xpart(obj(@#sb[i]).e-obj(@#sb[i]).w); + fi; + endfor; +enddef; + +streamline("VBox")("(text sublist)","suffixlist(sublist)"); + +def BpathVBox(suffix n)= StandardBpath(n) enddef; + +def drawVBox(suffix n)= + drawFramedOrFilledObject_(n); + drawObjArray(n)(sb); + drawMemorizedPaths_(n); +enddef; + +% Default values of |VBox|: +setObjectDefaultOption("VBox")("dx")(0mm); +setObjectDefaultOption("VBox")("dy")(0mm); +setObjectDefaultOption("VBox")("vbsep")(1mm); +setObjectDefaultOption("VBox")("elementsize")(-1pt); % like PSTricks +setObjectDefaultOption("VBox")("align")("left"); +setObjectDefaultOption("VBox")("framed")(false); +setObjectDefaultOption("VBox")("filled")(false); +setObjectDefaultOption("VBox")("fillcolor")(black); +setObjectDefaultOption("VBox")("framewidth")(.5bp); +setObjectDefaultOption("VBox")("framecolor")(black); +setObjectDefaultOption("VBox")("framestyle")(""); +setObjectDefaultOption("VBox")("flip")(false); +setObjectDefaultOption("VBox")("shadow")(false); % no shadow by default +setObjectDefaultOption("VBox")("shadowcolor")(black); + +% Replace an element in an |VBox| or add an element at the end of the list. +% A succeeding call to this function resets the object. +vardef replaceVBoxElement.expl@#(expr i)(suffix rep)= + setcurrentobjname_(str @#); + if (i<1) or (i>@#sb.n_+1): + errmessage "Value out of range"; + elseif i<@#sb.n_+1: + % first, we reset the object in order to be sure we have its right + % dimensions when we try to update |widest| + resetObj.expl@#; + @#sb[i]:=str rep; + % we recompute the widest element: + setWidest@#; + resetObj.expl@#; + else: % |i=@#sb.n_+1| + % we add |rep| at the end of the |VBox| + % first, we reset the object in order to be sure we have its right + % dimensions when we try to update |widest| + resetObj.expl@#; + @#sb.n_:=@#sb.n_+1; + @#sb[@#sb.n_]:=str rep; + setWidest@#; % not fast, but short + resetObj.expl@#; + % we need to add one tie, and the easiest is to recreate them all: + @#nsubobjties_:=0; + StandardTies; + fi; +enddef; + +% Delete an element in an |VBox| +% A succeeding call to this function resets the object. +% This function should be merged with |deleteHBoxElement.expl| +vardef deleteVBoxElement.expl@#(expr i)= + setcurrentobjname_(str @#); + if (i<0) or (i>@#sb.n_): + errmessage "Value out of range"; + else: + resetObj.expl@#; + for j:=i upto @#sb.n_-1: + @#sb[j]:=@#sb[j+1]; + endfor; + @#sb[@#sb.n_]:=whateverstring; + @#sb.n_:=@#sb.n_-1; + setWidest@#; + resetObj.expl@#; + % we reconstruct the standard ties + @#nsubobjties_:=0; + StandardTies; + fi; +enddef; + +%===================================================================== +% |Matrix| class + +% |Matrix|: Generic Matrix +% |@#| is a name for an object (must be a suffix) +% |@#| will be the number of the object, but will also be used +% as a prefix for other variables. +vardef newMatrix@#(expr Nx,Ny)(text elements) text options = + ExecuteOptions(@#)(options); + assignObj(@#,"Matrix"); + StandardInterface; + save i,eq;numeric i;string eq; + ObjSubArray(sb)(Nx*Ny); + ObjNumeric nx,ny; + setNumeric(nx)(Nx); + setNumeric(ny)(Ny); + ObjNumericArray(wd)(Ny); + ObjNumericArray(ht)(Nx); + + i=0; + forsuffixes $:=elements:i:=i+1; + if $<>0: % null box + SubObjectOfArray(sb[i],$); + fi; + endfor; + + % We compute for each column, which element is the widest, + % and for each line, which one is the tallest; the indices + % are stored in the |wd| and |ht| arrays: + % This assumes that there is at least one object in each column + % and line. + % First, the tallest elements in each line: + if OptionValue@#("matrixnodevsize")<0: + for i:=1 upto Nx: + % find the first column which contains an object and initialize + % |@#ht[i]| to its index: + @#ht[i]=0; + for k:=1 upto Ny: + if known @#sb[(i-1)*Ny+k]: @#ht[i]:=k;fi; + exitif @#ht[i]=k; + endfor; + for j:=@#ht[i]+1 upto Ny: + if known @#sb[(i-1)*Ny+j]: + if ypart(obj(@#sb[(i-1)*Ny+j]).n-obj(@#sb[(i-1)*Ny+j]).s)> + ypart(obj(@#sb[(i-1)*Ny+@#ht[i]]).n-obj(@#sb[(i-1)*Ny+@#ht[i]]).s): + @#ht[i]:=j; + fi; + fi; + endfor; + @#ht[i]:=(i-1)*Ny+@#ht[i]; + endfor; + else: + for i:=1 upto Nx: + @#ht[i]=1; + endfor; + fi; + + % Then, the widest elements in each column: + if OptionValue@#("matrixnodehsize")<0: + for i:=1 upto Ny: + @#wd[i]=0; + % find the first line which contains an object and initialize + % |@#wd[i]| to its index: + for k:=1 upto Nx: + if known @#sb[(k-1)*Ny+i]: @#wd[i]:=k;fi; + exitif @#wd[i]=k; + endfor; + for j:=@#wd[i]+1 upto Nx: + if known @#sb[(j-1)*Ny+i]: + if xpart(obj(@#sb[(j-1)*Ny+i]).e-obj(@#sb[(j-1)*Ny+i]).w)> + xpart(obj(@#sb[(@#wd[i]-1)*Ny+i]).e-obj(@#sb[(@#wd[i]-1)*Ny+i]).w): + @#wd[i]:=j; + fi; + fi; + endfor; + @#wd[i]:=(@#wd[i]-1)*Ny+i; + endfor; + else: + for i:=1 upto Ny: + @#wd[i]=1; + endfor; + fi; + % The basic equations are: + % horizontally: + % |xpart(sb[wd(1)].w-@#w)=5mm;| + % |xpart(@#e-sb[wd(ny)].e)=5mm;| + % |for i=1 upto ny-1| + % |xpart(sb[wd(i+1)].w-sb[wd(i)].e)=5mm;| **** + % |for i=1 upto ny| + % |for j=1 upto nx| + % |xpart(sb[(j-1)*ny+i].c)=xpart(sb[wd(i)].c)| + % vertically: + % |ypart(@#n-sb[ht(1)].n)=5mm;| + % |ypart(sb[ht(nx)].s-@#s)=5mm;| + % |for i=1 upto nx-1| + % |ypart(sb[ht(i)].s-sb[ht(i+1)].n)=5mm;| **** + % |for i=1 upto ny| + % |for j=1 upto nx| + % |ypart(sb[(j-1)*ny+i].c)=ypart(sb[ht(j)].c)| + % + % `****' shows where matrixnode(h/v)size needs to be taken into account + % These two equations become: + % |xpart(sb[wd(i+1)].c-sb[wd(i)].c)=matrixnodehsize;| + % |ypart(sb[ht(i)].c-sb[ht(i+1)].c)=matrixnodevsize;| + % + % By not hardwiring the widest and tallest elements + % we allow ourselves the possibility to replace elements + % and still have the size adjusted (after resetting the object). + % The only assumption is that there is always at least one non null + % object in each column and each line. + + eq:="save fal_;" & + "vardef fal_(expr i,s)=" & + "save l;" & + "hide(l=length(s);)" & + "substring if i>l: (l-1,l) else: (i-1,i) fi of s " & + "enddef; " & + "xpart(obj(@#sb[@#wd[1]]).w-@#w)=" & decimal (OptionValue@#("dx")) &";" & + "xpart(@#e-obj(@#sb[@#wd[@#ny]]).e)=" & + decimal (OptionValue@#("dx")) &";" & + "for i:=1 upto @#ny-1:"; + if OptionValue@#("matrixnodehsize")>=0: + eq:=eq & + "xpart(obj(@#sb[@#wd[i+1]]).c-obj(@#sb[@#wd[i]]).c)=" & + decimal (OptionValue@#("matrixnodehsize")) &";"; + else: + eq:=eq & + "xpart(obj(@#sb[@#wd[i+1]]).w-obj(@#sb[@#wd[i]]).e)=" & + decimal (OptionValue@#("hsep")) &";"; + fi; + eq:=eq & + "endfor;" & + "for i:=1 upto @#ny:" & + "for j:=1 upto @#nx:" & + "if ((j-1)*@#ny+i<>@#wd[i]) and (known @#sb[(j-1)*@#ny+i]):" & + "xpart(obj(@#sb[(j-1)*@#ny+i]).sc_(fal_(i," & + quote(OptionValue@#("halign")) & ")))" & + "=xpart(obj(@#sb[@#wd[i]]).sc_(fal_(i," & + quote(OptionValue@#("halign")) & ")));" & + "fi;" & + "endfor;" & + "endfor;" & + "ypart(@#n-obj(@#sb[@#ht[1]]).n)=" & decimal (OptionValue@#("dy")) &";" & + "ypart(obj(@#sb[@#ht[@#nx]]).s-@#s)=" & + decimal (OptionValue@#("dy")) &";" & + "for i:=1 upto @#nx-1:"; + if OptionValue@#("matrixnodevsize")>=0: + eq:=eq & + "ypart(obj(@#sb[@#ht[i]]).s-obj(@#sb[@#ht[i+1]]).n)=" & + decimal (OptionValue@#("matrixnodevsize")) &";"; + else: + eq:=eq & + "ypart(obj(@#sb[@#ht[i]]).s-obj(@#sb[@#ht[i+1]]).n)=" & + decimal (OptionValue@#("vsep")) &";"; + fi; + eq:=eq & + "endfor;" & + "for i:=1 upto @#ny:" & + "for j:=1 upto @#nx:" & + "if ((j-1)*@#ny+i<>@#ht[j]) and (known @#sb[(j-1)*@#ny+i]):" & + "ypart(obj(@#sb[(j-1)*@#ny+i]).sc_(fal_(i," & + quote(OptionValue@#("valign")) & ")))" & + "=ypart(obj(@#sb[@#ht[j]]).sc_(fal_(i," & + quote(OptionValue@#("valign")) & ")));" & + "fi;" & + "endfor;" & + "endfor;"; + ObjCode StandardEquations,eq; + StandardTies; +enddef; + +streamline("Matrix")("(expr nx,ny)(text sublist)", + "(nx,ny)suffixlist(sublist)"); + +def BpathMatrix(suffix n)= StandardBpath(n) enddef; + +def drawMatrix(suffix n)= + drawFramedOrFilledObject_(n); + drawObjArray(n)(sb); + drawMemorizedPaths_(n); +enddef; + +% Default values of |Matrix|: +setObjectDefaultOption("Matrix")("dx")(0mm); +setObjectDefaultOption("Matrix")("dy")(0mm); +setObjectDefaultOption("Matrix")("hsep")(1mm); +setObjectDefaultOption("Matrix")("vsep")(1mm); +setObjectDefaultOption("Matrix")("halign")("c"); +setObjectDefaultOption("Matrix")("valign")("c"); +setObjectDefaultOption("Matrix")("framed")(false); +setObjectDefaultOption("Matrix")("filled")(false); +setObjectDefaultOption("Matrix")("fillcolor")(black); +setObjectDefaultOption("Matrix")("framewidth")(.5bp); +setObjectDefaultOption("Matrix")("framecolor")(black); +setObjectDefaultOption("Matrix")("framestyle")(""); +setObjectDefaultOption("Matrix")("shadow")(false); % no shadow by default +setObjectDefaultOption("Matrix")("shadowcolor")(black); +setObjectDefaultOption("Matrix")("matrixnodehsize")(-1pt); +setObjectDefaultOption("Matrix")("matrixnodevsize")(-1pt); + + +% Some special functions on matrices: + +% This function replaces the element at position (i,j) by element |rep| +% Since we call |resetObj.expl|, this function cancels transformations. +% However, the new matrix has its equations correctly applied +% to the new object. +% |i| is the line, |j| the column +% It is possible to create new columns or new lines by giving to +% |i| (or |j|) the value of the number of lines (or columns) plus one. +vardef replaceMatrixElement.expl@#(expr i,j)(suffix rep)= + % first, we reset the object in order to be sure we have its right + % dimensions when we try to update |ht[i]| and |wd[j]| + resetObj.expl@#; + + % first, see if a new column or a new line are needed + if i=@#nx+1: + if (j>0) and (j<=@#ny): + % create new line + @#nx:=@#nx+1; + @#sb.n_:=@#nx*@#ny; + + % increase size of |@#ht[]| array + @#ht.n_:=@#nx; + + @#ht[i]=(i-1)*@#ny+j; + if xpart(rep.e-rep.w)>xpart(obj(@#sb[@#wd[j]]).e-obj(@#sb[@#wd[j]]).w): + @#wd[j]:=(i-1)*@#ny+j; + fi; + % we replace the string representing the subobject + @#sb[(i-1)*@#ny+j]:= str rep; + % we reset the object again, this time in order to take the changes + % to |ht[i]| and |wd[j]| into account + resetObj.expl@#; + + elseif j=@#ny+1: + % in this case, we create a new line and a new column + % first, a new column: + addmatrixcolumn_@#; + + % create new line + @#nx:=@#nx+1; + @#sb.n_:=@#nx*@#ny; + % increase sizes of |@#ht[]| array + @#ht.n_:=@#nx; + + % we now update |@#ht| and |@#wd| because of the new object; + % this is easy, because the object is alone on its line and column. + @#ht[@#nx]:=@#nx*@#ny; + @#wd[@#ny]:=@#nx*@#ny; + % we add the subobject: + @#sb[@#nx*@#ny]:= str rep; + % and we reset the object + + resetObj.expl@#; + else: + errmessage "Column number out of range"; + fi; + elseif (i>@#nx+1) or (i<1): + errmessage "Line number out of range"; + else: + if (j>0) and (j<=@#ny): + % AVERAGE CASE + % we replace the string representing the subobject + @#sb[(i-1)*@#ny+j]:= str rep; + % we recompute the |ht[i]| and |wd[j]| values; since it is possible + % that we replace the largest element by a smaller one, the new largest + % element can be different from both the previous largest and the + % new element; so, in order to simplify the code, we recompute + % |ht[i]| and |wd[j]| from scratch. + @#ht[i]:=(i-1)*@#ny+j; % we are sure this element exists + updateHeight_@#(i); + @#wd[j]:=(i-1)*@#ny+j; % we are sure this element exists + updateWidth_@#(j); + % we reset the object again, this time in order to take the changes + % to |ht[i]| and |wd[j]| into account + resetObj.expl@#; + + elseif j=@#ny+1: + addmatrixcolumn_@#; + @#sb.n_:=@#nx*@#ny; + + % we now update |@#ht| and |@#wd| because of the new object; + % the width is easy, because the object is alone on its column. + + @#wd[@#ny]:=i*@#ny; + + % for the height, we update |@#ht[i]|: + if ypart(rep.n-rep.s) > ypart(obj(@#sb[@#ht[i]]).n-obj(@#sb[@#ht[i]]).s): + @#ht[i]:=i*@#ny; + fi; + + % we add the subobject: + @#sb[i*@#ny]:= str rep; + % and we reset the object + resetObj.expl@#; + else: + errmessage "Column number out of range"; + fi; + fi; +enddef; + +% This function is only used by |replaceMatrixElement.expl| +vardef addmatrixcolumn_@#= + % create a new column + for k:=@#nx downto 1: + for l:=@#ny downto 1: + if known @#sb[(k-1)*@#ny+l]: + @#sb[(k-1)*(@#ny+1)+l]:=@#sb[(k-1)*@#ny+l]; + else: + @#sb[(k-1)*(@#ny+1)+l]:=whateverstring; + fi; + endfor; + endfor; + % we must also refresh the new column: + for k:= 1 upto @#nx: + @#sb[k*(@#ny+1)]:=whateverstring; + endfor; + + % The values of |@#ht[i]| and |@#wd[i]| are now incorrect + % because of the new column that changed the indices. + % + for k:=1 upto @#nx: + @#ht[k]:=@#ht[k]+((@#ht[k]-1) div @#ny); + endfor; + for k:=1 upto @#ny: + @#wd[k]:=@#wd[k]+((@#wd[k]-1) div @#ny); + endfor; + @#ny:=@#ny+1; + % increase sizes of |@#wd[]| array + @#wd.n_:=@#ny; +enddef; + + +% This function is only used by |replaceMatrixElement.expl| +vardef updateHeight_@#(expr i)= + for k:=1 upto @#ny: + if known @#sb[(i-1)*@#ny+k]: + if @#ht[i]>0: + if ypart(obj(@#sb[(i-1)*@#ny+k]).n-obj(@#sb[(i-1)*@#ny+k]).s)> + ypart(obj(@#sb[@#ht[i]]).n-obj(@#sb[@#ht[i]]).s): + @#ht[i]:=(i-1)*@#ny+k; + fi; + else: + @#ht[i]:=(i-1)*@#ny+k; + fi; + fi; + endfor; +enddef; + +% This function is only used by |replaceMatrixElement.expl| +vardef updateWidth_@#(expr j)= + for k:=1 upto @#nx: + if known @#sb[(k-1)*@#ny+j]: + if @#wd[j]>0: + if xpart(obj(@#sb[(k-1)*@#ny+j]).e-obj(@#sb[(k-1)*@#ny+j]).w)> + xpart(obj(@#sb[@#wd[j]]).e-obj(@#sb[@#wd[j]]).w): + @#wd[j]:=(k-1)*@#ny+j; + fi; + else: + @#wd[j]:=(k-1)*@#ny+j; + fi; + fi; + endfor; +enddef; + +% Delete matrix element (i,j). In certain cases, we reduce the number +% of columns or lines. +% We assume that after deletion the matrix is not empty. +vardef deleteMatrixElement.expl@#(expr i,j)= + % The easy case is when the element we want to remove was neither + % alone on its line, nor on its column + if isaloneoncolumn_@#(i,j): + if isaloneonline_@#(i,j): % case 1 (toughest case) + % Here, we have to shift up to three whole blocks of the matrix + for k:=1 upto (@#nx-1)*(@#ny-1): + if known @#sb[transfer_@#(k,@#nx-1,@#ny-1,i,j)]: + @#sb[k]:=@#sb[transfer_@#(k,@#nx-1,@#ny-1,i,j)]; + else: + @#sb[k]:=whateverstring; + fi; + endfor; + + % the last column and line must be refreshed + for k:=(@#nx-1)*(@#ny-1)+1 upto @#nx*@#ny: + @#sb[k]:=whateverstring; + endfor; + + % |@#wd[]| and |@#ht[]| must be updated, + % as well as their number of elements. + for k:=1 upto i-1: + @#ht[k]:=transferi_@#(@#ht[k],@#nx-1,@#ny-1,i,j); + endfor; + for k:=i+1 upto @#nx: + @#ht[k-1]:=transferi_@#(@#ht[k],@#nx-1,@#ny-1,i,j); + endfor; + for k:=1 upto j-1: + @#wd[k]:=transferi_@#(@#wd[k],@#nx-1,@#ny-1,i,j); + endfor; + for k:=j+1 upto @#ny: + @#wd[k-1]:=transferi_@#(@#wd[k],@#nx-1,@#ny-1,i,j); + endfor; + + % |@#nx| and |@#ny| must be updated + @#nx:=@#nx-1;@#ny:=@#ny-1; + @#sb.n_:=@#nx*@#ny; + + @#ht.n_:=@#ht.n_-1;@#wd.n_:=@#wd.n_-1; + + else: % case 2: we remove column |j| + for k:=1 upto @#nx*(@#ny-1): + if known @#sb[transfer_@#(k,@#nx,@#ny-1,@#nx+1,j)]: + @#sb[k]:=@#sb[transfer_@#(k,@#nx,@#ny-1,@#nx+1,j)]; + else: + @#sb[k]:=whateverstring; + fi; + endfor; + % the last column must be refreshed + for k:=@#nx*(@#ny-1)+1 upto @#nx*@#ny: + @#sb[k]:=whateverstring; + endfor; + + % |@#wd[]| and |@#ht[]| must be updated, + % as well as their number of elements. + for k:=1 upto @#nx: + @#ht[k]:=transferi_@#(@#ht[k],@#nx,@#ny-1,@#nx+1,j); + endfor; + % SPECIAL TREATMENT FOR |@#ht[i]|: + @#ht[i]:=0;updateHeight_@#(i); + + for k:=1 upto j-1: + @#wd[k]:=transferi_@#(@#wd[k],@#nx,@#ny-1,@#nx+1,j); + endfor; + for k:=j+1 upto @#ny: + @#wd[k-1]:=transferi_@#(@#wd[k],@#nx,@#ny-1,@#nx+1,j); + endfor; + + % |@#ny| must be updated + @#ny:=@#ny-1; + @#sb.n_:=@#nx*@#ny; + + @#wd.n_:=@#wd.n_-1; + + fi; + else: + if isaloneonline_@#(i,j): % case 3: we remove line |i| + for k:=1 upto (@#nx-1)*@#ny: + if known @#sb[transfer_@#(k,@#nx-1,@#ny,i,@#ny+1)]: + @#sb[k]:=@#sb[transfer_@#(k,@#nx-1,@#ny,i,@#ny+1)]; + else: + @#sb[k]:=whateverstring; + fi; + endfor; + + % the last line must be refreshed + for k:=(@#nx-1)*@#ny+1 upto @#nx*@#ny: + @#sb[k]:=whateverstring; + endfor; + + % |@#wd[]| and |@#ht[]| must be updated, + % as well as their number of elements. + for k:=1 upto i-1: + @#ht[k]:=transferi_@#(@#ht[k],@#nx-1,@#ny,i,@#ny+1); + endfor; + for k:=i+1 upto @#nx: + @#ht[k-1]:=transferi_@#(@#ht[k],@#nx-1,@#ny,i,@#ny+1); + endfor; + for k:=1 upto @#ny: + @#wd[k]:=transferi_@#(@#wd[k],@#nx-1,@#ny,i,@#ny+1); + % SPECIAL TREATMENT FOR |@#wd[j]|: + endfor; + @#wd[j]:=0;updateWidth_@#(j); + % |@#nx| and |@#ny| must be updated + @#nx:=@#nx-1; + @#sb.n_:=@#nx*@#ny; + + @#ht.n_:=@#ht.n_-1; + + else: % case 4 (easiest case) + % we cancel the subobject + @#sb[(i-1)*@#ny+j]:=whateverstring; + % and we recompute the |@#ht[i]| and |@#wd[j]| values: + @#ht[i]:=0;updateHeight_@#(i); + @#wd[j]:=0;updateWidth_@#(j); + fi; + fi; + resetObj.expl@#; +enddef; + +% This function is only used by |deleteMatrixElement.expl| +% Given a slot |n| in a matrix |nnx|$\times$|nny|, where |nnx=@#nx| or +% |@#nx-1|, and |nny=@#ny| or |@#ny-1|, this function finds +% the slot number from the matrix |@#nx|$\times$|@#ny|. +% |i| and |j| are the missing line and column indexes +% If either |i| or |j| is equal to 0, only a line or only a column is missing. +vardef transfer_@#(expr n,nnx,nny,i,j)= + save l,c,res; + hide( + % line and column of |n|: + l=((n-1) div nny)+1; + c=n-(l-1)*nny; + if i*j>0: + if (l>=1) and (l<i): + if c<j: res=(l-1)*@#ny+c; + else: res=(l-1)*@#ny+c+1; + fi; + elseif (l>=i): + if c<j: res=l*@#ny+c; + else: res=l*@#ny+c+1; + fi; + else: + errmessage "Function not defined"; + fi; + else: + errmessage "This should not happen"; + fi; + ) res +enddef; + +% This is an inverse to |transfer_|. +% |n| is an index in the |@#nx|$\times$|@#ny| matrix, +% the new matrix is |nnx|$\times$|nny| and |i| and |j| are the cuts. +% The function returns the index in the new matrix. +vardef transferi_@#(expr n,nnx,nny,i,j)= + save l,c,res; + hide( + % line and column of |n|: + l=((n-1) div @#ny)+1; + c=n-(l-1)*@#ny; + % FIRST, THE CASE WHERE |i|*|j|>0: + if i*j>0: + if (l>=1) and (l<i): + if c<j: res=(l-1)*nny+c; + else: res=(l-1)*nny+c-1; + fi; + elseif (l>=i): + if c<j: res=(l-2)*nny+c; + else: res=(l-2)*nny+c-1; + fi; + else: + errmessage "Function not defined"; + fi; + else: + errmessage "This should not happen"; + fi; + ) res +enddef; + +% This function is only used by |deleteMatrixElement.expl| +vardef isaloneoncolumn_@#(expr i,j)= + save res;boolean res;res=true; + for k:=1 upto @#nx: + if (k<>i) and (known @#sb[(k-1)*@#ny+j]): + res:=false; + fi; + endfor; + res +enddef; + +% This function is only used by |deleteMatrixElement.expl| +vardef isaloneonline_@#(expr i,j)= + save res;boolean res;res=true; + for k:=1 upto @#ny: + if (k<>j) and (known @#sb[(i-1)*@#ny+k]): + res:=false; + fi; + endfor; + res +enddef; + +% add brackets to an object +% the left bracket is |left| and the right bracket is |right| +vardef bracketit.expl(suffix $)(expr left,right)= + save ratio;numeric ratio; + ratio=ypart($n-$s)/ypart(urcorner left-lrcorner left); + settodefaultifnotknown_("labshift")(pair) + ((-.5ratio*xpart(urcorner left-ulcorner left),0)); + ObjLabel.$(left scaled ratio) "labpoint(w)"; + ratio:=ypart($n-$s)/ypart(urcorner right-lrcorner right); + o_labshift_val:=(.5ratio*xpart(urcorner right-ulcorner right),0); + ObjLabel.$(right scaled ratio) "labpoint(e)"; +enddef; + +%===================================================================== +% Definitions specific to the |EmptyBox| class + +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +vardef newEmptyBox@#(expr dx,dy) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"EmptyBox"); + StandardInterface; + ObjCode StandardEquations, + "@#ise-@#isw=(" & decimal dx & ",0)", + "@#ine-@#ise=(0," & decimal dy & ")"; +enddef; + +% shortcut (PSTricks compatibility) +def Tn= + new_EmptyBox(0,0) +enddef; + +streamline("EmptyBox")("(expr dx,dy)","(dx,dy)"); + +def BpathEmptyBox(suffix n)=StandardBpath(n) enddef; + +def drawEmptyBox(suffix n)= + if show_empty_boxes: + drawFramedOrFilledObject_(n); + fi; + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("EmptyBox")("filled")(false); +setObjectDefaultOption("EmptyBox")("fillcolor")(black); +setObjectDefaultOption("EmptyBox")("framed")(false); +setObjectDefaultOption("EmptyBox")("framewidth")(.5bp); +setObjectDefaultOption("EmptyBox")("framecolor")(black); +setObjectDefaultOption("EmptyBox")("framestyle")(""); +setObjectDefaultOption("EmptyBox")("shadow")(false); % no shadow by default +setObjectDefaultOption("EmptyBox")("shadowcolor")(black); + + +% |HRazor| and |VRazor| are just wrappers around the |EmptyBox| class +vardef newHRazor@#(expr dx) text options =newEmptyBox@#(dx,0) options enddef; +vardef new_HRazor(expr dx)= new_EmptyBox(dx,0) enddef; +vardef newVRazor@#(expr dy) text options =newEmptyBox@#(0,dy) options enddef; +vardef new_VRazor(expr dy)= new_EmptyBox(0,dy) enddef; + +% Moreover, we define two handy abbreviations for the streamlined versions: +def HR(expr dx)=new_HRazor(dx) enddef; +def VR(expr dy)=new_VRazor(dy) enddef; + +%===================================================================== +% Definitions specific to the |RandomBox| class +% A class ``|RandomBox|'' with four random points. + +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +% |wd| is the width, |ht| the height, and |dx| and |dy| are +% maximum allowed variations. Then to each point are +% added |(uniformdeviate(dx),uniformdeviate(dy))| +vardef newRandomBox@#(expr wd,ht,dx,dy) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"RandomBox"); + StandardInterface; + % The random calculations are done only once, when the object + % is created. So, there are no problems for duplicating such + % an object. + ObjCode MinimumStandardEquations, + "xpart(@#ine)-xpart(@#inw)=" & decimal (wd+uniformdeviate(dx)-dx/2), + "xpart(@#ise)-xpart(@#inw)=" & decimal (wd+uniformdeviate(dx)-dx/2), + "xpart(@#isw)-xpart(@#inw)=" & decimal (uniformdeviate(dx)-dx/2), + "ypart(@#inw)-ypart(@#ine)=" & decimal (uniformdeviate(dy)-dy/2), + "ypart(@#inw)-ypart(@#ise)=" & decimal (ht+uniformdeviate(dy)-dy/2), + "ypart(@#inw)-ypart(@#isw)=" & decimal (ht+uniformdeviate(dy)-dy/2); +enddef; + +streamline("RandomBox")("(expr wd,ht,dx,dy)","(wd,ht,dx,dy)"); + +def BpathRandomBox(suffix n)=StandardBpath(n) enddef; + +def drawRandomBox(suffix n)= + drawFramedOrFilledObject_(n); + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("RandomBox")("filled")(false); +setObjectDefaultOption("RandomBox")("fillcolor")(black); +setObjectDefaultOption("RandomBox")("framed")(true); +setObjectDefaultOption("RandomBox")("framewidth")(.5bp); +setObjectDefaultOption("RandomBox")("framecolor")(black); +setObjectDefaultOption("RandomBox")("framestyle")(""); +setObjectDefaultOption("RandomBox")("shadow")(false); % no shadow by default +setObjectDefaultOption("RandomBox")("shadowcolor")(black); + +%===================================================================== +% Definitions specific to the |RecursiveBox| class +% A class ``|RecursiveBox|'' with four points. + +% A constructor initializing a box containing |n| levels of itself. +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +vardef newRecursiveBox@#(expr n) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"RecursiveBox"); + StandardInterface; + % we create a subobject only when |n|>0 + if n>0: + % we find a name for the subobject: + SubObject(sub,obj(newobjstring_)); + % and we continue to create the hierarchy: + newRecursiveBox.obj(@#sub)(n-1); + rotateObj(obj(@#sub),OptionValue@#("rotangle")); + % the equations are slightly adapted from |newBB|: + ObjCode StandardEquations, + "save lftmost,rtmost,topmost,botmost;", + "string lftmost,rtmost,topmost,botmost;", + "lftmost=find_lft_most.obj(@#sub);", + "rtmost =find_rt_most.obj(@#sub);", + "topmost=find_top_most.obj(@#sub);", + "botmost=find_bot_most.obj(@#sub);", + "xpart(@#inw)=xpart(obj(@#sub).obj(lftmost));", + "xpart(@#ine)=xpart(obj(@#sub).obj(rtmost));", + "ypart(@#inw)=ypart(obj(@#sub).obj(topmost));", + "ypart(@#isw)=ypart(obj(@#sub).obj(botmost));"; + else: + ObjCode StandardEquations, + "@#ise-@#isw=(" & decimal (OptionValue@#("dx")) & ",0)", + "@#ine-@#ise=(0," & decimal (OptionValue@#("dy")) & ")"; + fi; + StandardTies; +enddef; + +streamline("RecursiveBox")("(expr n)","(n)"); + +def BpathRecursiveBox(suffix n)=StandardBpath(n) enddef; + +def drawRecursiveBox(suffix n)= + drawFramedOrFilledObject_(n); + if known n.sub: + drawObj(obj(n.sub)); + fi; + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("RecursiveBox")("filled")(false); +setObjectDefaultOption("RecursiveBox")("fillcolor")(black); +setObjectDefaultOption("RecursiveBox")("framed")(true); +setObjectDefaultOption("RecursiveBox")("framewidth")(.5bp); +setObjectDefaultOption("RecursiveBox")("framecolor")(black); +setObjectDefaultOption("RecursiveBox")("framestyle")(""); +setObjectDefaultOption("RecursiveBox")("dx")(5cm); +setObjectDefaultOption("RecursiveBox")("dy")(5cm); +setObjectDefaultOption("RecursiveBox")("rotangle")(10); +setObjectDefaultOption("RecursiveBox")("shadow")(false); % no shadow by default +setObjectDefaultOption("RecursiveBox")("shadowcolor")(black); + +%===================================================================== +% Definitions specific to the |VonKochFlake| class +% This class draws a generic Von Koch flake. + +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +vardef newVonKochFlake@#(expr n) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"VonKochFlake"); + StandardInterface; + % define a triangle + ObjPoint A,B,C; + save p; + pair p[]; + % Compute the three vertices: + p2-p1=(10cm,0);p3-p1=(p2-p1) rotated 60; + % we create subobjects only when |n|>0 + if n>0: + % we find names for the three subobjects + % (one for each side of the triangle) + SubObject(suba,obj(newobjstring_)); + SubObject(subb,obj(newobjstring_)); + SubObject(subc,obj(newobjstring_)); + % and we continue to create the hierarchy: + newVonKochSide.obj(@#suba)(p1,p2,n-1); + newVonKochSide.obj(@#subb)(p2,p3,n-1); + newVonKochSide.obj(@#subc)(p3,p1,n-1); + ObjCode StandardEquations, + "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")", + "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")", + "@#A=@#isw","@#B=@#ise", "ypart(@#C)=ypart(@#inw)", + "@#A=obj(@#suba).A=obj(@#subc).E", + "@#B=obj(@#suba).E=obj(@#subb).A", + "@#C=obj(@#subb).E=obj(@#subc).A"; + else: + ObjCode StandardEquations, + "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")", + "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")", + "@#A=@#isw","@#B=@#ise","ypart(@#C)=ypart(@#inw)"; + fi; + StandardTies; +enddef; + +streamline("VonKochFlake")("(expr n)","(n)"); + +def BpathVonKochFlake(suffix n)=n.A--n.B--n.C--cycle enddef; + +def drawVonKochFlake(suffix n)= + if known n.suba:drawObj(obj(n.suba));else: draw n.A--n.B;fi; + if known n.subb:drawObj(obj(n.subb));else: draw n.B--n.C;fi; + if known n.subc:drawObj(obj(n.subc));else: draw n.C--n.A;fi; + drawMemorizedPaths_(n); +enddef; + +%===================================================================== +% Definitions specific to the |VonKochSide| class +% This class draws a generic Von Koch flake side. + +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +vardef newVonKochSide@#(expr pa,pb,n) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"VonKochSide"); + StandardInterface; + % define a triangle + ObjPoint A,B,C,D,E; + save p; + pair p[]; + % Compute the five vertices: + p1=pa;p5=pb;p2-p1=p4-p2=p5-p4=(p4-p3) rotated -60=(p3-p2) rotated 60; + % we create subobjects only when |n|>0 + if n>0: + % we find names for the four subobjects + % (one for each of the subdivision of the sides) + SubObject(suba,obj(newobjstring_)); + SubObject(subb,obj(newobjstring_)); + SubObject(subc,obj(newobjstring_)); + SubObject(subd,obj(newobjstring_)); + % and we continue to create the hierarchy: + newVonKochSide.obj(@#suba)(p1,p2,n-1); + newVonKochSide.obj(@#subb)(p2,p3,n-1); + newVonKochSide.obj(@#subc)(p3,p4,n-1); + newVonKochSide.obj(@#subd)(p4,p5,n-1); + ObjCode StandardEquations, + "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")", + "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")", + "@#D-@#A=(" & decimal xpart(p4-p1) & "," & decimal ypart(p4-p1) & ")", + "@#E-@#A=(" & decimal xpart(p5-p1) & "," & decimal ypart(p5-p1) & ")", + "@#isw=@#A","@#ine=@#E", + "@#A=obj(@#suba).A", + "@#B=obj(@#suba).E=obj(@#subb).A", + "@#C=obj(@#subb).E=obj(@#subc).A", + "@#D=obj(@#subc).E=obj(@#subd).A", + "@#E=obj(@#subd).E"; + else: + ObjCode StandardEquations, + "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")", + "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")", + "@#D-@#A=(" & decimal xpart(p4-p1) & "," & decimal ypart(p4-p1) & ")", + "@#E-@#A=(" & decimal xpart(p5-p1) & "," & decimal ypart(p5-p1) & ")", + "@#isw=(xpart(@#A),ypart(@#A))", "@#ine=(xpart(@#E),ypart(@#E))"; + fi; + StandardTies; +enddef; + +streamline("VonKochSide")("(expr pa,pb,n)","(pa,pb,n)"); + +def BpathVonKochSide(suffix n)=n.A--n.B--n.C--n.D--n.E enddef; + +def drawVonKochSide(suffix n)= + if known n.suba:drawObj(obj(n.suba));else: draw n.A--n.B;fi; + if known n.subb:drawObj(obj(n.subb));else: draw n.B--n.C;fi; + if known n.subc:drawObj(obj(n.subc));else: draw n.C--n.D;fi; + if known n.subd:drawObj(obj(n.subd));else: draw n.D--n.E;fi; + drawMemorizedPaths_(n); +enddef; + +%===================================================================== +% Definitions specific to the |Box| class +% A class ``Box'' with four points. + +% A constructor initializing the variable |p| (picture) +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +% |v| is either a picture, a string or an object given by its number +vardef newBox@#(expr v) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"Box"); + StandardInterface; + StandardObjectOrPictureContainerSetup(v); + if OptionValue@#("rbox_radius")>0: + ObjPoint ene,ese,sse,ssw,wsw,wnw,nnw,nne; + % we use paths for the rounded corners if necessary + addPathVariables@#(_spath_); + fi; + if not OptionValue@#("fit"): + @#a:=max(@#a,@#b);@#b:=@#a; % square + fi; + ObjCode StandardEquations, + if numeric v: + ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object + elseif (picture v) or (string v): + ".5[@#isw,@#ine]=@#p.off", % picture offset + fi + if OptionValue@#("rbox_radius")>0: + "@#ine-@#nne=@#ise-@#sse=@#nnw-@#inw=@#ssw-@#isw=(" & + decimal (OptionValue@#("rbox_radius")) & ",0)", + "@#ine-@#ene=@#ese-@#ise=@#inw-@#wnw=@#wsw-@#isw=(0," & + decimal (OptionValue@#("rbox_radius")) & ")", + fi + "@#ise-@#isw=(" & decimal (2@#a+2*OptionValue@#("dx")) & ",0)", + "@#ine-@#ise=(0," & decimal (2@#b+2*OptionValue@#("dy")) & ")"; + StandardTies; + if OptionValue@#("rbox_radius")>0: + addPath@#(_spath_,1, + @#nnw{left}..{down}@#wnw--@#wsw{down} + ..{right}@#ssw--@#sse{right}..{up}@#ese--@#ene{up} + ..{left}@#nne--cycle + ); + defineBox_pathparameters(@#); + fi; +enddef; + +def defineBox_pathparameters(suffix $)= + $_spath_.n_:=1; + $_spath_._draw_[1]:=LocalOptionValue("cdraw","cdraw_default"); + $_spath_.visible[1]:=true; + $_spath_.pathfilled[1]:=false; + $_spath_.pathfillcolor[1]:=black; + $_spath_.border[1]:=CLOV_("border"); + $_spath_.bordercolor[1]:=CLOV_("bordercolor"); + $_spath_.linewidth[1]:=OptionValue$("framewidth"); + $_spath_.linecolor[1]:=OptionValue$("framecolor"); + $_spath_.nodesepA[1]:=0; + $_spath_.nodesepB[1]:=0; + $_spath_.arrows[1]:="draw"; + $_spath_.linestyle[1]:=CLOV_("linestyle"); + $_spath_.doubleline[1]:=false; + forsuffixes $$=_draw_,visible,border,bordercolor,linewidth,linecolor, + arrows,linestyle,nodesepA,nodesepB,doubleline,pathfilled,pathfillcolor: + $_spath_$$n_:=1; + endfor; +enddef; + +def Tr_(expr p)= + new_Box_(p)("framed(false)") +enddef; + +def Tf= + new_Box_("")("filled(true)") +enddef; + +vardef newRBox@#(expr v) text options= + newBox@#(v) "rbox_radius(1mm)", options; +enddef; + +vardef new_RBox(expr v)= + new_Box_(v)("rbox_radius(1mm)") +enddef; + +streamline("Box")("(expr v)","(v)"); + +def BpathBox(suffix n)= + (if OptionValue.n("rbox_radius")=0: + StandardBpath(n) + else: + % good curve: + % |cycle| was added because in certain cases, |unfill| is called + % on the path returned by |BpathBox|. + (Path.n(_spath_,1)--cycle) + % bad curve: +% (n.nnw{n.nnw-n.nne}..{n.wsw-n.wnw}n.wnw--n.wsw{n.wsw-n.wnw} +% ..{n.sse-n.ssw}n.ssw--n.sse{n.sse-n.ssw} +% ..{n.ene-n.ese}n.ese--n.ene{n.ene-n.ese} +% ..{n.nnw-n.nne}n.nne--cycle) + fi + ) +enddef; + +def drawBox(suffix n)= + if OptionValue.n("rbox_radius")=0: + drawFramedOrFilledObject_(n); + else: + if OptionValue.n("framed"): + if OptionValue.n("shadow"): + fill (BpathObj(n) shifted (1mm,-1mm)) + withcolor OptionValue.n("shadowcolor"); + fi; + unfill BpathObj(n); + fi; + if OptionValue.n("filled"): + fill BpathObj(n) withcolor OptionValue.n("fillcolor"); + fi; + fi; + drawPictureOrObject(n); + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("Box")("dx")(3bp); % same value as in |boxes.mp| +setObjectDefaultOption("Box")("dy")(3bp); % same value as in |boxes.mp| +setObjectDefaultOption("Box")("filled")(false); +setObjectDefaultOption("Box")("fillcolor")(black); +setObjectDefaultOption("Box")("framed")(true); +setObjectDefaultOption("Box")("shadow")(false); % no shadow by default +setObjectDefaultOption("Box")("shadowcolor")(black); +setObjectDefaultOption("Box")("fit")(true); +setObjectDefaultOption("Box")("framewidth")(.5bp); +setObjectDefaultOption("Box")("framecolor")(black); +setObjectDefaultOption("Box")("framestyle")(""); +setObjectDefaultOption("Box")("rbox_radius")(0); % after rboxes.mp +setObjectDefaultOption("Box")("picturecolor")(black); + + +%===================================================================== +% Definitions specific to the |Polygon| class + +% A polygon, either empty, or enclosing a picture or an object |v|. +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +% |nsides| is the number of sides +vardef newPolygon@#(expr v,nsides) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"Polygon"); + StandardInterface; + StandardObjectOrPictureContainerSetup(v); + ObjPointArray(po)(nsides); + % we can now use |po1|, |po2|, ..., |po[nsides]| + ObjNumeric ns; + setNumeric(ns)(nsides); % now, we can use |@#ns| in the |ObjCode| + % we actually define an ellipse on which we build the polygon: + ObjNumeric cdx,cdy; % computed dx and dy + @#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("polymargin"), + (@#a+d_,0){up}...(0,@#b+d_){left}); + ObjCode StandardEquations, + if numeric v: + ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object + elseif (picture v) or (string v): + ".5[@#isw,@#ine]=@#p.off", % picture offset + fi + % the size of the box is related to the size of its contents + if OptionValue@#("fit"): + "@#ise-@#isw=(" & decimal (2@#a+2*@#cdx) & ",0)", + "@#ine-@#ise=(0," & decimal (2@#b+2*@#cdy) & ")", + else: + "@#ise-@#isw=(" & decimal(2(@#a++@#b) + + OptionValue@#("polymargin")) & ",0);", + "@#ine-@#ise=(0," & decimal(2(@#a++@#b) + + OptionValue@#("polymargin")) & ");", + fi + "save ys,op;numeric ys;", + "def op expr $=(.5(@#ine-@#inw)) rotated $ yscaled ys enddef;", + if OptionValue@#("fit"): + "ys=" & decimal((@#b+@#cdy)/(@#a+@#cdx)) & ";", + else: + "ys=1;", + fi + "save k;for k:=1 upto " & decimal nsides & ":", + "@#po[k]-.5(@#isw+@#ine)=op (" & decimal(OptionValue@#("angle")) & + "+(k-1)*(360/@#ns));", + "endfor;"; + StandardTies; +enddef; + +streamline("Polygon")("(expr v,nsides)","(v,nsides)"); + +def BpathPolygon(suffix n)= + (for i:=1 upto n.po.n_: n.po[i]--endfor cycle) +enddef; + +def drawPolygon(suffix n)= + drawFramedOrFilledObject_(n); + drawPictureOrObject(n); + drawMemorizedPaths_(n); +enddef; + +% These are all the options that can be used with a |Polygon|. +setObjectDefaultOption("Polygon")("polymargin")(2mm); +setObjectDefaultOption("Polygon")("angle")(0); +setObjectDefaultOption("Polygon")("filled")(false); +setObjectDefaultOption("Polygon")("fillcolor")(black); +setObjectDefaultOption("Polygon")("framed")(true); +setObjectDefaultOption("Polygon")("fit")(true); +setObjectDefaultOption("Polygon")("framewidth")(.5bp); +setObjectDefaultOption("Polygon")("framecolor")(black); +setObjectDefaultOption("Polygon")("framestyle")(""); +setObjectDefaultOption("Polygon")("picturecolor")(black); +setObjectDefaultOption("Polygon")("shadow")(false); % no shadow by default +setObjectDefaultOption("Polygon")("shadowcolor")(black); + +% a few common shortcuts: +vardef newTriangle@#(expr v) text options= + newPolygon@#(v,3) options; +enddef; + +vardef newSquare@#(expr v) text options= + newPolygon@#(v,4) options; +enddef; + +vardef newPentagon@#(expr v) text options= + newPolygon@#(v,5) options; +enddef; + +vardef newHexagon@#(expr v) text options= + newPolygon@#(v,6) options; +enddef; + +vardef newHeptagon@#(expr v) text options= + newPolygon@#(v,7) options; +enddef; + +vardef newOctagon@#(expr v) text options= + newPolygon@#(v,8) options; +enddef; + +vardef newEnneagon@#(expr v) text options= + newPolygon@#(v,9) options; +enddef; + +vardef newDecagon@#(expr v) text options= + newPolygon@#(v,10) options; +enddef; + + +% THESE SHORTCUTS SHOULD BE STREAMLINED (OR MAYBE NOT, TO DISCOURAGE THEIR USE +% FOR THE MORE GENERIC newPolygon) + + +%===================================================================== +% Definitions specific to the |Ellipse| class + +% A constructor initializing the variable |p| (picture) +% |@#| is a name for a box (must be a suffix) +% |@#| will be the number of the box, but will also be used +% as a prefix for other variables. +vardef newEllipse@#(expr v) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"Ellipse"); + StandardInterface; + StandardObjectOrPictureContainerSetup(v); + if not OptionValue@#("fit"): + @#a:=max(@#a,@#b);@#b:=@#a; % circle + fi; + ObjNumeric cdx,cdy; % computed dx and dy + if (@#a=0) and (@#b=0): + @#cdx=@#cdy=OptionValue@#("circmargin"); + else: + @#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("circmargin"), + (@#a+d_,0){up}...(0,@#b+d_){left}); + fi; + if not OptionValue@#("fit"): + % we draw a circle that fits horizontally + @#cdx:=OptionValue@#("circmargin"); + @#cdy:=@#cdx; + fi; + ObjCode StandardEquations, + if numeric v: + ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object + elseif (picture v) or (string v): + ".5[@#isw,@#ine]=@#p.off", % picture offset + fi + "@#ise-@#isw=(" & decimal (2@#a+2*@#cdx) & ",0)", + "@#ine-@#ise=(0," & decimal (2@#b+2*@#cdy) & ")"; + StandardTies; +enddef; + +streamline("Ellipse")("(expr v)","(v)"); + +% shortcut (PSTricks compatibility) +def Toval_(expr p)= + new_Ellipse(p) +enddef; + +% The function drawing the ellipse uses the current transformation +% of the object to get the right shape. However, when doing so, +% we can't use the current points, since the current transformation +% applies to the initial points... We can either inverse +% the current transform (using |inverse|) or use some information +% stored on the initial status. +vardef ellipse@#(expr a_,b_,c_,d_)= + (fullcircle + xscaled (2@#a+2*@#cdx) + yscaled (2@#b+2*@#cdy) + transformed @#ctransform_ + shifted ((a_+c_)/2) + ) +enddef; + +def BpathEllipse(suffix n)= + ellipse.n(n.isw,n.ise,n.ine,n.inw) +enddef; + +def drawEllipse(suffix n)= + drawFramedOrFilledObject_(n); + drawPictureOrObject(n); + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("Ellipse")("circmargin")(2bp); % same value as in |boxes.mp| +setObjectDefaultOption("Ellipse")("framed")(true); +setObjectDefaultOption("Ellipse")("filled")(false); +setObjectDefaultOption("Ellipse")("fillcolor")(black); +setObjectDefaultOption("Ellipse")("fit")(true); +setObjectDefaultOption("Ellipse")("framewidth")(.5bp); +setObjectDefaultOption("Ellipse")("framecolor")(black); +setObjectDefaultOption("Ellipse")("framestyle")(""); +setObjectDefaultOption("Ellipse")("picturecolor")(black); +setObjectDefaultOption("Ellipse")("shadow")(false); % no shadow by default +setObjectDefaultOption("Ellipse")("shadowcolor")(black); + + +%===================================================================== +% Definitions specific to the |Circle| class + +vardef newCircle@#(expr v) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"Circle"); + StandardInterface; + StandardObjectOrPictureContainerSetup(v); + ObjNumeric cdx,cdy; % computed dx and dy + if (numeric v) or (picture v) or (string v): % object or picture + @#cdx=(@#a++@#b)+OptionValue@#("circmargin")-@#a; + @#cdy=(@#a++@#b)+OptionValue@#("circmargin")-@#b; + %@#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("circmargin"), + % (@#a+d_,0){up}...(0,@#b+d_){left}); + else: + @#cdx=@#cdy=OptionValue@#("circmargin"); + fi; + ObjCode StandardEquations, + if numeric v: + ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object + elseif (picture v) or (string v): + ".5[@#isw,@#ine]=@#p.off", % picture offset + fi + "@#ise-@#isw=(" & decimal(2*max(@#a,@#b)+2*@#cdx) + %decimal(@#a++@#b+OptionValue@#("circmargin")) + & ",0)", + "@#ine-@#ise=(0," & decimal(2*max(@#a,@#b)+2*@#cdy) + %decimal(@#a++@#b+OptionValue@#("circmargin")) + & ")"; + StandardTies; +enddef; + +streamline("Circle")("(expr v)","(v)"); + +% shortcuts (PSTricks compatibility) +def Tcircle_(expr p)= + new_Circle(p) +enddef; + +% circle with a 1mm radius +def Tc= + new_Circle_("")("circmargin(1mm)") +enddef; + +def Tc_(expr s)= + new_Circle_("")("circmargin(" & decimal(s) & ")") +enddef; + +% filled circle with a 1mm radius +def TC= + new_Circle_("")("filled(true)","circmargin(1mm)") +enddef; + +% default filled circle +def TCs= + new_Circle_("")("filled(true)") +enddef; + +def TC_(expr s)= + new_Circle_("")("filled(true)","circmargin(" & decimal(s) & ")") +enddef; + +vardef circle@#(expr a_,b_,c_,d_)= + (fullcircle + scaled 2(@#a+@#cdx) + transformed @#ctransform_ + shifted ((a_+c_)/2) + ) +enddef; + +def BpathCircle(suffix n)= + circle.n(n.isw,n.ise,n.ine,n.inw) +enddef; + +def drawCircle(suffix n_)= + drawFramedOrFilledObject_(n_); + drawPictureOrObject(n_); + drawMemorizedPaths_(n_); +enddef; + +setObjectDefaultOption("Circle")("circmargin")(2bp); % same value as in |boxes.mp| +setObjectDefaultOption("Circle")("filled")(false); +setObjectDefaultOption("Circle")("fillcolor")(black); +setObjectDefaultOption("Circle")("framed")(true); +setObjectDefaultOption("Circle")("framewidth")(.5bp); +setObjectDefaultOption("Circle")("framecolor")(black); +setObjectDefaultOption("Circle")("framestyle")(""); +setObjectDefaultOption("Circle")("picturecolor")(black); +setObjectDefaultOption("Circle")("shadow")(false); % no shadow by default +setObjectDefaultOption("Circle")("shadowcolor")(black); + +%===================================================================== +% Double Box +vardef newDBox@#(expr v) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"DBox"); + StandardInterface; + StandardObjectOrPictureContainerSetup(v); + if not OptionValue@#("fit"): + @#a:=max(@#a,@#b);@#b:=@#a; % square + fi; + ObjPoint swi,nwi,sei,nei; + ObjCode StandardEquations, + if numeric v: + ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object + elseif (picture v) or (string v): + ".5[@#isw,@#ine]=@#p.off", % picture offset + fi + % inner/outer: + "@#isw-@#swi=@#nei-@#ine=(-" & decimal(OptionValue@#("hsep")) & ",-" & + decimal(OptionValue@#("vsep")) & ");", + "@#ise-@#sei=@#nwi-@#inw=(" & decimal(OptionValue@#("hsep")) & ",-" & + decimal(OptionValue@#("vsep")) & ");", + % the size of the inner box is related to the size of its contents + "@#sei-@#swi=(" & decimal(2@#a+2*OptionValue@#("dx")) & ",0)", + "@#nei-@#sei=(0," & decimal(2@#b+2*OptionValue@#("dy")) & ")"; + StandardTies; +enddef; + +streamline("DBox")("(expr v)","(v)"); + +def BpathDBox(suffix n)=StandardBpath(n) enddef; + +def drawDBox(suffix n)= + drawFramedOrFilledObject_(n); + if OptionValue.n("framed"): + draw n.swi--n.sei--n.nei--n.nwi--cycle + withcolor OptionValue.n("framecolor") sc_(OptionValue.n("framestyle")); + fi; + drawPictureOrObject(n); + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("DBox")("filled")(false); +setObjectDefaultOption("DBox")("fillcolor")(black); +setObjectDefaultOption("DBox")("framed")(true); +setObjectDefaultOption("DBox")("hsep")(1mm); +setObjectDefaultOption("DBox")("vsep")(1mm); +setObjectDefaultOption("DBox")("dx")(3bp); % same value as in |boxes.mp| +setObjectDefaultOption("DBox")("dy")(3bp); % same value as in |boxes.mp| +setObjectDefaultOption("DBox")("fit")(true); +setObjectDefaultOption("DBox")("framewidth")(.5bp); +setObjectDefaultOption("DBox")("framecolor")(black); +setObjectDefaultOption("DBox")("framestyle")(""); +setObjectDefaultOption("DBox")("picturecolor")(black); +setObjectDefaultOption("DBox")("shadow")(false); % no shadow by default +setObjectDefaultOption("DBox")("shadowcolor")(black); + +%===================================================================== +% Double Ellipse +vardef newDEllipse@#(expr v) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"DEllipse"); + StandardInterface; + StandardObjectOrPictureContainerSetup(v); + if not OptionValue@#("fit"): + @#a:=max(@#a,@#b);@#b:=@#a; % circle + fi; + ObjPoint swi,nwi,sei,nei; + ObjNumeric cdx,cdy; % computed dx and dy + @#a:=@#a+OptionValue@#("hsep");@#b:=@#b+OptionValue@#("vsep"); + if (@#a=0) and (@#b=0): + @#cdx=@#cdy=OptionValue@#("circmargin"); + else: + @#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("circmargin"), + (@#a+d_,0){up}...(0,@#b+d_){left}); + fi; + if not OptionValue@#("fit"): + % we draw a circle that fits horizontally + @#cdx:=OptionValue@#("circmargin"); + @#cdy:=@#cdx; + fi; + ObjCode StandardEquations, + if numeric v: + ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object + elseif (picture v) or (string v): + ".5[@#isw,@#ine]=@#p.off", % picture offset + fi + % inner/outer: + "@#isw-@#swi=@#nei-@#ine=(-" & decimal(OptionValue@#("hsep")) & ",-" & + decimal(OptionValue@#("vsep")) & ");", + "@#ise-@#sei=@#nwi-@#inw=(" & decimal(OptionValue@#("hsep")) & ",-" & + decimal(OptionValue@#("vsep")) & ");", + "@#ise-@#isw=(" & decimal(2@#a+2*@#cdx) & ",0)", + "@#ine-@#ise=(0," & decimal(2@#b+2*@#cdx) & ")"; + StandardTies; +enddef; + +streamline("DEllipse")("(expr v)","(v)"); + +vardef innerellipse@#(expr a_,b_,c_,d_)= + (fullcircle + xscaled (2@#a+2*@#cdx-2*OptionValue@#("hsep")) + yscaled (2@#b+2*@#cdx-2*OptionValue@#("vsep")) + transformed @#ctransform_ + shifted ((a_+c_)/2) + ) +enddef; + +def BpathDEllipse(suffix n)=BpathEllipse(n) enddef; + +def drawDEllipse(suffix n)= + drawFramedOrFilledObject_(n); + if OptionValue.n("framed"): + draw innerellipse.n(n.swi,n.sei,n.nei,n.nwi) + withcolor OptionValue.n("framecolor") sc_(OptionValue.n("framestyle")); + fi; + drawPictureOrObject(n); + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("DEllipse")("circmargin")(2bp); % same value as in |boxes.mp| +setObjectDefaultOption("DEllipse")("filled")(false); +setObjectDefaultOption("DEllipse")("fillcolor")(black); +setObjectDefaultOption("DEllipse")("framed")(true); +setObjectDefaultOption("DEllipse")("hsep")(1mm); +setObjectDefaultOption("DEllipse")("vsep")(1mm); +setObjectDefaultOption("DEllipse")("fit")(true); +setObjectDefaultOption("DEllipse")("framewidth")(.5bp); +setObjectDefaultOption("DEllipse")("framecolor")(black); +setObjectDefaultOption("DEllipse")("framestyle")(""); +setObjectDefaultOption("DEllipse")("picturecolor")(black); +setObjectDefaultOption("DEllipse")("shadow")(false); % no shadow by default +setObjectDefaultOption("DEllipse")("shadowcolor")(black); + +% It would of course be easy to create triple boxes, triple circles, etc. + +%===================================================================== +% Definitions specific to the |BB| class (Bounding Box) +% Sometimes, we want to make a new object hiding the positions +% of an object. For instance, if we rotate an object upside down, +% the |.s| component will be at the top, etc., and this is likely +% to produce unwanted effects when such an object is a subobject +% somewhere. One solution is to move the bounding points, +% without moving the contents (with respect to the whole bounding box). +% This may be a problem if the drawing macros of the object rely +% on the bounding box (which would be bad practice). +% So here we provide another solution which is simply a class +% to encapsulate cleanly a strange object. This class merely adds a layer. +% +% The computation of the new bounding box only looks at the corners +% of the object, not at other points or subobjects. |rebindObj| might +% be used to ensure that nothing protrudes. + +vardef newBB@#(suffix t) text options= + ExecuteOptions(@#)(options); + assignObj(@#,"BB"); + StandardInterface; + SubObject(sub,t); + % We inject the following in the equations, using |obj(@#sub)| + % instead of |t|, so that |resetObj.expl|, or any other function + % using the object code, can reexecute the function code. + % |lftmost=find_lft_most.t;| + % |rtmost =find_rt_most.t;| + % |topmost=find_top_most.t;| + % |botmost=find_bot_most.t;| + % The equations are now: + % |xpart(@#nw)=xpart(obj(@#sub).obj(lftmost))| + % |xpart(@#ne)=xpart(obj(@#sub).obj(rtmost))| + % |ypart(@#nw)=ypart(obj(@#sub).obj(topmost))| + % |ypart(@#sw)=ypart(obj(@#sub).obj(botmost))| + % (the other points are found with the standard equations) + ObjCode StandardEquations, + "save lftmost,rtmost,topmost,botmost;", + "string lftmost,rtmost,topmost,botmost;", + "lftmost=find_lft_most.obj(@#sub);", + "rtmost =find_rt_most.obj(@#sub);", + "topmost=find_top_most.obj(@#sub);", + "botmost=find_bot_most.obj(@#sub);", + "xpart(@#inw)=xpart(obj(@#sub).obj(lftmost));", + "xpart(@#ine)=xpart(obj(@#sub).obj(rtmost));", + "ypart(@#inw)=ypart(obj(@#sub).obj(topmost));", + "ypart(@#isw)=ypart(obj(@#sub).obj(botmost));"; + StandardTies; +enddef; + +% create a streamlined version +streamline("BB")("(expr t)","suffixpar(t)"); + +def BpathBB(suffix n)= StandardBpath(n) enddef; + +def drawBB(suffix n)= + drawFramedOrFilledObject_(n); + drawObj(obj(n.sub)); + drawMemorizedPaths_(n); +enddef; + +setObjectDefaultOption("BB")("filled")(false); +setObjectDefaultOption("BB")("fillcolor")(black); +setObjectDefaultOption("BB")("framed")(false); +setObjectDefaultOption("BB")("framewidth")(.5bp); +setObjectDefaultOption("BB")("framecolor")(black); +setObjectDefaultOption("BB")("framestyle")(""); +setObjectDefaultOption("BB")("shadow")(false); % no shadow by default +setObjectDefaultOption("BB")("shadowcolor")(black); + +endinput diff --git a/Master/texmf-dist/metapost/metaobj/mobjstandard.mp b/Master/texmf-dist/metapost/metaobj/mobjstandard.mp new file mode 100644 index 00000000000..e51e3e9a811 --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/mobjstandard.mp @@ -0,0 +1,931 @@ +input metaobj + +def show_standard_bb(suffix n_)= + pickup pencircle scaled 2pt; + draw n_.nw;draw n_.ne; + draw n_.sw;draw n_.se; + pickup pencircle scaled .5bp; + label.ulft(btex nw etex,n_.nw); + label.urt(btex ne etex,n_.ne); + label.llft(btex sw etex,n_.sw); + label.lrt(btex se etex,n_.se); +enddef; + +def show_standard_ibb(suffix n_)= + pickup pencircle scaled 2pt; + draw n_.inw;draw n_.ine; + draw n_.isw;draw n_.ise; + pickup pencircle scaled .5bp; + label.ulft(btex inw etex,n_.inw); + label.urt(btex ine etex,n_.ine); + label.llft(btex isw etex,n_.isw); + label.lrt(btex ise etex,n_.ise); +enddef; + + + +beginfig(1); + show_empty_boxes:=true; + newEmptyBox.a(2cm,1cm) "framed(true)"; + a.c=origin; + drawObj(a); +endfig; + +beginfig(2); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(3); + newHRazor.a(3cm) "framed(true)"; + a.c=origin; + drawObj(a); +endfig; + +beginfig(4); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(5); + show_empty_boxes:=true; + newRandomBox.a(2cm,1cm,2mm,-1mm) "framed(true)"; + a.c=origin; + drawObj(a); +endfig; + +beginfig(6); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(7); + newRandomBox.a(2cm,1cm,2mm,-1mm) "framed(true)", "framewidth(1mm)"; + a.c=origin; + drawObj(a); + +endfig; + +clearObj a; + +beginfig(8); + newRandomBox.a(1cm,5mm,2mm,-1mm) "framed(true)", "filled(true)", + "fillcolor(red)","framewidth(1mm)","framecolor(green)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(10); + newBox.a(btex some text etex); + a.c=origin; + drawObj(a); +endfig; + +beginfig(11); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(12); + newBox.a(btex some text etex) "fit(false)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(13); + newBox.a("") "filled(true)", "dx(2mm)", "dy(2mm)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(15); + newBox.a(btex This is an ovalbox etex) "rbox_radius(2mm)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(17); + newBox.a(btex This is a shadowbox etex) "shadow(true)"; + a.c=origin; + drawObj(a); +endfig; + + +clearObj a; + +beginfig(20); + newPolygon.a(btex some text etex,5); + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(21); + newPolygon.a(btex some text etex,5) "polymargin(3mm)"; + a.c=origin; + drawObj(a); +endfig; + +beginfig(22); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(23); + newPolygon.a(btex some text etex,7) "fit(false)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(30); + newEllipse.a(btex some text etex); + a.c=origin; + drawObj(a); +endfig; + +beginfig(31); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(32); + newEllipse.a(btex some text etex) "fit(false)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(33); + newEllipse.a("") "filled(true)","circmargin(2mm)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(35); + newCircle.a(btex some text etex); + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(40); + newDBox.a(btex some text etex); + a.c=origin; + drawObj(a); +endfig; + +beginfig(41); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(42); + newDBox.a(btex some text etex) "fit(false)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(43); + newDBox.a("") "dx(1cm)", "dy(1cm)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(50); + newDEllipse.a(btex some text etex); + a.c=origin; + drawObj(a); +endfig; + +beginfig(51); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(52); + newDEllipse.a(btex some text etex) "fit(false)"; + a.c=origin; + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +beginfig(53); + newDEllipse.a("") "filled(true)","circmargin(2mm)"; + a.c=origin; + drawObj(a); +endfig; + +clearObj a; + +beginfig(55); + newDEllipse.a(btex some text etex); + scaleObj(a,2); + rotateObj(a,45); + a.c=origin; + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + + +beginfig(61); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newHBox.h(a,b,c); + h.c=origin; + drawObj(h); +endfig; + +beginfig(62); + drawObj(h); + show_standard_bb(h); +endfig; + +clearObj a,b,c,h; + +beginfig(64); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newHBox.h(a,b,c) "align(top)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,c,h; + +beginfig(65); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newHBox.h(a,b,c) "align(center)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,c,h; + +beginfig(67); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newHBox.h(a,b,c) "align(center)","hbsep(3mm)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,c,h; + +beginfig(68); + newPolygon.a(btex Box A etex,5) "fit(false)","polymargin(5mm)"; + newBox.b(btex Box B etex scaled \magstep3); + newHRazor.ba(1cm); + newPolygon.c(btex Box C etex scaled \magstep2,11) "polymargin(3mm)"; + newHBox.h(a,b,ba,c) "align(center)","hbsep(3mm)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,ba,c,h; + + +beginfig(71); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newVBox.h(a,b,c); + h.c=origin; + drawObj(h); +endfig; + +beginfig(72); + drawObj(h); + show_standard_bb(h); +endfig; + +clearObj a,b,c,h; + +beginfig(74); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newVBox.h(a,b,c) "align(right)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,c,h; + +beginfig(75); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newVBox.h(a,b,c) "align(center)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,c,h; + +beginfig(77); + newBox.a(btex Box A etex); + newBox.b(btex Box B etex scaled \magstep3); + newBox.c(btex Box C etex scaled \magstep2); + newVBox.h(a,b,c) "align(center)","vbsep(3mm)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,c,h; + +beginfig(78); + newPolygon.a(btex Box A etex,5) "fit(false)","polymargin(5mm)"; + newBox.b(btex Box B etex scaled \magstep3); + newVRazor.ba(1cm); + newPolygon.c(btex Box C etex scaled \magstep2,11) "polymargin(3mm)"; + newVBox.h(a,b,ba,c) "align(center)","vbsep(3mm)"; + h.c=origin; + drawObj(h); +endfig; + +clearObj a,b,ba,c,h; + +beginfig(101); + newRecursiveBox.a(10); + scaleObj(a,.3); + a.c=origin; + drawObj(a); +endfig; + +beginfig(102); + drawObj(a); + show_standard_bb(a); +endfig; + +clearObj a; + +% beginfig(104); +% newRecursiveBox.a(20); +% a.c=origin; +% drawObj(a); +% endfig; + + +% beginfig(111); +% newVonKochFlake.a(3); +% scaleObj(a,.5); +% a.c=origin; +% drawObj(a); +% endfig; + +%clearObj a; + + +beginfig(121); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c); + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e); + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables); + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +beginfig(122); + drawObj(food); + show_standard_bb(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(124); + newBox.a(btex apples\strut etex); + newBox.b(btex oranges\strut etex); + newBox.c(btex bananas\strut etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Dalign(bot)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Dalign(center)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hbsep(1cm)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(134); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Lalign(left)", "treemode(L)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Lalign(center)", "treemode(L)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)", "treemode(L)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(135); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + extendObjRight.a(3cm); + extendObjRight.b(3cm); + extendObjRight.c(3cm); + extendObjRight.d(3cm); + extendObjRight.e(3cm); + + newBox.f(btex fruits etex); + newBox.v(btex vegetables etex); + rebindrelativeObj(f)(0,0,0,-xpart(v.e-v.w-f.e+f.w)); + newTree.fruits(f)(a,b,c) "Lalign(left)", "treemode(L)"; + newTree.vegetables(v)(d,e) "Lalign(center)", "treemode(L)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)", "treemode(L)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(136); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Ralign(right)", "treemode(R)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Ralign(center)", "treemode(R)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)", "treemode(R)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(137); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + rebindrelativeObj(f)(0,0,xpart(v.e-v.w-f.e+f.w),0); + newTree.fruits(f)(a,b,c) "Ralign(right)", "treemode(R)"; + newTree.vegetables(v)(d,e) "Ralign(center)", "treemode(R)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)", "treemode(R)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(138); + newBox.a(btex apples\strut etex); + newBox.b(btex oranges\strut etex); + newBox.c(btex bananas\strut etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Ualign(bot)", "treemode(U)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Ualign(center)", "treemode(U)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)", "treemode(U)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(139); + setObjectDefaultOption("Tree")("treeflip")(true); + newBox.a(btex apples\strut etex); + newBox.b(btex oranges\strut etex); + newBox.c(btex bananas\strut etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Ualign(bot)", "treemode(U)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Ualign(center)", "treemode(U)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)", "treemode(U)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); + setObjectDefaultOption("Tree")("treeflip")(false); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(140); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Dalign(bot)", "hideleaves(true)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Dalign(center)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(142); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Dalign(bot)", "hideleaves(true)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Dalign(center)", "hideleaves(true)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hbsep(5cm)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(144); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Dalign(bot)", "hideleaves(true)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Ralign(center)", "hideleaves(true)", "treemode(R)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hbsep(1cm)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(146); + newBox.a(btex apples etex); + newBox.b(btex oranges etex); + newBox.c(btex bananas etex); + newBox.f(btex fruits etex); + newTree.fruits(f)(a,b,c) "Lalign(left)", "hideleaves(true)", "treemode(L)", + "vsep(3mm)"; + newBox.d(btex potatoes etex); + newBox.e(btex peas etex); + newBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "align(center)", "hideleaves(true)", "treemode(R)"; + newBox.fo(btex food etex); + newTree.food(fo)(fruits,vegetables) "hbsep(1cm)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +clearObj a,b,c,f,fruits,d,e,v,vegetables,fo,food; + +beginfig(148); + newPolygon.a(btex apples etex,5); + newPolygon.b(btex oranges etex,6); + newPolygon.c(btex bananas etex,7); + newPolygon.f(btex fruits etex,8); + newTree.fruits(f)(a,b,c) "Lalign(left)", "hideleaves(true)", "treemode(L)", + "vsep(3mm)"; + newEllipse.d(btex potatoes etex); + newDEllipse.e(btex peas etex); + newDBox.v(btex vegetables etex); + newTree.vegetables(v)(d,e) "Ralign(center)", "hideleaves(true)", "treemode(R)"; + newPolygon.fo(btex food etex,12); + newTree.food(fo)(fruits,vegetables) "hsep(1cm)"; + scaleObj(food,.5); + food.c=origin; + drawObj(food); +endfig; + +beginfig(149); + newDEllipse.ff(food); + ff.c=origin; + drawObj(ff); +endfig; + +clearObj ff; + +beginfig(150); + rebindVisibleObj(food); + newDEllipse.ff(food); + drawObj(ff); +endfig; + +beginfig(151); + newEllipse.xx(btex This is a new root etex); + newTree.x(xx)(ff); + drawObj(x); +endfig; + +clearObj x,xx,food,ff,a,b,c,f,fruits,d,e,v,vegetables,fo; + +% fans + +beginfig(160); +newBox.a(btex root etex); +newBox.leaf1(btex leaf 1 etex); +newBox.leaf2(btex leaf 2 etex); +newHFan.f(1cm,0); +newTree.t(a)(leaf1,leaf2,f) "hsep(5mm)","Dalign(center)"; +t.c=origin; +drawObj(t); +endfig; + +clearObj a,leaf,f,t; + +beginfig(161); +newBox.a(btex root etex); +newBox.leaf1(btex leaf 1 etex); +newBox.leaf2(btex leaf 2 etex); +newHFan.f(2cm,0); +newTree.t(a)(leaf1,leaf2,f) "hsep(5mm)","Dalign(center)"; +t.c=origin; +drawObj(t); +endfig; + +clearObj a,leaf,f,t; + +beginfig(162); +newBox.a(btex root etex); +newBox.leaf1(btex leaf 1 etex); +newBox.leaf2(btex leaf 2 etex); +newVFan.f(0,1.5cm); +newTree.t(a)(leaf1,leaf2,f) "vsep(5mm)","Ralign(right)","treemode(R)"; +t.c=origin; +drawObj(t); +endfig; + +clearObj a,leaf,f,t; + + +beginfig(201); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $B$ etex); + newPTree.proof(c)(a,b)("")(""); + proof.c=origin; + drawObj(proof); +endfig; + +clearObj a,b,c,proof; + +beginfig(202); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $B$ etex); + newPTree.proof(c)(a,b)("")("") "treemode(U)"; + proof.c=origin; + drawObj(proof); +endfig; + + +clearObj a,b,c,proof; + +beginfig(203); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $B$ etex); + newPTree.proof(c)(a,b)(btex (left rule) etex)(btex (right rule) etex); + proof.c=origin; + drawObj(proof); +endfig; + +clearObj a,b,c,proof; + +beginfig(204); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $B$ etex); + newPTree.proof(c)(a,b)("")(btex (MP) etex); + proof.c=origin; + drawObj(proof); +endfig; + +clearObj a,b,c,proof; + +beginfig(205); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $B$ etex); + newPTreeR.proof(c)(a,b)(btex (MP) etex) "lenddx(1cm)"; + proof.c=origin; + drawObj(proof); +endfig; + +beginfig(206); + scaleObj(proof,2); + slantObj(proof,1); + proof.c=origin; + drawObj(proof); +endfig; + +clearObj a,b,c,proof; + +beginfig(220); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $B$ etex); + newAssumption.d(btex $D$ etex); + newAssumption.e(btex $E$ etex); + newPTreeR.proof1(c)(a,b)(btex (MP) etex); + newPTreeR.proof2(proof1)(d,e)("") "treemode(U)"; + proof2.c=origin; + drawObj(proof2); +endfig; + +clearObj a,b,c,d,e,proof; + +beginfig(221); + newAssumption.a(btex $A$ etex); + newAssumption.b(btex $A\rightarrow B$ etex); + newConclusion.c(btex $BBBBBBBBBBBBBB$ etex); + newAssumption.d(btex $D$ etex); + newAssumption.e(btex $E$ etex); + newPTreeR.proof1(c)(a,b)(btex (MP) etex); + newPTreeR.proof2(proof1)(d,e)("") "treemode(U)"; + proof2.c=origin; + drawObj(proof2); +endfig; + +clearObj a,b,c,d,e,proof; + +beginfig(300); + + newBox.mela(btex A etex); + newMatrix.mat(1,1)(mela); + mat.c=origin; + drawObj(mat); +endfig; + +clearObj mat,mela; + +beginfig(302); + + newBox.melb(btex B etex) "dx(1cm)"; + newBox.melc(btex C etex) "dy(1cm)"; + newMatrix.mata(2,1)(melb,melc); + + mata.c=origin; + + drawObj(mata); + +endfig; + +beginfig(304); + newBox.melba(btex melba etex); + newBox.melda(btex D$\displaystyle\int_0^\infty{1\over 1+x^2}dx$ etex); + newBox.melbb(btex Bb etex); + newBox.melcb(btex C etex); + newBox.meldb(btex D etex); + + newMatrix.matc(3,2)(melba,nb,melda,melbb,melcb,meldb) + "halign(ew)", "valign(sns)"; + + matc.c=origin-(0,10cm); + drawObj(matc); + +endfig; + +beginfig(306); + + + duplicateObj(matd,matc); % the holes get duplicated + scaleObj(matd,2); + matd.c=origin-(0,15cm); + drawObj(matd); + +endfig; + +beginfig(308); + + + newBox.rep(btex Very Long Replacement etex); + + replaceMatrixElement.exp.matd(1,1)(rep); + newBox.repc(btex court etex); + replaceMatrixElement.exp.matd(1,1)(repc); + newBox.repd(btex D etex yscaled 3 rotated 30); + replaceMatrixElement.exp.matd(3,2)(repd); + newBox.repe(btex 00000000000000000 etex yscaled 3 rotated 30); + replaceMatrixElement.exp.matd(1,1)(repe); + newBox.repf(btex new line etex); + replaceMatrixElement.exp.matd(4,2)(repf); + matd.c=origin; + drawObj(matd); + +endfig; + +beginfig(320); + + + newBox.repg(btex new corner etex); + replaceMatrixElement.exp.matd(4,3)(repg); + matd.c=origin; + drawObj(matd); + + +endfig; + +beginfig(330); + + + deleteMatrixElement.exp.matd(2,2); + deleteMatrixElement.exp.matd(4,2); + deleteMatrixElement.exp.matd(3,1); + deleteMatrixElement.exp.matd(3,2); + deleteMatrixElement.exp.matd(3,2); + deleteMatrixElement.exp.matd(1,1); + matd.c=origin; + drawObj(matd); + + +endfig; + +end diff --git a/Master/texmf-dist/metapost/metaobj/proofex.mp b/Master/texmf-dist/metapost/metaobj/proofex.mp new file mode 100644 index 00000000000..02d61b7df91 --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/proofex.mp @@ -0,0 +1,153 @@ +% D. Roegel, 20/5/2001 + +input metaobj + +% Proof from +% David, Nour, Raffalli: Introduction à la logique, Paris: Dunod, 2001 +% p. 197 + +verbatimtex + \newcount\pntcnt + \pntcnt=0 + \def\npoints#1{\pntcnt=#1\vbox{\offinterlineskip\kern5pt\npointsa}} + \def\npointsa{\ifnum\pntcnt>0\hbox{$.$}\kern5pt\advance\pntcnt-1 + \expandafter\npointsa\fi} +etex + +beginfig(1); +% setObjectDefaultOption("PTree")("treemode")("U"); % default is down + newAssumption.pi1(btex $\Pi_1$ etex); + newConclusion.pi1c1(btex \npoints3 etex); + newPTreeR.pi1proof(pi1c1)(pi1)("") "rule(0)"; + newConclusion.pi1c2(btex $\Gamma,B \vdash \Delta$ etex); + newPTreeR.a1(pi1c2)(pi1proof)("") "rule(0)"; + + newAssumption.pi2(btex $\Pi_2$ etex); + newConclusion.pi2c1(btex \npoints3 etex); + newPTreeR.pi2proof(pi2c1)(pi2)("") "rule(0)"; + newConclusion.pi2c2(btex $\Gamma,C \vdash \Delta$ etex); + newPTreeR.a2(pi2c2)(pi2proof)("") "rule(0)"; + + + newConclusion.c1(btex $\Gamma,B\lor C \vdash \Delta$ etex); + newPTreeR.proof1(c1)(a1,a2)(btex $\lor_g$ etex); + + newAssumption.pi3(btex $\Pi_3$ etex); + newConclusion.pi3c1(btex \npoints3 etex); + newPTreeR.pi3proof(pi3c1)(pi3)("") "rule(0)"; + newConclusion.pi3c2(btex $\Gamma' \vdash B,C, \Delta'$ etex); + newPTreeR.a3(pi3c2)(pi3proof)("") "rule(0)"; + + newConclusion.c2 + (btex $\Gamma_A,\Gamma'\vdash B,C,\Delta,\Delta'_A$ etex); + newPTreeR.proof2(c2)(proof1,a3)(btex {\it mix\/}$(1)$ etex); + newConclusion.c2points + (btex $\npoints{12}$ etex); + newPTreeR.proof2a(c2points)(proof2)("") "rule(0)"; + + duplicateObj(a4,a1); + duplicateObj(a5,a3); + newConclusion.c3(btex $\Gamma' \vdash B\lor C, \Delta'$ etex); + newPTreeR.proof3(c3)(a5)(btex $\lor_d$ etex); + newConclusion.c4(btex $\Gamma_A,\Gamma',B \vdash \Delta, \Delta'_A$ etex); + newPTreeR.proof4(c4)(a4,proof3)(btex {\it mix\/}$(2)$ etex); + newConclusion.c5(btex $\Gamma_A,\Gamma',\Gamma_A,\Gamma' + \vdash C,\Delta, \Delta'_A,\Delta, \Delta'_A$ etex); + newHRazor.hr1(-4cm); + newPTreeR.proof5(c5)(proof2a,hr1,proof4)(btex {\it mix\/}$(3)$ etex); + + duplicateObj(a6,a2); + + duplicateObj(proof3a,proof3); + + newConclusion.c7(btex $\Gamma_A,\Gamma',C + \vdash \Delta, \Delta'_A$ etex); + newPTreeR.proof3b(c7)(a6,proof3a)(btex {\it mix\/}$(4)$ etex); + newConclusion.c8(btex $\Gamma_A,\Gamma',\Gamma_A,\Gamma',\Gamma_A,\Gamma' + \vdash \Delta, \Delta'_A,\Delta, \Delta'_A,\Delta, \Delta'_A$ etex); + newPTreeR.proof3d(c8)(proof5,proof3b)(btex {\it mix\/}$(5)$ etex) + "hsep(5mm)"; + newConclusion.c9(btex $\Gamma_A,\Gamma'\vdash \Delta, \Delta'_A$ etex); + newPTreeR.proof3E(c9)(proof3d)(btex contr$_g$,contr$_d$ etex); + + + %yscaleObj(proof3E,2); + %reflectObj(proof3E,(0,0),(0,1)); + %slantObj(proof3E,0.2); + + proof3E.c=origin; + drawObj(proof3E); + +endfig; + +clearObj pi,a,c,proof,hr; + +beginfig(2); + setObjectDefaultOption("PTree")("treemode")("U"); % default is down + newAssumption.pi1(btex $\Pi_1$ etex); + newConclusion.pi1c1(btex \npoints3 etex); + newPTreeR.pi1proof(pi1c1)(pi1)("") "rule(0)"; + newConclusion.pi1c2(btex $\Gamma,B \vdash \Delta$ etex); + newPTreeR.a1(pi1c2)(pi1proof)("") "rule(0)"; + + newAssumption.pi2(btex $\Pi_2$ etex); + newConclusion.pi2c1(btex \npoints3 etex); + newPTreeR.pi2proof(pi2c1)(pi2)("") "rule(0)"; + newConclusion.pi2c2(btex $\Gamma,C \vdash \Delta$ etex); + newPTreeR.a2(pi2c2)(pi2proof)("") "rule(0)"; + + + newConclusion.c1(btex $\Gamma,B\lor C \vdash \Delta$ etex); + newPTreeR.proof1(c1)(a1,a2)(btex $\lor_g$ etex); + + newAssumption.pi3(btex $\Pi_3$ etex); + newConclusion.pi3c1(btex \npoints3 etex); + newPTreeR.pi3proof(pi3c1)(pi3)("") "rule(0)"; + newConclusion.pi3c2(btex $\Gamma' \vdash B,C, \Delta'$ etex); + newPTreeR.a3(pi3c2)(pi3proof)("") "rule(0)"; + + newConclusion.c2 + (btex $\Gamma_A,\Gamma'\vdash B,C,\Delta,\Delta'_A$ etex); + newPTreeR.proof2(c2)(proof1,a3)(btex {\it mix\/}$(1)$ etex); + newConclusion.c2points + (btex $\npoints{12}$ etex); + newPTreeR.proof2a(c2points)(proof2)("") "rule(0)"; + + duplicateObj(a4,a1); + duplicateObj(a5,a3); + newConclusion.c3(btex $\Gamma' \vdash B\lor C, \Delta'$ etex); + newPTreeR.proof3(c3)(a5)(btex $\lor_d$ etex); + newConclusion.c4(btex $\Gamma_A,\Gamma',B \vdash \Delta, \Delta'_A$ etex); + newPTreeR.proof4(c4)(a4,proof3)(btex {\it mix\/}$(2)$ etex); + newConclusion.c5(btex $\Gamma_A,\Gamma',\Gamma_A,\Gamma' + \vdash C,\Delta, \Delta'_A,\Delta, \Delta'_A$ etex); + newHRazor.hr1(-4cm); + newPTreeR.proof5(c5)(proof2a,hr1,proof4)(btex {\it mix\/}$(3)$ etex); + + duplicateObj(a6,a2); + + duplicateObj(proof3a,proof3); + + newConclusion.c7(btex $\Gamma_A,\Gamma',C + \vdash \Delta, \Delta'_A$ etex); + newPTreeR.proof3b(c7)(a6,proof3a)(btex {\it mix\/}$(4)$ etex); + newConclusion.c8(btex $\Gamma_A,\Gamma',\Gamma_A,\Gamma',\Gamma_A,\Gamma' + \vdash \Delta, \Delta'_A,\Delta, \Delta'_A,\Delta, \Delta'_A$ etex); + newPTreeR.proof3d(c8)(proof5,proof3b)(btex {\it mix\/}$(5)$ etex) + "hsep(5mm)"; + newConclusion.c9(btex $\Gamma_A,\Gamma'\vdash \Delta, \Delta'_A$ etex); + newPTreeR.proof3E(c9)(proof3d)(btex contr$_g$,contr$_d$ etex); + + + %yscaleObj(proof3E,2); + %reflectObj(proof3E,(0,0),(0,1)); + %slantObj(proof3E,0.2); + + proof3E.c=origin; + drawObj(proof3E); + +endfig; + + + +end diff --git a/Master/texmf-dist/metapost/metaobj/pstricksex1.mp b/Master/texmf-dist/metapost/metaobj/pstricksex1.mp new file mode 100644 index 00000000000..ef733cf97cb --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/pstricksex1.mp @@ -0,0 +1,311 @@ +% This file contains metaobj code for several figures of the pstricks manual, +% regarding connections, matrices and trees. + +% D. Roegel, May 6-9, 2001 + +verbatimtex +%&latex +\documentclass{article} +\begin{document} +etex + +def TCs= + new_Circle_("")("filled(true)") +enddef; + +def Tdot(expr p)= + new_Circle_(p)("circmargin(-.2mm)") +enddef; + +def Toplus= + Tdot(btex $+$ etex) +enddef; + +input metaobj + +% page 26 of beta manual + +beginfig(1); + setObjectDefaultOption("Matrix")("hsep")(1cm); + setObjectDefaultOption("Matrix")("vsep")(1cm); + newBox.a(btex $U$ etex) "framed(false)"; + newBox.b(btex $X\times_Z Y$ etex) "framed(false)"; + newBox.c(btex $X$ etex) "framed(false)"; + newBox.d(btex $Y$ etex) "framed(false)"; + newBox.e(btex $Z$ etex) "framed(false)"; + newMatrix.mat(3,3)(a,nb,nb,nb,b,c,nb,d,e); + mat.c=origin; + + mcline.mat(1,1,2,2) "name(a)"; + ObjLabel.mat(btex $y$ etex) "labpathname(a)","labdir(llft)"; + mcline.mat(1,1,2,3) "doubleline(true)", + "arrows(draw)","linestyle(dashed evenly)", "name(b)"; + ObjLabel.mat(btex $x$ etex) "labpathname(b)","labdir(urt)"; + mcline.mat(2,2,2,3), "name(c)"; + ObjLabel.mat(btex $p$ etex) "labpathname(c)","labdir(bot)"; + mcline.mat(2,2,3,2), "name(d)"; + ObjLabel.mat(btex $q$ etex) "labpathname(d)","labdir(lft)"; + mcline.mat(3,2,3,3), "name(e)"; + ObjLabel.mat(btex $g$ etex) "labpathname(e)","labdir(bot)"; + mcline.mat(2,3,3,3), "name(f)"; + ObjLabel.mat(btex $f$ etex) "labpathname(f)","labdir(rt)"; + + drawObj(mat); +endfig; + +clearObj a,b,c,d,e,mat; + +% page 27 of beta manual + +beginfig(3); + newCircle.a(btex A etex); + newCircle.b(btex B etex); + newCircle.c(btex C etex); + newCircle.d(btex D etex); + newCircle.e(btex E etex); + verbatimtex \small etex; + newMatrix.mat(3,3)(nb,a,nb,b,e,c,nb,d,nb) "hsep(2cm)", "vsep(2cm)"; + mcline.mat(2,2,2,3) "name(a)"; + ObjLabel.mat(btex a etex) "labpathname(a)","labpos(0.75)", "labdir(top)"; + mcline.mat(2,2,2,1) "name(b)"; + ObjLabel.mat(btex b etex) "labpathname(b)","labdir(bot)"; + mcline.mat(3,2,2,1) "name(c)"; + ObjLabel.mat(btex c etex) "labpathname(c)","labdir(llft)"; + mcarc.mat(3,2,1,2) + "arcangleA(-40)","arcangleB(-40)", "border(3pt)", "name(d)";%, + %"laberase(true)"; + ObjLabel.mat(btex d etex) "labpathname(d)","labdir(lrt)", "labpos(0.3)"; + ObjLabel.mat(btex e etex) "labpathname(d)","labdir(llft)", "labpos(0.7)"; + mcarc.mat(1,2,2,1) "arcangleA(12)","arcangleB(12)", "name(f)"; + ObjLabel.mat(btex f etex) "labpathname(f)","labdir(lrt)"; + mcarc.mat(2,1,1,2) "arcangleA(12)","arcangleB(12)", "name(g)"; + ObjLabel.mat(btex g etex) "labpathname(g)","labdir(ulft)"; + mat.c=origin; + drawObj(mat); +endfig; + +% page 28 of beta manual + +clearObj a,b,c,d,e,mat; + +beginfig(4); + newCircle.x(btex X etex); + newCircle.y(btex Y etex) "framed(false)"; + newCircle.Z(btex Z etex) "framed(false)"; % |z| is reserved + newMatrix.mat(2,2)(nb,x,y,Z) "hsep(1cm)", "vsep(2cm)"; + mcline.mat(1,2,2,1) "nodesepA(3pt)"; + mcline.mat(1,2,2,2) "nodesepA(3pt)"; + mcline.mat(2,1,2,2) "linestyle(dashed withdots)"; + mat.c=origin; + drawObj(mat); +endfig; + +clearObj x,y,Z,mat; + +% page 33 of beta manual + +beginfig(5); + setCurveDefaultOption("arrows")("draw"); % works + t=_T(new_Ellipse(btex root etex))(TCs,TCs,TCs,TCs); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(55); +setCurveDefaultOption("arrows")("draw"); + u=T_(Tn)(TCs, + T_(Tc)(TCs,TCs)("hbsep(5mm)","hideleaves(true)"), + TCs)("hbsep(5mm)"); + + Obj(u).c=origin; + draw_Obj(u); +endfig; + + +% page 34 of beta manual + +beginfig(6); +setCurveDefaultOption("arrows")("draw"); + t:=_T(new_Circle(btex $X$ etex)) + (new_Box_(btex $\tilde{\tilde{X}}$ etex)("framed(false)"), + new_Box_(btex $x$ etex)("framed(false)"), + new_Box_(btex $y$ etex)("framed(false)")); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(66); +setCurveDefaultOption("arrows")("draw"); + % in the next example, we align the baselines, by adding \strut s: + t:=_T(new_Circle(btex $X$ etex)) + (new_Box_(btex \strut $\smash{\tilde{\tilde{X}}}$ etex)("framed(false)"), + new_Box_(btex \strut $x$ etex)("framed(false)"), + new_Box_(btex \strut $y$ etex)("framed(false)")); + Obj(t).c=origin; + draw_Obj(t); +endfig; + + + +% page 35 of beta manual + + +beginfig(7); +setCurveDefaultOption("arrows")("draw"); + setCurveDefaultOption("nodesepA")(3pt); % works + setCurveDefaultOption("nodesepB")(3pt); % works + setObjectDefaultOption("Tree")("hideleaves")(true); % works + + t:=_T(TCs) + (_T(TCs)(TCs,Tn), + _T(TCs)(TCs,_T(TCs)(Tn,TCs)) + ); + Obj(t).c=origin; + draw_Obj(t); + setCurveDefaultOption("nodesepA")(0); % works + setCurveDefaultOption("nodesepB")(0); % works +endfig; + +% page 36 of beta manual + +beginfig(8); + setObjectDefaultOption("Tree")("hideleaves")(true); + t:=T_(new_Circle(btex foo etex)) + (new_HFan_(1cm,0)("filled(true)"), + Tf, + _T(new_RBox(btex bar etex))(new_HFan(1cm,0)) + ) + ("Dalign(center)"); + Obj(t).c=origin; + draw_Obj(t); + setObjectDefaultOption("Tree")("hideleaves")(false); +endfig; + +beginfig(88); + setObjectDefaultOption("Tree")("hideleaves")(true); + t:=_T(new_Circle(btex foo etex)) + (_T(new_HFan_(1cm,0)("filled(true)","fillcolor(red)","fanlinearc(1mm)" + %,"pointedfan(false)" + )) + (TCs,new_HFan_(1cm,0)("fanlinestyle(dashed evenly)"))); + Obj(t).c=origin; + draw_Obj(t); + setObjectDefaultOption("Tree")("hideleaves")(false); +endfig; + +% page 37 of beta manual + +beginfig(9); +setCurveDefaultOption("arrows")("draw"); + setObjectDefaultOption("Tree")("hideleaves")(true); % works + setCurveDefaultOption("nodesepA")(3pt); % works + setCurveDefaultOption("nodesepB")(3pt); % works + setObjectDefaultOption("Tree")("Ualign")("center"); + setObjectDefaultOption("Tree")("Lalign")("center"); + setObjectDefaultOption("Tree")("hbsep")(5mm); + setObjectDefaultOption("Tree")("vbsep")(5mm); + setObjectDefaultOption("Tree")("hsep")(2cm); + setObjectDefaultOption("Tree")("vsep")(2cm); + + t:=T_(Tc_(1.5mm))(T_(Tc_(1.5mm))(Toplus,Toplus)("treemode(L)"),Toplus,Toplus)("treemode(U)"); + Obj(t).c=origin; + draw_Obj(t); + setCurveDefaultOption("nodesepA")(0pt); % works + setCurveDefaultOption("nodesepB")(0pt); % works +endfig; + +beginfig(10); +setCurveDefaultOption("arrows")("draw"); + setObjectDefaultOption("Tree")("hsep")(1cm); + setObjectDefaultOption("Tree")("vsep")(1cm); + % we draw two trees which share a root node: + t:=T_(new_Circle(btex root etex))(Tr_(btex B etex))("treemode(L)"); + Obj(t).c=origin; + u:=_T(obj(Obj(t).root))(Tr_(btex A1 etex),Tr_(btex A2 etex)); + draw_Obj(t); + draw_Obj(u); +endfig; + +% page 38 of beta manual + +beginfig(11); +setCurveDefaultOption("arrows")("draw"); + setObjectDefaultOption("Tree")("Dalign")("center"); + setObjectDefaultOption("Tree")("hbsep")(5mm); + + t:=_T(Tc)(TCs, + T_(Tc)(new_Circle_("")("filled(true)","circmargin(15pt)"),TCs) + ("treenodehsize(1cm)"), + TCs); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(110); + setCurveDefaultOption("arrows")("draw"); + t:=_T(Tc)(Tr_(btex $j$ etex),Tr_(btex $K_4$ etex),Tr_(btex $x>y$ etex)); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(111); + setCurveDefaultOption("arrows")("draw"); + t:=T_(Tc)(Tr_(btex $j$ etex),Tr_(btex $K_4$ etex),Tr_(btex $x>y$ etex)) + ("treenodehsize(5mm)"); + Obj(t).c=origin; + draw_Obj(t); +endfig; + + setObjectDefaultOption("Tree")("Dalign")("top"); + setObjectDefaultOption("Tree")("hideleaves")(false); % works + +% page 39 of beta manual + +beginfig(12); + setCurveDefaultOption("arrows")("draw"); + t:=_T(TCs)(Tc,_T(TCs)(_T(Tc)(Tc,Tc,Tc),TCs,TCs,TCs)); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(120); + setCurveDefaultOption("arrows")("draw"); + setObjectDefaultOption("Tree")("hideleaves")(true); + t:=_T(TCs)(Tc,_T(TCs)(_T(Tc)(Tc,Tc,Tc),TCs,TCs,TCs)); + Obj(t).c=origin; + draw_Obj(t); + setObjectDefaultOption("Tree")("hideleaves")(false); +endfig; + +beginfig(121); + setCurveDefaultOption("arrows")("draw"); + t:=T_(TCs)(_T(TCs)(TCs,TCs),_T(TCs)(TCs,TCs))("vsep(.5cm)","hbsep(2cm)"); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +% page 40 of beta manual + +beginfig(13); + % We don't have a hook for a given level as PSTricks does, + % so we have to give the hsep option several times; + % however, we could avoid it by building the tree in a non-streamlined way. + % Also, the labels must be given in the opposite order. + setCurveDefaultOption("arrows")("draw"); + setObjectDefaultOption("Tree")("treemode")("R"); + %setObjectDefaultOption("Tree")("treeflip")(true); + t:=_T(Tc)( + _T(TCs)(T_(TCs)(Tr_(btex $J_1$ etex),Tr_(btex $J_2$ etex))("hsep(3cm)"), + T_(TCs)(Tr_(btex $K_1$ etex),Tr_(btex $K_2$ etex))("hsep(3cm)") + ), + _T(TCs)(T_(TCs)(Tr_(btex $Y_1$ etex),Tr_(btex $Y_2$ etex))("hsep(3cm)"), + T_(TCs)(Tr_(btex $X_1$ etex),Tr_(btex $X_2$ etex))("hsep(3cm)") + ) + ); + Obj(t).c=origin; + draw_Obj(t); +endfig; + + +end + diff --git a/Master/texmf-dist/metapost/metaobj/pstricksex2.mp b/Master/texmf-dist/metapost/metaobj/pstricksex2.mp new file mode 100644 index 00000000000..c1fb1ba0a4a --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/pstricksex2.mp @@ -0,0 +1,136 @@ +input metaobj + +% page 41 of beta manual + +beginfig(15); + setObjectDefaultOption("Tree")("treemode")("R"); + t:=T_(new_Circle_("")("circmargin(3mm)")) + (Tcircle_(btex L etex),Tcircle_(btex H etex), + Tcircle_(btex K etex),Tcircle_(btex N etex))("edge(ncdiag)", "angleB(0)", + "armA(0)","armB(1cm)","hsep(3.5cm)","posA(e)","arrows(draw)"); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +% page 42 of beta manual + +beginfig(16); + setObjectDefaultOption("Tree")("treemode")("R"); + setObjectDefaultOption("Tree")("Ralign")("center"); + t:=T_(new_Circle_("")("circmargin(1mm)","framewidth(1pt)")) + (Tr_(btex $x<y$ etex),Tr_(btex $z_2 < y\leq x$ etex), + Tr_(btex $z_1<y\leq z_2$ etex),Tr_(btex $z_1\leq y$ etex)) + ("edge(ncdiag)", "nodesepA(2mm)","angleB(0)", + "armA(0)","armB(3cm)","hsep(3.5cm)","arrows(draw)","vbsep(5mm)", + "linewidth(1pt)"); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(17); + setObjectDefaultOption("Tree")("treemode")("U"); + setObjectDefaultOption("Tree")("hbsep")(5mm); + setObjectDefaultOption("Tree")("hideleaves")(true); % works + setCurveDefaultOption("arrows")("draw"); + + t:=_T(Tc)(TCs,_T(Tc)(TCs,TCs),TCs); + + % changes to the edges: + setTreeEdge(Obj(t))(1)(linestyle)("dashed evenly"); + setTreeEdge(treepos(Obj(t))(2))(1)(linestyle)("dashed evenly"); + + Obj(t).c=origin; + draw_Obj(t); + setObjectDefaultOption("Tree")("treemode")("D"); + setObjectDefaultOption("Tree")("hideleaves")(false); +endfig; + +% page 43 of beta manual + +beginfig(18); + setCurveDefaultOption("arrows")("draw"); + setCurveDefaultOption("nodesepA")(2mm); + setCurveDefaultOption("nodesepB")(2mm); + + t:=_T(Toval_(btex nature etex)) + (_T(new_Circle_("")("circmargin(1mm)","name(top)"))(TCs,TCs), + _T(new_Circle_("")("circmargin(1mm)","name(bot)"))(TCs,TCs)); + Obj(t).c=origin; + + ncline.Obj(t)("top")("bot") + "nodesepA(0)","nodesepB(0)","linestyle(dashed evenly)"; + + draw_Obj(t); + setCurveDefaultOption("nodesepA")(0); + setCurveDefaultOption("nodesepB")(0); +endfig; + +beginfig(19); + setCurveDefaultOption("arrows")("draw"); + setObjectDefaultOption("Tree")("treemode")("R"); + t:=T_(Toval_(btex root etex)) + (Tr_(btex Z etex),Tr_(btex Y etex),Tr_(btex X etex)) + ("edge(nccurve)","angleA(0)","angleB(0)","hsep(3.5cm)", + "posA(e)"); + Obj(t).c=origin; + draw_Obj(t); + setObjectDefaultOption("Tree")("treemode")("D"); +endfig; + +beginfig(20); + setCurveDefaultOption("arrows")("drawarrow"); + t:=T_(new_Polygon_(btex root etex)(4)("name(top)")) + (new_Box_(btex x etex)("framed(false)","name(lx)"), + new_Box_(btex y etex)("framed(false)","name(ly)"), + new_Box_(btex z etex)("framed(false)","name(lz)")) + ("edge(none)","vsep(1.5cm)"); + ncbar.Obj(t)("top")("lx") "angleA(180)","armA(1cm)"; + ncline.Obj(t)("top")("ly"); + ncbar.Obj(t)("top")("lz") "angleA(0)","armA(1cm)"; + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(21); + setObjectDefaultOption("Tree")("treemode")("D"); + setCurveDefaultOption("nodesepA")(2mm); + setCurveDefaultOption("nodesepB")(0); + setCurveDefaultOption("arrows")("rdrawarrow"); + + t:=T_(new_Polygon_(btex root etex,3)("angle(90)","polymargin(4mm)")) + (TCs,TCs,TCs,TCs) + ("edge(rncangle)","angleA(90)","angleB(90)","armB(1cm)","vsep(2.5cm)"); + Obj(t).c=origin; + draw_Obj(t); +endfig; + +beginfig(22); + newBox.a(btex Idea1 etex); + newBox.b(btex Idea2 etex); + b.c-a.c=(5cm,3cm); + a.c=origin; + ncbox(a)(b) "linearc(1mm)","linestyle(dashed evenly)", + "boxsize(1cm)","nodesepA(1cm)","nodesepB(1cm)"; + drawObj(a,b); +endfig; + +clearObj a,b; + +beginfig(23); + newBox.a(btex Idea1 etex); + newBox.b(btex Idea2 etex); + b.c-a.c=(5cm,3cm); + a.c=origin; + ncarcbox(a)(b) "doubleline(true)", + %"doublesep(5mm)", + "linestyle(dashed evenly)", + "boxsize(7mm)","nodesepA(1cm)","nodesepB(1cm)","arcangleA(-50)"; + drawObj(a,b); +endfig; + + + +end + + + diff --git a/Master/texmf-dist/metapost/metaobj/pstricksex3.mp b/Master/texmf-dist/metapost/metaobj/pstricksex3.mp new file mode 100644 index 00000000000..386b76ebf9e --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/pstricksex3.mp @@ -0,0 +1,127 @@ +input metaobj + +% the black disk is small, but its bounding box is extended so that we +% get a good alignment with the empty circles + +% TCE=TC Extended +def TCE= + rebindrelative_Obj(new_Circle_("")("filled(true)","circmargin(.5mm)")) + (1.5mm,-1.5mm,1.5mm,-1.5mm) +enddef; + +% 11-12/5/2001 +beginfig(25); + setCurveDefaultOption("arrows","draw"); + setObjectDefaultOption("Tree")("vsep")(2cm); + setObjectDefaultOption("Tree")("hbsep")(2cm); + setObjectDefaultOption("Tree")("treenodevsize")(5mm); + t:=T_(Tn)(T_(Tr_(btex Player 1 etex)) + (T_(Tr_(btex Player 2 etex)) + (Tr_(btex Player 3 etex))("edge(none)"))("edge(none)"), + T_(Tc_(2mm))( + _T(Tc_(2mm))(TCE,T_(Tc_(2mm))(TCE,TCE)("hideleaves(true)")), + _T(Tc_(2mm))(TCE,T_(Tc_(2mm))(TCE,TCE)("hideleaves(true)")) + )("hbsep(2cm)"), + new_HRazor(-5cm), + TCE)("edge(none)"); + Obj(t).c=origin; + + ncbox.Obj(t)(treeroot(Obj(t))(2,1)) + (treeroot(Obj(t))(2,2)) + "linestyle(dashed evenly)", "boxsize(3mm)", + "nodesepA(5mm)", "nodesepB(5mm)", "linearc(3mm)"; + ncarcbox.Obj(t)(treeroot(Obj(t))(2,1,2)) + (treeroot(Obj(t))(2,2,2)) + "linestyle(dashed evenly)", "arcangleA(30)", + "nodesepA(5mm)", "nodesepB(5mm)","boxsize(3mm)"; + ncline.Obj(t)(treeroot(Obj(t))(2))(treeroot(Obj(t))(4)) "name(N)"; + + ObjLabel.Obj(t)(btex N etex) "labpathname(N)", "labdir(top)"; + % we add labels on edges; the standard edges of a tree are numbered 1,2, ... + % and we use |labpathid|; we must take care to give the correct objet + % as first parameter of |ObjLabel|. + ObjLabel.treepos(Obj(t))(2)(btex L etex) "labpathid(1)", "labdir(lft)"; + ObjLabel.treepos(Obj(t))(2)(btex R etex) "labpathid(2)", "labdir(rt)"; + + ObjLabel.ntreepos(Obj(t))(2,1)(btex l etex) "labpathid(1)", "labdir(lft)"; + % The previous is a shorthand for + % ObjLabel.treepos(treepos(Obj(t))(2))(1)(btex l etex) + % "labpathid(1)", "labdir(lft)"; + + ObjLabel.ntreepos(Obj(t))(2,1)(btex r etex) "labpathid(2)" + %,"laberase(true)"; + , "labdir(rt)"; + ObjLabel.ntreepos(Obj(t))(2,2)(btex l etex) "labpathid(1)", "labdir(lft)"; + ObjLabel.ntreepos(Obj(t))(2,2)(btex r etex) "labpathid(2)", "labdir(rt)"; + + ObjLabel.ntreepos(Obj(t))(2,1,2)(btex c etex) "labpathid(1)", "labdir(lft)"; + ObjLabel.ntreepos(Obj(t))(2,1,2)(btex d etex) "labpathid(2)", "labdir(rt)"; + ObjLabel.ntreepos(Obj(t))(2,2,2)(btex c etex) "labpathid(1)", "labdir(lft)"; + ObjLabel.ntreepos(Obj(t))(2,2,2)(btex d etex) "labpathid(2)", "labdir(rt)"; + + % labels on nodes: + ObjLabel.ntreepos(Obj(t))(2,1,1)(btex $(-10,10.-10)$ etex) "labcard(s)"; + % the distance between the node and the label is 1cm as defined in |ObjLabel| + ObjLabel.ntreepos(Obj(t))(2,2,1)(btex $(10,-10.0)$ etex) "labcard(s)"; + ObjLabel.ntreepos(Obj(t))(2,1,2,1)(btex $(3,8,-4)$ etex) "labcard(s)"; + ObjLabel.ntreepos(Obj(t))(2,1,2,2)(btex $(-8,3,4)$ etex) "labcard(s)"; + ObjLabel.ntreepos(Obj(t))(2,2,2,1)(btex $(4,8,-3)$ etex) "labcard(s)"; + ObjLabel.ntreepos(Obj(t))(2,2,2,2)(btex $(0,-5,0)$ etex) "labcard(s)"; + + ObjLabel.treepos(Obj(t))(4)(btex $(0,0,0)$ etex) "labcard(e)"; + % 4, because the HRazor counts for one subtree + + draw_Obj(t); + +endfig; + +% TCE=TC Extended +def TCE= + rebindrelative_Obj(new_Circle_("")("filled(true)","circmargin(.5mm)")) + (.5mm,-.5mm,.5mm,-.5mm) +enddef; + +beginfig(27); +setCurveDefaultOption("arrows","draw"); + setObjectDefaultOption("Tree")("treemode")("R"); + setObjectDefaultOption("Tree")("vbsep")(5mm); + setObjectDefaultOption("Tree")("treenodevsize")(-1); + setObjectDefaultOption("Tree")("treenodehsize")(5mm); + t:=T_(Tc)( + T_(Tc)( + _T(Tc)(TCE,TCE), + T_(Tn)(T_(Tn)(TCE)("edge(none)"))("edge(none)"), + T_(Tn)(T_(Tn)(_T(Tc)(TCE,TCE))("edge(none)"))("edge(none)"), + TCE + )("edge(none)"), + _T(Tn)(new_VFan_(2mm,1cm)("edge(none)")) + )("edge(none)","pointedfan(false)"); + + ncline.Obj(t)(treeroot(Obj(t))(1))(treeroot(Obj(t))(1,1)); + ncline.Obj(t)(treeroot(Obj(t))(1))(treeroot(Obj(t))(1,2,1,1)); + ncline.Obj(t)(treeroot(Obj(t))(1))(treeroot(Obj(t))(1,3,1,1)); + ncline.Obj(t)(treeroot(Obj(t))(1))(ntreepos(Obj(t))(1,4)); + ncline.Obj(t)(obj(Obj(t)root)) (treeroot(Obj(t))(1)); + + % we call |ncfan| because we draw a non-standard fan + ncfan.Obj(t)(obj(Obj(t)root))(ntreepos(Obj(t))(2,1))(2); + + Obj(t).c=origin; + + draw_Obj(t); + + % we call |drawfan| because we draw a non-standard fan + drawfan.Obj(t)(ntreepos(Obj(t))(2,1))(2); + +% draw ntreepos(Obj(t))(1,2,1,1).nw-- +% ntreepos(Obj(t))(1,2,1,1).ne-- +% ntreepos(Obj(t))(1,2,1,1).se-- +% ntreepos(Obj(t))(1,2,1,1).sw--cycle withcolor red; + +% draw treeroot(Obj(t))(1,3,1,1).nw-- +% treeroot(Obj(t))(1,3,1,1).ne-- +% treeroot(Obj(t))(1,3,1,1).se-- +% treeroot(Obj(t))(1,3,1,1).sw--cycle withcolor red; + +endfig; +end diff --git a/Master/texmf-dist/metapost/metaobj/pstricksex4.mp b/Master/texmf-dist/metapost/metaobj/pstricksex4.mp new file mode 100644 index 00000000000..9d9616333d7 --- /dev/null +++ b/Master/texmf-dist/metapost/metaobj/pstricksex4.mp @@ -0,0 +1,25 @@ +input metaobj + +% top of page 45 of beta manual + +beginfig(30); + t:=T_(Tc)(TC,TC,Tc)("treemode(R)","arrows(draw)","hsep(2cm)"); + Obj(t).c=origin; + ObjLabel.Obj(t)(btex below etex) "labpathid(1)", "labdir(bot)"; + ObjLabel.Obj(t)(btex above etex) "labpathid(2)", "labdir(top)"; + ObjLabel.Obj(t)(btex above etex) "labpathid(3)", "labdir(top)"; + draw_Obj(t); +endfig; + +beginfig(31); + t:=T_(Tc)(TC,TC,Tc)("treemode(R)","arrows(draw)","hsep(2cm)"); + Obj(t).c=origin; + ObjLabel.Obj(t)(btex below etex) + "labpathid(1)", "labdir(bot)","labangle(0)","labpos(0.4)"; + ObjLabel.Obj(t)(btex above etex) "labpathid(2)", "labdir(top)","labpos(0.6)"; + ObjLabel.Obj(t)(btex above etex) + "labpathid(3)", "labdir(top)","labangle(0)","labpos(0.3)"; + draw_Obj(t); +endfig; + +end diff --git a/Master/texmf-dist/metapost/metaplot/axes.mp b/Master/texmf-dist/metapost/metaplot/axes.mp new file mode 100644 index 00000000000..a56e4bad115 --- /dev/null +++ b/Master/texmf-dist/metapost/metaplot/axes.mp @@ -0,0 +1,219 @@ +% AXES: Axis/grid-tick formatter, for the METAPLOT package. +% Copyright(C) 2004, Brooks Moses +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License, either +% version 1.3 of this license or (at your option) any +% later version. +% The latest version of the license is in +% http://www.latex-project.org/lppl.txt +% and version 1.3 or later is part of all distributions of +% LaTeX version 2003/06/01 or later. +% +% This work has the LPPL maintenance status "author-maintained". +% +% Version 0.9. +% +% The n < 1.0 release number indicates that this is a beta release; +% the author at present makes no assurances that the command syntax +% will remain unchanged between this and the final Version 1.0 +% release. +% +% Bug reports, feature requests, and all other suggestions should +% be directed to Brooks Moses, bmoses@stanford.edu. + + +input format + +% axes_tick(pair tickorigin, +% numeric ticklength, +% pair tickdir) +% +% Draws a grid tick, located on tickorigin, in the direction indicated by +% tickdir, with length ticklength. + +def axes_tick(expr tickorigin, ticklength, tickdir) = + begingroup + interim linecap := butt; + save theaxistick; picture theaxistick; theaxistick := nullpicture; + addto theaxistick doublepath ((0,0)--(ticklength * unitvector(tickdir))); + + theaxistick shifted tickorigin + endgroup +enddef; + + +% axes_ticklabeled(pair tickorigin, +% numeric ticklength, +% numeric tickspace, +% pair tickdir, +% picture ticklabel) +% +% Draws a grid tick, located on tickorigin, in the direction indicated by +% tickdir, with length ticklength. In addition, ticklabel is placed as +% a label such that its center is along the line of the tick, and the +% bounding box is a distance tickspace from the end of the tick. + +def axes_ticklabeled(expr tickorigin, ticklength, tickspace, tickdir, ticklabel) = + begingroup + interim linecap := butt; + save tickunitvector; pair tickunitvector; + tickunitvector := unitvector(tickdir); + + % We calculate an intersection point between the bbox of ticklabel + % and a ray extending from center(ticklabel) in the direction of + % tickdir (approximated by a line guaranteed to be long enough to + % exit the bbox), in the coordinates of ticklabel. Thus, shifting + % ticklabel by the negative of this amount will put this intersection + % point at (0,0). + + save thelabelshift; pair thelabelshift; + thelabelshift = + (center(ticklabel) -- (center(ticklabel) + - tickunitvector * (xpart(urcorner ticklabel - llcorner ticklabel) + + ypart(urcorner ticklabel - llcorner ticklabel)))) + intersectionpoint (llcorner ticklabel -- lrcorner ticklabel + -- urcorner ticklabel -- ulcorner ticklabel -- cycle); + + save thetick; picture thetick; thetick := nullpicture; + addto thetick doublepath ((0,0)--(ticklength * tickunitvector)); + addto thetick also ticklabel + shifted ((ticklength + tickspace)*tickunitvector - thelabelshift); + + thetick shifted tickorigin + endgroup +enddef; + + +% axes_ticknumbered(pair tickorigin, +% numeric ticklength, +% numeric tickspace, +% pair tickdir, +% numeric tickvalue) +% string ticklabelformat) +% +% Draws a grid tick with a formatted number (tickvalue) as the label, +% according to the format given in ticklabelformat, with the remainder +% of the syntax identical to axes_ticklabeled. + +def axes_ticknumbered(expr tickorigin, ticklength, tickspace, tickdir, + tickvalue, ticklabelformat) = + axes_ticklabeled(tickorigin, ticklength, tickspace, tickdir, + format(ticklabelformat, tickvalue)) +enddef; + + +% axes_tickrow(pair startpoint, +% pair endpoint, +% numeric ticklength, +% pair tickdir, +% numeric ntickspaces) +% +% Draws a row of ntickspaces+1 grid ticks (that is, ticks with ntickspaces +% spaces between them) from startpoint to endpoint, with parameters given +% by ticklength and tickdir. + +def axes_tickrow(expr startpoint, endpoint, + ticklength, tickdir, ntickspaces) = + begingroup + save thetickrow; picture thetickrow; thetickrow := nullpicture; + save tickpoint; pair tickpoint; + for itick=0 upto ntickspaces: + tickpoint := (itick/ntickspaces) * (endpoint - startpoint) + startpoint; + addto thetickrow also + axes_tick(tickpoint, ticklength, tickdir); + endfor + thetickrow + endgroup +enddef; + + +% axes_tickrow_numbered(pair startpoint, +% pair endpoint, +% numeric ticklength, +% numeric tickspace, +% pair tickdir, +% numeric startvalue, +% numeric endvalue, +% numeric ntickspaces, +% string ticklabelformat) +% +% Draws a row of ntickspaces+1 labeled grid ticks (that is, ticks with +% ntickspaces spaces between them) from startpoint to endpoint, with +% parameters given by ticklength, tickspace, and tickdir. These ticks +% are labeled with numeric values that range from startvalue (at' +% startpoint) to endvalue (at endpoint), according to the format given +% in ticklabelformat. + +def axes_tickrow_numbered(expr startpoint, endpoint, + ticklength, tickspace, tickdir, + startvalue, endvalue, ntickspaces, + ticklabelformat) = + begingroup + save thetickrow; picture thetickrow; thetickrow := nullpicture; + save tickpoint; pair tickpoint; + save tickvalue; numeric tickvalue; + for itick=0 upto ntickspaces: + tickpoint := (itick/ntickspaces) * (endpoint - startpoint) + startpoint; + tickvalue := (itick/ntickspaces) * (endvalue - startvalue) + startvalue; + addto thetickrow also + axes_ticknumbered(tickpoint, ticklength, tickspace, tickdir, + tickvalue, ticklabelformat); + endfor + thetickrow + endgroup +enddef; + + +% axes_tickscale(pair startpoint, +% pair endpoint, +% numeric ticklength, +% numeric tickspace, +% pair tickdir, +% numeric startvalue, +% numeric endvalue, +% numeric tickzero, +% numeric tickstep, +% string ticklabelformat) +% +% Draws a row of grid ticks from startpoint to endpoint, arranged +% such that their values increase in steps of size tickstep, and +% located so that the sequence of grid ticks, if continued to +% infinity, will include a tick with value tickzero. The ticks +% will be labeled according to format ticklabelformat, or if +% ticklabelformat is "", they will be unlabeled. + +def axes_tickscale(expr startpoint, endpoint, + ticklength, tickspace, tickdir, + startvalue, endvalue, tickzero, tickstep, + ticklabelformat) = + begingroup + % tickepsilon is a small tolerance value to avoid roundoff errors. + save tickepsilon; numeric tickepsilon; + tickepsilon = 0.005 * min(1.0, abs(endvalue-startvalue)/tickstep); + + save firstticknumber; numeric firstticknumber; + save lastticknumber; numeric lastticknumber; + firstticknumber = ceiling((min(startvalue,endvalue)-tickzero)/tickstep - tickepsilon); + lastticknumber = floor((max(startvalue,endvalue)-tickzero)/tickstep + tickepsilon); + + save firsttickvalue; numeric firsttickvalue; + save lasttickvalue; numeric lasttickvalue; + firsttickvalue = firstticknumber * tickstep + tickzero; + lasttickvalue = lastticknumber * tickstep + tickzero; + + if ticklabelformat="": + axes_tickrow( + ((firsttickvalue-startvalue)/(endvalue-startvalue))[startpoint, endpoint], + ((lasttickvalue-startvalue)/(endvalue-startvalue))[startpoint, endpoint], + ticklength, tickdir, lastticknumber - firstticknumber) + else: + axes_tickrow_numbered( + ((firsttickvalue-startvalue)/(endvalue-startvalue))[startpoint, endpoint], + ((lasttickvalue-startvalue)/(endvalue-startvalue))[startpoint, endpoint], + ticklength, tickspace, tickdir, + firsttickvalue, lasttickvalue, lastticknumber - firstticknumber, + ticklabelformat) + fi + endgroup +enddef; diff --git a/Master/texmf-dist/metapost/metaplot/metaplot.mp b/Master/texmf-dist/metapost/metaplot/metaplot.mp new file mode 100644 index 00000000000..d26c938d6ce --- /dev/null +++ b/Master/texmf-dist/metapost/metaplot/metaplot.mp @@ -0,0 +1,170 @@ +% METAPLOT: primary plot routines for the METAPLOT package. +% Copyright(C) 2004, Brooks Moses +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License, either +% version 1.3 of this license or (at your option) any +% later version. +% The latest version of the license is in +% http://www.latex-project.org/lppl.txt +% and version 1.3 or later is part of all distributions of +% LaTeX version 2003/06/01 or later. +% +% This work has the LPPL maintenance status "author-maintained". +% +% Version 0.9. +% +% The n < 1.0 release number indicates that this is a beta release; +% the author at present makes no assurances that the command syntax +% will remain unchanged between this and the final Version 1.0 +% release. +% +% Bug reports, feature requests, and all other suggestions should +% be directed to Brooks Moses, bmoses@stanford.edu. + + +% Load MetaPlot axes macros +input axes + +% plot_instantiate(suffix inst, suffix plot_object) +% +% Defines a page-instance of plot-object inst, and sets up the relevant +% correspondences between the page locations and the plot-object's scale +% locations. + +def plot_instantiate(suffix inst)(suffix plot_object) = + + % Define (unknown) parameters for plot-instance location on page + + numeric inst.pagewidth, inst.pageheight; + numeric inst.pageleft, inst.pageright, inst.pagetop, inst.pagebottom; + pair inst.llft, inst.lrt, inst.ulft, inst.urt; + + inst.pageleft + inst.pagewidth = inst.pageright; + inst.pagebottom + inst.pageheight = inst.pagetop; + inst.llft = (inst.pageleft, inst.pagebottom); + inst.lrt = (inst.pageright, inst.pagebottom); + inst.ulft = (inst.pageleft, inst.pagetop); + inst.urt = (inst.pageright, inst.pagetop); + + % Define (known) parameters for plot's scaling + + numeric inst.scalewidth, inst.scaleheight; + numeric inst.scaleleft, inst.scaleright, inst.scaletop, inst.scalebottom; + + inst.scaleleft := plot_object.xleft; + inst.scaleright := plot_object.xright; + inst.scalebottom := plot_object.ybot; + inst.scaletop := plot_object.ytop; + + inst.scalewidth := inst.scaleright - inst.scaleleft; + inst.scaleheight := inst.scaletop - inst.scalebottom; + + % Pointer-function to plot_object's plots, scaled and positioned. + + vardef inst.plot(suffix name) = + plot_object.name xscaled inst.pagewidth yscaled inst.pageheight + shifted inst.llft + enddef; + +enddef; + +% plot_setequalaxes(suffix inst) +% +% Sets the axis-scales equal on plot inst. + +def plot_setequalaxes(suffix inst) = + inst.pagewidth = inst.pageheight * (inst.scalewidth/inst.scaleheight); +enddef; + + +% plot_[x | y | x]pageloc(suffix inst, +% numeric [scalex | scaley | scalex, scaley]) +% +% Scale-to-page conversion functions, which produce the value (or pair) +% for the page location that corresponds to the given x location, y +% location, or pair in plot-object inst's coordinates. + +def plot_xpageloc(suffix inst)(expr scalex) = + inst.pageleft + (inst.pagewidth/inst.scalewidth) * (scalex - inst.scaleleft) +enddef; + +def plot_ypageloc(suffix inst)(expr scaley) = + inst.pagebottom + (inst.pageheight/inst.scaleheight) * (scaley - inst.scalebottom) +enddef; + +def plot_zpageloc(suffix inst)(expr scalex)(expr scaley) = + (plot_xpageloc(inst, scalex), plot_ypageloc(inst,scaley)) +enddef; + + +% plot_[x | y]scaleloc(suffix inst, +% numeric [pagex | pagey]) +% +% Page-to-scale conversion functions, which produce the value +% for the location in plot-object inst's coordinates that corresponds +% to the given x location or y location on the page. + +def plot_xscaleloc(suffix inst)(expr pagex) = + inst.scaleleft + (inst.scalewidth/inst.pagewidth) * (pagex - inst.pageleft) +enddef; + +def plot_yscaleloc(suffix inst)(expr pagey) = + inst.scalebottom + (inst.scaleheight/inst.pageheight) * (pagey - inst.pagebottom) +enddef; + + + +% plot_xtickscale(suffix inst, +% pair startpoint, +% pair endpoint, +% numeric ticklength, +% numeric tickspace, +% pair tickdir, +% numeric tickzero, +% numeric tickstep, +% string ticklabelformat) +% +% Draws a row of x-axis grid ticks from startpoint to endpoint, +% with the values determined by the x-scale of plot-object inst, +% and the details of the tick location and format determined +% according to the axes_tickscale parameters. + +def plot_xtickscale(suffix inst) + (expr startpoint, endpoint, + ticklength, tickspace, tickdir, + tickzero, tickstep, ticklabelformat) = + axes_tickscale(startpoint, endpoint, + ticklength, tickspace, tickdir, + plot_xscaleloc(inst)(xpart(startpoint)), + plot_xscaleloc(inst)(xpart(endpoint)), + tickzero, tickstep, ticklabelformat) +enddef; + + +% plot_ytickscale(suffix inst, +% pair startpoint, +% pair endpoint, +% numeric ticklength, +% numeric tickspace, +% pair tickdir, +% numeric tickzero, +% numeric tickstep, +% string ticklabelformat) +% +% Draws a row of y-axis grid ticks from startpoint to endpoint, +% with the values determined by the y-scale of plot-object inst, +% and the details of the tick location and format determined +% according to the axes_tickscale parameters. + +def plot_ytickscale(suffix inst) + (expr startpoint, endpoint, + ticklength, tickspace, tickdir, + tickzero, tickstep, ticklabelformat) = + axes_tickscale(startpoint, endpoint, + ticklength, tickspace, tickdir, + plot_yscaleloc(inst)(ypart(startpoint)), + plot_yscaleloc(inst)(ypart(endpoint)), + tickzero, tickstep, ticklabelformat) +enddef; + diff --git a/Master/texmf-dist/metapost/mfpic/dvipsnam.mp b/Master/texmf-dist/metapost/mfpic/dvipsnam.mp new file mode 100644 index 00000000000..7cbc933d2c6 --- /dev/null +++ b/Master/texmf-dist/metapost/mfpic/dvipsnam.mp @@ -0,0 +1,116 @@ +%% +%% This is file `dvipsnam.mp', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% grafbase.dtx (with options: `dvips') +%% +%% ------------------------------------------------------------------- +%% +%% Copyright 2002--2003, Daniel H. Luecking +%% +%% Mfpic consists of the 3 files mfpic.dtx, grafbase.dtx and mfpic.ins +%% and the 5 files they generate: mfpic.tex, mfpic.sty, grafbase.mf, +%% grafbase.mp, and dvipsnam.mp. +%% +%% Documentation, examples, and ancillary files are separate. See +%% readme.1st for a complete list. +%% +%% Mfpic may be distributed and/or modified under the conditions of the +%% LaTeX Project Public License, either version 1.2 of this license or (at +%% your option) any later version. The latest version of this license is in +%% +%% http://www.latex-project.org/lppl.txt +%% +%% and version 1.2 or later is part of all distributions of LaTeX version +%% 1999/12/01 or later. +%% +%% With respect to the proposed draft LPPL-1.3: mfpic has maintenance +%% status "maintained". The Current Maintainer is Daniel H. Luecking. There +%% are several Base Interpreters: TeX, LaTeX, MetaPost and Metafont. +%% +color Apricot, Aquamarine, Bittersweet, Black, Blue, BlueGreen, +BlueViolet, BrickRed, Brown, BurntOrange, CadetBlue, CarnationPink, +Cerulean, CornflowerBlue, Cyan, Dandelion, DarkOrchid, Emerald, +ForestGreen, Fuchsia, Goldenrod, Gray, Green, GreenYellow, JungleGreen, +Lavender, LimeGreen, Magenta, Mahogany, Maroon, Melon, MidnightBlue, +Mulberry, NavyBlue, OliveGreen, Orange, OrangeRed, Orchid, Peach, +Periwinkle, PineGreen, Plum, ProcessBlue, Purple, RawSienna, Red, +RedOrange, RedViolet, Rhodamine, RoyalBlue, RoyalPurple, RubineRed, +Salmon, SeaGreen, Sepia, SkyBlue, SpringGreen, Tan, TealBlue, Thistle, +Turquoise, Violet, VioletRed, White, WildStrawberry, Yellow, +YellowGreen, YellowOrange; + +Apricot = cmyk( 0, 0.32, 0.52, 0); +Aquamarine = cmyk(0.82, 0, 0.30, 0); +Bittersweet = cmyk( 0, 0.75, 1, 0.24); +Black = cmyk( 0, 0, 0, 1); +Blue = cmyk( 1, 1, 0, 0); +BlueGreen = cmyk(0.85, 0, 0.33, 0); +BlueViolet = cmyk(0.86, 0.91, 0, 0.04); +BrickRed = cmyk( 0, 0.89, 0.94, 0.28); +Brown = cmyk( 0, 0.81, 1, 0.60); +BurntOrange = cmyk( 0, 0.51, 1, 0); +CadetBlue = cmyk(0.62, 0.57, 0.23, 0); +CarnationPink = cmyk( 0, 0.63, 0, 0); +Cerulean = cmyk(0.94, 0.11, 0, 0); +CornflowerBlue = cmyk(0.65, 0.13, 0, 0); +Cyan = cmyk( 1, 0, 0, 0); +Dandelion = cmyk( 0, 0.29, 0.84, 0); +DarkOrchid = cmyk(0.40, 0.80, 0.20, 0); +Emerald = cmyk( 1, 0, 0.50, 0); +ForestGreen = cmyk(0.91, 0, 0.88, 0.12); +Fuchsia = cmyk(0.47, 0.91, 0, 0.08); +Goldenrod = cmyk( 0, 0.10, 0.84, 0); +Gray = cmyk( 0, 0, 0, 0.50); +Green = cmyk( 1, 0, 1, 0); +GreenYellow = cmyk(0.15, 0, 0.69, 0); +JungleGreen = cmyk(0.99, 0, 0.52, 0); +Lavender = cmyk( 0, 0.48, 0, 0); +LimeGreen = cmyk(0.50, 0, 1, 0); +Magenta = cmyk( 0, 1, 0, 0); +Mahogany = cmyk( 0, 0.85, 0.87, 0.35); +Maroon = cmyk( 0, 0.87, 0.68, 0.32); +Melon = cmyk( 0, 0.46, 0.50, 0); +MidnightBlue = cmyk(0.98, 0.13, 0, 0.43); +Mulberry = cmyk(0.34, 0.90, 0, 0.02); +NavyBlue = cmyk(0.94, 0.54, 0, 0); +OliveGreen = cmyk(0.64, 0, 0.95, 0.40); +Orange = cmyk( 0, 0.61, 0.87, 0); +OrangeRed = cmyk( 0, 1, 0.50, 0); +Orchid = cmyk(0.32, 0.64, 0, 0); +Peach = cmyk( 0, 0.50, 0.70, 0); +Periwinkle = cmyk(0.57, 0.55, 0, 0); +PineGreen = cmyk(0.92, 0, 0.59, 0.25); +Plum = cmyk(0.50, 1, 0, 0); +ProcessBlue = cmyk(0.96, 0, 0, 0); +Purple = cmyk(0.45, 0.86, 0, 0); +RawSienna = cmyk( 0, 0.72, 1, 0.45); +Red = cmyk( 0, 1, 1, 0); +RedOrange = cmyk( 0, 0.77, 0.87, 0); +RedViolet = cmyk(0.07, 0.90, 0, 0.34); +Rhodamine = cmyk( 0, 0.82, 0, 0); +RoyalBlue = cmyk( 1, 0.50, 0, 0); +RoyalPurple = cmyk(0.75, 0.90, 0, 0); +RubineRed = cmyk( 0, 1, 0.13, 0); +Salmon = cmyk( 0, 0.53, 0.38, 0); +SeaGreen = cmyk(0.69, 0, 0.50, 0); +Sepia = cmyk( 0, 0.83, 1, 0.70); +SkyBlue = cmyk(0.62, 0, 0.12, 0); +SpringGreen = cmyk(0.26, 0, 0.76, 0); +Tan = cmyk(0.14, 0.42, 0.56, 0); +TealBlue = cmyk(0.86, 0, 0.34, 0.02); +Thistle = cmyk(0.12, 0.59, 0, 0); +Turquoise = cmyk(0.85, 0, 0.20, 0); +Violet = cmyk(0.79, 0.88, 0, 0); +VioletRed = cmyk( 0, 0.81, 0, 0); +White = cmyk( 0, 0, 0, 0); +WildStrawberry = cmyk( 0, 0.96, 0.39, 0); +Yellow = cmyk( 0, 0, 1, 0); +YellowGreen = cmyk(0.44, 0, 0.74, 0); +YellowOrange = cmyk( 0, 0.42, 1, 0); + +endinput. +%% +%% End of file `dvipsnam.mp'. diff --git a/Master/texmf-dist/metapost/mfpic/grafbase.mp b/Master/texmf-dist/metapost/mfpic/grafbase.mp new file mode 100644 index 00000000000..08e9f3de9b1 --- /dev/null +++ b/Master/texmf-dist/metapost/mfpic/grafbase.mp @@ -0,0 +1,2283 @@ +%% +%% This is file `grafbase.mp', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% grafbase.dtx (with options: `MP') +%% +%% ------------------------------------------------------------------- +%% +%% Copyright 2002--2003, Daniel H. Luecking +%% +%% Mfpic consists of the 3 files mfpic.dtx, grafbase.dtx and mfpic.ins +%% and the 5 files they generate: mfpic.tex, mfpic.sty, grafbase.mf, +%% grafbase.mp, and dvipsnam.mp. +%% +%% Documentation, examples, and ancillary files are separate. See +%% readme.1st for a complete list. +%% +%% Mfpic may be distributed and/or modified under the conditions of the +%% LaTeX Project Public License, either version 1.2 of this license or (at +%% your option) any later version. The latest version of this license is in +%% +%% http://www.latex-project.org/lppl.txt +%% +%% and version 1.2 or later is part of all distributions of LaTeX version +%% 1999/12/01 or later. +%% +%% With respect to the proposed draft LPPL-1.3: mfpic has maintenance +%% status "maintained". The Current Maintainer is Daniel H. Luecking. There +%% are several Base Interpreters: TeX, LaTeX, MetaPost and Metafont. +%% +string fileversion, filedate; +fileversion := "0.7a beta"; filedate := "2004/04/16"; +def GBmsg expr s = message "Grafbase: " & s; enddef; +def GBerrmsg (expr s) expr t = + errhelp t; + errmessage "Grafbase: "& s; + errhelp ""; +enddef; +if (known grafbaseversion) or (known grafbase) : + GBmsg "You have loaded grafbase more than once! " & + "Please make sure that it is loaded only once."; + endinput; +fi + +boolean grafbase; grafbase := true; +boolean MFPIC; MFPIC := false; + +def checkversions (expr g)= + numeric grafbaseversion; grafbaseversion := g; + if unknown mfpicversion : % no mfpic, or < 0.63 + GBmsg "Recent mfpic not detected."; + elseif g = mfpicversion : + MFPIC := true; + else: + GBerrmsg ("version mismatch") + "The installation may be broken: mfpic and grafbase " & + "versions do not match."; + fi +enddef; + +checkversions (70); + +if unknown base_name : input plain; +elseif not string base_name : input plain; +elseif base_name <> "plain" : input plain; +fi + +boolean METAPOST; + +if known color Maurits Cornelis Escher : METAPOST := true; +else: METAPOST := false; +fi + +if not METAPOST : + GBerrmsg ("wrong compiler") + "You may have input to Metafont a file designed for Metapost. " & + "Instead of the file grafbase.mp, Metafont should be using " & + "grafbase.mf. Make sure the extension was not changed."; +fi + +if (unknown debug) or (not boolean debug) : + boolean debug; debug := false; +fi + +def GBdebug = + begingroup + save >>; def >> = message enddef; + >> "Grafbase DEBUG: "; +enddef; +def GBenddebug = + >> "End DEBUG"; + endgroup +enddef; + +vardef mftitle expr t = + t; message t; +enddef; + +pt# := 1pt; +def t_ = transformed currenttransform enddef; +if unknown aspect_ratio: aspect_ratio := 1; fi +if unknown hppp : hppp := 1 fi; +if unknown currenttransform : + transform currenttransform; + currenttransform := identity yscaled aspect_ratio; +fi + +interim warningcheck := 0; +numeric unitlen, xscale, yscale, xneg, xpos, yneg, ypos; + +unitlen := 1 bp; +xscale := 7.2; % (xscale * unitlen) = 1/10 inch +yscale := 7.2; % (yscale * unitlen) = 1/10 inch +xneg := 0; xpos := 10; +yneg := 0; ypos := 10; + +newinternal radian, pi, deg; +deg := 1; pi := 3.14159; +radian := 180/pi; + + +newinternal penwd; penwd := 0.5pt; +pen drawpen; + +def resizedrawpen (expr s) = + interim penwd := s; + setvariable (pen) (drawpen) (pencircle scaled penwd); + save currentpen; pen currentpen; pickup drawpen; +enddef; + +numeric hatchwd; hatchwd := 0.5bp; +pen hatchpen; hatchpen := pencircle scaled hatchwd; + +boolean clipall; clipall := false; +boolean ClipOn; ClipOn := false; +path ClipPath[]; numeric ClipPath; ClipPath = 0; +boolean truebbox; truebbox := false; + +def DoClip (suffix v) = + if ClipOn and (ClipPath > 0) : clipsto (v, ClipPath); fi +enddef; + +def noclip (text t) = + hide( save ClipOn; boolean ClipOn; ClipOn := false; t) +enddef; + +boolean showbbox; showbbox := false; + +def _wc_ = withcolor enddef; + +color currentcolor, fillcolor, drawcolor, hatchcolor, + headcolor, pointcolor, tlabelcolor, background; +currentcolor := fillcolor := drawcolor := hatchcolor := + headcolor := pointcolor := tlabelcolor := black; +background := white; + +vardef snapto expr t = + if unknown t : 0 + elseif not (numeric t) : 0 + elseif t < 0 : 0 + elseif t > 1 : 1 + else : t + fi +enddef; + +vardef gray (expr g) = (snapto g)*white enddef; + +vardef makeclr (expr r, g, b) = + (r, g, b) +enddef; + +vardef rgb (expr r, g, b) = + makeclr (snapto r, snapto g, snapto b) +enddef; + +vardef cmyk (expr c, m, y, k) = + rgb (1-c-k, 1-m-k, 1-y-k) +enddef; + +vardef RGB (expr R, G, B) = + rgb (R/255, G/255, B/255) +enddef; + +vardef named (suffix c) = forceclr (c) enddef; +vardef forceclr (expr c) = + if unknown c : black + elseif numeric c : gray (c) + elseif color c : c + else : black + fi +enddef; + +color red, green, blue, cyan, magenta, yellow; +red := rgb (1, 0, 0); +green := rgb (0, 1, 0); +blue := rgb (0, 0, 1); +cyan := rgb (0, 1, 1); +magenta := rgb (1, 0, 1); +yellow := rgb (1, 1, 0); + +vardef list (suffix v) (text lst) = + v := 0; for _itm = lst: v[incr v] := _itm; endfor +enddef; + +def map (text proc) (text lst) = + hide(_map := 0;) + for _a = lst : + if _map = 0 : hide(_map := 1;) else: , fi + proc(_a) + endfor +enddef; + +vardef knownarray suffix arr = + save _kna; boolean _kna; + _kna := (known arr) and (numeric arr); + if _kna : + _kna := (arr = floor arr) and (arr >= 1); + for _idx = 1 upto arr : + exitif not _kna; + _kna := known arr[_idx]; + endfor + fi + _kna +enddef; + +def copyarray(suffix from, to) = + to := 0; + for _idx = 1 upto from: + to[incr to] := from[_idx]; + endfor +enddef; + +def maparr (text proc) (suffix p) = + for _idx = 1 upto p: proc (p[_idx]); endfor +enddef; + +def textpairs (suffix p) (text t) = + numeric p; pair p[]; list (p) (t); +enddef; + +vardef chpair (text proc) (expr p) = + (proc (xpart p), proc (ypart p)) +enddef; + +vardef floorpair (expr p) = chpair (floor) (p) enddef; +vardef ceilingpair (expr p) = chpair (ceiling) (p) enddef; + +vardef emin (expr a, b) = if a < b : a else: b fi enddef; +vardef emax (expr a, b) = if a > b : a else: b fi enddef; + +vardef pairmin (expr z, w) = + ( emin (xpart z, xpart w), emin (ypart z, ypart w ) ) +enddef; +vardef pairmax (expr z, w) = + ( emax (xpart z, xpart w), emax (ypart z, ypart w ) ) +enddef; + +vardef minpair (suffix p) = + save _mp; pair _mp; _mp := p1; + for _idx = 2 upto p - 1 : + _mp := pairmin(_mp, p[_idx]); + endfor + pairmin (_mp, p[p]) +enddef; +vardef maxpair (suffix p) = + save _mp; pair _mp; _mp := p1; + for _idx = 2 upto p - 1: _mp := pairmax(_mp, p[_idx]); endfor + pairmax (_mp, p[p]) +enddef; + +transform ztr, vtr; +def setztr = + if debug : + GBdebug; + >> "w_ = " & decimal w_ & "bp"; + >> "h_ = " & decimal h_ & "bp"; + >> "unitlen = " & decimal unitlen & "bp"; + >> "xneg = " & decimal xneg; + >> "xpos = " & decimal xpos; + >> "yneg = " & decimal yneg; + >> "ypos = " & decimal ypos; + >> "xscale = " & decimal xscale; + >> "yscale = " & decimal yscale; + GBenddebug; + fi + save ztr, vtr; + transform ztr, vtr; + vtr := identity xscaled (xscale) yscaled (yscale) + scaled (unitlen*hppp); + ztr := identity shifted (-(xneg, yneg)) transformed vtr; + if debug : + GBdebug; + >> "ztr: "; + show ztr; + >> "vtr: "; + show vtr; + GBenddebug; + fi +enddef; + +vardef zconv (expr a) = a transformed ztr enddef; +vardef invzconv (expr a) = a transformed (inverse ztr) enddef; +vardef vconv (expr v) = v transformed vtr enddef; +vardef invvconv (expr v) = v transformed (inverse vtr) enddef; + +def active_plane = currentpicture enddef; + +boolean overlaylabels; +overlaylabels = false; + +def initpic = + setztr; + resizedrawpen (penwd); + if ClipOn : ClipPath := 1; + ClipPath1 := rect (origin, (w_, h_)); + fi + if debug : + GBdebug; + >> "Drawing nominal bounding box around picture"; + GBenddebug; + noclip ( safedraw rect (origin, (w_, h_)) ); + fi + save current_labels; picture current_labels; + current_labels := nullpicture; + save labelbb; pair labelbb.ll, labelbb.ur; + labelbb.ll := labelbb.ur := origin; +enddef; + +def mfpicenv = enddef; +def endmfpicenv = enddef; +def bounds (expr a, b, c, d) = + xneg := a; xpos := b; + yneg := c; ypos := d; +enddef; + +def setvariable (text kind) (suffix name) (expr value) = + save name; kind name; name := value; +enddef; + +string extra_beginmfpic; extra_beginmfpic := ""; +string extra_endmfpic; extra_endmfpic := ""; + +def beginmfpic (expr ch) = + beginfig (ch); + gcode := ch; + save w_, h_, d_; numeric w_, h_, d_; + charwd := (xpos-xneg)*xscale*unitlen; + charht := (ypos-yneg)*yscale*unitlen; + chardp := 0; + w_ := charwd; + h_ := charht; + d_ := chardp; + initpic; + scantokens extra_beginmfpic; +enddef; + +def endmfpic = + scantokens extra_endmfpic; + if debug : + GBdebug; + >> "width = " & decimal w_ & "bp"; + >> "height = " & decimal h_ & "bp"; + GBenddebug; + fi + DoClip (active_plane); + if clipall : clipto (active_plane) rect(origin, (w_, h_)); fi + if showbbox : noclip ( safedraw rect (origin, (w_, h_)) ); fi + save _ll, _ur; + pair _ll, _ur; + if truebbox : + _ll := llcorner active_plane; + _ur := urcorner active_plane; + elseif clipall: + _ll := origin; + _ur := (w_,h_); + else: % expand to accomodate labels + _ll := pairmin((0, 0 ), labelbb.ll); + _ur := pairmax((w_, h_), labelbb.ur); + fi + _ur := pairmax(_ur, _ll + eps*(1, 1)); + setbounds active_plane to rect(_ll, _ur); + addto active_plane also current_labels; + endfig; +enddef; + +pair label_adjust; label_adjust := (0, 0); +numeric label_sep; label_sep := 0; + + +vardef newgblabel (expr hf, vf, BL, r) (expr s) (text pts) = + save _lab, _ll, _ur; picture _lab; pair _ll, _ur; + _lab := + if picture s : s + elseif string s : s infont defaultfont scaled defaultscale + elseif path s : picpath (s) + else : nullpicture + fi; + labeldims (origin, _lab) (_ll, _ur); + _lab := thegblabel(ref_shift (hf, vf, BL, _ll, _ur), r, _lab); + save _b; pair _b; + for _itm = pts : + _b := zconv(_itm); + if overlaylabels : + addto current_labels also _lab shifted _b _wc_ tlabelcolor; + else: + addto active_plane also _lab shifted _b _wc_ tlabelcolor; + labelbb.ll := pairmin (_b + llcorner _lab, labelbb.ll); + labelbb.ur := pairmax (_b + urcorner _lab, labelbb.ur); + fi + endfor +enddef; + +vardef gblabel (expr a, b, c, d, r) (expr s) (text t) = + newgblabel (b, d, (c = 0) and (d = 0), r) (s) (t); +enddef; + +vardef ref_shift (expr hf, vf, BL, ll, ur) = + - ( (hf)[xpart ll, xpart ur], + (vf)[if BL: 0 else: (ypart ll) fi, ypart ur] ) +enddef; + +vardef thegblabel (expr z, r, p) = + ((p shifted z) rotated r) shifted label_adjust +enddef; + +vardef textrect (expr lbl, rad, loc) = + textrectx (.5, .5, false, 0) (origin, lbl, rad, loc) +enddef; +vardef textoval (expr lbl, mult, loc) = + xellipse (true, .5, .5, false, 0) (origin, lbl, mult, loc) +enddef; +vardef textellipse (expr lbl, rat, loc) = + xellipse (false, .5, .5, false, 0) (origin, lbl, rat, loc) +enddef; + +boolean roundends; roundends := true; +vardef textrectx (expr a, b, c, rot, xy, lbl, rad, loc) = + save ll, ur, _r, f, zz; + pair ll, ur, zz; path f; + labeldims (xy, lbl) (ll, ur); + _r := + if boolean rad : + if rad : emin (xpart (ur-ll), ypart (ur-ll))/sqrt(2) + else: 0 + fi + elseif numeric rad : rad + else: 0 + fi; + if _r = 0 : + f := rect(ll, ur); + else: + save p, q; + pair p[]; path q; + p1 := ur - _r*dir(45); % center of upper right arc + p3 := ll + _r*dir(45); % lower left + p2 := (xpart p3, ypart p1); % upper left + p4 := (xpart p1, ypart p3); % lower right + q := quartercircle scaled 2_r; + if _r > 0: + f := (q shifted p1) -- (q rotated 90 shifted p2) + -- (q rotated 180 shifted p3) + -- (q rotated -90 shifted p4) + -- cycle; + else: + f := (q shifted p1) -- (q rotated -90 shifted p4) + -- (q rotated 180 shifted p3) + -- (q rotated 90 shifted p2) + -- cycle; + fi + fi + invvconv(thegblabel(ref_shift(a, b, c, ll, ur), rot, f)) shifted loc +enddef; + +def textovalx = xellipse (true) enddef; +def textellipsex = xellipse (false) enddef; + +vardef xellipse (expr aspect, a, b, c, r, xy, lbl, mult, loc) = + if mult = 0 : + textrectx (a, b, c, r) (xy, lbl, 0, loc) + else: + save ll, ur, cc, ww, hh, f; + pair ll, ur, cc; path f; + labeldims (xy, lbl) (ll, ur); + cc := .5[ll, ur]; % center + (ww, hh) = ur - cc; + if (ww = 0) or (hh = 0) : % make a line: + f = (ll--ur); + else: + save aa, bb, mm; + mm := if aspect : ww/hh*mult else: mult fi; + aa := ww ++ hh*mm; + bb := aa/mm; + f := ellipse(cc, aa, bb, 0); + fi + invvconv(thegblabel (ref_shift (a, b, c, ll, ur), r, f)) shifted loc + fi +enddef; + + +def labeldims (expr xy, lbl) (suffix ll, ur) = + if pair lbl : + ll := xy; ur := lbl; + else: + save _lbl; picture _lbl; + _lbl := + if picture lbl : lbl + elseif string lbl : + lbl infont defaultfont scaled defaultscale + elseif path lbl : picpath (lbl) + else : nullpicture + fi; + ll := llcorner _lbl; + ur := urcorner _lbl; + fi + ll := ll - label_sep*(1, 1); + ur := ur + label_sep*(1, 1); +enddef; + +newinternal nottoosmall; nottoosmall := eps/2 + 2epsilon; +newinternal reallysmall; reallysmall := 3epsilon; +def signof (expr X) = if X < 0 : - fi enddef; +def TruncateWarn expr s = GBmsg s & " too large; truncating"; enddef; + +vardef secd primary X = + save temp; temp := cosd(X); + if abs(temp) < reallysmall : + TruncateWarn "Secant"; + temp := signof (temp) reallysmall; + fi + 1/temp +enddef; +vardef tand primary X = sind(X)*secd(X) enddef; + +vardef cscd primary X = + save temp; temp := sind(X); + if abs(temp) < reallysmall : + TruncateWarn "Cosecant"; + temp := signof(temp) reallysmall; + fi + 1/temp +enddef; +vardef cotd primary X = cosd(X)*cscd(X) enddef; + +vardef acos primary X = angle (X, 1 +-+ X) enddef; +vardef asin primary X = angle (1 +-+ X, X) enddef; +vardef atan primary X = angle (1, X) enddef; + +vardef sin primary X = sind (X*radian) enddef; +vardef cos primary X = cosd (X*radian) enddef; +vardef tan primary X = tand (X*radian) enddef; +vardef cot primary X = cotd (X*radian) enddef; +vardef sec primary X = secd (X*radian) enddef; +vardef csc primary X = cscd (X*radian) enddef; + +vardef invcos primary X = (acos X)/radian enddef; +vardef invsin primary X = (asin X)/radian enddef; +vardef invtan primary X = (atan X)/radian enddef; + +vardef exp primary X = mexp (256 * X) enddef; +vardef ln primary X = (mlog X) / 256 enddef; +def log = ln enddef; +vardef logbase (expr B) primary X = (mlog X)/(mlog B) enddef; +def logtwo = logbase( 2) enddef; +def logten = logbase(10) enddef; + +vardef Arg primary Z = (angle Z)/radian enddef; +vardef Log primary Z = (ln(abs(Z)), Arg (Z)) enddef; +vardef cis primary T = dir(radian*T) enddef; +vardef zexp primary Z = (exp (xpart Z))*(cis(ypart Z)) enddef; +vardef sgn primary Z = + if Z = origin : origin else: unitvector Z fi +enddef; + +vardef cosh primary X = + save temp; temp := 2 exp (-abs(X)); + if temp < reallysmall : + TruncateWarn "Cosh"; + temp := reallysmall; + fi + 1/temp + temp/4 +enddef; + +vardef sinh primary X = + save temp; temp := 2 exp (-abs(X)); + if temp < reallysmall : + TruncateWarn "Sinh"; + temp := reallysmall; + fi + signof (X) (1/temp - temp/4) +enddef; + +vardef sech primary X = + save temp; temp := exp(-(abs (X))); + 2temp/(1 + temp*temp) +enddef; + +vardef tanh primary X = + save temp; temp := exp(-2(abs (X))); + signof (X) (1 - temp)/(1 + temp) +enddef; + +vardef csch primary X = + save temp; temp := exp(-(abs (X))); + if abs(1 - temp*temp) < reallysmall : + TruncateWarn "Csch"; + signof (X) 2temp / reallysmall + else: + signof (X) 2temp / (1 - temp*temp) + fi +enddef; + +vardef coth primary X = + save temp; temp := tanh(X); + if abs(temp) < reallysmall : + TruncateWarn "Coth"; + temp := signof (temp) reallysmall; + fi + 1/temp +enddef; + +vardef acosh primary y = + if y < 1 : + GBerrmsg ("Undefined function: acosh " & decimal y) + "If you proceed, a value of 0 will be used. " & + "Expect more errors later."; + 0 + else: + ln (y + (y+-+1)) + fi +enddef; + +vardef asinh primary y = ln (y + (y++1)) enddef; + +vardef atanh primary y = + if abs (y) < 1 : + (ln(1+y) - ln(1-y))/2 + else: + GBerrmsg ("Undefined function: atanh " & decimal y) + "If you proceed, a value of plus or minus infinity " & + "will be used. Expect more errors later."; + signof (y) infinity + fi +enddef; + +vardef polar (expr p) = (xpart p) * dir (ypart p) enddef; +def id (expr x) = x enddef; + +transform T_stack[]; T_stack := 0; +def T_push (expr T) = T_stack[incr T_stack] := T; enddef; +def T_pop (suffix $) = + if T_stack > 0 : + $ := T_stack[T_stack]; T_stack := T_stack - 1; + fi +enddef; + +def bcoords = hide ( T_push (ztr); T_push (vtr) ) enddef; +def ecoords = hide ( T_pop (vtr); T_pop (ztr) ) enddef; + +def apply_t (text Transformer) = + ztr := identity Transformer transformed ztr; + vtr := ztr shifted - zconv(origin); +enddef; + +def xslant = slanted enddef; % (x+sy, y). +def yslant primary s = % (x, y+sx). + transformed + begingroup + save _T; transform _T; + origin transformed _T = origin; + (1, 0) transformed _T = (1, s); + (0, 1) transformed _T = (0, 1); + _T + endgroup +enddef; + +def zslant primary p = % (xu+yv, xv+yu), where p = (u, v). + transformed + begingroup + save _T; transform _T; + xpart _T = ypart _T = 0; + xxpart _T = yypart _T = xpart p; + xypart _T = yxpart _T = ypart p; + _T + endgroup +enddef; + +def xyswap = zslant (0, 1) enddef; +def boost primary X = zslant (cosh X, sinh X) enddef; + +vardef rotatedpath (expr p, th) expr f = + f transformed vtr rotatedaround (p transformed vtr, th) + transformed (inverse vtr) +enddef; +vardef scaledpath (expr p, s) expr f = + f shifted -p scaled s shifted p +enddef; +vardef xslantedpath (expr b, s) expr f = + f shifted (0, -b) slanted s shifted (0, b) +enddef; +def slantedpath = xslantedpath enddef; +vardef yslantedpath (expr a, s) expr f = + f shifted (-a, 0) yslant s shifted (0, a) +enddef; +vardef xscaledpath (expr a, s) expr f = + f shifted (-a, 0) xscaled s shifted (a, 0) +enddef; +vardef yscaledpath (expr b, s) expr f = + f shifted (0, -b) yscaled s shifted (0, b) +enddef; +vardef shiftedpath (expr v) expr f = f shifted v enddef; +vardef reflectedpath (expr p, q) expr f = + f transformed vtr + reflectedabout (p transformed vtr, q transformed vtr) + transformed (inverse vtr) +enddef; +vardef xyswappedpath expr f = f xyswap enddef; +vardef transformedpath (text Transformer) expr f = + f Transformer +enddef; + +vardef partialpath (expr a, b) expr f = + save p; path p; + p := zconv (f) scaled (1/unit_of_length); + save cumlen, totlen, idx, ta, tb; + totlen := makelengtharray(cumlen) p; + idx := 0; + if a <= b: + ta := gettime (cumlen, idx) (a*totlen); + tb := gettime (cumlen, idx) (b*totlen); + else: + tb := gettime (cumlen, idx) (b*totlen); + ta := gettime (cumlen, idx) (a*totlen); + fi + subpath (ta, tb) of f +enddef; +vardef gsubpath (expr a, b) expr f = subpath (a, b) of f enddef; + +def coloraddto (expr clr) (suffix u) (expr v) = + addto u also v _wc_ clr; +enddef; + +def orto (suffix u) (expr v) = addto u also v; enddef; + +vardef interior expr c = + save v; picture v; v := nullpicture; + addto v contour (c.t_); + v +enddef; +vardef interiors suffix cc = + save _ints; picture _ints; _ints := nullpicture; + for _idx = 1 upto cc: + addto _ints also interior cc[_idx]); + endfor + _ints +enddef; + +def clipto (suffix vt) expr c = + clip vt to c; +enddef; +def clipsto (suffix vt, cc) = + begingroup + save _cl, _cl_; picture _cl, _cl_; _cl_ := nullpicture; + for _idx = 1 upto cc: + _cl := vt; clip _cl to cc[_idx]; addto _cl_ also _cl; + endfor + vt := _cl_; + endgroup +enddef; + +vardef Clipped (suffix vt) expr c = + save _Cl; picture _Cl; _Cl := vt; clipto (_Cl) c; _Cl +enddef; +let clipped_ = clipped; +def clipped = Clipped enddef; + +vardef picneg (suffix vt) expr c = + save _pn; picture _pn; _pn := nullpicture; + addto _pn (interior c) _wc_ fillcolor; + addto _pn also (Clipped (vt) c) _wc_ background; + _pn +enddef; + +def shpath (suffix v) (expr q, f) = + addto v doublepath (f.t_) withpen (q.t_); +enddef; + +numeric minpenwd; +minpenwd := .05bp; % 1 pixel at 1440dpi +vardef picpath expr d = + save v; picture v; v := nullpicture; + if penwd >= minpenwd : + shpath (v, drawpen) (d); + fi + v +enddef; + +def picdot (suffix v) (expr w, p) = + addto v also + (w shifted p); +enddef; + +vardef setdot (expr apath, sc) = + if cycle apath : interior + else : picpath + fi + (apath scaled emax(sc, minpenwd)) +enddef; + +vardef shaded (expr clr) expr c = + if cycle c : + save v; picture v; + v := nullpicture; + addto v contour c _wc_ clr; + v + else: picpath c % should we? or just make it null? + fi +enddef; + +vardef filledwith (expr pic, dims, ll, ur) = + save b, v; picture b, v; + b := v := nullpicture; + for s = xpart ll step xpart dims until xpart ur: + addto b also pic shifted (s, 0); + endfor + for s = ypart ll step ypart dims until ypart ur: + addto v also b shifted (0, s); + endfor + v +enddef; + +vardef thatchf (suffix v) (expr CT, sp, a, b) = + save _sp; + _sp = signof (ypart(b - a)) abs(sp); + for _y = _sp*( ceiling ((ypart a)/_sp) ) step _sp until ypart b: + shpath (v, hatchpen) + ( ( (xpart a, _y)--(xpart b, _y) ) transformed CT ); + endfor +enddef; + +def tile (suffix atile) (expr unit, width, height, clipit) = + picture atile.pic; atile.pic := nullpicture; + numeric atile.wd, atile.ht; + (atile.wd, atile.ht) = (width, height)*unit; + boolean atile.clipon; atile.clipon := clipit; + begingroup + save active_plane; + def active_plane = atile.pic enddef; + save ztr, vtr; transform ztr, vtr; + ztr := identity scaled unit; vtr := ztr; + save ClipOn; boolean ClipOn; + if clipit : + ClipOn := true; + save ClipPath; path ClipPath[]; + ClipPath = 1; + ClipPath[1] = rect(origin, (atile.wd, atile.ht)); + else: + ClipOn := false; + fi +enddef; +def endtile = + DoClip (active_plane); + endgroup +enddef; + +vardef is_tile (suffix atile) = + (known atile.pic ) and (picture atile.pic ) and + (known atile.wd ) and (numeric atile.wd ) and + (known atile.ht ) and (numeric atile.ht ) and + (known atile.clipon) and (boolean atile.clipon) +enddef; + +vardef pnt@# (expr p) = point @# of p enddef; +vardef pre@# (expr p) = precontrol @# of p enddef; +vardef post@# (expr p) = postcontrol @# of p enddef; + +vardef gbbox (expr g) (suffix ll, ur) = + ll := llcorner g; ur := urcorner g; + if showbbox : noclip ( safedraw rect (ll, ur) ); fi +enddef; + +def safedraw = colorsafedraw (drawcolor) enddef; +vardef colorsafedraw (expr clr) expr d = + save v; picture v; v := picpath d; + DoClip (v); + coloraddto (clr) (active_plane, v); +enddef; + +def NoCycleWarn expr s = + GBmsg s & " cannot be applied to an open path. " + & "The path will be drawn instead."; +enddef; + +def safefill = colorsafefill (fillcolor) enddef; +vardef colorsafefill (expr clr) expr c = + if cycle c : + save v; picture v; v := interior c; + DoClip (v); + coloraddto (clr) (active_plane, v); + else: NoCycleWarn "fill"; safedraw c; + fi +enddef; +def safeunfill expr c = + if cycle c : noclip (colorsafefill (background) c); + else: NoCycleWarn "unfill"; safedraw c; + fi +enddef; + +def safeclip expr c = + if cycle c : clipto (active_plane) c; + else: NoCycleWarn "clip"; safedraw c; + fi +enddef; + +def store (suffix fs) expr f = +hide( + if (not path f) and (not pair f) : + GBerrmsg ("Second argument to `store' must be a path or pair") + ""; + fi + if not path fs : path fs; fi + fs := f +) +enddef; +vardef stored (suffix fs) expr f = store (fs) f; f enddef; + +def drawn = colordrawn (drawcolor) enddef; +vardef colordrawn (expr clr) expr f = + colorsafedraw (clr) (zconv (f)); f +enddef; + +def filled = colorfilled (fillcolor) enddef; +vardef colorfilled (expr clr) expr c = + colorsafefill (clr) zconv (c); c +enddef; +vardef unfilled expr c = safeunfill zconv (c); c enddef; +vardef Clip expr c = safeclip zconv(c); c enddef; + +numeric shadewd; shadewd := 0.5bp; +path shadedotpath; +shadedotpath := fullcircle; % unitsquare; + +vardef shade (expr sp) expr f = + save g; path g; g := zconv (f); + save gr; numeric gr; + gr := 1 - (.88*abs(shadewd)/sp)**2; + if not cycle g : NoCycleWarn "shade"; safedraw g; + elseif gr <= 0 : safefill g; + else: + colorsafefill (gr*white) g; + fi + f +enddef; + +polkadotwd := 5bp; +mindotspace := 1bp; +path polkadotpath; polkadotpath := fullcircle; + +vardef polkadot (expr sp) expr f = + save g; path g; g := zconv (f); + if not cycle g : NoCycleWarn "polkadot"; safedraw g; + elseif sp <= emax (2*polkadotwd/3, mindotspace) : + safefill g; + else: + save ll, ur; pair ll, ur; + gbbox (g, ll, ur); + save dx, dy; dx := sp/2; dy := dx*(sqrt 3); + hshift := ((xpart (ur - ll)) mod dx)/2; + vshift := ((ypart (ur - ll)) mod dy)/2; + save p, dims; pair p, dims; + p := ll + (hshift, vshift); + dims := 2(dx, dy); + save v, thepolkadot; picture v, thepolkadot; + thepolkadot := setdot (polkadotpath, polkadotwd); + v := filledwith (thepolkadot, dims, p, ur); + p := p + (dx, dy); + orto (v, filledwith (thepolkadot, dims, p, ur)); + DoClip (v); clipto (v) g; + coloraddto (fillcolor) (active_plane) (v); + fi + f +enddef; + +def thatch = colorthatch (hatchcolor) enddef; +vardef colorthatch (expr clr) (expr sp, theta) expr f = + save g; path g; g := zconv (f); + if not cycle g : NoCycleWarn "hatch"; safedraw g; + elseif sp <= abs(hatchwd) : colorsafefill (clr) g; + else: + save v; picture v; v := nullpicture; + save CT; transform CT; CT := identity rotated theta; + save ll, ur; pair ll, ur; + gbbox (g transformed inverse CT, ll, ur); + thatchf (v, CT, sp, ll, ur); + DoClip(v); + coloraddto (clr) (active_plane) (Clipped (v) g); + fi + f +enddef; + +def hhatch (expr sp) = thatch (sp, 0) enddef; +def vhatch (expr sp) = thatch (sp, 90) enddef; +def lhatch (expr sp) = thatch (sp, -45) enddef; +def rhatch (expr sp) = thatch (sp, 45) enddef; + +def xhatch = colorxhatch (hatchcolor) enddef; +vardef colorxhatch (expr clr, sp) expr f = + colorthatch (clr) (sp, 45) colorthatch (clr) (sp, -45) f +enddef; + +vardef tess (suffix atile) expr c = + save _g; path _g; _g := zconv (c); + if not is_tile (atile) : + GBerrmsg ("Tile parameter " & str atile & " of tess() is invalid") + "This tile may be undefined or incorrectly defined. " & + "If you proceed, tess() will be abandoned and the curve " & + "merely drawn."; safedraw _g; + elseif not cycle _g : NoCycleWarn "tess"; safedraw _g; + else: + save _ll, _ur; pair _ll, _ur; + gbbox (_g, _ll, _ur); + save _ts; picture _ts; + _ts := filledwith (atile.pic, (atile.wd, atile.ht), _ll, _ur); + DoClip (_ts); + orto (active_plane, Clipped (_ts) _g); + fi + c +enddef; + +if unknown segment_split : segment_split := 8; fi +if unknown dashsize : dashsize := 3bp; fi +if unknown dashgap : dashgap := dashsize + 2penwd; fi +if unknown dash_finish : dash_finish := .5; fi +if unknown dash_start : dash_start := .5; fi +if unknown unit_of_length : unit_of_length := 0.1in; fi + +vardef gendashed (suffix pat) expr f = + save _g; path _g; _g := zconv(f); + if (unknown pat.rep) : % no "pattern" + GBmsg "Dash pattern " & str pat & " undefined. " & + "Path will be drawn instead."; + safedraw _g; + elseif pat.rep < 2 : % no "spaces" + safedraw _g; + else: + save _dl, _tmppat; + forsuffixes _s = start, rep, finish : + _dl._s := 0; _tmppat._s := pat._s; + for i = 1 upto pat._s : + _tmppat._s[i] := pat._s[i]/unit_of_length; + _dl._s := _dl._s + _tmppat._s[i]; + endfor + endfor + if _dl.rep = 0 : + GBmsg "Dash pattern " & str pat & " has length 0. " & + "Path will be drawn instead."; + safedraw _g; + else: + save _p; path _p; + _p := _g scaled (1/unit_of_length); + save _cumlen, _totlen, _n, _sf; + _totlen := makelengtharray(_cumlen) _p; + _sf := scale_adjust (_n, _dl)(_totlen); + if _n < 0 : safedraw _g; + else: + forsuffixes _s = start, rep, finish : + for _i = 1 upto _tmppat._s : + _tmppat._s[_i] := _tmppat._s[_i]*_sf; + endfor + _dl._s := _dl._s*_sf; + endfor + save dashingdot; picture dashingdot; + if known plot_pic : dashingdot := makesymbol(plot_pic, penwd); + else: dashingdot := makesymbol(dotpath, penwd); + fi + save _ct, _t, _d, _v; + picture _v; _v := nullpicture; + _ct := 0; + % Begin with pat.start + _d0 := 0; _t0 := 0; + dashit (_tmppat.start) (_v); + % then pat.rep + if _n > 0 : + save _m; _m := ceiling sqrt(_n); + for _j = 0 step _m until _n - 1 : + for _i = 0 upto _m - 1 : + exitif (_i + _j) > _n - 1; + _d0 := _dl.start + (_j + _i)*_dl.rep; + _t0 := gettime(_cumlen, _ct) (_d0); + dashit (_tmppat.rep) (_v); + endfor + % add _m patterns and reset. + DoClip(_v); + coloraddto (drawcolor) (active_plane, _v); + _v := nullpicture; + endfor + fi + % and finally, pat.finish + _d0 := _totlen - _dl.finish; + _t0 := gettime(_cumlen, _ct) (_d0); + dashit (_tmppat.finish) (_v); + DoClip(_v); + coloraddto (drawcolor) (active_plane, _v); + fi + fi + fi + f +enddef; + +vardef makelengtharray (suffix clen) expr p = + save _s; _s := emax (1, ceiling segment_split); + clen := _s*length p; clen[0] := 0; + for _i = 1 upto clen : + clen[_i] := clen[_i-1] + abs (pnt[_i/_s] (p) - pnt[(_i-1)/_s] (p)); + endfor + clen[clen] +enddef; + +vardef scale_adjust (suffix n, pl) (expr lngth) = + n := (lngth - pl.start - pl.finish)/pl.rep; + n := if n < 0 : -1 else: round(n) fi; + lngth/(pl.start + emax(n, 0)*pl.rep + pl.finish) +enddef; + +vardef gettime (suffix arr, ct) (expr lngth) = + save _gtl, _s; + _s := emax(1, ceiling segment_split); + _gtl := emax (arr[ct], emin (arr[arr], lngth)); + forever: + exitif ( (arr[ct] <= _gtl) and (_gtl <= arr[ct+1]) ); + ct := ct + 1; % need to exit *before* incrementing + endfor + if arr[ct] = arr[ct+1] : ct + else: ( ct + (_gtl - arr[ct]) / (arr[ct+1] - arr[ct]) ) + fi /_s +enddef; + +def dashit (suffix pos) (suffix pic) = + for _k = 1 upto pos: + if odd _k : % draw a dash of length pos[_k] + if pos[_k] = 0 : % point required + _d1 := _d0; _t1 := _t0; + picdot (pic, dashingdot, pnt [_t0] (_g)); + else: + _d1 := _d0 + pos[_k]; + _t1 := gettime (_cumlen, _ct) (_d1); + shpath (pic, drawpen) (subpath (_t0, _t1) of _g); + fi + else: % find the start of the next dash: + _d0 := _d1 + pos[_k]; + _t0 := gettime(_cumlen, _ct) (_d0); + fi + endfor +enddef; + +def dashpat (suffix pat) (text t) = + pat.rep := 0; + for _itm = t: + pat.rep[incr pat.rep] := _itm; + endfor; + if odd (pat.rep) and (pat.rep > 1): + pat.rep[incr pat.rep] := 0; + fi + pat.start := 1; + pat.start[1] := pat.rep[1]*dash_start; + for _idx = 2 upto pat.rep : + pat.start[incr pat.start] := pat.rep[_idx]; + endfor + pat.finish := 1; + pat.finish[1] := pat.rep[1]*dash_finish; +enddef; + +vardef DASHED (expr dlen, dgap) expr f = + save dashes; dashpat (dashes) (dlen, dgap); + gendashed (dashes) f +enddef; + +let dashed_ = dashed; +def dashed = DASHED enddef; + +vardef doplot (expr spath, sc, dgap) expr f = + save dots; dashpat (dots) (0, dgap); + save plot_pic; picture plot_pic; + plot_pic := makesymbol (spath, sc); + gendashed (dots) f +enddef; + +path dotpath; dotpath := fullcircle; +vardef dotted (expr dsize, dgap) expr f = + doplot (dotpath, dsize, dgap) f +enddef; + +vardef plotnodes (expr symbol, size) expr f = + save _pln; pair _pln[]; + _pln := 0; + for _a = 0 upto (length f) if cycle f : - 1 fi : + _pln[incr _pln] := pnt[_a] (f); + endfor + dosymbols (drawcolor, symbol, size) (_pln); + f +enddef; + +vardef centerit (expr pic) = + pic shifted -(0.5[urcorner pic, llcorner pic]); +enddef; + +vardef makesymbol (expr spath, sc) = + if path spath : setdot (spath, sc) + elseif picture spath : + spath + elseif string spath : + spath infont defaultfont scaled defaultscale + else: + GBmsg "Undefined symbol for plotting, using dotpath instead."; + setdot (dotpath, sc) + fi +enddef; + +path Triangle, Square, Circle, Diamond, Star, Plus, Cross, + Asterisk, SolidTriangle, SolidSquare, SolidCircle, + SolidDiamond, SolidStar; + +Triangle := (for n = 0 upto 2: + (up rotated 120n)-- endfor up) scaled .78; +SolidTriangle := Triangle & cycle; + +Square := (for n = 0 upto 3: + dir (90n + 45)-- endfor dir 45) scaled .63; +SolidSquare := Square & cycle; + +Circle := halfcircle & halfcircle rotated 180; +SolidCircle := Circle & cycle; + +Diamond := (Square rotated 45) xscaled (1/1.2) yscaled 1.2; +SolidDiamond := Diamond & cycle; + +Plus := (origin for n = 0 upto 3: + --(up rotated 90n)--origin endfor) scaled .65; +Cross := Plus rotated 45; +Asterisk := (origin for n = 0 upto 5: + --(up rotated 60n)--origin endfor) scaled .6; + +pair zz; +zz = (whatever)[up, up rotated 144]; +zz = (whatever)[up rotated 72, up rotated -72]; +Star := (for n = 0 upto 4: + (up rotated 72n)--(zz rotated 72n)-- endfor up) scaled .84; +SolidStar := Star & cycle; +save zz; + +numeric dashtype; +forsuffixes s = start, rep, finish : + numeric dashtype[].s, dashtype[].s[]; +endfor +def defaultdashes = + dashpat (dashtype0) (0); % solid + dashpat (dashtype1) (3bp, 4bp); % dashed + dashpat (dashtype2) (0, 4bp); % dotted + dashpat (dashtype3) (0, 4bp, 3bp, 4bp); % dot-dash + dashpat (dashtype4) (0, 4bp, 3bp, 4bp, 0, 4bp);% dot-dash-dot + dashpat (dashtype5) (0, 4bp, 3bp, 4bp, 3bp, 4bp);% dot-dash-dash + dashtype := 6; +enddef; +defaultdashes; + +vardef isdashpat suffix pat = + (knownarray pat.start) and + (knownarray pat.finish) and + (knownarray pat.rep) +enddef; + +def setdatadashes (text lst) = + save dashtype; dashtype := 0; + forsuffixes _itm = lst : + if isdashpat _itm : + forsuffixes _s = start, rep, finish : + copyarray (_itm._s, dashtype[dashtype]._s); + endfor + dashtype := dashtype + 1; + else: GBmsg "Improper dash pattern in setdatadashes."; + fi + endfor + if dashtype = 0 : + SetdataWarn "dashes"; + defaultdashes; + fi +enddef; +def getdashpat expr n = dashtype[n mod dashtype] enddef; + +def SetdataWarn expr s = + GBmsg "Command setdata"& s &"() failed; using defaults." +enddef; + +def setdatasymbols (text lst) = + save pointtype; path pointtype[]; pointtype := 0; + for _itm = lst : + if (known _itm) and (path _itm): + pointtype[pointtype] := _itm; + pointtype := pointtype + 1; + else: + GBmsg "Improper path in setdatasymbols()."; + fi + endfor + if pointtype = 0: + SetdataWarn "symbols"; + defaultsymbols; + fi +enddef; +def getsymbol expr n := pointtype[n mod pointtype] enddef; + +numeric pointtype; path pointtype[]; +def defaultsymbols = + pointtype0 := Circle; + pointtype1 := Cross; + pointtype2 := SolidDiamond; + pointtype3 := Square; + pointtype4 := Plus; + pointtype5 := Triangle; + pointtype6 := SolidCircle; + pointtype7 := Star; + pointtype8 := SolidTriangle; + pointtype := 9; +enddef; +defaultsymbols; + +def setdatacolors (text lst) = + save colortype; color colortype[]; colortype := 0; + for _itm = lst : + if (known _itm) and (color _itm) : + colortype[colortype] := _itm; + colortype := colortype + 1; + else: GBmsg "Improper color in setdatacolors()."; + fi + endfor + if colortype = 0 : + SetdataWarm "colors"; + defaultcolors; + fi +enddef; +def getcolor expr n = colortype[n mod colortype] enddef; + +numeric colortype; color colortype[]; +def defaultcolors = + colortype0 := black; + colortype1 := red; + colortype2 := 0.80blue + .2white; % blue + colortype3 := 0.66yellow + .34red; % orange + colortype4 := 0.80green; % green + colortype5 := 0.85magenta; % magenta + colortype6 := 0.85cyan; % cyan + colortype7 := 0.85yellow; % yellow + colortype := 8; +enddef; +defaultcolors; + +vardef bpoint (expr ptwd, b) = + fullcircle scaled ptwd shifted b +enddef; +def pointd (expr ptwd, filled) (text t) = + if filled : + plotsymbol (SolidCircle, ptwd) (t); + else : + begingroup; + save clearsymbols; boolean clearsymbols; clearsymbols := true; + plotsymbol (Circle, ptwd) (t); + endgroup + fi +enddef; + +boolean clearsymbols; clearsymbols := false; +vardef clearable (expr pth) = + false + if path pth : + if (not cycle pth) and (length pth > 0): + if ( pnt0 (pth) = pnt[length pth] (pth) ) : + or true + fi fi fi +enddef; + +def plotsymbol = colorplotsymbol (pointcolor) enddef; +vardef colorplotsymbol (expr clr, spath, sc) (text t) = + save _cpls; + textpairs (_cpls) (t); + dosymbols (clr, spath, sc) (_cpls); +enddef; + +vardef dosymbols (expr clr, spath, sc) (suffix arr) = + save one_symbol, _pls; picture one_symbol, _pls; + if clearsymbols and clearable (spath): + addsymbols (background, spath&cycle, sc) (arr); + fi + addsymbols (clr, spath, sc) (arr); +enddef; + +def addsymbols (expr clr, spath, sc) (suffix arr) = + one_symbol := makesymbol (spath, sc); + _pls := nullpicture; + for _idx = 1 upto arr: + picdot (_pls, one_symbol, zconv(arr[_idx])); + endfor + DoClip (_pls); + coloraddto (clr) (active_plane) (_pls); +enddef; + +vardef lclosed expr f = f if not cycle f : --cycle fi enddef; + +numeric default_tension; +default_tension := 1; + +def sclosed = sclosedt (default_tension) enddef; +vardef sclosedt (expr t) expr f = + if cycle f : f + else: save n; n := length f; + if n = 0 : f&cycle + elseif n = 1 : f..tension t..cycle + else : + (pnt0 (f)) { (pnt1(f)) - (pnt[n] (f)) }..tension t + ..(subpath (1, n-1) of f)..tension t + ..(pnt[n](f)) { pnt0(f) - pnt[n-1](f) } + ..tension t..cycle + fi + fi +enddef; + +def bclosed = bclosedt (default_tension) enddef; +vardef bclosedt (expr t) expr f = + f if not cycle f : ..tension t..cycle fi +enddef; + +def uclosed = bclosed enddef; + +def bsplinecontrols (suffix b) expr f = + b := 4; + b1 := 2[pre 1(f), post0(f)]; + b2 := 2[post0(f), pnt 0(f)]; + b3 := 2[b1, b2]; + b4 := 2[b2, b3]; +enddef; + +vardef cbclosed expr f = + if cycle f : f + elseif (length f)=0 : f&cycle + else: + save p, q; pair p[], q[]; + bsplinecontrols (p) f; % defines p1 to p4 + bsplinecontrols (q) reverse f; % defines q1 to q4 + f..controls q2 and q3..opencbs (q1,q4,p4,p1) + ..controls p3 and p2..cycle + fi +enddef; + +vardef qbclosed expr f = + if cycle f : f + else: save n; n := length f; + if n = 0 : f&cycle + else: + save p; pair p[]; p := 4; + p1 := (3/2)[pnt[n](f), pre[n](f)]; + p2 := 2[p1, pnt[n](f)]; + p4 := (3/2)[pnt 0 (f), post0 (f)]; + p3 := 2[p4, pnt 0 (f)]; + f & mkqbs (p) & cycle + fi + fi +enddef; + +vardef makesector expr p = + (pathcenter p)--p--cycle +enddef; + +vardef cutoffbefore (expr b) expr f = + save w, t, u, n; n:= length f; + pair w; + for k = 1 upto n : + w := (subpath (0,k) of f) intersectiontimes b; + exitif w > left; + endfor + if debug : + GBdebug; + >> "Intersectiontimes:"; + show w; + GBenddebug; + fi + t := xpart w; + if t < 0: + cuttings := pnt0 (f); + f + else: + cuttings := subpath (0,t) of f; + subpath (t, n) of f + fi +enddef; + +vardef cutoffafter (expr b) expr f = + save g; path g; + g := cutoffbefore (b) reverse f; + cuttings := reverse cuttings; + reverse g +enddef; + +vardef trimmedpath (expr btrim, etrim) expr f = + save g, h; path g, h; + g := invvconv (fullcircle scaled 2btrim) shifted pnt0(f); + h := invvconv (fullcircle scaled 2etrim) shifted pnt[length f] (f); + cutoffafter (h) cutoffbefore (g) f +enddef; + +vardef predirection@# (expr p) = + - postdirection[length p - @#] (reverse p) +enddef; + +vardef postdirection@# (expr p) = + save _n; _n := length (p); + save v; pair v; v := __dir (subpath (@#, @# + _n) of p); + if v = origin : + v := - __dir (subpath (@#, @# - _n) of p); + fi + v +enddef; + +vardef __dir (expr p) = + save v, w; pair v, w; w := pnt0 (p); + v := origin; + for n = 1 upto length (p) : + v := post[n-1] (p) - w; + if v = origin : + v := pre[n] (p) - w; + if v = origin : + v := pnt[n] (p) - w; + fi + fi + exitif v <> origin; + endfor + v +enddef; + +newinternal hdwdr, hdten; +interim hdwdr := 1; interim hdten := 1; +boolean hfilled; hfilled := false; + +def headshape (expr wr, tens, fil) = + interim hdwdr := wr; interim hdten := tens; + save hfilled; boolean hfilled; hfilled := fil; +enddef; + +def head = ahead enddef; + +vardef ahead (expr clr, front, back, hwr, tens, filled) = + if front <> back : + save side; pair side; + side := (hwr/2) * ((front-back) rotated 90); + save f; path f; + f := (back + side)..tension tens.. + {front-back}front{back-front}..tension tens.. + (back - side) + if filled : --cycle; colorsafefill (clr) f fi; + colorsafedraw (clr) f; + fi +enddef; + +def headpath = colorheadpath (headcolor) enddef; +vardef colorheadpath (expr clr, hlen, hrot, hback) expr f = + if hlen <> 0 : + save g; path g; g := zconv (f); + save P; pair P[]; + P2 := pnt[length g] (g); + P1 := predirection[length g] (g); + if P1 <> (0, 0) : + P3 := (unitvector P1) rotated hrot; + P4 := P2 - (hback * P3); + P5 := P4 - (hlen * P3); + ahead (clr, P4, P5, hdwdr, hdten, hfilled); + fi + fi + f +enddef; + +def arrowdraw (expr hlen) (expr f) = + store (curpath) headpath (hlen, 0, 0) drawn f; +enddef; + +def xaxis (expr hlen) = arrowdraw (hlen) ((xneg, 0)--(xpos, 0)); enddef; +def yaxis (expr hlen) = arrowdraw (hlen) ((0, yneg)--(0, ypos)); enddef; +def axes (expr hlen) = xaxis (hlen); yaxis (hlen); enddef; + +laxis := baxis := raxis := taxis := 0; + +vardef axisline.x = (xneg + laxis, 0)--(xpos - raxis, 0) enddef; +vardef axisline.y = (0, yneg + baxis)--(0, ypos - taxis) enddef; +vardef axisline.l = axisline.y shifted (xneg + laxis, 0) enddef; +vardef axisline.b = axisline.x shifted (0, yneg + baxis) enddef; +vardef axisline.r = axisline.y shifted (xpos - raxis, 0) enddef; +vardef axisline.t = axisline.x shifted (0, ypos - taxis) enddef; +vardef axis@# (expr len) = + headpath (len, 0, 0) axisline@# +enddef; + +numeric inside, outside, centered, onleft, onright, ontop, onbottom; +inside := -2; +outside := -1; +onright := 1; +onleft := 2; +centered := .5[onright, onleft]; +onbottom := onright; +ontop := onleft; +ltick := rtick := ttick := btick := inside; +xtick := ytick := centered; + +vardef axismarks (expr inang, tp, loc, pdir) (expr len) (text t) = + save _tp, _U, _P, _tic, _ticang; + pair _U, _P, _tic[]; + _ticang := if tp<0 : inang else: 90 fi; + _tp := abs(tp) - 1; + _U := unitvector (vconv (pdir)) rotated _ticang; + _tic1 := (_tp - 1) * len * _U; % start of mark + _tic2 := _tp * len * _U; % end of mark + for _a = t: + safedraw ((_tic1--_tic2) shifted zconv (loc + _a*pdir)); + endfor +enddef; + +def xmarks = axismarks ( 90, xtick, (0, 0), right) enddef; +def ymarks = axismarks (-90, ytick, (0, 0), up) enddef; +def lmarks = axismarks (-90, ltick, (xneg + laxis, 0), up) enddef; +def bmarks = axismarks ( 90, btick, (0, yneg + baxis), right) enddef; +def rmarks = axismarks ( 90, rtick, (xpos - raxis, 0), up) enddef; +def tmarks = axismarks (-90, ttick, (0, ypos - taxis), right) enddef; + +path griddotpath; griddotpath := fullcircle; +def grid = vgrid (0.5bp) enddef; +vardef vgrid (expr dsize, xspace, yspace) = + save gdot, gridpic; picture gdot, gridpic; + gdot := setdot (griddotpath, dsize); + gridpic := nullpicture; + for n = ceiling(xneg/xspace) upto floor(xpos/xspace): + for m = ceiling(yneg/yspace) upto floor(ypos/yspace): + picdot (gridpic, gdot, zconv((n*xspace, m*yspace))); + endfor + endfor + coloraddto (pointcolor) (active_plane) (gridpic); +enddef; + +def hgridlines (expr ysp) = + for n = ceiling((yneg + baxis)/ysp) upto floor((ypos - taxis)/ysp) : + safedraw zconv((xneg + laxis, n*ysp)--(xpos - raxis, n*ysp)); + endfor +enddef; +def vgridlines (expr xsp) = + for n = ceiling((xneg + laxis)/xsp) upto floor((xpos - raxis)/xsp) : + safedraw zconv((n*xsp, yneg + baxis)--(n*xsp, ypos - taxis)); + endfor +enddef; +def gridlines (expr xsp, ysp) = + vgridlines (xsp); hgridlines (ysp); +enddef; + +vardef plrpatch (expr rstart, rstop, rstep, tstart, tstop, tstep) = + save v; picture v; v := nullpicture; + patcharcs (v) (rstart, rstop, rstep, tstart, tstop); + coloraddto (drawcolor) (active_plane, v); + v := nullpicture; + patchrays (v) (tstart, tstop, tstep, rstart, rstop); + coloraddto (drawcolor) (active_plane, v); +enddef; +def patcharcs (suffix X) (expr rstart, rstop, rstep, tstart, tstop) = + for rad = (if rstart=0: rstep else: rstart fi) step rstep until rstop: + orto (X, picpath zconv (arcplr ((0, 0), tstart, tstop, rad)) ); + endfor +enddef; +def patchrays (suffix X) (expr tstart, tstop, tstep, rstart, rstop) = + for _ang = tstart step tstep until tstop: + orto (X) (picpath zconv ((rstart*dir _ang)--(rstop*dir _ang))); + endfor +enddef; + +def polargrid (expr rstep, tstep) = + gridarcs (rstep); gridrays (tstep); +enddef; + +def polargridpoints (expr dsize, rstep, tstep) = + beginpolargrid; + save gdot; picture gdot; gdot := setdot (griddotpath, dsize); + if rmin = 0: + picdot (gridpic, gdot, zconv(origin)); + rmin := rstep; + fi + for n = ceiling (rmin/rstep) upto floor (rmax/rstep) : + for m = ceiling (tmin/tstep) upto floor (tmax/tstep) : + picdot ( gridpic, gdot, zconv ( polar((n*rstep, m*tstep)) ) ); + endfor + endfor + endpolargrid (pointcolor, .5dsize); +enddef; + +def gridarcs (expr rstep) = + beginpolargrid; + if rmin = 0 : % add "circle" of radius 0 + picdot (gridpic, setdot(griddotpath, penwd), zconv(origin)); + fi + rmin := rstep * floor(rmin/rstep + 1); + rmax := rstep*ceiling(rmax/rstep - 1); + patcharcs (gridpic) (rmin, rmax, rstep, tmin, tmax); + endpolargrid (drawcolor, .5penwd); +enddef; + +def gridrays (expr tstep) = + beginpolargrid; + tmin := tstep*ceiling(tmin/tstep); + tmax := tstep * floor(tmax/tstep); + patchrays (gridpic) (tmin, tmax, tstep, rmin, rmax); + endpolargrid (drawcolor, .5penwd); +enddef; + +def beginpolargrid = + begingroup; + save p, r, t, rmax, rmin, tmax, tmin; + pair p[]; + % Four corners: + p0 := (xneg, yneg); p1 := (xneg, ypos); + p2 := (xpos, ypos); p3 := (xpos, yneg); + r0 := abs(p0); rmax := r0; + for j = 1 upto 3 : + r[j] := abs(p[j]); + if rmax < r[j] : rmax := r[j]; fi + endfor + rmin := 0; + if (xneg < 0) and (xpos > 0) and (yneg < 0) and (ypos > 0) : + tmin := 0; tmax := 360; + elseif (p0 = (0,0)) : tmin := 0; tmax := 90; + elseif (p1 = (0,0)) : tmin := -90; tmax := 0; + elseif (p2 = (0,0)) : tmin := -180; tmax := -90; + elseif (p3 = (0,0)) : tmin := 90; tmax := 180; + else : + tmax := tmin := t0 := angle p0; + for j = 1 upto 3: + t := t0 + angle (p[j] rotated -t0); + if tmax < t : tmax := t; fi + if tmin > t : tmin := t; fi + endfor + if (xneg < 0) and (xpos > 0) : % (1) + rmin := emin(abs(yneg), abs(ypos)); + elseif (yneg < 0) and (ypos > 0) : % (2) + rmin := emin(abs(xneg), abs(xpos)); + else : % (3) + rmin := min(r0, r1, r2, r3); + fi + fi + save gridpic; picture gridpic; gridpic := nullpicture; +enddef; + + +def endpolargrid (expr clr, size)= + clipto (gridpic) rect ( zconv((xneg, yneg)) - size*(1,1), + zconv((xpos, ypos)) + size*(1,1) ); + coloraddto (clr) (active_plane) (gridpic); + endgroup +enddef; + +vardef polarpatch (expr rstart, rstop, rstep, tstart, tstop, tstep) = + plrpatch (rstart, rstop, rstep, tstart, tstop, tstep); + safedraw zconv ( arcplr ((0, 0), tstart, tstop, rstop) ); + safedraw zconv ( ((rstart, 0)--(rstop, 0)) rotated tstop ); +enddef; + +vardef rect (expr ll, ur) = + ll--(xpart ur, ypart ll)--ur--(xpart ll, ypart ur)--cycle +enddef; +vardef triangle (expr A, B, C) = A--B--C--cycle enddef; + +vardef regularpolygon (expr n) (suffix Bob) (text eqns) = + pair Bob[]; Bob := emax(round (abs (n)), 2); + eqns; + for _uncle = 1 upto Bob - 1 : + (Bob1 - Bob0) rotated (360*_uncle/Bob) = Bob[_uncle+1] - Bob0; + endfor + mkpoly (true) (Bob) +enddef; + +vardef altitudept expr n of t = + save A, B, C, zz; pair A, B, C, zz; + A := pnt[n] (t); + B := pnt[n + 1] (t); % wraps around a cyclic path + C := pnt[n + 2] (t); + zz = whatever[B,C]; + zz = A + whatever*((C-B) rotated 90); + zz +enddef; + +vardef altitude expr n of t = + (pnt[n](t))--(altitudept n of t) +enddef; + +vardef medianpt expr n of t = + 0.5[pnt[n + 1] (t), pnt[n + 2] (t)] +enddef; + +vardef median expr n of t = + (pnt[n](t))--(medianpt n of t) +enddef; + +vardef anglebisectorpt expr n of t = + save A, B, C; pair A, B, C; + A := pnt[n ] (t); + B := pnt[n + 1] (t); + C := pnt[n + 2] (t); + save zz; pair zz; + zz = whatever[B,C]; + zz = A + whatever*((B-A) rotated (.5*cornerangle (A,B,C))); + zz +enddef; + +vardef anglebisector expr n of t = + (pnt[n](t))--(anglebisectorpt n of t) +enddef; + +vardef cornerangle (expr A, B, C) = + if (A = B) and (B = C) : 60 + elseif (B = C) : 0 + elseif (A = B) or (A = C) : 90 + else: angle ((C - A) rotated (-angle (B - A))) + fi +enddef; + +vardef mkpath (expr smooth, tens, cyclic) (suffix pts) = + if smooth : mksmooth (tens, cyclic, pts) + else : mkpoly (cyclic, pts) + fi +enddef; + +vardef mkpoly (expr cyclic) (suffix pts) = + for _i = 1 upto pts-1: pts[_i]-- endfor + pts[pts] if cyclic : -- cycle fi +enddef; + +vardef polyline (expr cyclic) (text t) = + save _pl; textpairs (_pl) (t); mkpoly (cyclic, _pl) +enddef; + +vardef mksmooth (expr tens, cyclic) (suffix pts) = + pts1 + if pts = 1 : + if cyclic : &cycle fi + else: + if cyclic : + {pts[2]-pts[pts]} + fi + for _i = 2 upto pts-1: + ..tension tens..pts[_i]{pts[_i+1]-pts[_i-1]} + endfor + ..tension tens..pts[pts] + if cyclic : + {pts[1]-pts[pts-1]}..tension tens..cycle + fi + fi +enddef; + +def curve = tcurve (default_tension) enddef; +vardef tcurve (expr tens, cyclic) (text t) = + save _tc; textpairs (_tc) (t); mksmooth (tens, cyclic, _tc) +enddef; + +vardef mkbezier (expr tens, cyclic) (suffix pts) = + for _i = 1 upto pts-1 : pts[_i]..tension tens.. endfor + pts[pts] if cyclic : ..tension tens..cycle fi +enddef; + +def bezier = tbezier (default_tension) enddef; +vardef tbezier (expr tens, cyclic) (text t) = + save _tsb; textpairs (_tsb) (t); mkbezier (tens, cyclic) (_tsb) +enddef; + +vardef mkqbezier (expr cyclic) (suffix pts) = + save _mqb; _mqb := pts; + if (cyclic and odd pts) or not (cyclic or odd pts): + pts[incr _mqb] := pts[pts]; + fi + if cyclic : pts[incr _mqb] := pts1; fi + pts1 + for _i = 2 step 2 until _mqb - 1 : + ..controls 1/3[pts[_i],pts[_i-1]] and 1/3[pts[_i], pts[_i+1]] + ..pts[_i+1] + endfor + if cyclic : &cycle fi +enddef; + +vardef qbezier (expr cyclic) (text t) = + save _qbz; textpairs (_qbz) (t); mkqbezier (cyclic) (_qbz) +enddef; + +vardef openqbs (text t) = + save _oq; textpairs (_oq) (t); mkqbs (_oq) +enddef; + +vardef closedqbs (text t) = + save _cq; textpairs (_cq) (t); + _cq[incr _cq] := _cq1; _cq[incr _cq] := _cq2; + mkqbs (_cq) & cycle +enddef; + +vardef mkqbs (suffix b) = + for _i = 1 upto b-2: + 0.5[b[_i], b[_i+1]] + ..controls 1/6[b[_i+1], b[_i]] and 1/6[b[_i+1], b[_i+2]].. + endfor + 0.5[b[b-1], b[b]] +enddef; + +vardef mkopencbs (suffix b) = + for _i = 1 upto b-3: + (b[_i]+4b[_i+1]+b[_i+2])/6 + ..controls 1/3[b[_i+1], b[_i+2]] and 2/3[b[_i+1], b[_i+2]].. + endfor + (b[b-2]+4b[b-1]+b[b])/6 +enddef; +vardef mkclosedcbs (suffix b) = + mkopencbs (b) & opencbs (b[b-2],b[b-1],b[b], b1, b2, b3) & cycle +enddef; + +vardef opencbs (text t) = + save _oc; textpairs (_oc) (t); mkopencbs (_oc) +enddef; +vardef closedcbs (text t) = + save _clc; textpairs (_clc) (t); mkclosedcbs (_clc) +enddef; + +vardef fcncontrol (expr ftens, X, Y, Z) = + save dl, dr, before, after; pair before, after; + before := Y - X; after := Z - Y; + dl := xpart (before); dr := xpart (after); + if (dr = 0) or (dl = 0): + Y + abs(dr)/ftens * sgn before + else: + Y + abs(dr)/ftens * unitvector (before*dr/dl + after*dl/dr) + fi +enddef; + +vardef mkfcnpath (expr ftens) (suffix q) = + for _i = 1 upto q - 1: + q[_i]..controls fcncontrol (ftens) (q[_i-1], q[_i], q[_i+1]) + and fcncontrol (ftens) (q[_i+2], q[_i+1], q[_i]).. + endfor + q[q] +enddef; + +def fcncurve = functioncurve (emax(1.2default_tension, eps)) enddef; +vardef functioncurve (expr ftens) (text t) = + save _fc; textpairs (_fc) (t); + if _fc > 1 : _fc0 := _fc1; _fc[_fc+1] := _fc[_fc]; fi + mkfcnpath (ftens)(_fc) +enddef; + +vardef turtle (text t) = + save _tu; pair _tu[]; _tu := 0; _tu0 := (0, 0); + for _a = t: _tu[incr _tu] := _tu[_tu - 1] + _a; endfor + mkpoly (false, _tu) +enddef; + +vardef mkarc (expr center, from, to, sweep) = + save n, d; pair d; + n := ceiling (abs(sweep)/45); + d := (from - center) rotated (signof (sweep) 90); + from{d} + for j = 1 upto n-1 : + ..(from rotatedabout (center, j/n*sweep)){d rotated (j/n*sweep)} + endfor ..to{d rotated sweep} +enddef; + +vardef arc (expr center, from, sweep) = + if (center = from) or (sweep = 0) : + from--from + else: + save to; pair to; + to := from rotatedabout (center, sweep); + mkarc (center, from, to, sweep) + fi +enddef; +def arccps = arc enddef; + +vardef arccenter (expr from, to, sweep) = + save ang, c; + pair c; + ang := 90 - (sweep mod 360)/2; % -90 < ang <= 90 + if (abs(ang) = 90) or (from = to) : + GBmsg "The central point of this arc is undefined. " & + "Using midpoint of chord instead."; + 0.5[from, to] + else: + save cd; pair cd; cd := to - from; + c = from + whatever*(cd rotated ang); + if abs(ang) < 30 : + c = (0.5)[from, to] + whatever*(cd rotated 90); + else: + c = to + whatever*(-cd rotated -ang); + fi + c + fi +enddef; + +vardef midarc (expr from, to, sweep) = + save m, cd; pair m, cd; + cd := to - from; + m = from + whatever*( cd rotated (-sweep/4)); + m = 0.5[from, to] + whatever*(cd rotated 90); + m +enddef; + +vardef arcpps (expr from, to, sweep) = + if ((sweep mod 360) = 0) or (from = to) : + GBmsg "Undefined arc. A line segment will be used instead."; + from--to + elseif abs(sweep) <= 90 : + save cd; pair cd; cd := to - from; + if abs(sweep) <= 45 : + from{cd rotated (-sweep/2)}..to{cd rotated (sweep/2)} + else: + from{cd rotated (-sweep/2)}..midarc(from, to, sweep){cd} + ..to{cd rotated (sweep/2)} + fi + else: + save center; pair center; + center := arccenter (from, to, sweep); + mkarc (center, from, to, sweep) + fi +enddef; + +vardef arcplr (expr center, frtheta, totheta, rad) = + if rad = 0 : + center -- center + else: + save from, to; pair from, to; + from := center + rad*dir frtheta; + to := center + rad*dir totheta; + if frtheta = totheta : + from--to + else: + mkarc (center, from, to, totheta - frtheta) + fi + fi +enddef; +vardef arcalt (expr center, radius, anglefrom, angleto) = + arcplr (center, anglefrom, angleto, radius) +enddef; + +vardef arcppp (expr first, second, third) = + arcpps (first, second, 2*cornerangle (third, first, second)) & + arcpps (second, third, 2*cornerangle (first, second, third)) +enddef; + +vardef ellipse (expr center, radx, rady, angle) = + fullcircle xscaled (2*radx) yscaled (2*rady) rotated angle + shifted center +enddef; +vardef circle (expr center, rad) = + fullcircle scaled (2*rad) shifted center +enddef; + +vardef circlecp (expr center, point) = + mkarc (center, point, point, 360) & cycle +enddef; +vardef circleppp (expr one, two, three) = + save ang; numeric ang[]; + ang0 := cornerangle(three, one, two); + ang1 := cornerangle(one, two, three); + ang2 := cornerangle(two, three, one); + arcpps (one, two, 2ang0) & arcpps (two, three, 2ang1) & + arcpps (three, one, 2ang2) & cycle +enddef; +vardef circlepps (expr one, two, sweep) = + save ang, full; numeric ang[], full; + full := signof (sweep) 360; + ang1 := sweep mod (full); + ang2 := full - ang1; + arcpps (one, two, ang1) & arcpps (two, one, ang2) & cycle +enddef; + +vardef pathcenter expr p = + save a, cntr, n; pair cntr, a[]; + n := length p; + a1 = pnt 0 (p); + a3 = pnt [n/2] (p); + if cycle p : + a2 = pnt [n/4] (p); + a4 = pnt [3n/4] (p); + else: + a2 := a3; + a4 := pnt[n] (p); + fi + cntr = .5[a1, a3] + whatever*((a3 - a1) rotated 90); + cntr = .5[a2, a4] + whatever*((a4 - a2) rotated 90); + cntr +enddef; + +vardef circumcircle expr t = + circleppp (pnt0 (t), pnt1 (t), pnt2 (t)) +enddef; + +vardef incircle expr t = + save A, B, C; pair A, B, C; + A := pnt0 (t); + B := pnt1 (t); + C := pnt2 (t); + % Find the tangent points on the sides. E.g., a is the common + % distance from A to the tangent points on the adjacent sides. + save a, b, c; + a + b = abs (B-A); + b + c = abs (C-B); + a + c = abs (A-C); + circleppp (A + a*unitvector (B-A), + B + b*unitvector (C-B), + C + c*unitvector (A-C)) +enddef; + +vardef excircle expr n of t = + save A, B, C; pair A, B, C; + A := pnt[n] (t); + B := pnt[n + 1] (t); % wraps around + C := pnt[n + 2] (t); + save a, b, c; + a - b = abs (B-A); + b + c = abs (C-B); + a - c = abs (C-A); + circleppp (A + a*unitvector(B-A), + B + b*unitvector(C-B), + C + c*unitvector(C-A)) +enddef; + +vardef ninepointcircle expr t = + circleppp (medianpt 0 of t, medianpt 1 of t, medianpt 2 of t) +enddef; + +vardef circumcenter expr t = pathcenter circumcircle t enddef; +vardef incenter expr t = pathcenter incircle t enddef; +vardef excenter expr n of t = pathcenter excircle n of t enddef; +vardef ninepointcenter expr t = pathcenter ninepointcircle t enddef; + +vardef barycenter expr t = + save n, m; n := length t; m := n + 1; + save xxx; + xxx : = pnt0 (t)/m for k = 1 upto n-1 : + pnt[k] (t)/m endfor; + if cycle t: xxx*(1 + 1/n) + else: xxx + pnt[n] (t)/m + fi +enddef; +vardef sector (expr center, rad, frtheta, totheta) = + center -- arcalt (center, rad, frtheta, totheta) -- cycle +enddef; + +vardef mkfcn (expr smooth, tens) (expr bmin, bmax, bst) (text pf) = + save _p; pair _p[]; _p := 0; + save _dx, _n, _r; numeric _dx, _n, _r; + if bmax = bmin : _n := 1; + else: + _r := bmax - bmin; + _dx := max (abs(bst), nottoosmall*abs(_r), epsilon); + _n := emax (round(abs(_r)/_dx), 1); + fi + for _i = 0 upto _n: _p[incr _p] := pf(bmin + _i/_n*_r); endfor + mkpath (smooth, tens, false, _p) +enddef; +def tfcn (expr smooth) = mkfcn (smooth, default_tension) enddef; + +def parafcn (expr smooth) = tparafcn (smooth, default_tension) enddef; +vardef tparafcn (expr sm, tn) (expr bmin, bmax, bst) (text pf) = + save _fp; vardef _fp (expr t) = pf enddef; + mkfcn (sm, tn) (bmin, bmax, bst) (_fp) +enddef; + +vardef xfcn (expr smooth) (expr xmin, xmax, st) (text _fx) = + save _fp; vardef _fp (expr _x) = (_x, _fx(_x)) enddef; + mkfcn (smooth, default_tension) (xmin, xmax, st) (_fp) +enddef; + +def function (expr smooth) = tfunction (smooth, default_tension) enddef; +vardef tfunction (expr smooth, tens) (expr xmin, xmax, st) (text _fx) = + save _fp; vardef _fp (expr x) = (x, _fx) enddef; + mkfcn (smooth, tens) (xmin, xmax, st) (_fp) +enddef; + +def btwnfcn (expr sm) = tbtwnfcn (sm, default_tension) enddef; +vardef tbtwnfcn (expr sm, tn)(expr xlo, xhi, st)(text _fx)(text _gx) = + tfunction (sm, tn) (xlo, xhi, st) (_fx) -- + ( reverse tfunction (sm, tn) (xlo, xhi, st) (_gx) ) -- cycle +enddef; + +vardef rfcn (expr smooth) (expr tmin, tmax, st) (text ft) = + save _fq; vardef _fq (expr t) = (ft(t)) * (dir t) enddef; + mkfcn (smooth, default_tension) (tmin, tmax, st) (_fq) +enddef; + +def plrfcn (expr smooth) = tplrfcn (smooth, default_tension) enddef; +vardef tplrfcn (expr smooth, tens) (expr tmin, tmax, st) (text ft) = + save _fq; vardef _fq (expr t) = (ft) * (dir t) enddef; + mkfcn (smooth, tens) (tmin, tmax, st) (_fq) +enddef; + +vardef piechart (expr sign, ang, cent, rad) (text data) = + save _sum, _tot; + numeric piewedge; piewedge := 0; + numeric pieangle, pieangle[]; pieangle0 := 0; + for _val = data : + pieangle[incr piewedge] := pieangle[piewedge - 1] + _val; + endfor + _tot := pieangle[piewedge]; + pair piecenter; piecenter := cent; + path piewedge[]; + numeric piedirection; pair piedirection[]; + pieangle[piewedge + 1] = ang + sign*360; + for _n = piewedge downto 1 : + pieangle[_n] := ang + sign*pieangle[_n - 1]/_tot*360; + piewedge[_n] = + sector(cent, rad, pieangle[_n], pieangle[_n+1]); + piedirection[_n] := dir(0.5[ pieangle[_n], pieangle[_n+1] ]); + endfor + piedirection := pieangle := piewedge; +enddef; + +def barchart (expr start, sep, r, vert)(text data) = + numeric barbegin, barbegin[], + barend, barend[], + barlength, barlength[], + barstart, barstart[], + chartbar, barwd; + path chartbar[]; + chartbar := 0; barwd := r*sep; + for _itm = data : + barend[incr chartbar] := if pair _itm: ypart _itm else: _itm fi; + barbegin[chartbar] := if pair _itm: xpart _itm else: 0 fi; + endfor + barbegin := barend := barlength := barstart := chartbar; + for _n = 1 upto chartbar : + barstart[_n] := start + sep*(_n-1); + barlength[_n] := barend[_n]; + chartbar[_n] := rect ((barbegin[_n], 0), ( barend[_n], barwd) ) + shifted (0, barstart[_n]) if vert: xyswap fi; + endfor +enddef; + +picture totalpicture; +boolean totalnull, currentnull; +def clearit = + currentpicture := totalpicture := nullpicture; + currentnull := totalnull := true; +enddef; + +def keepit = + addto totalpicture also currentpicture; + currentpicture := nullpicture; + totalnull := currentnull; + currentnull := true; +enddef; + +def addto_currentpicture = + currentnull := false; + addto currentpicture +enddef; + +def mergeit (text do) = + if totalnull : + do currentpicture + elseif currentnull : + do totalpicture + else: + begingroup + save _v_; picture _v_; + _v_ := currentpicture; + addto _v_ also totalpicture; + do _v_ + endgroup + fi +enddef; + +def shipit_ = + mergeit (shipout) +enddef; +def shipit = shipit_ enddef; + +numeric gcode; gcode := 0; + +% end grafbase.mp +endinput. +%% +%% End of file `grafbase.mp'. diff --git a/Master/texmf-dist/metapost/misc/null.mp b/Master/texmf-dist/metapost/misc/null.mp new file mode 100644 index 00000000000..3effc30e951 --- /dev/null +++ b/Master/texmf-dist/metapost/misc/null.mp @@ -0,0 +1,3 @@ +% This is an empty MetaPost source file. Why do you want it? Because if +% mp says `Please type another input file name:' and if you don't have one +% in mind, you can just say `null' and MetaPost will get out of its loop. diff --git a/Master/texmf-dist/metapost/mp3d/3d.mp b/Master/texmf-dist/metapost/mp3d/3d.mp new file mode 100644 index 00000000000..7335a384d2c --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/3d.mp @@ -0,0 +1,1259 @@ +%%\input epsf +%%\def\newpage{\vfill\eject} +%%\advance\vsize1in +%%\let\ora\overrightarrow +%%\def\title#1{\hrule\vskip1mm#1\par\vskip1mm\hrule\vskip5mm} +%%\def\figure#1{\par\centerline{\epsfbox{#1}}} +%%\title{{\bf 3D.MP: 3-DIMENSIONAL REPRESENTATIONS IN METAPOST}} + +%% version 1.34, 17 August 2003 +%% {\bf Denis Roegel} ({\tt roegel@loria.fr}) + +%% This package provides definitions enabling the manipulation +%% and animation of 3-dimensional objects. +%% Such objects can be included in a \TeX{} file or used on web pages +%% for instance. See the documentation enclosed in the distribution for +%% more details. + +%% Thanks to John Hobby and Ulrik Vieth for helpful hints. + +%% PROJECTS FOR THE FUTURE: + +%% $-$ take light sources into account and show shadows and darker faces + +%% $-$ handle overlapping of objects ({\it obj\_name\/} can be used when +%% going through all faces) + +if known three_d_version: + expandafter endinput % avoids loading this package twice +fi; + +message "*** 3d, v1.34 (c) D. Roegel, 17 August 2003 ***"; +numeric three_d_version; +three_d_version=1.34; + +% This package needs |3dgeom| in a few places. |3dgeom| also loads |3d| +% but that's not a problem. +% +input 3dgeom; + +%%\newpage +%%\title{Vector operations} + +% components of vector |i| +def xval(expr i)=vec[i]x enddef; +def yval(expr i)=vec[i]y enddef; +def zval(expr i)=vec[i]z enddef; + +% vector (or point) equality (absolute version) +def vec_eq_(expr i,j)= + ((xval(i)=xval(j)) and (yval(i)=yval(j)) and (zval(i)=zval(j))) +enddef; + +% vector (or point) equality (local version) +def vec_eq(expr i,j)=vec_eq_(pnt(i),pnt(j)) enddef; + +% vector inequality (absolute version) +def vec_neq_(expr i,j)=(not vec_eq_(i,j)) enddef; + +% vector inequality (local version) +def vec_neq(expr i,j)=(not vec_eq(i,j)) enddef; + +% definition of vector |i| by its coordinates (absolute version) +def vec_def_(expr i,xi,yi,zi)= vec[i]x:=xi;vec[i]y:=yi;vec[i]z:=zi; enddef; + +% definition of vector |i| by its coordinates (local version) +def vec_def(expr i,xi,yi,zi)= vec_def_(pnt(i),xi,yi,zi) enddef; + +% a point is stored as a vector (absolute version) +let set_point_ = vec_def_; + +% a point is stored as a vector (local version) +let set_point = vec_def; + +def set_point_vec_(expr i,v)= + set_point_(i,xval(v),yval(v),zval(v)) +enddef; + +def set_point_vec(expr i,v)=set_point_vec_(pnt(i),v) enddef; + +let vec_def_vec_=set_point_vec_; +let vec_def_vec=set_point_vec; + +% vector sum: |vec[k]| $\leftarrow$ |vec[i]|$+$|vec[j]| (absolute version) +def vec_sum_(expr k,i,j)= + vec[k]x:=vec[i]x+vec[j]x; + vec[k]y:=vec[i]y+vec[j]y; + vec[k]z:=vec[i]z+vec[j]z; +enddef; + +% vector sum: |vec[k]| $\leftarrow$ |vec[i]|$+$|vec[j]| (local version) +def vec_sum(expr k,i,j)=vec_sum_(pnt(k),pnt(i),pnt(j)) enddef; + +% vector translation: |vec[i]| $\leftarrow$ |vec[i]|$+$|vec[v]| +def vec_translate_(expr i,v)=vec_sum_(i,i,v) enddef; + +% Here, the second parameter is absolute, because this is probably +% the most common case. +def vec_translate(expr i,v)=vec_translate_(pnt(i),v) enddef; + +% vector difference: |vec[k]| $\leftarrow$ |vec[i]|$-$|vec[j]| +def vec_diff_(expr k,i,j)= + vec[k]x:=vec[i]x-vec[j]x; + vec[k]y:=vec[i]y-vec[j]y; + vec[k]z:=vec[i]z-vec[j]z; +enddef; + +def vec_diff(expr k,i,j)=vec_diff_(pnt(k),pnt(i),pnt(j)) enddef; + +% dot product of |vec[i]| and |vec[j]| +vardef vec_dprod_(expr i,j)= + (vec[i]x*vec[j]x+vec[i]y*vec[j]y+vec[i]z*vec[j]z) +enddef; + +vardef vec_dprod(expr i,j)=vec_dprod_(pnt(i),pnt(j)) enddef; + +% modulus of |vec[i]|, absolute version +% In the computation, we try to avoid overflows or underflows; +% we perform a scaling in order to avoid losing too much +% information in certain cases +vardef vec_mod_(expr i)= + save prod,m_; + hide( + new_vec(v_a); + m_=max(abs(xval(i)),abs(yval(i)),abs(zval(i))); + if m_>0:vec_mult_(v_a,i,1/m_);else:vec_def_vec_(v_a,vec_null);fi; + prod=m_*sqrt(vec_dprod_(v_a,v_a)); + free_vec(v_a); + ) + prod +enddef; + +% modulus of |vec[i]|, local version +% If the return value must be compared to 0, +% use |vec_eq| with |vec_null| instead. +vardef vec_mod(expr i)= vec_mod_(pnt(i)) enddef; + +% unit vector |vec[i]| corresponding to vector |vec[j]| +% only non-null vectors are changed +def vec_unit_(expr i,j)= + if vec_mod_(j)>0: vec_mult_(i,j,1/vec_mod_(j)); + else:vec_def_vec_(i,j); + fi; +enddef; + +def vec_unit(expr i,j)=vec_unit_(pnt(i),pnt(j)) enddef; + +% vector product: |vec[k]| $\leftarrow$ |vec[i]| $\land$ |vec[j]| +def vec_prod_(expr k,i,j)= + vec[k]x:=vec[i]y*vec[j]z-vec[i]z*vec[j]y; + vec[k]y:=vec[i]z*vec[j]x-vec[i]x*vec[j]z; + vec[k]z:=vec[i]x*vec[j]y-vec[i]y*vec[j]x; +enddef; + +def vec_prod(expr k,i,j)=vec_prod_(pnt(k),pnt(i),pnt(j)) enddef; + +% scalar multiplication: |vec[j]| $\leftarrow$ |vec[i]*v| (absolute version) +def vec_mult_(expr j,i,v)= + vec[j]x:=v*vec[i]x;vec[j]y:=v*vec[i]y;vec[j]z:=v*vec[i]z; +enddef; + +% scalar multiplication: |vec[j]| $\leftarrow$ |vec[i]*v| (local version) +def vec_mult(expr j,i,v)=vec_mult_(pnt(j),pnt(i),v) enddef; + +% middle of two points (absolute version) +def mid_point_(expr k,i,j)= vec_sum_(k,i,j);vec_mult_(k,k,.5); enddef; + +% middle of two points (local version) +def mid_point(expr k,i,j)= mid_point_(pnt(k),pnt(i),pnt(j)); enddef; + +%%\newpage +%%\title{Vector rotation} +% Rotation of |vec[v]| around |vec[axis]| by an angle |alpha| + +%% The vector $\vec{v}$ is first projected on the axis +%% giving vectors $\vec{a}$ and $\vec{h}$: +%%\figure{vect-fig.9} +%% If we set +%% $\vec{b}={\ora{axis}\over \left\Vert\vcenter{\ora{axis}}\right\Vert}$, +%% the rotated vector $\vec{v'}$ is equal to $\vec{h}+\vec{f}$ +%% where $\vec{f}=\cos\alpha \cdot \vec{a} + \sin\alpha\cdot \vec{c}$. +%% and $\vec{h}=(\vec{v}\cdot\vec{b})\vec{b}$ +%%\figure{vect-fig.10} + +% The rotation is independent of |vec[axis]|'s module. +% |v| = old and new vector +% |axis| = rotation axis +% |alpha| = rotation angle +% +vardef vec_rotate_(expr v,axis,alpha)= + new_vec(v_a);new_vec(v_b);new_vec(v_c); + new_vec(v_d);new_vec(v_e);new_vec(v_f); + new_vec(v_g);new_vec(v_h); + vec_mult_(v_b,axis,1/vec_mod_(axis)); + vec_mult_(v_h,v_b,vec_dprod_(v_b,v)); % projection of |v| on |axis| + vec_diff_(v_a,v,v_h); + vec_prod_(v_c,v_b,v_a); + vec_mult_(v_d,v_a,cosd(alpha)); + vec_mult_(v_e,v_c,sind(alpha)); + vec_sum_(v_f,v_d,v_e); + vec_sum_(v,v_f,v_h); + free_vec(v_h);free_vec(v_g); + free_vec(v_f);free_vec(v_e);free_vec(v_d); + free_vec(v_c);free_vec(v_b);free_vec(v_a); +enddef; + +% The second parameter is left absolute because this is probably the most +% common case. +vardef vec_rotate(expr v,axis,alpha)=vec_rotate_(pnt(v),axis,alpha) enddef; + +%%\newpage +%%\title{Operations on objects} +% |iname| is the handler for an instance of an object of class |name| +% |iname| must be a letter string +% |vardef| is not used because at some point we give other names +% to |assign_obj| with |let| and this cannot be done with |vardef|. +% (see MFbook for details) +def assign_obj(expr iname,name)= + begingroup + save tmpdef; + string tmpdef; % we need to add double quotes (char 34) + tmpdef="def " & iname & "_class=" & ditto & name & ditto & " enddef"; + scantokens tmpdef; + def_obj(iname); + endgroup +enddef; + +% |name| is the the name of an object instance +% It must be made only of letters (or underscores), but no digits. +def def_obj(expr name)= + scantokens begingroup + save tmpdef;string tmpdef; + tmpdef="def_" & obj_class_(name) & "(" & ditto & name & ditto & ")"; + tmpdef + endgroup +enddef; + +% This macro puts an object back where it was right at the beginning, +% or rather, where the |set| definition puts it (which may be different +% than the initial position, in case it depends on parameters). +% |iname| is the name of an object instance. +vardef reset_obj(expr iname)= + save tmpdef; + string tmpdef; + define_current_point_offset_(iname); + tmpdef="set_" & obj_class_(iname) & "_points"; + scantokens tmpdef(iname); +enddef; + +% Put an object at position given by |pos| (a vector) and +% with orientations given by angles |psi|, |theta|, |phi|. +% The object is scaled by |scale|. +% |iname| is the name of an object instance. +% If the shape of the object has been changed since it was +% created, these changes are lost. +vardef put_obj(expr iname,pos,scale,psi,theta,phi)= + reset_obj(iname);scale_obj(iname,scale); + new_vec(v_x);new_vec(v_y);new_vec(v_z); + vec_def_vec_(v_x,vec_I); + vec_def_vec_(v_y,vec_J); + vec_def_vec_(v_z,vec_K); + rotate_obj_abs_pv(iname,point_null,v_z,psi); + vec_rotate_(v_x,v_z,psi);vec_rotate_(v_y,v_z,psi); + rotate_obj_abs_pv(iname,point_null,v_y,theta); + vec_rotate_(v_x,v_y,theta);vec_rotate_(v_z,v_y,theta); + rotate_obj_abs_pv(iname,point_null,v_x,phi); + vec_rotate_(v_y,v_x,phi);vec_rotate_(v_z,v_x,phi); + free_vec(v_z);free_vec(v_y);free_vec(v_x); + translate_obj(iname,pos); +enddef; + +%%\newpage +%%\title{Rotation, translation and scaling of objects} +% Rotation of an object instance |name| around an axis +% going through a point |p| (local to the object) +% and directed by vector |vec[v]|. The angle of rotation is |a|. +vardef rotate_obj_pv(expr name,p,v,a)= + define_current_point_offset_(name); + rotate_obj_abs_pv(name,pnt(p),v,a); +enddef; + +vardef rotate_obj_abs_pv(expr name,p,v,a)= + define_current_point_offset_(name); + new_vec(v_a); + for i:=1 upto obj_points_(name): + vec_diff_(v_a,pnt(i),p); + vec_rotate_(v_a,v,a); + vec_sum_(pnt(i),v_a,p); + endfor; + free_vec(v_a); +enddef; + +% Rotation of an object instance |name| around an axis +% going through a point |p| (local to the object) +% and directed by vector $\ora{pq}$. The angle of rotation is |a|. +vardef rotate_obj_pp(expr name,p,q,a)= + define_current_point_offset_(name); + new_vec(v_a);new_vec(axis); + vec_diff_(axis,pnt(q),pnt(p)); + for i:=1 upto obj_points_(name): + vec_diff_(v_a,pnt(i),pnt(p)); + vec_rotate_(v_a,axis,a); + vec_sum_(pnt(i),v_a,pnt(p)); + endfor; + free_vec(axis);free_vec(v_a); +enddef; + +% Translation of an object instance |name| by a vector |vec[v]|. +vardef translate_obj(expr name,v)= + define_current_point_offset_(name); + for i:=1 upto obj_points_(name): + vec_sum_(pnt(i),pnt(i),v); + endfor; +enddef; + +% Scalar multiplication of an object instance |name| by a scalar |v|. +vardef scale_obj(expr name,v)= + define_current_point_offset_(name); + for i:=1 upto obj_points_(name): + vec_mult(i,i,v); + endfor; +enddef; + + +%%\newpage +%%\title{Functions to build new points in space} +% Rotation in a plane: this is useful to define a regular polygon. +% |k| is a new point obtained from point |j| by rotation around |o| +% by a angle $\alpha$ equal to the angle from |i| to |j|. +%%\figure{vect-fig.11} +vardef rotate_in_plane_(expr k,o,i,j)= + save cosalpha,sinalpha,alpha; + new_vec(v_a);new_vec(v_b);new_vec(v_c); + vec_diff_(v_a,i,o);vec_diff_(v_b,j,o);vec_prod_(v_c,v_a,v_b); + cosalpha=vec_dprod_(v_a,v_b)/vec_mod_(v_a)/vec_mod_(v_b); + sinalpha=sqrt(1-cosalpha**2); + alpha=angle((cosalpha,sinalpha)); + vec_rotate_(v_b,v_c,alpha); + vec_sum_(k,o,v_b); + free_vec(v_c);free_vec(v_b);free_vec(v_a); +enddef; + +vardef rotate_in_plane(expr k,o,i,j)= + rotate_in_plane_(pnt(k),o,pnt(i),pnt(j)) +enddef; + +% Build a point on a adjacent face. +%% The middle $m$ of points $i$ and $j$ is such that +%% $\widehat{(\ora{om},\ora{mc})}=\alpha$ +%% This is useful to define regular polyhedra +%%\figure{vect-fig.7} +vardef new_face_point_(expr c,o,i,j,alpha)= + new_vec(v_a);new_vec(v_b);new_vec(v_c);new_vec(v_d);new_vec(v_e); + vec_diff_(v_a,i,o);vec_diff_(v_b,j,o); + vec_sum_(v_c,v_a,v_b); + vec_mult_(v_d,v_c,.5); + vec_diff_(v_e,i,j); + vec_sum_(c,v_d,o); + vec_rotate_(v_d,v_e,alpha); + vec_sum_(c,v_d,c); + free_vec(v_e);free_vec(v_d);free_vec(v_c);free_vec(v_b);free_vec(v_a); +enddef; + +vardef new_face_point(expr c,o,i,j,alpha)= + new_face_point_(pnt(c),pnt(o),pnt(i),pnt(j),alpha) +enddef; + +vardef new_abs_face_point(expr c,o,i,j,alpha)= + new_face_point_(c,o,pnt(i),pnt(j),alpha) +enddef; + +%%\newpage +%%\title{Computation of the projection of a point on the ``screen''} +% |p| is the projection of |m| +% |m| = point in space (3 coordinates) +% |p| = point of the intersection plane +%%\figure{vect-fig.8} +vardef project_point(expr p,m)= + save tmpalpha; + new_vec(v_a);new_vec(v_b); + if projection_type=2: % oblique + if point_in_plane_p_pl_(m)(projection_plane): + % |m| is on the projection plane + vec_diff_(v_a,m,ObliqueCenter_); + y[p]:=drawing_scale*vec_dprod_(v_a,ProjJ_); + x[p]:=drawing_scale*vec_dprod_(v_a,ProjK_); + else: % |m| is not on the projection plane + new_line_(l)(m,ObliqueCenter_); + vec_diff_(l2,l2,Obs); + vec_sum_(l2,l2,m); + % (the direction does not depend on Obs) + if def_inter_p_l_pl_(v_a)(l)(projection_plane): + vec_diff_(v_a,v_a,ObliqueCenter_); + y[p]:=drawing_scale*vec_dprod_(v_a,ProjJ_); + x[p]:=drawing_scale*vec_dprod_(v_a,ProjK_); + else: message "Point " & decimal m & " cannot be projected"; + x[p]:=too_big_;y[p]=too_big_; + fi; + free_line(l); + fi; + else: + vec_diff_(v_b,m,Obs); % vector |Obs|-|m| + % |vec[v_a]| is |vec[v_b]| expressed in (|ObsI_|,|ObsJ_|,|ObsK_|) + % coordinates. + vec[v_a]x:=vec[IObsI_]x*vec[v_b]x + +vec[IObsJ_]x*vec[v_b]y+vec[IObsK_]x*vec[v_b]z; + vec[v_a]y:=vec[IObsI_]y*vec[v_b]x + +vec[IObsJ_]y*vec[v_b]y+vec[IObsK_]y*vec[v_b]z; + vec[v_a]z:=vec[IObsI_]z*vec[v_b]x + +vec[IObsJ_]z*vec[v_b]y+vec[IObsK_]z*vec[v_b]z; + if vec[v_a]x<Obs_dist: % then, point |m| is too close + message "Point " & decimal m & " too close -> not drawn"; + x[p]:=too_big_;y[p]=too_big_; + else: + if (angle(vec[v_a]x,vec[v_a]z)>h_field/2) + or (angle(vec[v_a]x,vec[v_a]y)>v_field/2): + message "Point " & decimal m & " out of screen -> not drawn"; + x[p]:=too_big_;y[p]=too_big_; + else: + if projection_type=0: % central perspective + tmpalpha:=Obs_dist/vec[v_a]x; + else: + tmpalpha:=1; % parallel + fi; + y[p]:=drawing_scale*tmpalpha*vec[v_a]y; + x[p]:=drawing_scale*tmpalpha*vec[v_a]z; + fi; + fi; + fi; + free_vec(v_b);free_vec(v_a); +enddef; + +% At some point, we may need to do an oblique projection +% of vectors |ObsK_| and |ObsI_| on a plane, and to normalize +% and orthogonalize the projections (with the projection of |ObsK_| +% keeping the same direction). This is done here, +% where we take two vectors, a direction (line) and +% a plane, and return two vectors. This function assumes +% there is an intersection between line |l| and plane |p|. +% We do not test it here. + +vardef project_vectors(expr va,vb)(expr k,i)(text l)(text p)= + save vc;new_vec(vc); + if proj_v_v_l_pl_(va,k)(l)(p): % |va| is the projection of vector |k| + else: message "THIS SHOULD NOT HAPPEN"; + fi; + if proj_v_v_l_pl_(vb,i)(l)(p): % |vb| is the projection of vector |i| + else: message "THIS SHOULD NOT HAPPEN"; + fi; + % now, we orthonormalize these vectors: + vec_prod_(vc,va,vb); + vec_unit_(va,va);vec_unit_(vc,vc);vec_prod_(vb,vc,va); + free_vec(vc); +enddef; + +% Object projection +% This is a mere iteration on |project_point| +def project_obj(expr name)= + define_current_point_offset_(name); + for i:=1 upto obj_points_(name): + project_point(ipnt_(i),pnt(i));endfor; +enddef; + +% Projection screen +vardef show_projection_screen= + save dx,dy; + dx=Obs_dist*sind(h_field/2)/cosd(h_field/2); + dy=Obs_dist*sind(v_field/2)/cosd(v_field/2); + new_vec(pa);new_vec(pb);new_vec(pc);new_vec(pd);new_vec(op); + new_vec(w);new_vec(h); + vec_mult_(op,ObsI_,Obs_dist);vec_sum_(op,op,Obs); % center of screen + vec_mult_(w,ObsK_,dx);vec_mult_(h,ObsJ_,dy); + vec_sum_(pa,op,w);vec_sum_(pa,pa,h); % upper right corner + vec_mult_(w,w,-2);vec_mult_(h,h,-2); + vec_sum_(pb,pa,w);vec_sum_(pc,pb,h);vec_sum_(pd,pa,h); + message "Screen at corners:"; + show_point("urcorner: ",pa); + show_point("ulcorner: ",pb); + show_point("llcorner: ",pc); + show_point("lrcorner: ",pd); + show_point("Obs:",Obs); + free_vec(h);free_vec(w); + free_vec(op);free_vec(pd);free_vec(pc);free_vec(pb);free_vec(pa); +enddef; + + +%%\newpage +%%\title{Draw one face, hiding it if it is hidden} +% The order of the vertices determines what is the visible side +% of the face. The order must be clockwise when the face is seen. +% |drawhidden| is a boolean; if |true| only hidden faces are drawn; if |false|, +% only visible faces are drawn. Therefore, |draw_face| is called twice +% by |draw_faces|. +vardef draw_face(text vertices)(expr col,drawhidden)= + save p,num,overflow,i,j,k,nv; + path p;boolean overflow; + overflow=false; + forsuffixes $=vertices: + if z[ipnt_($)]=(too_big_,too_big_):overflow:=true; fi; + exitif overflow; + endfor; + if overflow: message "Face can not be drawn, due to overflow"; + else: + p=forsuffixes $=vertices:z[ipnt_($)]--endfor cycle; + % we do now search for three distinct and non-aligned suffixes: + % usually, the first three suffixes do + new_vec(normal_vec);new_vec(v_a);new_vec(v_b);new_vec(v_c); + % first, we copy all the indexes in an array, so that + % it is easier to go through them + i=1; % num0 is not used + forsuffixes $=vertices:num[i]=$;i:=i+1;endfor; + nv=i-1; + for $:=1 upto nv: + for $$:=$+1 upto nv: + for $$$:=$$+1 upto nv: + vec_diff_(v_a,pnt(num[$$]),pnt(num[$])); + vec_diff_(v_b,pnt(num[$$$]),pnt(num[$$])); + vec_prod_(normal_vec,v_a,v_b); + exitif vec_neq_(normal_vec,vec_null); + % |vec_mod_| must not be used for such a test + endfor; + exitif vec_neq_(normal_vec,vec_null); + endfor; + exitif vec_neq_(normal_vec,vec_null); + endfor; + if projection_type=0: % perspective + vec_diff_(v_c,pnt(num1),Obs); + else: % parallel + vec_def_vec_(v_c,ObsI_); + fi; + if filled_faces: + if vec_dprod_(normal_vec,v_c)<0: + fill p withcolor col;drawcontour(p,contour_width,contour_color)(); + else: % |draw p dashed evenly;| if this is done, you must ensure + % that hidden faces are (re)drawn at the end + fi; + else: + if vec_dprod_(normal_vec,v_c)<0:%visible + if not drawhidden:drawcontour(p,contour_width,contour_color)();fi; + else: % hidden + if drawhidden: + drawcontour(p,contour_width,contour_color)(dashed evenly); + fi; + fi; + fi; + free_vec(v_c);free_vec(v_b);free_vec(v_a);free_vec(normal_vec); + fi; +enddef; + +% |p| is the path to draw (a face contour), |thickness| is the pen width +% |col| is the color and |type| is a line modifier. +def drawcontour(expr p,thickness,col)(text type)= + if draw_contours and (thickness>0): + pickup pencircle scaled thickness; + draw p withcolor background; % avoid strange overlapping dashes + draw p type withcolor col; + pickup pencircle scaled .4pt; + fi; +enddef; + +%%\newpage +% Variables for face handling. First, we have an array for lists of vertices +% corresponding to faces. +string face_points_[];% analogous to |vec| arrays + +% Then, we have an array of colors. A color needs to be a string +% representing an hexadecimal RGB coding of a color. +string face_color_[]; + +% |name| is the name of an object instance +vardef draw_faces(expr name)= + save tmpdef;string tmpdef; + define_current_face_offset_(name); + % first the hidden faces (dashes must be drawn first): + for i:=1 upto obj_faces_(name): + tmpdef:="draw_face(" & face_points_[face(i)] + & ")(hexcolor(" & ditto & face_color_[face(i)] & ditto + & "),true)";scantokens tmpdef; + endfor; + % then, the visible faces: + for i:=1 upto obj_faces_(name): + tmpdef:="draw_face(" & face_points_[face(i)] + & ")(hexcolor(" & ditto & face_color_[face(i)] & ditto + & "),false)";scantokens tmpdef; + endfor; +enddef; + +% Draw point |n| of object instance |name| +vardef draw_point(expr name,n)= + define_current_point_offset_(name); + project_point(ipnt_(n),pnt(n)); + if z[ipnt_(n)] <> (too_big_,too_big_): + pickup pencircle scaled 5pt; + drawdot(z[ipnt_(n)]); + pickup pencircle scaled .4pt; + fi; +enddef; + +vardef draw_axes(expr r,g,b)= + project_point(1,vec_null); + project_point(2,vec_I); + project_point(3,vec_J); + project_point(4,vec_K); + if (z1<>(too_big_,too_big_)): + if (z2<>(too_big_,too_big_)): + drawarrow z1--z2 dashed evenly withcolor r; + fi; + if (z3<>(too_big_,too_big_)): + drawarrow z1--z3 dashed evenly withcolor g; + fi; + if (z4<>(too_big_,too_big_)): + drawarrow z1--z4 dashed evenly withcolor b; + fi; + fi; +enddef; + +% Draw a polygonal line through the list of points +% This implementation does not work if you call +% |draw_lines(i,i+4)| because \MP{} adds parentheses around +% the value of |i|. +def draw_lines(text vertices)= + begingroup % so that we can |let| |draw_lines| + save j,num,np; + % first, we copy all the indexes in an array, so that + % it is easier to go through them + j=1; + for $=vertices:num[j]=$;j:=j+1;endfor; + np=j-1; + for j:=1 upto np-1: + draw z[ipnt_(num[j])]--z[ipnt_(num[j+1])]; + endfor; + endgroup +enddef; + +let draw_line=draw_lines; + +% Draw an arrow between points |i| and |j| of current object +% This is used from the |draw| definition of an object. +def draw_arrow(expr i,j)= + drawarrow z[ipnt_(i)]--z[ipnt_(j)]; +enddef; + +% Draw a line between points |i| of object |obja| and |j| of |objb| +% This is used when outside an object (i.e., we can't presuppose +% any object offset) +vardef draw_line_inter(expr obja, i, objb, j)= + project_point(1,pnt_obj(obja,i)); + project_point(2,pnt_obj(objb,j)); + draw z1--z2; +enddef; + +% Draw an arrow between points |i| of object |obja| and |j| of |objb| +% This is used when outside an object (i.e., we can't presuppose +% any object offset) +vardef draw_arrow_inter(expr obja, i, objb, j)= + project_point(1,pnt_obj(obja,i)); + project_point(2,pnt_obj(objb,j)); + draw z1--z2; +enddef; + +%%\newpage +% Definition of a macro |obj_name| returning an object name +% when given an absolute +% face number. This definition is built incrementally through a string, +% everytime a new object is defined. +% |obj_name| is defined by |redefine_obj_name_|. + +% Initial definition +string index_to_name_; +index_to_name_="def obj_name(expr i)=if i<1:"; + +% |name| is the name of an object instance +% |n| is the absolute index of its last face +def redefine_obj_name_(expr name,n)= + index_to_name_:=index_to_name_ & "elseif i<=" & decimal n & ":" & ditto + & name & ditto; + scantokens begingroup index_to_name_ & "fi;enddef;" endgroup; +enddef; + +% |i| is an absolute face number +% |vertices| is a string representing a list of vertices +% |rgbcolor| is a string representing a color in rgb hexadecimal +def set_face(expr i,vertices,rgbcolor)= + face_points_[i]:=vertices;face_color_[i]:=rgbcolor; +enddef; + +% |i| is a local face number +% |vertices| is a string representing a list of vertices +% |rgbcolor| is a string representing a color in rgb hexadecimal +def set_obj_face(expr i,vertices,rgbcolor)=set_face(face(i),vertices,rgbcolor) +enddef; + +% |i| is a local face number of object |inst| +% |rgbcolor| is a string representing a color in rgb hexadecimal +def set_obj_face_color(expr inst,i,rgbcolor)= + face_color_[face_obj(inst,i)]:=rgbcolor; +enddef; + + +%%\newpage +%%\title{Compute the vectors corresponding to the observer's viewpoint} +% (vectors |ObsI_|,|ObsJ_| and |ObsK_| in the |vec_I|,|vec_J|, +% |vec_K| reference; and vectors |IObsI_|,|IObsJ_| and |IObsK_| +% which are |vec_I|,|vec_J|,|vec_K| +% in the |ObsI_|,|ObsJ_|,|ObsK_| reference) +%%\figure{vect-fig.16} +%% (here, $\psi>0$, $\theta<0$ and $\phi>0$; moreover, +%% $\vert\theta\vert \leq 90^\circ$) + +def compute_reference(expr psi,theta,phi)= + % |ObsI_| defines the direction of observation; + % |ObsJ_| and |ObsK_| the orientation + % (but one of these two vectors is enough, + % since |ObsK_| = |ObsI_| $\land$ |ObsJ_|) + % The vectors are found by rotations of |vec_I|,|vec_J|,|vec_K|. + vec_def_vec_(ObsI_,vec_I);vec_def_vec_(ObsJ_,vec_J); + vec_def_vec_(ObsK_,vec_K); + vec_rotate_(ObsI_,ObsK_,psi); + vec_rotate_(ObsJ_,ObsK_,psi);% gives ($u$,$v$,$z$) + vec_rotate_(ObsI_,ObsJ_,theta); + vec_rotate_(ObsK_,ObsJ_,theta);% gives ($Obs_x$,$v$,$w$) + vec_rotate_(ObsJ_,ObsI_,phi); + vec_rotate_(ObsK_,ObsI_,phi);% gives ($Obs_x$,$Obs_y$,$Obs_z$) + % The passage matrix $P$ from |vec_I|,|vec_J|,|vec_K| + % to |ObsI_|,|ObsJ_|,|ObsK_| is the matrix + % composed of the vectors |ObsI_|,|ObsJ_| and |ObsK_| expressed + % in the base |vec_I|,|vec_J|,|vec_K|. + % We have $X=P X'$ where $X$ are the coordinates of a point + % in |vec_I|,|vec_J|,|vec_K| + % and $X'$ the coordinates of the same point in |ObsI_|,|ObsJ_|,|ObsK_|. + % In order to get $P^{-1}$, it suffices to build vectors using + % the previous rotations in the inverse order. + vec_def_vec_(IObsI_,vec_I);vec_def_vec_(IObsJ_,vec_J); + vec_def_vec_(IObsK_,vec_K); + vec_rotate_(IObsK_,IObsI_,-phi);vec_rotate_(IObsJ_,IObsI_,-phi); + vec_rotate_(IObsK_,IObsJ_,-theta);vec_rotate_(IObsI_,IObsJ_,-theta); + vec_rotate_(IObsJ_,IObsK_,-psi);vec_rotate_(IObsI_,IObsK_,-psi); +enddef; + +%%\newpage +%%\title{Point of view} +% This macro computes the three angles necessary for |compute_reference| +% |name| = name of an instance of an object +% |target| = target point (local to object |name|) +% |phi| = angle +vardef point_of_view_obj(expr name,target,phi)= + define_current_point_offset_(name);% enables |pnt| + point_of_view_abs(pnt(target),phi); +enddef; + +% Compute absolute perspective. |target| is an absolute point number +% |phi| = angle +% This function also computes two vectors needed in case +% of an oblique projection. +vardef point_of_view_abs(expr target,phi)= + save psi,theta; + new_vec(v_a); + vec_diff_(v_a,target,Obs); + vec_mult_(v_a,v_a,1/vec_mod_(v_a)); + psi=angle((vec[v_a]x,vec[v_a]y)); + theta=-angle((vec[v_a]x++vec[v_a]y,vec[v_a]z)); + compute_reference(psi,theta,phi); + if projection_type=2: % oblique + % we start by checking that at a minimum the three points defining + % the projection plane have different indexes; it doesn't mean + % the plane if well defined, but if two values are identical, + % the plane can't be well defined. + if ((projection_plane1<>projection_plane2) and + (projection_plane1<>projection_plane3) and + (projection_plane2<>projection_plane3)): + new_line_(l)(Obs,Obs); + vec_sum_(l2,ObsI_,Obs); + if def_inter_p_l_pl_(ObliqueCenter_)(l)(projection_plane): + project_vectors(ProjK_,ProjJ_)(ObsK_,ObsJ_)(l)(projection_plane); + % define the projection direction + set_line_(projection_direction)(Obs,ObliqueCenter_); + else: + message "Anomalous oblique projection:"; + message " the observer is watching parallely to the plane"; + fi; + free_line(l); + else: + message "Anomalous projection plane; did you define it?"; + fi; + fi; + free_vec(v_a); +enddef; + + +% Distance between the observer and point |n| of object |name| +% Result is put in |dist| +vardef obs_distance(text dist)(expr name,n)= + new_vec(v_a); + define_current_point_offset_(name);% enables |pnt| + dist:=vec_mod_(v_a,pnt(n),Obs); + free_vec(v_a); +enddef; + +%%\newpage +%%\title{Vector and point allocation} +% Allocation is done through a stack of vectors +numeric last_vec_; +last_vec_=0; + +% vector allocation +% (this must not be a |vardef| because the vector |v| saved is not saved +% in this macro, but in the calling context) +def new_vec(text v)= + save v; + new_vec_(v); +enddef; + +def new_vec_(text v)= + v:=incr(last_vec_); + %|message "Vector " & decimal (last_vec_+1) & " allocated";| +enddef; + +let new_point = new_vec; +let new_point_ = new_vec_; + +def new_points(text p)(expr n)= + save p; + numeric p[]; + for i:=1 upto n:new_point_(p[i]);endfor; +enddef; + +% Free a vector +% A vector can only be freed safely when it was the last vector created. +def free_vec(expr i)= + if i=last_vec_: last_vec_:=last_vec_-1; + %|message "Vector " & decimal i & " freed";| + else: errmessage("Vector " & decimal i & " can't be freed!"); + fi; +enddef; + +let free_point = free_vec; + +def free_points(text p)(expr n)= + for i:=n step-1 until 1:free_point(p[i]);endfor; +enddef; + +%%\title{Debugging} + +def show_vec(expr t,i)= + message "Vector " & t & "=" + & "(" & decimal vec[i]x & "," & decimal vec[i]y & "," + & decimal vec[i]z & ")"; +enddef; + +% One can write |show_point("2",pnt_obj("obj",2));| +let show_point=show_vec; + +def show_pair(expr t,zz)= + message t & "=(" & decimal xpart(zz) & "," & decimal ypart(zz) & ")"; +enddef; + +%%\newpage +%%\title{Access to object features} +% |a| must be a string representing a class name, such as |"dodecahedron"|. +% |b| is the tail of a macro name. + +def obj_(expr a,b,i)= + scantokens + begingroup save n;string n;n=a & b & i;n + endgroup +enddef; + +def obj_points_(expr name)= + obj_(obj_class_(name),"_points",name) +enddef; + +def obj_faces_(expr name)= + obj_(obj_class_(name),"_faces",name) +enddef; + +vardef obj_point_offset_(expr name)= + obj_(obj_class_(name),"_point_offset",name) +enddef; + +vardef obj_face_offset_(expr name)= + obj_(obj_class_(name),"_face_offset",name) +enddef; + +def obj_class_(expr name)=obj_(name,"_class","") enddef; + +%%\newpage +def define_point_offset_(expr name,o)= + begingroup save n,tmpdef; + string n,tmpdef; + n=obj_class_(name) & "_point_offset" & name; + expandafter numeric scantokens n; + scantokens n:=last_point_offset_; + last_point_offset_:=last_point_offset_+o; + tmpdef="def " & obj_class_(name) & "_points" & name & + "=" & decimal o & " enddef"; + scantokens tmpdef; + endgroup +enddef; + +def define_face_offset_(expr name,o)= + begingroup save n,tmpdef; + string n,tmpdef; + n=obj_class_(name) & "_face_offset" & name; + expandafter numeric scantokens n; + scantokens n:=last_face_offset_; + last_face_offset_:=last_face_offset_+o; + tmpdef="def " & obj_class_(name) & "_faces" & name & + "=" & decimal o & " enddef"; + scantokens tmpdef; + endgroup +enddef; + +def define_current_point_offset_(expr name)= + save current_point_offset_; + numeric current_point_offset_; + current_point_offset_:=obj_point_offset_(name); +enddef; + +def define_current_face_offset_(expr name)= + save current_face_offset_; + numeric current_face_offset_; + current_face_offset_:=obj_face_offset_(name); +enddef; + + +%%\newpage +%%\title{Drawing an object} +% |name| is an object instance +vardef draw_obj(expr name)= + save tmpdef; + string tmpdef; + current_obj:=name; + tmpdef="draw_" & obj_class_(name); + project_obj(name);% compute screen coordinates + save overflow; boolean overflow; overflow=false; + for $:=1 upto obj_points_(name): + if z[ipnt_($)]=(too_big_,too_big_):overflow:=true; + x[ipnt_($)] := 10; % so that the figure can be drawn anyway + y[ipnt_($)] := 10; + % why can't I write z[ipnt_($)]:=(10,10); ? + fi; + exitif overflow; + endfor; + if overflow: + message "Figure has overflows"; + message " (at least one point is not visible "; + message " and had to be drawn at a wrong place)"; + fi; + scantokens tmpdef(name); +enddef; + +%%\title{Normalization of an object} +% This macro translates an object so that a list of vertices is centered +% on the origin, and the last vertex is put on a sphere whose radius is 1. +% |name| is the name of the object and |vertices| is a list +% of points whose barycenter will define the center of the object. +% (|vertices| need not be the list of all vertices) +vardef normalize_obj(expr name)(text vertices)= + save nvertices,last; + nvertices=0; + new_vec(v_a);vec_def_(v_a,0,0,0) + forsuffixes $=vertices: + vec_sum_(v_a,v_a,pnt($)); + nvertices:=nvertices+1; + last:=$; + endfor; + vec_mult_(v_a,v_a,-1/nvertices); + translate_obj(name,v_a);% object centered on the origin + scale_obj(name,1/vec_mod(last)); + free_vec(v_a); +enddef; + + +%%\newpage +%%\title{General definitions} +% Vector arrays +numeric vec[]x,vec[]y,vec[]z; + +% Reference vectors $\vec{0}$, $\vec{\imath}$, $\vec{\jmath}$ and $\vec{k}$ +% and their definition +new_vec(vec_null);new_vec(vec_I);new_vec(vec_J);new_vec(vec_K); +vec_def_(vec_null,0,0,0); +vec_def_(vec_I,1,0,0);vec_def_(vec_J,0,1,0);vec_def_(vec_K,0,0,1); +numeric point_null; +point_null=vec_null; + +% Observer +new_point(Obs); +% default value: +set_point_(Obs,0,0,20); + +% Observer's vectors +new_vec(ObsI_);new_vec(ObsJ_);new_vec(ObsK_); +% default values: +vec_def_vec_(ObsI_,vec_I); +vec_def_vec_(ObsJ_,vec_J); +vec_def_vec_(ObsK_,vec_K); + +new_vec(IObsI_);new_vec(IObsJ_);new_vec(IObsK_); + +% These vectors will be vectors of the projection plane, +% in case of oblique projections: +new_vec(ProjK_);new_vec(ProjJ_); % there is no |ProjI_| + +% This will be the center of the projection plane, in oblique projections +new_point(ObliqueCenter_); + + +% distance observer/plane (must be $>0$) +numeric Obs_dist; % represents |Obs_dist| $\times$ |drawing_scale| +% default value: +Obs_dist=2; % means |Obs_dist| $\times$ |drawing_scale| + +% current object being drawn +string current_obj; + +% kind of projection: 0 for linear (or central) perspective, 1 for parallel, +% 2 for oblique projection +% (default is 0) +numeric projection_type; +projection_type:=0; + +% Definition of a projection plane (only used in oblique projections) +% +new_plane_(projection_plane)(1,1,1); % the initial value is irrelevant + +% Definition of a projection direction (only used in oblique projections) +new_line_(projection_direction)(1,1); % the initial value is irrelevant + +% this positions the observer at vector |p| (the point observed) +% + |d| (distance) * (k-(i+j)) +def isometric_projection(expr i,j,k,p,d,phi)= + trimetric_projection(i,j,k,1,1,1,p,d,phi); +enddef; + +% this positions the observer at vector |p| (the point observed) +% + |d| (distance) * (ak-(i+j)) +def dimetric_projection(expr i,j,k,a,p,d,phi)= + trimetric_projection(i,j,k,1,1,a,p,d,phi); +enddef; + +% this positions the observer at vector |p| (the point observed) +% + |d| (distance) * (k-(i+j)) +% |a|, |b| and |c| are multiplicative factors to vectors |i|, |j| and |k| +vardef trimetric_projection(expr i,j,k,a,b,c,p,d,phi)= + save v_a,v_b,v_c; + new_vec(v_a);new_vec(v_b);new_vec(v_c); + vec_mult_(v_a,i,a);vec_mult_(v_b,j,b);vec_mult_(v_c,k,c); + vec_sum_(Obs,v_a,v_b); + vec_diff_(Obs,v_c,Obs); + vec_mult_(Obs,Obs,d); + vec_sum_(Obs,Obs,p); + point_of_view_abs(p,phi); + projection_type:=1; + free_vec(v_c);free_vec(v_b);free_vec(v_a); +enddef; + +% |hor| is an horizontal plane (in the sense that it will represent +% the horizontal for the observer) +% |p| is the point in space that the observer targets (center of screen) +% |a| is an angle (45 degrees corresponds to cavalier drawing) +% |b| is an angle (see examples defined below) +% |d| is the distance of the observer +vardef oblique_projection(text hor)(expr p,a,b,d)= + save _l,v_a,v_b,v_c,xxx_,obsJangle_; + new_vec(v_a);new_vec(v_b);new_vec(v_c); + % we first compute a horizontal line: + new_line_(_l)(1,1); + if def_inter_l_pl_pl(_l)(hor)(projection_plane): + vec_diff_(v_a,_l2,_l1); % horizontal vector + % then, we find a normal to the projection plane: + def_normal_p_(v_b)(projection_plane); + % complete the line and the vector by a third vector (=vertical) + vec_prod_(v_c,v_a,v_b); + % we make |v_a| a copy of |v_b| since we no longer need |v_b| + vec_def_vec_(v_a,v_b); + % we rotate |v_b| by an angle |a| around |v_c| + vec_rotate_(v_b,v_c,a); + % we rotate |v_b| by an angle |b| around |v_a| + vec_rotate_(v_b,v_a,b); + % we put the observer at the distance |d| of |p| in + % the direction of |v_b|: + vec_unit_(v_b,v_b); + vec_mult_(v_b,v_b,d);vec_sum_(Obs,p,v_b); + % We now have to make sure that point |p| and point |Obs| + % are on different sides of the projection plane. For this, + % we compute two dot products: + new_vec(v_d);new_vec(v_e); + vec_diff_(v_d,p,_l1);vec_diff_(v_e,Obs,_l1); + if vec_dprod_(v_d,v_a)*vec_dprod_(v_e,v_a)>=0: + % |p| and |Obs| are on the same side of the projection plane + % |Obs| needs to be recomputed. + vec_mult_(v_b,v_b,-1); + vec_sum_(Obs,p,v_b); + fi; + free_vec(v_e);free_vec(v_d); + projection_type:=2; % needs to be set before |point_of_view_abs| + point_of_view_abs(p,90); % this computes |ObliqueCenter_| + % and now, make sure the vectors defining the observer are right: + % Create the plane containing lines _l and projection_direction + % (defined by point_of_view_abs): + new_plane_(xxx_)(1,1,1); + def_plane_pl_l_l(xxx_)(_l)(projection_direction); + % Compute the angle of |ObsK_| with this plane: + obsJangle_=vangle_v_pl_(ObsK_)(xxx_); + % rotate |ObsJ_| and |ObsK_| by |obsJangle_| around |ObsI_| + vec_rotate_(ObsJ_,ObsI_,obsJangle_); + vec_rotate_(ObsK_,ObsI_,obsJangle_); + if abs(vangle_v_pl_(ObsK_)(xxx_))>1: % the rotation was done + % in the wrong direction + vec_rotate_(ObsJ_,ObsI_,-2obsJangle_); + vec_rotate_(ObsK_,ObsI_,-2obsJangle_); + fi; + % |vec_rotate_(ObsJ_,ObsI_,45);| % planometric test + % |vec_rotate_(ObsK_,ObsI_,45);| % planometric test + free_plane(xxx_); + % and now, |ProjJ_| and |ProjK_| must be recomputed: + project_vectors(ProjK_,ProjJ_)(ObsK_,ObsJ_)% + (projection_direction)(projection_plane); + else: + message "Error: the ``horizontal plane'' cannot be"; + message " parallel to the projection plane."; + fi; + free_line(_l); + free_vec(v_c);free_vec(v_b);free_vec(v_a); +enddef; + +% These two are the most common values for the third parameter +% of |oblique_projection| +numeric CAVALIER;CAVALIER=45; +numeric CABINET;CABINET=angle((1,.5)); % atn(.5) + +% Screen Size +% The screen size is defined through two angles: the horizontal field +% and the vertical field +numeric h_field,v_field; +h_field=100; % degrees +v_field=70; % degrees + +% Observer's orientation, defined by three angles +numeric Obs_psi,Obs_theta,Obs_phi; +% default value: +Obs_psi=0;Obs_theta=90;Obs_phi=0; + +% This array relates an absolute object point number to the +% absolute point number (that is, to the |vec| array). +% The absolute object point number is the rank of a point +% with respect to all object points. The absolute point number +% considers in addition the extra points, such as |Obs|, which do +% not belong to an object. +% If |i| is an absolute object point number, |points_[i]| +% is the absolute point number. +numeric points_[]; + +% |name| is the name of an object instance +% |npoints| is its number of defining points +def new_obj_points(expr name,npoints)= + define_point_offset_(name,npoints);define_current_point_offset_(name); + for i:=1 upto obj_points_(name):new_point_(pnt(i));endfor; +enddef; + +% |name| is the name of an object instance +% |nfaces| is its number of defining faces +def new_obj_faces(expr name,nfaces)= + define_face_offset_(name,nfaces);define_current_face_offset_(name); + redefine_obj_name_(name,current_face_offset_+nfaces); +enddef; + +%%\newpage +% Absolute point number corresponding to object point number |i| +% This macro must only be used within the function defining an object +% (such as |def_cube|) or the function drawing an object (such as +% |draw_cube|). +def ipnt_(expr i)=i+current_point_offset_ enddef; +def pnt(expr i)=points_[ipnt_(i)] enddef; + +def face(expr i)=(i+current_face_offset_) enddef; + +% Absolute point number corresponding to local point |n| +% in object instance |name| +vardef pnt_obj(expr name,n)= + points_[n+obj_point_offset_(name)] + %hide(define_current_point_offset_(name);) pnt(n) % HAS SIDE EFFECTS +enddef; + +% Absolute face number corresponding to local face |n| +% in object instance |name| +vardef face_obj(expr name,n)= + (n+obj_face_offset_(name)) + %hide(define_current_face_offset_(name);) face(n) % HAS SIDE EFFECTS +enddef; + + +% Scale +numeric drawing_scale; +drawing_scale=2cm; + +% Color +% This function is useful when a color is expressed in hexadecimal. +% This does the opposite from |tohexcolor| +def hexcolor(expr s)= + (hex(substring (0,2) of s)/255,hex(substring (2,4) of s)/255, + hex(substring (4,6) of s)/255) +enddef; + +% Convert a color triple into a hexadecimal color string. +% |rv|, |gv| and |bv| are values between 0 and 1. +% This does the opposite from |hexcolor| +vardef tohexcolor(expr rv,gv,bv)= + save dig;numeric dig[]; + hide( + dig2=floor(rv*255);dig1=floor((dig2)/16);dig2:=dig2-16*dig1; + dig4=floor(gv*255);dig3=floor((dig4)/16);dig4:=dig4-16*dig3; + dig6=floor(bv*255);dig5=floor((dig6)/16);dig6:=dig6-16*dig5; + for i:=1 upto 6: + if dig[i]<10:dig[i]:=dig[i]+48; + else:dig[i]:=dig[i]+87; + fi; + endfor; + ) + char(dig1)&char(dig2)&char(dig3)&char(dig4)&char(dig5)&char(dig6) +enddef; + +% Conversions + +% Returns a string encoding the integer |n| as follows: +% if $n=10*a+b$ with $b<10$, +% |alphabetize|(|n|)=|alphabetize|(|a|) |&| |char (65+b)| +% For instance, alphabetize(3835) returns "DIDF" +% This function is useful in places where digits are not allowed. +def alphabetize(expr n)= + if (n>9): + alphabetize(floor(n/10)) & fi + char(65+n-10*floor(n/10)) +enddef; + +% Filling and contours +boolean filled_faces,draw_contours; +filled_faces=true; +draw_contours=true; +numeric contour_width; % thickness of contours +contour_width=1pt; +color contour_color; % face contours +contour_color=black; + +% Overflow control +% An overflow can occur when an object is too close from the observer +% or if an object is out of sight. We use a special value to mark +% coordinates which would lead to an overflow. +numeric too_big_; +too_big_=4000; + + +% Object offset (the points defining an object are arranged +% in a single array, and the objects are easier to manipulate +% if the point numbers are divided into a number and an offset). +numeric last_point_offset_,last_face_offset_; +last_point_offset_=0;last_face_offset_=0; + +endinput diff --git a/Master/texmf-dist/metapost/mp3d/3danim.mp b/Master/texmf-dist/metapost/mp3d/3danim.mp new file mode 100644 index 00000000000..3e49922a69f --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/3danim.mp @@ -0,0 +1,269 @@ +%%\input epsf +%%\def\newpage{\vfill\eject} +%%\advance\vsize1in +%%\let\ora\overrightarrow +%%\def\title#1{\hrule\vskip1mm#1\par\vskip1mm\hrule\vskip5mm} +%%\def\figure#1{\par\centerline{\epsfbox{#1}}} +%%\title{{\bf 3DANIM.MP: STANDARD ANIMATION DEFINITIONS IN METAPOST}} + +%% version 1.34, 17 August 2003 +%% {\bf Denis Roegel} ({\tt roegel@loria.fr}) +%% +%%This package provides standard animation definitions and +%%must be used with the {\bf 3d} package. + +if known three_d_anim_version: + expandafter endinput % avoids loading this package twice +fi; + +% First, we load the 3D package +input 3d + +message "*** 3danim, v1.34 (c) D. Roegel, 17 August 2003 ***"; +numeric three_d_anim_version; +three_d_anim_version=1.34; + +%%\newpage +%%\title{Computation of field parameters of an animation} +numeric xmin_,ymin_,xmax_,ymax_; + +def compute_bbox= + if known xmin_: + xmin_:=min(xmin_,xpart(llcorner(currentpicture))); + ymin_:=min(ymin_,ypart(llcorner(currentpicture))); + xmax_:=max(xmax_,xpart(urcorner(currentpicture))); + ymax_:=max(ymax_,ypart(urcorner(currentpicture))); + else: + xmin_=xpart(llcorner(currentpicture)); + ymin_=ypart(llcorner(currentpicture)); + xmax_=xpart(urcorner(currentpicture)); + ymax_=ypart(urcorner(currentpicture)); + fi; +enddef; + +extra_endfig:=extra_endfig & "compute_bbox;"; + +boolean show_animation_parameters; +show_animation_parameters=false; +% The paper height is purely virtual; it is a paper size +% such that the full animation can rest on it. +% It must be compatible with the |PAPERSIZE| option +% of |gs| in |write_script|. +% If the size (i.e. the bounding box) of the animation is too large, +% you may have to change the |paper_height| and the |gs| parameter. +% The ratio between the paper height and width is assumed to be sqrt(2). +numeric paper_height; +paper_height=29.7; % A4 paper height in cm +numeric output_res; +output_res=36; % default output resolution of bitmap: 36 dots per inch + +% show bounding box of an animation, in PostScript points +% and parameters for animation script +vardef show_animation_bbox= + save trx,try,h,w,delta,pnmx,pnmy,pnmw,pnmh,phbp,pwbp; + w=xmax_-xmin_;h=ymax_-ymin_; + if show_animation_parameters: + message "animation bbox: (llx=" & decimal round(xmin_) + & ",lly=" & decimal round(ymin_) + & ",w=" & decimal round(w) & ",h=" & decimal round(h) & ")"; + fi; + % the lower left corner is put at position (20,20) + trx=20-xmin_; + try=20-ymin_; + if show_animation_parameters: + message "translate parameters: " + & decimal round(trx) & " " & decimal round(try); + fi; + xmin_:=xmin_+trx;ymin_:=ymin_+try; + delta=10; % extra space + phbp=paper_height/2.54*72; % paper height in PostScript points + pwbp=phbp/sqrt(2); % paper width in PostScript points + % (assuming a sqrt(2) ratio) + pnmx=round(xmin_*(output_res/72)-delta); + pnmy=round((paper_height/2.54*72-ymin_-h)*(output_res/72)-delta); + pnmw=round(w*(output_res/72)+2*delta); + pnmh=round(h*(output_res/72)+2*delta); + if show_animation_parameters: + message "pnmcut parameters (with -r" & decimal output_res & "): " + & decimal pnmx & " " & decimal pnmy & " " + & decimal pnmw & " " & decimal pnmh; + fi; + if (pnmx<0) or (pnmy<0) or (pnmx+pnmw>=pwbp) or (pnmy+pnmh>=phbp): + message "!! paper size overflow: you may need to reduce the size of"; + message "!! the animation, or to change the paper size"; + fi; + write_script(round(trx),round(try), + pnmx,pnmy,pnmw,pnmh,output_res,jobname,"create_animation.sh"); +enddef; + +%%\newpage +%%\title{Creation of a shell script to automate the animation} +% This is UNIX targetted and may need to be customized. + +vardef write_script(expr trx,try,xmin,ymin,w,h,res,output,file)= + save s; + string s; + def write_to_file(text arg)=write arg to file; enddef; + write_to_file("#! /bin/sh"); + write_to_file(""); + write_to_file("/bin/rm -f "&output&".log"); + write_to_file("for i in `ls "&output&".*| grep '"&output&".[0-9]'`;do"); + if false: "endfor" fi % indentation hack for meta-mode.el + write_to_file("echo $i"); + write_to_file("echo '=============='"); + s:="awk < $i '{print} /^%%Page: /{print "&ditto; + s:=s&decimal trx&" "&decimal try&" translate\n"&ditto&"}' > $i.ps"; + write_to_file(s); + % ghostscript PostScript into ppm + % (the paper size must be compatible with the definition of |paper_height|) + s:="gs -sDEVICE=ppmraw -sPAPERSIZE=a4 -dNOPAUSE "; + s:=s&"-r"&decimal res &" -sOutputFile=$i.ppm -q -- $i.ps"; + write_to_file(s); + write_to_file("/bin/rm -f $i.ps"); + % possible alternative: + % |s:="mogrify -compress -crop " & decimal(w) & "x" & decimal(h);| + % |s:=s&"+"& decimal(xmin) &"+"&decimal(ymin);| + % |s:=s&" -colors 32 -format gif $i.ppm";| + s:="ppmquant 32 $i.ppm | pnmcut "& decimal(xmin) &" "&decimal(ymin); + s:=s&" "&decimal(w)&" "&decimal(h) &" | "; + s:=s&"ppmtogif > `expr $i.ppm : '\(.*\)ppm'`gif"; + write_to_file(s); + write_to_file("/bin/rm -f $i.ppm"); + write_to_file("done"); + write_to_file("/bin/rm -f "&output&".gif"); + s:="gifmerge -10 -l1000 "; + s:=s&output&".*.gif > "&output&".gif"; + write_to_file(s); + write_to_file("/bin/rm -f "&output&".*.gif"); + write_to_file(EOF);% end of file +enddef; + +% These definitions produce {\it one\/} image of some kind. + +% In the standard animations, the observer follows a circle, shown below: +%%\figure{vect-fig.17} + +% Standard image 1: this is an example and may be adapted. +% |name| is an object instance +def one_image(expr name,i,a,rd,ang)= + beginfig(i); + set_point_(Obs,-rd*cosd(a*ang),-rd*sind(a*ang),1); + Obs_phi:=90;Obs_dist:=2; + point_of_view_obj(name,1,Obs_phi);% fix point 1 of object |name| + draw_obj(name); + rotate_obj_pv(name,1,vec_I,ang); + draw_point(name,1);% show the rotation point + draw_axes(red,green,blue); + endfig; +enddef; + +% Standard image 2: this is an example and may be adapted. +% |name_a| and |name_b| are object instances. +def one_image_two_objects(expr name_a,name_b,i,a,rd,ang)= + beginfig(i); + set_point_(Obs,-rd*cosd(a*ang),-rd*sind(a*ang),1); + Obs_phi:=90;Obs_dist:=2; + point_of_view_obj(name_a,1,Obs_phi);% fix point 1 of object |name_a| + draw_obj(name_a);draw_obj(name_b); + rotate_obj_pv(name_a,1,vec_I,ang); + rotate_obj_pv(name_b,13,vec_J,-ang); + %|rotate_obj_pp(name_b,13,7,-ang);| + draw_point(name_a,1);% show the rotation point + draw_axes(red,green,blue); + endfig; +enddef; + +%%\newpage +% Standard image 3: this is an example and may be adapted. +% |name_a|, |name_b| and |name_c| are object instances. +def one_image_three_objects(expr name_a,name_b,name_c,i,a,rd,ang)= + beginfig(i); + set_point_(Obs,-rd*cosd(a*ang),-rd*sind(a*ang),1); + Obs_phi:=90;Obs_dist:=2;h_field:=100;v_field:=150; + point_of_view_obj(name_a,1,Obs_phi);% fix point 1 of object |name_a| + draw_obj(name_a);draw_obj(name_b);draw_obj(name_c); + new_vec(v_a); + vec_def_(v_a,.03*cosd(-a*ang+90),.03*sind(-a*ang+90),0); + translate_obj(name_c,v_a); + free_vec(v_a); + rotate_obj_pv(name_a,1,vec_I,ang); + rotate_obj_pv(name_b,13,vec_J,-ang); + %|rotate_obj_pp(name_b,13,7,-ang);| + draw_point(name_a,1);% show the rotation point + draw_axes(red,green,blue); + endfig; +enddef; + +% Standard image 4: this is an example and may be adapted. +% |name_a| and |name_b| are object instances. +def one_image_two_identical_objects(expr name_a,name_b,i,a,rd,ang)= + beginfig(i); + set_point_(Obs,-rd*cosd(a*ang),-rd*sind(a*ang),2); + Obs_phi:=90;Obs_dist:=2; + point_of_view_obj(name_a,1,Obs_phi);% fix point 1 of object |name_a| + draw_obj(name_a);draw_obj(name_b); + rotate_obj_pv(name_a,1,vec_I,ang); + rotate_obj_pv(name_b,13,vec_J,-ang); + %|rotate_obj_pp(name_a,13,7,-ang);| + draw_point(name_a,1);% show the rotation point + draw_axes(red,green,blue); + endfig; +enddef; + + +%%\newpage +% An animation is a series of images, and these series are produced here. + +% Standard animation 1 +% |name| is a class name +def animate_object(expr name,imin,imax,index)= + numeric ang;ang=360/(imax-imin+1); + assign_obj("obj",name); + for i:=imin upto imax:one_image("obj",i+index,i,5,ang);endfor; + show_animation_bbox; +enddef; + +% Standard animation 2 +% |name_a| and |name_b| are class names +def animate_two_objects(expr name_a,name_b,imin,imax,index)= + numeric ang;ang=360/(imax-imin+1); + assign_obj("obja",name_a);assign_obj("objb",name_b); + translate_obj("objb",vec_K);translate_obj("objb",vec_K); + for i:=imin upto imax: + one_image_two_objects("obja","objb",i+index,i,10,ang); + endfor; + show_animation_bbox; +enddef; + +% Standard animation 3 +% |name_a|, |name_b| and |name_c| are class names +vardef animate_three_objects(expr name_a,name_b,name_c,imin,imax,index)= + numeric ang;ang=360/(imax-imin+1); + assign_obj("obja",name_a);assign_obj("objb",name_b); + assign_obj("objc",name_c); + scale_obj("objb",.7); + new_vec(v_a); + vec_def_vec_(v_a,vec_K);vec_mult_(v_a,v_a,4);put_obj("objb",v_a,1,0,0,0); + free_vec(v_a); + scale_obj("objc",.5); + translate_obj("objc",vec_K);translate_obj("objc",vec_K); + for i:=imin upto imax: + one_image_three_objects("obja","objb","objc",i+index,i,7,ang); + endfor; + show_animation_bbox; +enddef; + +% Standard animation 4 +% |name| is a class name +def animate_two_identical_objects(expr name,imin,imax,index)= + numeric ang;ang=360/(imax-imin+1); + assign_obj("obja",name);assign_obj("objb",name); + translate_obj("objb",vec_K);translate_obj("objb",vec_K); + for i:=imin upto imax: + one_image_two_identical_objects("obja","objb",i+index,i,10,ang); + endfor; + show_animation_bbox; +enddef; + +endinput + diff --git a/Master/texmf-dist/metapost/mp3d/3dgeom.mp b/Master/texmf-dist/metapost/mp3d/3dgeom.mp new file mode 100644 index 00000000000..22a30315b65 --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/3dgeom.mp @@ -0,0 +1,931 @@ +%%\input epsf +%%\def\newpage{\vfill\eject} +%%\advance\vsize1in +%%\let\ora\overrightarrow +%%\def\title#1{\hrule\vskip1mm#1\par\vskip1mm\hrule\vskip5mm} +%%\def\figure#1{\par\centerline{\epsfbox{#1}}} +%%\title{{\bf 3DGEOM.MP: 3D GEOMETRY IN METAPOST}} + +%% version 1.34, 17 August 2003 +%% {\bf Denis Roegel} ({\tt roegel@loria.fr}) + +% This package provides useful definitions for geometrical drawings. +% It contains functions dealing with lines, planes, etc. + +if known three_d_geom_version: + expandafter endinput % avoids loading this package twice +fi; + +% First, we load the 3D package +input 3d +% and some utilities +input 3dutil + +message "*** 3dgeom, v1.34 (c) D. Roegel 17 August 2003 ***"; +numeric three_d_geom_version; three_d_geom_version:=1.34; + +% WARNING: +% Known bugs: unnecessary overflows can occur, especially when +% computing the intersection of two planes. + + +% Among other things, this file defines so-called ``structures.'' +% These structures are different from the ``objects'' manipulated +% by the main 3d package. For some explanations, see the article +% +% Denis Roegel: La géométrie dans l'espace avec METAPOST, +% Cahiers GUTenberg number 39-40, 2001, pages 107-138. +% (in French, conference proceedings of GUT2001) +% +% +% +% Future versions of this module will consider the following structures, +% not all of which are currently implemented: +% +% structure name standard abreviation +% point p +% line l +% plane pl +% circle c +% triangle tr +% sphere s +% cone co +% cylinder cy +% tetrahedron te +% +% These names are considered reserved and should not be used for classes. +% +% The left column names are used when defining a structure with |def|, +% |set| or freeing it with |free|. +% +% When a function using parameters of these types is defined, +% the abreviations of the types are part of the function name. +% For instance, the function giving the intersection between a +% line and a plane is named |def_inter_l_pl|. +% +% Functions computing intersections should be named |def_inter| +% and should be followed by the resulting type. For instance, +% the intersection of two lines is |def_inter_p_l_l|, +% the intersection of two planes is |def_inter_l_pl_pl| +% +% Functions computing inscriptions (like a circle inscribed +% in a triangle) should be named |def_ins|. +% For instance, |def_ins_c_tr|. +% +% Functions computing circumscriptions (like a circle circumscribing +% a triangle) should be named |def_circums|. +% For instance, |def_circums_c_tr|. +% +% Functions computing exinscriptions (like a circle exinscribed +% in a triangle) should be named |def_exins|. +% For instance, |def_exins_c_tr|. +% +% Functions computing tangencies (like a tangent to a circle) +% should be named |def_tang|. +% For instance, |def_tang_l_c|. +% +% Functions computing orthogonal planes, lines, etc. should +% be named |def_orth|. +% +% All these functions can have more parameters than what the name +% implies. +% +% These rules are guidelines, not a standard. If you have some idea +% on naming conventions, please let me know at roegel@loria.fr. +% +% Possibly, more thought should be given in +% order to distinguish pseudo-objects like ``circle'' +% from the other objects of 3d.mp (like the polyhedra, etc.). + + +% Structures can be allocated, set and freed. + +% Our first structure is the line. A line is defined by two points. +% This is not an object in the usual sense of the 3d package. +% It is just made of two points. +% |l| is the line name: it must be different from already known variables +% |i| and |j| are point numbers +% (absolute version) +def new_line_(text l)(expr i,j)= + new_points(l)(2); + set_line_(l)(i,j); +enddef; + +% The following version takes local point numbers instead of absolute ones. +def new_line(text l)(expr i,j)=new_line_(l)(pnt(i),pnt(j)) enddef; + +% This is used to set a line: +% (absolute version) +def set_line_(text l)(expr i,j)= + vec_def_vec_(l1,i); + vec_def_vec_(l2,j); % l[2]=l[1]+1 (this is assumed elsewhere, + % so should never change) +enddef; + +% (local version) +def set_line(text l)(expr i,j)=set_line_(l)(pnt(i),pnt(j)) enddef; + +def free_line(text l)= + free_points(l)(2); +enddef; + +% A circle |c| of center |i|, radius |r| and in plane |p|. +% We store the center as a point, and (r,p[1]) in another point. +def new_circle(text c)(expr i,r)(text p)= + new_points(c)(2); + vec_def_vec(c1,i); + vec_def(c2,r,p1,0); +enddef; + +% should |set_circle| be defined? + +def free_circle(text c)= + free_points(c)(2); +enddef; + +% Planes are similar to lines. A plane is just a triple of points. +% (absolute version) +def new_plane_(text p)(expr i,j,k)= + new_points(p)(3); + set_plane_(p)(i,j,k); +enddef; + +% (local version) +def new_plane(text p)(expr i,j,k)=new_plane_(p)(pnt(i),pnt(j),pnt(k)) enddef; + +% (absolute version) +def set_plane_(text p)(expr i,j,k)= + vec_def_vec_(p1,i); + vec_def_vec_(p2,j); % p[2]=p[1]+1 (this is assumed elsewhere, + % so should never change) + vec_def_vec_(p3,k); % p[3]=p[3]+1 (this is assumed elsewhere, + % so should never change) +enddef; + +% (local version) +def set_plane(text p)(expr i,j,k)=set_plane_(p)(pnt(i),pnt(j),pnt(k)) enddef; + +def free_plane(text p)= + free_points(p)(3); +enddef; + +% Spheres are not yet used, but here is how they will be allocated and freed. + +% A sphere is defined with a center |c| and a radius |r|. +% We store it using two points. +def new_sphere(text s)(expr c,r)= + new_points(s)(2); + vec_def_vec(s1,c); + vec_def(s2,r,0,0); +enddef; + +% Should |set_sphere| be defined? + +def free_sphere(text s)= + free_points(s)(2); +enddef; + +% Lines and planes may be used locally or globally to define +% new points or new lines. + +% In order to define a line which is given by a point and a vector, +% compute a second point before defining the line. +% In order to define a line which is given by two planes, +% define the planes and compute the intersection. + +% If a plane is given by a parametric equation (1 point, 2 vectors), +% compute two additional points and define the plane. +% If a plane is given by an equation ax+by+cz+d=0, compute three +% points and define the plane. + +% Currently, plane equations are not handled separately. + +% Projection of a vector |j| on a plane |p|, along a line |l|. +% The projection, if it exists, is vector |i|. +% Returns |true| is there is a projection, and |false| if there is none. +vardef proj_v_v_l_pl_(expr i,j)(text l)(text p)= + save pa,pb,int; boolean int; + hide( + new_point(pa);new_point(pb); + % we project two points: the origin, and origin+v(j): + if def_proj_pl_(pa)(p)(point_null)(l): + if def_proj_pl_(pb)(p)(j)(l): + vec_diff_(i,pb,pa); + int=true; + else: + message "Second point can not be projected"; + int=false; + fi; + else: int=false; + message "Origin can not be projected"; + fi; + free_point(pb);free_point(pa); + ) + int +enddef; + +% The next function checks if a point is part of a plane. +% Returns |true| is point |i| is in the plane |p|. +vardef point_in_plane_p_pl_(expr i)(text p)= + save v_a;boolean res; + hide( + new_vec(v_a);new_vec(v_b); + def_normal_p_(v_a)(p); + vec_diff_(v_b,p1,i); + if vec_dprod_(v_a,v_b)=0: res=true;else: res=false;fi; + free_vec(v_b);free_vec(v_a); + ) + res +enddef; + +% The next function finds the angle of a vector with respect to a plane. +% Returns the angle of a vector |v| with respect to a plane |p|. +vardef vangle_v_pl_(expr v)(text p)= + save v_a,an_; + hide( + new_vec(v_a); + % we compute a vector normal to the plane: + def_normal_p_(v_a)(p); + an_=90-vangle_v_v_(v,v_a); + free_vec(v_a); + ) + an_ +enddef; + +% Compute the angle between two vectors +% The angle is always between 0 and 180, +% since this is the best one can do with two vectors. +% If we had a third vector, we could be more accurate. +vardef vangle_v_v_(expr va,vb)= + save cosa_,sina_; + hide( + cosa_=vec_dprod_(va,vb)/vec_mod_(va)/vec_mod_(vb); + if cosa_>1: % sometimes, this happens with rounding errors + sina_=0; + else: + sina_= 1 +-+ cosa_; % sqrt(1-cosa_**2) + fi; + ) + angle((cosa_,sina_)) +enddef; + +% Define a plane with two lines: +def def_plane_pl_l_l(text p)(text l)(text m)= + set_plane_(p)(l1,l2,1); % the last value is irrelevant + vec_diff_(p3,m2,m1);vec_sum_(p3,p3,l1); +enddef; + +% Define the plane orthogonal to a line and going through a point +% (not necessarily belonging to the plane): +% the plane must already have been defined +% |p|=plane, |l|=line, |i|=point +%... +% (absolute version) +vardef def_orth_pl_l_p_(text p)(text l)(expr i)= + new_vec(va);new_vec(vb);new_vec(vc);new_vec(h); + vec_def_vec_(p1,i); % this is the first point of the plane + vec_diff_(va,l2,l1); + vec_def_vec_(vb,i); + if abs(xval(va))<absmin(yval(va),zval(va)): + vec_sum_(vb,vb,vec_I); + elseif abs(yval(va))<absmin(xval(va),zval(va)): + vec_sum_(vb,vb,vec_J); + else:vec_sum_(vb,vb,vec_K); + fi; + % now, |vb| is a point not on the line and not too close to it + % we compute a vertical to the line + def_vert_l_(h,vb)(l); + vec_diff_(vb,vb,h);vec_unit_(vb,vb); + vec_sum_(p2,vb,p1); + % |p[2]| is now a point of the plane + % a third point is obtained by cross product + vec_prod_(vc,va,vb);vec_unit_(vc,vc);vec_sum_(p3,vc,p1); + free_vec(h);free_vec(vc);free_vec(vb);free_vec(va); +enddef; + +% (local version) +vardef def_orth_pl_l_p(text p)(text l)(expr i)= + def_orth_pl_l_p_(p)(l)(pnt(i)) +enddef; + +% Line orthogonal to a plane and going through a point +% (not necessarily belonging to the plane); +% from the three points defining the plane, compute a normal, +% and add it to the point, this gives a second point, +% and make a line out of it +% (absolute version) +vardef def_orth_l_pl_p_(text l)(text p)(expr i)= + new_vec(va);new_vec(vb); + vec_def_vec_(l1,i); + def_normal_p_(l2)(p); + vec_sum_(l2,l2,l1); + free_vec(vb);free_vec(va); +enddef; + +% (local version) +vardef def_orth_l_pl_p(text l)(text p)(expr i)= + def_orth_l_pl_p_(l)(p)(pnt(i)) +enddef; + +% Unitary vector normal to a plane. +% |v| is a vector that must have been defined +% (absolute version) +vardef def_normal_p_(expr v)(text p)= + new_vec(va);new_vec(vb); + vec_diff_(va,p2,p1);vec_diff_(vb,p3,p1);vec_prod_(v,va,vb); + vec_unit_(v,v); + free_vec(vb);free_vec(va); +enddef; + +% Unitary vector normal to a plane (local version) +vardef def_normal_p(expr v)(text p)=def_normal_p_(pnt(v))(p) enddef; + +% The following two functions are old versions of the +% line/plane intersection. They are not used anymore. +% +% Intersection line/plane +% Point |i| is the intersection +% The return value is |true| if the intersection is a point, +% |false| otherwise +% (absolute version) +vardef old_def_inter_p_l_pl_(expr i)(text l)(text p)= + save d,t,int;boolean int; + hide( + new_vec(va);new_vec(vb);new_vec(vc); + % first, we compute a vector normal to the plane + vec_diff_(va,p2,p1); + vec_diff_(vb,p3,p2); + vec_prod_(vc,va,vb); + % we want the plane equation as ax+by+cz+d=0 + % the normal vector gives us (a,b,c) + % d is then easy to compute + d=-xval(vc)*xval(p1)-yval(vc)*yval(p1)-zval(vc)*zval(p1); + vec_diff_(i,l2,l1); + if vec_dprod_(i,vc)=0: % the line is parallel to the plane + int:=false; + else: + int:=true; + t=-(d+xval(vc)*xval(l1)+yval(vc)*yval(l1)+zval(vc)*zval(l1)) + /vec_dprod_(i,vc); + vec_mult_(i,i,t);vec_sum_(i,i,l1); + fi; + free_vec(vc);free_vec(vb);free_vec(va); + ) + int +enddef; + +% same (local version) +vardef old_def_inter_p_l_pl(expr i)(text l)(text p)= + def_inter_p_l_pl_(pnt(i))(l)(p) +enddef; + +% Intersection line/plane (absolute version) +% Point |i| is the intersection. +% The return value is |true| if the intersection is a point, +% |false| otherwise +vardef def_inter_p_l_pl_(expr i)(text l)(text p)= + save int;boolean int; + hide( + new_points(loc)(3); + vec_diff_(loc1,p2,p1);vec_diff_(loc2,p3,p1);vec_prod_(loc3,loc1,loc2); + vec_diff_(loc1,p1,l1);vec_diff_(loc2,l2,l1); + if vec_dprod_(loc2,loc3)<>0: + vec_mult_(loc2,loc2,vec_dprod_(loc1,loc3)/vec_dprod_(loc2,loc3)); + vec_sum_(i,l1,loc2); + int:=true; + % Remark: in order to prove that point |i| is on the plane, it + % suffices to compute vec(ci).(vec(cd) /\ vec(ce)) + % =(-vec(ac)+vec(ai)).(vec(cd) /\ vec(ce)) + % =-vec(ac).(vec(cd) /\ vec(ce)) + % +(vec(ab).(vec(cd) /\ vec(ce))) vec(ac).(vec(cd) /\ vec(ce)) + % ---------------------------- + % vec(ab).(vec(cd) /\ vec(ce)) + % =0 + else: % the line is parallel to the plane + int:=false; + fi; + free_points(loc)(3); + ) + int +enddef; + +% Intersection line/plane (local version) +vardef def_inter_p_l_pl(expr i)(text l)(text p)= + def_inter_p_l_pl_(pnt(i))(l)(p) +enddef; + +% The following function is used in |def_inter_l_pl_pl|. +% We could simplify it by breaking it in two. +vardef def_inter_l_pl_pl_base_case_(text l)(expr pa,pb,pc)(text q)= + save trial; + new_line_(trial)(pa,pb); + if def_inter_p_l_pl_(l1)(trial)(q): + else: % there is no intersection or the intersection is the line + vec_def_vec_(trial1,pa); + mid_point_(trial2,pb,pc); + if def_inter_p_l_pl_(l1)(trial)(q): + else: + message "THIS SHOULD NOT HAPPEN, PLEASE REPORT THIS PROBLEM"; + fi; + fi; + set_line_(trial)(pa,pc); + if def_inter_p_l_pl_(l2)(trial)(q): + else: % there is no intersection or the intersection is the line + vec_def_vec_(trial1,pa); + mid_point_(trial2,pb,pc); + if def_inter_p_l_pl_(l2)(trial)(q): + else: + message "THIS SHOULD NOT HAPPEN, PLEASE REPORT THIS PROBLEM"; + fi; + fi; + free_line(trial); +enddef; + +% Intersection of two planes. +% TO DO: this function is not yet robust enough, because +% unnecessary overflows can occur. +% A boolean is set if there is no intersection. +% The line |l| must already have been defined. +vardef def_inter_l_pl_pl(text l)(text p)(text q)= + save trial,da,db,dc,int;boolean int; + hide( + % we first search the point of p1, p2, p3 which is the farthest + % from q; + da=dist_pl_(p1)(q);db=dist_pl_(p2)(q);dc=dist_pl_(p3)(q); + if (da=db) and (db=dc): % the two planes are parallel + int:=false; + else: + int:=true; + if (da>=db) and (da>=dc): + def_inter_l_pl_pl_base_case_(l)(p1,p2,p3)(q); + elseif (db>=da) and (db>=dc): + def_inter_l_pl_pl_base_case_(l)(p2,p1,p3)(q); + else: + def_inter_l_pl_pl_base_case_(l)(p3,p1,p2)(q); + fi; + fi; + ) + int +enddef; + +% Visual intersection between lines (jk) and (lm). +% The computed intersection lies on (jk). +% Returns true if there is an intersection, false otherwise. +% (absolute version) +vardef def_visual_inter_(expr i)(expr j,k,l,m)= + save pla,plb,la,lb,d,int;boolean int; + hide( + new_plane_(pla)(Obs,l,m);new_plane_(plb)(Obs,j,k); + new_line_(la)(0,0);new_line_(lb)(j,k); + if def_inter_l_pl_pl(la)(pla)(plb): + int:=true; + % |d| is the closest distance between lines |la| and |lb| + % We don't use |d| here, and are only interested in point |i|. + d=def_inter_p_l_l_(i)(la)(lb); + else: + int:=false; + fi; + free_line(lb);free_line(la);free_plane(plb);free_plane(pla); + ) int +enddef; + +% same (local version) +vardef def_visual_inter(expr i)(expr j,k,l,m)= + def_visual_inter_(pnt(i),pnt(j),pnt(k),pnt(l),pnt(m)) +enddef; + +% Point of a line at a given distance from a given point. +% |i| = new point |d|=distance |j|=point |l|=line +% $|d|>0$ or $|d|<0$ give two different points. +% If there is an intersection, the function returns |true|; +% otherwise it returns |false|. +% (absolute version) +vardef def_point_at_(expr i)(expr d)(expr j)(text l)= + save dj,ld,int;boolean int; + hide( + new_point(h);new_point(hc); + def_vert_l_(h,j)(l); + vec_diff_(hc,j,h); + if d*d-vec_dprod_(hc,hc)>=0: int:=true; + ld=sign(d)*sqrt(d*d-vec_dprod_(hc,hc)); + vec_diff_(i,l1,l2); + vec_unit_(i,i); + vec_mult_(i,i,ld); + vec_sum_(i,i,h); + else: int:=false; + fi; + free_point(hc); + free_point(h); + ) + int +enddef; + +% same (local version) +vardef def_point_at(expr i)(expr d)(expr j)(text l)= + def_point_at_(pnt(i))(d)(pnt(j))(l) +enddef; + +% Define a vertical of a line. +% Point |i| is obtained as the intersection of a vertical +% starting from point |j| and reaching the line |l|. +vardef def_vert_l_(expr i,j)(text l)= + new_points(loc)(3); + vec_diff_(loc1,j,l1);vec_diff_(loc2,l2,l1); + vec_mult_(loc3,loc2,vec_dprod_(loc1,loc2)/vec_dprod_(loc2,loc2)); + vec_sum_(i,loc3,l1); + free_points(loc)(3); +enddef; + +% Define a vertical. (local version) +vardef def_vert_l(expr i,j)(text l)= + def_vert_l_(pnt(i),pnt(j))(l); +enddef; + +% Vertical falling on a plane. +% Point |j| falls on plane |p| at point |i| (absolute version) +vardef def_vert_pl_(expr i)(expr j)(text p)= + save d; + new_vec(va);new_vec(vb); + def_normal_p_(va)(p); + vec_diff_(vb,j,p1); + d=-vec_dprod_(vb,va); + vec_mult_(va,va,d); + vec_sum_(vb,vb,va); + vec_sum_(i,p1,vb); + free_vec(vb);free_vec(va); +enddef; + +% same (local version) +vardef def_vert_pl(expr i)(expr j)(text p)= + def_vert_pl_(pnt(i))(pnt(j))(p) +enddef; + +% Distance to a plane. +% (absolute version) +vardef dist_pl_(expr i)(text p)= + save d; + hide( + new_vec(va); + def_vert_pl_(va)(i)(p); + vec_diff_(va,va,i); + d=vec_mod_(va); + free_vec(va); + ) + d +enddef; + +% (local version) +def dist_pl(expr i)(text p)=dist_pl_(pnt(i))(p) enddef; + +% Projections on planes or lines, according to a direction. +% This one is very hazardous: use epsilon +% Find point |i| on |l| from point |j| using direction |d| + +def def_proj_l_(expr i)(text l)(expr j)(text d)= + NOT YET IMPLEMENTED +enddef; + +def def_proj_l(expr i)(text l)(expr j)(text d)= + def_proj_l_(pnt(i))(l)(pnt(j))(d) +enddef; + +% Find point |i| on |p| from point |j| using direction |d|. +vardef def_proj_pl_(expr i)(text p)(expr j)(text d)= + save l_,int; boolean int; + hide( + % we compute the intersection between line (|j|+|d|) and plane |p| + new_line_(l_)(1,1); % we must take a name that cannot + % conflict with the text replacement of |d| + vec_diff_(l_2,d2,d1);vec_sum_(l_2,l_2,j); + vec_def_vec_(l_1,j); + if def_inter_p_l_pl_(i)(l_)(p):int=true; + else: int=false; + fi; + free_line(l_); + ) + int +enddef; + +def def_proj_pl(expr i)(text p)(expr j)(text d)= + def_proj_pl_(pnt(i))(p)(pnt(j))(d) +enddef; + +% Central projection on a plane. +def def_cproj_pl_(expr i)(text p)(expr j)(expr k)= +% use |def_proj_p| + NOT YET IMPLEMENTED +enddef; + +% Central projection on a plane. +def def_cproj_pl(expr i)(text p)(expr j)(expr k)= + def_cproj_pl_(pnt(i))(p)(pnt(j))(pnt(k)) +enddef; + + +% Intersection of two lines (hazardous). +% Due to rounding errors, two lines that should intersect +% may not do so in reality. Therefore, +% we compute the point which is the middle of the two +% closest points between the lines and return the distance +% between the two lines. If the lines are parallel (possibly +% identical), we return -1. +vardef def_inter_p_l_l_(expr i)(text l)(text m)= + save ga,gb,gc,gd,ge,gf,t,u,d,mx; + hide( + new_point(va);new_point(vb);new_point(vc);new_point(h);new_point(k); + vec_diff_(va,m1,l1); + vec_diff_(vb,l2,l1); + vec_diff_(vc,m2,m1); + ga=vec_dprod_(vc,vb);gb=-vec_dprod_(vb,vb); + gc=vec_dprod_(va,vb);gd=vec_dprod_(vc,vc); + ge=-ga;gf=vec_dprod_(va,vc); + % compute the max of ga,gb,... + mx:=absmax(ga,gb);mx:=absmax(mx,gc);mx:=absmax(mx,gd);mx:=absmax(mx,ge); + mx:=absmax(mx,gf); + ga:=ga/mx;gb:=gb/mx;gc:=gc/mx;gd:=gd/mx;ge:=ge/mx;gf:=gf/mx; + if ga*ge=gb*gd: % the lines are parallel + % we return -1 + d=-1; + else: + t=(gc*gd-ga*gf)/(ga*ge-gb*gd);u=(gb*gf-gc*ge)/(ga*ge-gb*gd); + vec_diff_(h,l2,l1);vec_mult_(h,h,t);vec_sum_(h,h,l1); + vec_diff_(k,m2,m1);vec_mult_(k,k,u);vec_sum_(k,k,m1); + % |h| and |k| are now the closest points + % we set |i| to the middle of |h| and |k| and return the distance |hk| + mid_point_(i,h,k); + vec_diff_(h,h,k);d=vec_mod_(h); + fi; + free_point(k);free_point(h);free_point(vc);free_point(vb);free_point(va); + ) + d +enddef; + +def def_inter_p_l_l(expr i)(text l)(text m)= + def_inter_p_l_l_(pnt(i))(l)(m) +enddef; + +% Find point |i| symmetric of point |j| with respect to point |k| +def def_sym_(expr i)(expr j)(expr k)= + NOT YET IMPLEMENTED +enddef; + +def def_sym(expr i)(expr j)(expr k)= + def_sym_(pnt(i))(pnt(j))(pnt(k)) +enddef; + +% Find point |i| symmetric of point |j| with respect to plane |p| +def def_sym_pl_(expr i)(expr j)(text p)= + NOT YET IMPLEMENTED +enddef; + +def def_sym_pl(expr i)(expr j)(text p)= + def_sym_pl_(pnt(i))(pnt(j))(p) +enddef; + +% Find point |i| symmetric of point |j| with respect to line |l|. +% That's a mere 180 degrees rotation around the line. +def def_sym_l_(expr i)(expr j)(text l)= + NOT YET IMPLEMENTED +enddef; + +def def_sym_l(expr i)(expr j)(text l)= + def_sym_l_(pnt(i))(pnt(j))(l) +enddef; + + +% Intersection circle/line (hazardous). +% If some intersection does not exist, |infty| is put for its values +def def_inter_p_p_c_l_(expr i,j)(text c)(text l)= + NOT YET IMPLEMENTED +enddef; + +def def_inter_p_p_c_l(expr i,j)(text c)(text l)= + def_inter_p_p_c_l_(pnt(i),pnt(j))(c)(l) +enddef; + +% circle/plane +% A similar coding will distinguish the four cases: +% one point, two points, the full circle, nothing +def def_inter_p_p_c_pl_(expr i,j)(text c)(text p)= + NOT YET IMPLEMENTED +enddef; + +def def_inter_p_p_c_pl(expr i,j)(text c)(text p)= + def_inter_p_p_c_pl_(pnt(i),pnt(j))(c)(p) +enddef; + +% circle/circle +% A similar coding will distinguish the four cases: +% one point, two points, the full circle, nothing +def def_inter_p_p_c_c_(expr i,j)(text ca)(text cb)= + NOT YET IMPLEMENTED +enddef; + +def def_inter_p_p_c_c(expr i,j)(text ca)(text cb)= + def_inter_p_p_c_c_(pnt(i),pnt(j))(ca)(cb) +enddef; + +% Computation of tangent lines and planes. + +% Tangent line to a circle at a given point. +def def_tang_l_c_p_(text l)(text c)(expr i)= + NOT YET IMPLEMENTED +enddef; + +def def_tang_l_c_p(text l)(text c)(expr i)= + def_tang_l_c_p_(l)(c)(pnt(i)) +enddef; + +% Tangent plane to a sphere at a given point. +def def_tang_pl_s_p_(text p)(text s)(expr i)= + NOT YET IMPLEMENTED +enddef; + +def def_tang_pl_s_p(text p)(text s)(expr i)= + def_tang_pl_s_p_(p)(s)(pnt(i)) +enddef; + +% Sphere defined by four non-coplanar points. +def def_sphere_through_(text s)(expr i,j,k,l)= + NOT YET IMPLEMENTED +enddef; + +def def_sphere_through(text s)(expr i,j,k,l)= + def_sphere_through_(s)(pnt(i),pnt(j),pnt(k),pnt(l)) +enddef; + +% Line going through a point and parallel to another line. +def def_parallel_l_p_pl_(text l)(expr i)(text m)= + NOT YET IMPLEMENTED +enddef; + +def def_parallel_l_p_pl(text l)(expr i)(text m)= + def_parallel_l_p_pl_(l)(pnt(i))(m) +enddef; + +% Plane going through a point and parallel to another plane. +def def_parallel_pl_p_pl_(text p)(expr i)(text q)= + NOT YET IMPLEMENTED +enddef; + +def def_parallel_pl_p_pl(text p)(expr i)(text q)= + def_parallel_pl_p_pl_(p)(pnt(i))(q) +enddef; + +def def_rectangle_one_side_(expr p)(text l)(text pa)(text pb)(text pc)= + if def_inter_l_pl_pl(l)(pb)(pc): + else: + message "YOUR PLANES ARE NOT WELL SPECIFIED 1"; + fi; + if def_inter_p_l_pl_(p)(l)(pa): + else: + message "YOUR PLANES ARE NOT WELL SPECIFIED 2"; + fi; +enddef; + +% A rectangle (for instance representing a plane) can be defined +% from five planes; the rectangle is made of four points (corners) +% |pa| is the plane containing the rectangle +vardef def_rectangle_pl_pl_pl_pl_pl_(expr ca,cb,cc,cd) + (text pa)(text pb)(text pc)(text pd)(text pe)= + save l; + new_line_(l)(1,1); + def_rectangle_one_side_(ca)(l)(pa)(pb)(pc); + def_rectangle_one_side_(cb)(l)(pa)(pc)(pd); + def_rectangle_one_side_(cc)(l)(pa)(pd)(pe); + def_rectangle_one_side_(cd)(l)(pa)(pe)(pb); + free_line(l); +enddef; + +% Instead of using four additional planes, one can also use eight points: +% the order of the point is important. +vardef def_rectangle_pl_(expr ca,cb,cc,cd) + (text pa)(expr pta,ptb,ptc,ptd,pte,ptf,ptg,pth)= + save pb,pc,pd,pe; + % we create the four additionnal planes + new_plane_(pb)(pta,ptb,pte);new_plane_(pc)(ptb,ptc,ptf); + new_plane_(pd)(ptc,ptd,ptg);new_plane_(pe)(ptd,pta,pth); + def_rectangle_pl_pl_pl_pl_pl_(ca,cb,cc,cd)(pa)(pb)(pc)(pd)(pe); + free_plane(pe);free_plane(pd);free_plane(pc);free_plane(pb); +enddef; + +def draw_rectangle(expr i,j,k,l)= + draw_line(i,j);draw_line(j,k);draw_line(k,l);draw_line(l,i); +enddef; + +numeric mark_h,mark_l;mark_h=2mm;mark_l=1mm; + +def draw_one_mark(expr p,a)= + draw (p+unitvector(dir(a))*mark_h/2)--(p-unitvector(dir(a))*mark_h/2); +enddef; + +% Draw |n| marks between points |i| and |j|. +% |i| and |j| are local points and there is no absolute version +% since this is a drawing function. +vardef draw_equal_marks(expr i,j,n)= + save a,k,l,start; + a=angle(z[ipnt_(j)]-z[ipnt_(i)])+90; + l=(x[ipnt_(j)]-x[ipnt_(i)])++(y[ipnt_(j)]-y[ipnt_(i)]); + if n=1: + draw_one_mark(.5[z[ipnt_(i)],z[ipnt_(j)]],a); + elseif n>1: + start=0.5-(n-1)*mark_l/(2*l); + for k:=0 upto n-1: + draw_one_mark((start+k*mark_l/l)[z[ipnt_(i)],z[ipnt_(j)]],a); + endfor; + else: message "parameter " & decimal n & " should be positive"; + fi; +enddef; + +numeric square_angle_size; +square_angle_size=0.2; + +% (absolute version) +def def_right_angle_(expr pi,pj,pk,i,j,k)= + vec_diff_(pj,j,i);vec_diff_(pk,k,i); + if vec_mod_(pj)>0: + vec_mult_(pj,pj,square_angle_size/vec_mod_(pj)); + fi; + if vec_mod_(pk)>0: + vec_mult_(pk,pk,square_angle_size/vec_mod_(pk)); + fi; + vec_sum_(pi,i,pj);vec_sum_(pi,pi,pk); + vec_sum_(pj,pj,i);vec_sum_(pk,pk,i); +enddef; + +% (local version) +def def_right_angle(expr pi,pj,pk,i,j,k)= + def_right_angle_(pnt(pi),pnt(pj),pnt(pk),pnt(i),pnt(j),pnt(k)); +enddef; + +% Right angle on a plane projection. +% Similar to |def_right_angle_|. +% This also defines the vertical projection as |vp|. +vardef def_right_angle_p_(expr pi,pj,pk,vp)(expr i)(text p)= + def_vert_pl_(vp)(i)(p); + new_vec(va); + vec_diff_(va,p1,p2); + vec_sum_(va,va,vp); % va is now a second point on the plane, + % different from the projection + def_right_angle_(pi,pj,pk,vp,va,i); + free_vec(va); +enddef; + +def draw_right_angle(expr pi,pj,pk)= + draw z[ipnt_(pj)]--z[ipnt_(pi)]--z[ipnt_(pk)]; +enddef; + +def draw_double_right_angle(expr pi,pj,pk,pl)= + draw z[ipnt_(pj)]--z[ipnt_(pi)]--z[ipnt_(pk)]--z[ipnt_(pl)]--cycle; +enddef; + +% |draw_line| with extra drawing in either directions +def draw_line_extra(expr i,j)(expr exi,exj)= + draw exi[z[ipnt_(i)],z[ipnt_(j)]]--exj[z[ipnt_(i)],z[ipnt_(j)]]; +enddef; + +% defines point |i| at position |t| on segment |a|-|b| (absolute version) +def set_extra_point_(expr i,a,b,t)= + vec_diff_(i,b,a);vec_mult_(i,i,t);vec_sum_(i,i,a); +enddef; + +% defines point |i| at position |t| on segment |a|-|b| (local version) +def set_extra_point(expr i,a,b,t)= + set_extra_point_(pnt(i),pnt(a),pnt(b),t); +enddef; + +% labels with local points +vardef thelabel_obj@#(expr s,n) = + thelabel.@#(s,z[ipnt_(n)]) +enddef; + +def label_obj = draw thelabel_obj enddef; + +% The plane |p| (which must have been initialized) is defined +% as the screen plane. This is useful for computing vanishing points +def def_screen_pl(text p)= + vec_mult_(p1,ObsI_,Obs_dist);vec_sum_(p1,p1,Obs); % center of screen + vec_sum_(p2,p1,ObsJ_);vec_sum_(p3,p1,ObsK_); +enddef; + +% |i| is the resulting point, |l| defines a line in space, +% |s| is the screen plane +% Returns |true| is there is a vanishing point, otherwise |false|. +vardef def_vanishing_point_p_l_pl_(expr i)(text l)(text s)= + save vp;boolean vp; + hide( + new_vec(v); + vec_diff_(v,l2,l1);vec_sum_(v,Obs,v); + new_line_(obsl)(Obs,v); + if def_inter_p_l_pl_(i)(obsl)(s):vp=true;else:vp=false;fi; + free_line(obsl); + free_vec(v); + ) + vp +enddef; + +def def_vanishing_point_p_l_pl(expr i)(text l)(text s)= + def_vanishing_point_p_l_pl_(pnt(i))(l)(s) +enddef; + +endinput diff --git a/Master/texmf-dist/metapost/mp3d/3dpoly.mp b/Master/texmf-dist/metapost/mp3d/3dpoly.mp new file mode 100644 index 00000000000..5d3b8f5f2fa --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/3dpoly.mp @@ -0,0 +1,294 @@ +%%\input epsf +%%\def\newpage{\vfill\eject} +%%\def\vc#1{$\vcenter{#1}$} +%%\def\title#1{\hrule\vskip1mm#1\par\vskip1mm\hrule\vskip5mm} +%%\def\figure#1{\par\centerline{\epsfbox{#1}}} +%%\title{{\bf 3DPOLY.MP: DEFINITION OF REGULAR CONVEX POLYHEDRA IN METAPOST}} + +%% version 1.34, 17 August 2003 +%% {\bf Denis Roegel} ({\tt roegel@loria.fr}) +%% +%%This package defines the five regular convex polyhedra classes and +%%must be used with the {\bf 3d} package. + +if known three_d_poly_version: + expandafter endinput % avoids loading this package twice +fi; + +message "*** 3dpoly, v1.34 (c) D. Roegel, 17 August 2003 ***"; +numeric three_d_poly_version; +three_d_poly_version=1.34; + +%%Each object definition is parameterized by +%%an instance identification. + +%%All polyhedra are normalized (centered on the origin and inscriptible +%%in a sphere of radius 1). + +%%The polyhedra are defined with a certain number of points and faces. +%%The points comprise both the vertices and the center of the object. + +%%It might be useful to remind the Euler formula linking +%%the number of faces $f$, +%%vertices $v$ and edges $e$ in polyhedra with no hole in dimension 3: +%%$f+v-e=2$. This can be verified in the following table: + +%%\centerline{\vbox{\halign{\quad#\hfil\quad&&\quad\hfil#\quad\cr +%% \omit \hfil type\hfil&\omit\hfil faces\hfil +%% &\omit\hfil vertices\hfil&\omit\hfil edges\hfil\cr +%% tetrahedron&4&4&6\cr +%% cube&6&8&12\cr +%% octahedron&8&6&12\cr +%% dodecahedron&12&20&30\cr +%% icosahedron&20&12&30\cr}}} + +%%For more details, see the documentation enclosed in the distribution. + +%%\newpage\title{TETRAHEDRON (4 faces)\kern1cm\epsfbox{tetra.ps}} + +%% Construction of a tetrahedron: + +%% One face is \vc{\epsfbox{vect-fig.1}} with $h=c\sqrt{3}/2$ + +%% The angle $\alpha$ between two faces is given by +%% $\sin(\alpha/2)={\displaystyle c/2\over \displaystyle c\sqrt{3}/2}=1/\sqrt3$ + +%% \figure{vect-fig.2} + +def set_tetrahedron_points(expr inst)= + set_point(1)(0,0,0);set_point(2)(1,0,0); + set_point(3)(cosd(60),sind(60),0);% $60=360/6$ + sinan=1/sqrt(3);cosan=sqrt(1-sinan**2); + an=180-2*angle((cosan,sinan)); + new_face_point(4,1,2,3,an); + normalize_obj(inst)(1,2,3,4); + set_point(5)(0,0,0);% center of tetrahedron +enddef; + +vardef def_tetrahedron(expr inst)= + new_obj_points(inst,5);% 4 vertices and the center + new_obj_faces(inst,4);% 4 faces in the definition + set_tetrahedron_points(inst); + set_obj_face(1,"1,2,4","b4fefe"); + set_obj_face(2,"2,3,4","b49bc0"); + set_obj_face(3,"1,4,3","b4c8fe"); + set_obj_face(4,"1,3,2","b4fe40"); +enddef; + +%%\newpage\title{CUBE (HEXAHEDRON) (6 faces)\kern1cm\epsfbox{cube.ps}} + +%%The definition of a cube is straightforward. + +def set_cube_points(expr inst)= + set_point(1)(0,0,0); + set_point(2)(1,0,0); + set_point(3)(1,1,0); + set_point(4)(0,1,0); + set_point(5)(0,0,1); + set_point(6)(1,0,1); + set_point(7)(1,1,1); + set_point(8)(0,1,1); + normalize_obj(inst)(1,7);% 1 and 7 are opposite vertices + set_point(9)(0,0,0);% center of cube +enddef; + +vardef def_cube(expr inst)= + new_obj_points(inst,9);% 8 vertices and the center + new_obj_faces(inst,6);% 6 faces in the definition + set_cube_points(inst); + set_obj_face(1,"1,2,6,5","b4fe40"); + set_obj_face(2,"2,3,7,6","45d040"); + set_obj_face(3,"4,8,7,3","45a114"); + set_obj_face(4,"1,5,8,4","45a1d4"); + set_obj_face(5,"5,6,7,8","4569d4"); + set_obj_face(6,"4,3,2,1","112da1"); +enddef; + + +%%\newpage\title{OCTAHEDRON (8 faces)\kern1cm\epsfbox{octa.ps}} + +%% A section of a pyramid is: \vc{\epsfbox{vect-fig.3}} + +%% The height of this pyramid is given +%% by $H^2={(c\sqrt3/2)}^2-{(c/2)}^2=c^2/2$, hence $H=c/\sqrt2$ + +def set_octahedron_points(expr inst)= + set_point(1)(0,0,0); + set_point(2)(1,0,0); + set_point(3)(1,1,0); + set_point(4)(0,1,0); + set_point(5)(.5,.5,1/sqrt(2)); + set_point(6)(.5,.5,-1/sqrt(2)); + normalize_obj(inst)(5,6);% 5 and 6 are opposite vertices + set_point(7)(0,0,0);% center of octahedron +enddef; + +vardef def_octahedron(expr inst)= + new_obj_points(inst,7);% 6 vertices and the center + new_obj_faces(inst,8);% 8 faces in the definition + set_octahedron_points(inst); + set_obj_face(1,"1,2,5","b4fefe"); + set_obj_face(2,"2,3,5","45d040"); + set_obj_face(3,"3,4,5","4569d4"); + set_obj_face(4,"4,1,5","b49bc0"); + set_obj_face(5,"6,1,4","45a1d4"); + set_obj_face(6,"6,2,1","b4c8fe"); + set_obj_face(7,"6,3,2","b49b49"); + set_obj_face(8,"6,4,3","112da1"); +enddef; + + +%%\newpage\title{DODECAHEDRON (12 faces)\kern1cm\epsfbox{dodeca.ps}} + +%% Two adjacent faces (pentagons) of the dodecahedron are as follows: +%%\figure{vect-fig.13} +%% The angle between the faces is the angle between $\overrightarrow{OA}$ +%% and $\overrightarrow{OB}$. +%% $OA=OB=d_3$ as defined in \figure{vect-fig.14} +%% $d_1=2r\sin(\pi/5)$, $d_2=2r\sin(2\pi/5)$ +%% and $d_3=d_1\sin(2\pi/5)=2r\sin(\pi/5)\sin(2\pi/5)$ +%% +%% The angle $\alpha$ is defined by the following conditions: +%% \figure{vect-fig.15} +%% Thus $d_2^2=d_3^2+d_3^2-2d_3^2\cos\alpha$, which leads to +%% $\cos\alpha=1-{\displaystyle d_2^2\over\displaystyle2d_3^2} +%% =-{\displaystyle\cos(2\pi/5)\over\displaystyle2\sin^2(\pi/5)}$ +%%\newpage + +def set_dodecahedron_points(expr inst)= + new_points(fc)(10);% face centers + set_point_(fc1,0,0,0);set_point(1)(1,0,0); + set_point(2)(cosd(72),sind(72),0);% 72=360/5 + rotate_in_plane(3,fc1,1,2); + rotate_in_plane(4,fc1,2,3); + rotate_in_plane(5,fc1,3,4); + cosan=-cosd(72)/(2*sind(36)*sind(36));sinan=sqrt(1-cosan**2); + an=180-angle((cosan,sinan)); + new_abs_face_point(fc2,fc1,1,2,an); + new_abs_face_point(fc3,fc1,2,3,an); + new_abs_face_point(fc4,fc1,3,4,an); + new_abs_face_point(fc5,fc1,4,5,an); + new_abs_face_point(fc6,fc1,5,1,an); + rotate_in_plane(6,fc2,2,1); + rotate_in_plane(7,fc2,1,6); + rotate_in_plane(8,fc2,6,7); + rotate_in_plane(9,fc3,2,8); + rotate_in_plane(10,fc3,8,9); + rotate_in_plane(11,fc4,3,10); + rotate_in_plane(12,fc4,10,11); + rotate_in_plane(13,fc5,4,12); + rotate_in_plane(14,fc5,12,13); + rotate_in_plane(15,fc6,5,14); + new_abs_face_point(fc7,fc2,6,7,an); + new_abs_face_point(fc8,fc3,8,9,an); + new_abs_face_point(fc9,fc4,10,11,an); + new_abs_face_point(fc10,fc5,12,13,an); + rotate_in_plane(16,fc7,6,15); + rotate_in_plane(17,fc7,15,16); + rotate_in_plane(18,fc8,7,17); + rotate_in_plane(19,fc9,9,18); + rotate_in_plane(20,fc10,11,19); + normalize_obj(inst)(2,20);% opposite vertices + set_point(21)(0,0,0);% center of dodecahedron + free_points(fc)(10); +enddef; +%%\newpage +vardef def_dodecahedron(expr inst)= + save cosan,sinan,an; + new_obj_points(inst,21);% 21 points in the definition + new_obj_faces(inst,12);% 12 faces in the definition + set_dodecahedron_points(inst); + set_obj_face(1,"5,4,3,2,1","ff0fa1"); + set_obj_face(2,"8,7,6,1,2","b40000"); + set_obj_face(3,"10,9,8,2,3","b49b49"); + set_obj_face(4,"12,11,10,3,4","b49bc0"); + set_obj_face(5,"14,13,12,4,5","b4c8fe"); + set_obj_face(6,"6,15,14,5,1","b4fefe"); + set_obj_face(7,"6,7,17,16,15","b4fe40"); + set_obj_face(8,"8,9,18,17,7","45d040"); + set_obj_face(9,"10,11,19,18,9","45a114"); + set_obj_face(10,"11,12,13,20,19","45a1d4"); + set_obj_face(11,"14,15,16,20,13","4569d4"); + set_obj_face(12,"16,17,18,19,20","112da1"); +enddef; + +%%\newpage\title{ICOSAHEDRON (20 faces)\kern1cm\epsfbox{icosa.ps}} + +%%Two faces of an icosahedron are linked in the following way: + +%% \vc{\epsfbox{vect-fig.4}} where $h=c\sqrt3/2$ + +%% $d$ is also a diagonal in a pentagon: \vc{\epsfbox{vect-fig.5}} + +%% $c=2r\sin(\pi/5)$, +%% $d=2r\sin(2\pi/5)=2c\cos(\pi/5)$ + +%% The angle between two faces is computed as follows: +%% \vc{\epsfbox{vect-fig.6}} + +%% We have ${(2\cos(\pi/5))}^2=2{(\sqrt3/2)}^2-2{(\sqrt3/2)}^2\cos\alpha$ + +%% Thus $cos\alpha=1-{8\over3}\cos^2(\pi/5)$ +%%\newpage + +def set_icosahedron_points(expr inst)= + set_point(1)(0,0,0);set_point(2)(1,0,0); + set_point(3)(cosd(60),sind(60),0);% 60=360/6 + cosan=1-8/3*cosd(36)*cosd(36);sinan=sqrt(1-cosan**2); + an=180-angle((cosan,sinan)); + new_face_point(4,1,2,3,an); + new_face_point(5,2,3,1,an); + new_face_point(6,3,1,2,an); + new_face_point(7,2,4,3,an); + new_face_point(8,3,5,1,an); + new_face_point(9,1,6,2,an); + new_face_point(10,3,4,7,an); + new_face_point(11,3,7,5,an); + new_face_point(12,1,8,6,an); + normalize_obj(inst)(1,10);% opposite vertices + set_point(13)(0,0,0);% center of icosahedron +enddef; + +vardef def_icosahedron(expr inst)= + save cosan,sinan,an; + new_obj_points(inst,13);% 12 vertices and the center + new_obj_faces(inst,20);% 20 faces in the definition + set_icosahedron_points(inst); + set_obj_face(1,"3,2,1","b40000"); + set_obj_face(2,"2,3,4","ff0fa1"); + set_obj_face(3,"3,7,4","b49b49"); + set_obj_face(4,"3,5,7","b49bc0"); + set_obj_face(5,"3,1,5","b4c8fe"); + set_obj_face(6,"1,8,5","b4fefe"); + set_obj_face(7,"1,6,8","b4fe40"); + set_obj_face(8,"1,2,6","45d040"); + set_obj_face(9,"2,9,6","45a114"); + set_obj_face(10,"2,4,9","45a1d4"); + set_obj_face(11,"9,4,10","4569d4"); + set_obj_face(12,"4,7,10","112da1"); + set_obj_face(13,"7,5,11","b4fefe"); + set_obj_face(14,"5,8,11","b49bc0"); + set_obj_face(15,"8,6,12","45a114"); + set_obj_face(16,"6,9,12","b49b49"); + set_obj_face(17,"8,12,11","b40000"); + set_obj_face(18,"7,11,10","45a1d4"); + set_obj_face(19,"12,10,11","b4c8fe"); + set_obj_face(20,"9,10,12","ff0fa1"); +enddef; + +%%\newpage\title{General draw functions} + +def draw_polyhedron(expr name)= + draw_faces(name); +enddef; + +let draw_tetrahedron=draw_polyhedron; +let draw_cube=draw_polyhedron; +let draw_octahedron=draw_polyhedron; +let draw_dodecahedron=draw_polyhedron; +let draw_icosahedron=draw_polyhedron; + +let new_poly=assign_obj; + +endinput + diff --git a/Master/texmf-dist/metapost/mp3d/3dutil.mp b/Master/texmf-dist/metapost/mp3d/3dutil.mp new file mode 100644 index 00000000000..e83f5f18c05 --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/3dutil.mp @@ -0,0 +1,37 @@ +%%\input epsf +%%\def\newpage{\vfill\eject} +%%\advance\vsize1in +%%\let\ora\overrightarrow +%%\def\title#1{\hrule\vskip1mm#1\par\vskip1mm\hrule\vskip5mm} +%%\def\figure#1{\par\centerline{\epsfbox{#1}}} +%%\title{{\bf 3DUTIL.MP: 3D UTILITIES IN METAPOST}} + +%% version 1.34, 17 August 2003 +%% {\bf Denis Roegel} ({\tt roegel@loria.fr}) + +% This package provides some basic functions used in certain +% files of the 3d package. + +if known three_d_util_version: + expandafter endinput % avoids loading this package twice +fi; + +message "*** 3dutil, v1.34 (c) D. Roegel 17 August 2003 ***"; +numeric three_d_util_version; three_d_util_version:=1.34; + +% maybe this exists? +def sign(expr n)= + (if n>=0: 1 else: -1 fi) +enddef; + +% +def absmin(expr v,w)= + (if abs(v)<=abs(w):abs(v) else: abs(w) fi) +enddef; + +% +def absmax(expr v,w)= + (if abs(v)>abs(w):abs(v) else: abs(w) fi) +enddef; + +endinput diff --git a/Master/texmf-dist/metapost/mp3d/animpoly.mp b/Master/texmf-dist/metapost/mp3d/animpoly.mp new file mode 100644 index 00000000000..99300950053 --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/animpoly.mp @@ -0,0 +1,35 @@ +% Animation of polyhedra +% Example of use of 3d and poly packages +% METAPOST +% Denis Roegel, 17 August 2003 + +% package 3d +input 3d + +% polyhedra definitions +input 3dpoly + +% animations +input 3danim + +% set scale +drawing_scale:=8cm; + +% +filled_faces:=true; % default value +%filled_faces:=false; + +% +%show_animation_parameters:=true; % default value is |false| + +% animations +%animate_object("tetrahedron",1,100,100); +%animate_object("cube",1,100,100); +%animate_object("octahedron",1,100,100); +%animate_object("dodecahedron",1,100,100); +%animate_object("icosahedron",1,100,100); +%animate_two_objects("dodecahedron","icosahedron",1,100,100); +animate_three_objects("dodecahedron","icosahedron","octahedron",1,100,100); +%animate_two_identical_objects("dodecahedron",1,100,100); + +end diff --git a/Master/texmf-dist/metapost/mp3d/create_animation.sh b/Master/texmf-dist/metapost/mp3d/create_animation.sh new file mode 100644 index 00000000000..e99ca7383ca --- /dev/null +++ b/Master/texmf-dist/metapost/mp3d/create_animation.sh @@ -0,0 +1,15 @@ +#! /bin/sh + +/bin/rm -f animpoly.log +for i in `ls animpoly.*| grep 'animpoly.[0-9]'`;do +echo $i +echo '==============' +awk < $i '{print} /^%%Page: /{print "142 123 translate\n"}' > $i.ps +gs -sDEVICE=ppmraw -sPAPERSIZE=a4 -dNOPAUSE -r36 -sOutputFile=$i.ppm -q -- $i.ps +/bin/rm -f $i.ps +ppmquant 32 $i.ppm | pnmcut 0 114 141 307 | ppmtogif > `expr $i.ppm : '\(.*\)ppm'`gif +/bin/rm -f $i.ppm +done +/bin/rm -f animpoly.gif +gifmerge -10 -l1000 animpoly.*.gif > animpoly.gif +/bin/rm -f animpoly.*.gif diff --git a/Master/texmf-dist/metapost/mpattern/mpattern.mp b/Master/texmf-dist/metapost/mpattern/mpattern.mp new file mode 100644 index 00000000000..2b7cd79e38b --- /dev/null +++ b/Master/texmf-dist/metapost/mpattern/mpattern.mp @@ -0,0 +1,287 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% This file is part of the MPATTERN package +% +% mpattern.mp: MetaPost macros for pattern defining and filling +% +% Author: Piotr Bolek +% version 0.5: (Jun 25, 2001) +% +% $Id: mpattern.mp,v 1.3 2001/06/25 07:28:14 piotrek Exp $ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +boolean P_dict_; +boolean P_used_already_; +% Record all numbers (charcode) of pictures +extra_beginfig := extra_beginfig + & "numeric Pwritten_[]; Pcharcode_[charcode]=1; P_used_already_:=false; P_dict_:=false;"; + +% Working variables to store fragments of Pattern definition +string PBBox_, PHead_, PTail_, PPaintProc_, Pname_, Pdefs_; +string Pmatrix_; + +PHead_="<< /PaintType 1 /PatternType 1 /TilingType 1 "; +% 11.08.98 PPaintProc_="/PaintProc { begin "; +PPaintProc_="/PaintProc { pop "; +% 11.08.98 PTail_=" end } >>"; % matrix makepattern"; +PTail_=" } >>"; % matrix makepattern"; +Pdefs_=""; + +% New line string +string Pnl_; Pnl_=char 13; + +% Number of defined patterns +numeric Pnum_; Pnum_=0; + +% Split string defining pattern on new line chars +% and use each piece as argument to special +vardef Psplit_and_write_(expr s)= + save Pfirst_, Plast_; + Pfirst_:=0; Plast_:=0; + for i=0 upto length(s): + if ( substring (i,i+1) of s = Pnl_ ): + Plast_:=i; + special substring (Pfirst_,Plast_) of s; + Pfirst_:=i+1; + fi; + endfor; +enddef; + +% Find maximum charcode not used for picture yet +vardef Pmax_charcode_= + save Pn_; + for i=999 downto 1: + Pn_:=i; + exitif unknown Pcharcode_[i]; + endfor; + Pn_ +enddef; + +def PmakeBB_= + PBBox_ := "/BBox [" & decimal Plft_ & " " & decimal Plow_ & " " + & decimal Prt_ & " " & decimal Pup_ & "]" & Pnl_; +enddef; + +def Psteps_= + PBBox_ := PBBox_ & "/XStep " & decimal + if unknown PXStep_: (Prt_-Plft_) else: PXStep_ fi & Pnl_ + & "/YStep " & decimal + if unknown PYStep_: (Pup_-Plow_) else: PYStep_ fi; +enddef; + +vardef Pfindbounds_= +% save Plow_, Plft_, Pup_, Prt_; +% numeric Plow_, Plft_, Pup_, Prt_; + + Plow_ = ypart (llcorner currentpicture); + Plft_ = xpart (llcorner currentpicture); + Pup_ = ypart (urcorner currentpicture); + Prt_ = xpart (urcorner currentpicture); + + PmakeBB_; +enddef; + +% Read file in which the body of patterns PaintProc is stored +vardef PReadFile_= + save Pfile_, Pline_, Pall_; + string Pfile_, Pline_, Pall_; + Pline_=Pall_=""; + Pfile_:=jobname & "." & decimal charcode; + forever: + Pline_ := readfrom Pfile_; + exitif Pline_ = EOF; + if (substring(length Pline_-3,length Pline_) of Pline_ = "def") + and (substring (0,6) of Pline_ <> "/fshow"): + Pdefs_ := Pdefs_ & Pline_ & Pnl_; + else: + if (substring (0,2) of Pline_ = "%%") + or (substring (0,8) of Pline_ = "showpage") + or (substring (0,4) of Pline_ = "%!PS") + or (substring (0,6) of Pline_ = "/fshow"): + else: + Pall_:=Pall_ & Pline_ & Pnl_; + fi; + fi; + endfor; + Pall_ +enddef; + +% Join all parts of pattern definition +vardef PmakePattern_(expr name)= + save Pread_; + string Pread_; + + Pread_ = PReadFile_; + + % Write string used later to identify pattern +% batchmode; +% message "Defining pattern " & name & "->" & decimal (Pnum_*epsilon); +% errorstopmode; + "% Pattern:" & + if (not known PColor_): + decimal (Pnum_*epsilon) + else: + decimal (PColor_) + fi + & ":" & name & Pnl_ + & PHead_ & Pnl_ + & PBBox_ & Pnl_ + & Pdefs_ + & PPaintProc_ & Pnl_ + & Pread_ + & PTail_ & Pnl_ + & Pmatrix_ & " makepattern" & Pnl_ + & "/" & name & " exch def" & Pnl_ + & "MPP " & + if (not known PColor_): + decimal (Pnum_*epsilon) + else: + decimal (PColor_) + fi + & " " & name & " put" & Pnl_ +enddef; + +% find PatternColor -- color which will be replaced by pattern +vardef Pfindcolor_(expr s)= + save Pfirst_, Plast_; + numeric Pfirst_, Plast_; + Pfirst_=Plast_=0; + for i=0 upto 255: + if substring(i,i+1) of s=":": + if Pfirst_=0: + Pfirst_:=i+1; + else: + Plast_:=i; + fi; + fi; + exitif Plast_<>0; + endfor; + scantokens (substring (Pfirst_,Plast_) of s) +enddef; + +%%%%%%%%%%%%%% User interface macros + +% Define BoundingBox of pattern +vardef patternbbox(expr a)(text b)= +% save Plft_, Plow_, Prt_, Pup_, Pi_, Pz_; +% numeric Plft_, Plow_, Prt_, Pup_, Pi_, Pz_[]; + save Pi_, Pz_; + numeric Pi_, Pz_[]; + if pair a: + Plft_:=min(xpart(a),xpart(b)); Plow_:=min(ypart(a),ypart(b)); + Prt_:=max(xpart(a),xpart(b)); Pup_:=max(ypart(a),ypart(b)); + else: + Pi_=1; + for t=b: + Pz_[Pi_]=t; + Pi_:=Pi_+1; + endfor; + Plft_:=min(a,Pz_2); Plow_:=min(Pz_1,Pz_3); + Prt_:=max(a,Pz_2); Pup_:=max(Pz_1,Pz_3); + fi; + + PmakeBB_; +enddef; + +def beginpattern(suffix name)= + numeric PXStep_, PYStep_; + numeric Plow_, Plft_, Pup_, Prt_; + numeric PColor_; + Pmatrix_:=" matrix "; + + % Declare variable in which the pattern definition will be stored + string name; + Pname_:=str name; + + Pnum_:=Pnum_+1; + + % Use the largest available picture number (charcode) + % for storing the body od patten PaintProc + beginfig(Pmax_charcode_); +enddef; + +def endpattern= + if unknown PBBox_: + Pfindbounds_; + fi; + endfig; + Psteps_; + + begingroup; + save Punknown_, Ppattern_; + string Punknown_, Ppattern_; + + Ppattern_=PmakePattern_(Pname_); + % free used charcode + Pcharcode_[charcode]:=whatever; + PBBox_:=Punknown_; + Pdefs_:=""; + % Assign pattern to string variable + scantokens(Pname_ & "=Ppattern_;"); + endgroup; +enddef; + +primarydef p withpattern s= + hide( + if not P_dict_: + special "/MPP 100 dict def"; + special "/MPPshow {exch findfont exch scalefont setfont show}bind def"; + special "/fill { MPP currentgray known " & char 10 + & " { MPP currentgray get setpattern fill } { fill } " & char 10 + & " ifelse } bind def"; + special "/fshow { MPP currentgray known " & char 10 + & " { MPP currentgray get setpattern MPPshow } { MPPshow } " & char 10 + & " ifelse } bind def"; + P_dict_:=true; + fi; + Pc_:=Pfindcolor_(s); + % write definition of pattern used in picture + % but not yet written to output file; + if unknown Pwritten_[Pc_]: + Psplit_and_write_(s); + Pwritten_[Pc_]:=1; + fi; + if not P_used_already_: + batchmode; + message "Pattern:" & decimal charcode; + errorstopmode; + P_used_already_:=true; + fi; + %show p; + ) + p withcolor Pc_*white +enddef; + +def patterntransform expr t= + Pmatrix_ := "[ " & decimal xxpart t + & " " & decimal yxpart t + & " " & decimal xypart t + & " " & decimal yypart t + & " " & decimal xpart t + & " " & decimal ypart t & " ]"; +% show Pmatrix_; +enddef; + +def patternxstep expr t= + show t; + PXStep_ = t; +enddef; + +def patternystep expr t= + show t; + PYStep_ = t; +enddef; + +def patternstep text t= + show t; + if pair t: + PXStep_ = xpart t; + PYStep_ = ypart t; + else: + (PXStep_,PYStep_)=t; + fi; +enddef; + +def patterncolor expr t= + show t; + PColor_ = t; +enddef; diff --git a/Master/texmf-dist/metapost/nkarta/nkarta.mp b/Master/texmf-dist/metapost/nkarta/nkarta.mp new file mode 100644 index 00000000000..30c477b9961 --- /dev/null +++ b/Master/texmf-dist/metapost/nkarta/nkarta.mp @@ -0,0 +1,7375 @@ +% Nkarta.mp +% Author: Daniel H. Luecking +% Description: Derived from karta.mf (author and license unknown), this +% is a port to MetaPost code. +% Date: 02 March 2004 +% License: Use at your own risk. If it is found that karta limits +% derived works, nkarta will be subject to those limits. + +% The MF version uses scaling FS#=FontSize/1000. The following therefore +% makes the MP results have the same size as the MF results when +% Fontsize = 15. Of course it is easy to scale the figures to any size. + +pt#:=pt; +FS# := if (known FontSize) and (numeric FontSize): + FontSize + else: + 15pt# + fi/1000; +FS := FS#; + +% The following is essentially the code used in the original karta.mf +% (but here made into a macro instead of being repeated over 200 times). +% This doesn't cause the same problems as that code did in karta.mf +% because Metapost doesn't have a problem with zero or negative +% turningnumber. +boolean debug; debug:=false; + +path P[]; +def drawthem expr t = +if debug: % debug + pickup pencircle scaled .4bp; % +fi % + for n = 1 upto t: +if debug: % + draw (P[n] scaled FS); % +else: % + if ( turningnumber P[n] ) < 0 : + unfill + else : + fill + fi (P[n] scaled FS); +fi % debug + endfor +enddef; + +% Use same code as MF... + +numeric w_, h_, d_; +def beginchar (expr num, wd, ht, dp) = + beginfig (num); w_:=wd; h_:=ht; d_:=dp; +enddef; + +% ... and same bounding box as MF chars. +def endchar = + setbounds currentpicture to (0,-d_)--(w_,-d_)--(w_,h_)--(0,h_)--cycle; + endfig; +enddef; + +input nkchars.mf; +end; + +%beginfig (33); +beginchar (33,560*FS#,650*FS#,0*FS#); +% small circle +P1 := ((30,400) +.. controls (30,260) and (140,150) +.. (280,150) +.. controls (420,150) and (530,260) +.. (530,400) +.. controls (530,540) and (420,650) +.. (280,650) +.. controls (140,650) and (30,540) +.. (30,400) +-- cycle) ; +P2 := ((50,400) +.. controls (50,529) and (151,630) +.. (280,630) +.. controls (409,630) and (510,529) +.. (510,400) +.. controls (510,271) and (409,170) +.. (280,170) +.. controls (151,170) and (50,271) +.. (50,400) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (34); +% dot in triangle in hexagon +P1 := ((605,230) +-- (605,571) +-- (310,741) +-- (15,571) +-- (15,230) +-- (310,60) +-- cycle) ; +P2 := ((585,238) +-- (310,82) +-- (35,238) +-- (35,562) +-- (310,719) +-- (585,562) +-- cycle) ; +P3 := ((513,255) +-- (310,659) +-- (106,255) +-- cycle) ; +P4 := ((140,275) +-- (310,617) +-- (481,275) +-- cycle) ; +P5 := ((268,389) +.. controls (268,365) and (286,347) +.. (310,347) +.. controls (334,347) and (352,365) +.. (352,389) +.. controls (352,414) and (334,432) +.. (310,432) +.. controls (286,432) and (268,414) +.. (268,389) +-- cycle) ; +drawthem 5; +endfig; + +beginfig (35); +% small white triangle +P1 := ((530,150) +-- (280,650) +-- (30,150) +-- cycle) ; +P2 := ((65,170) +-- (280,600) +-- (495,170) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (36); +% small white diamond +P1 := ((563,400) +-- (280,683) +-- (-3,400) +-- (280,117) +-- cycle) ; +P2 := ((280,147) +-- (27,400) +-- (280,653) +-- (533,400) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (37); +% white hexagon +P1 := ((424,150) +-- (569,400) +-- (424,650) +-- (136,650) +-- (-9,400) +-- (136,150) +-- cycle) ; +P2 := ((148,170) +-- (15,400) +-- (148,630) +-- (412,630) +-- (545,400) +-- (412,170) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (38); +% black explosion +P1 := ((1130,192) +-- (1132,194) +-- (928,330) +-- (1166,432) +-- (1164,434) +-- (876,402) +-- (1038,808) +-- (1036,810) +-- (806,542) +-- (790,682) +-- (720,584) +-- (402,916) +-- (400,914) +-- (528,534) +-- (392,558) +-- (518,424) +-- (18,536) +-- (16,534) +-- (420,318) +-- (270,232) +-- (272,230) +-- (446,242) +-- (60,-52) +-- (62,-54) +-- (524,50) +-- (532,-210) +-- (710,24) +-- (804,-88) +-- (810,68) +-- (1230,-216) +-- (1232,-214) +-- (894,224) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (39); +% dot in hexagon +P1 := ((605,230) +-- (605,571) +-- (310,741) +-- (15,571) +-- (15,230) +-- (310,60) +-- cycle) ; +P2 := ((585,238) +-- (310,82) +-- (35,238) +-- (35,562) +-- (310,719) +-- (585,562) +-- cycle) ; +P3 := ((365,400) +.. controls (365,432) and (341,456) +.. (310,456) +.. controls (279,456) and (255,432) +.. (255,400) +.. controls (255,370) and (279,346) +.. (310,346) +.. controls (341,346) and (365,370) +.. (365,400) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (40); +% missile +P1 := ((202,47) +-- (184,47) +-- (150,105) +-- (150,419) +-- (167,464) +-- (135,464) +-- (135,596) +.. controls (135,626) and (126,651) +.. (116,669) +.. controls (106,651) and (97,626) +.. (97,596) +-- (97,464) +-- (65,464) +-- (82,419) +-- (82,105) +-- (48,47) +-- (30,47) +-- (30,23) +-- (40,23) +-- (53,0) +-- (179,0) +-- (192,23) +-- (202,23) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (41); +% rocket +P1 := ((142,545) +.. controls (142,559) and (130,565) +.. (127,565) +-- (127,658) +.. controls (127,679) and (120,699) +.. (112,720) +.. controls (104,699) and (97,679) +.. (97,658) +-- (97,565) +.. controls (94,565) and (82,559) +.. (82,545) +-- (82,389) +.. controls (79,389) and (67,383) +.. (67,369) +-- (67,68) +.. controls (67,52) and (48,38) +.. (30,34) +-- (46,0) +-- (89,0) +-- (112,27) +-- (135,0) +-- (178,0) +-- (194,34) +.. controls (176,38) and (157,52) +.. (157,68) +-- (157,369) +.. controls (157,383) and (145,389) +.. (142,389) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (42); +% alternate black explosion +P1 := ((1538,327) +-- (862,580) +-- (989,1035) +-- (987,1037) +-- (585,616) +-- (440,791) +-- (454,552) +-- (0,468) +-- (317,287) +-- (188,58) +-- (416,58) +-- (463,-237) +-- (661,65) +-- (918,-110) +-- (920,-108) +-- (788,150) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (43); +% three dots +P1 := ((485,175) +.. controls (521,175) and (550,204) +.. (550,240) +.. controls (550,275) and (521,305) +.. (485,305) +.. controls (450,305) and (420,275) +.. (420,240) +.. controls (420,204) and (450,175) +.. (485,175) +-- cycle) ; +P2 := ((115,175) +.. controls (151,175) and (180,204) +.. (180,240) +.. controls (180,275) and (151,305) +.. (115,305) +.. controls (80,305) and (50,275) +.. (50,240) +.. controls (50,204) and (80,175) +.. (115,175) +-- cycle) ; +P3 := ((300,495) +.. controls (336,495) and (365,524) +.. (365,560) +.. controls (365,595) and (336,625) +.. (300,625) +.. controls (265,625) and (235,595) +.. (235,560) +.. controls (235,524) and (265,495) +.. (300,495) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (44); +% ingot +P1 := ((942,613) +.. controls (927,631) and (902,650) +.. (872,655) +-- (718,683) +.. controls (701,686) and (683,676) +.. (662,667) +-- (210,473) +.. controls (170,456) and (159,454) +.. (136,423) +-- (37,288) +.. controls (28,276) and (24,251) +.. (44,243) +-- (330,123) +.. controls (367,108) and (410,115) +.. (444,135) +-- (1004,471) +.. controls (1023,482) and (1034,502) +.. (1020,519) +-- cycle) ; +P2 := ((224,421) +.. controls (204,428) and (212,442) +.. (238,453) +-- (679,642) +.. controls (698,650) and (709,656) +.. (728,653) +-- (826,635) +.. controls (849,631) and (839,622) +.. (825,614) +-- (401,382) +.. controls (387,374) and (373,368) +.. (354,375) +-- cycle) ; +P3 := ((350,341) +.. controls (366,335) and (378,325) +.. (378,293) +-- (378,187) +.. controls (378,169) and (364,149) +.. (330,163) +-- (92,263) +.. controls (67,273) and (74,288) +.. (88,307) +-- (148,389) +.. controls (162,408) and (174,403) +.. (195,396) +-- cycle) ; +P4 := ((871,597) +.. controls (888,607) and (902,601) +.. (912,589) +-- (968,521) +.. controls (985,501) and (972,490) +.. (950,477) +-- (454,179) +.. controls (418,157) and (408,165) +.. (408,201) +-- (408,311) +.. controls (408,335) and (416,348) +.. (430,356) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (45); +% lighthouse +P1 := ((323,587) +-- (343,587) +-- (343,807) +-- (323,807) +-- cycle) ; +P2 := ((409,572) +-- (423,558) +-- (579,713) +-- (565,728) +-- cycle) ; +P3 := ((446,524) +-- (446,504) +-- (666,504) +-- (666,524) +-- cycle) ; +P4 := ((243,558) +-- (257,572) +-- (102,728) +-- (87,714) +-- cycle) ; +P5 := ((220,504) +-- (220,524) +-- (0,524) +-- (0,504) +-- cycle) ; +P6 := ((473,0) +-- (398,500) +.. controls (394,524) and (378,540) +.. (353,540) +-- (313,540) +.. controls (288,540) and (271,524) +.. (267,500) +-- (193,0) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (46); +% crossed picks +P1 := ((372,370) +-- (589,586) +-- (608,567) +.. controls (632,542) and (654,508) +.. (662,472) +-- (695,505) +.. controls (683,540) and (652,585) +.. (613,624) +.. controls (553,684) and (444,699) +.. (395,641) +.. controls (462,658) and (521,654) +.. (550,625) +-- (567,607) +-- (351,391) +-- (135,607) +-- (152,625) +.. controls (181,654) and (240,658) +.. (307,641) +.. controls (258,699) and (149,684) +.. (89,624) +.. controls (50,585) and (19,540) +.. (7,505) +-- (40,472) +.. controls (48,508) and (70,542) +.. (94,567) +-- (113,586) +-- (330,370) +-- (66,106) +-- (87,84) +-- (351,349) +-- (615,84) +-- (637,105) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (47); +% circle with two black quadrants +P1 := ((60,400) +.. controls (60,260) and (170,150) +.. (310,150) +.. controls (450,150) and (560,260) +.. (560,400) +.. controls (560,540) and (450,650) +.. (310,650) +.. controls (170,650) and (60,540) +.. (60,400) +-- cycle) ; +P2 := ((312,170) +.. controls (181,170) and (80,271) +.. (80,402) +-- (308,402) +-- (308,630) +.. controls (439,630) and (540,529) +.. (540,398) +-- (312,398) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (48); +% the digit 0 +P1 := ((150,-4) +.. controls (230,-5) and (291,59) +.. (291,199) +.. controls (291,339) and (230,404) +.. (150,404) +.. controls (70,404) and (9,339) +.. (9,199) +.. controls (9,59) and (70,-3) +.. (150,-4) +-- cycle) ; +P2 := ((150,58) +.. controls (98,58) and (71,115) +.. (71,199) +.. controls (71,284) and (98,342) +.. (150,342) +.. controls (202,342) and (229,284) +.. (229,199) +.. controls (229,115) and (202,58) +.. (150,58) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (49); +% the digit 1 +P1 := ((99,320) +-- (139,320) +-- (139,0) +-- (201,0) +-- (201,400) +-- (146,400) +.. controls (136,384) and (116,373) +.. (99,370) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (50); +% the digit 2 +P1 := ((284,0) +-- (284,62) +-- (90,62) +.. controls (94,95) and (118,123) +.. (145,142) +.. controls (197,179) and (286,203) +.. (288,292) +.. controls (289,347) and (243,404) +.. (151,404) +.. controls (79,404) and (28,353) +.. (16,299) +-- (75,285) +.. controls (88,324) and (106,342) +.. (152,342) +.. controls (192,342) and (226,322) +.. (226,289) +.. controls (226,245) and (128,207) +.. (82,169) +.. controls (38,133) and (13,75) +.. (13,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (51); +% the digit 3 +P1 := ((153,186) +.. controls (204,188) and (225,160) +.. (225,132) +.. controls (225,99) and (194,58) +.. (150,58) +.. controls (94,58) and (80,95) +.. (74,115) +-- (13,99) +.. controls (33,34) and (79,-2) +.. (146,-4) +.. controls (217,-5) and (287,58) +.. (287,134) +.. controls (287,174) and (266,207) +.. (251,217) +.. controls (266,243) and (273,262) +.. (273,297) +.. controls (273,332) and (248,404) +.. (148,404) +.. controls (82,404) and (47,353) +.. (31,327) +-- (91,302) +.. controls (104,326) and (117,342) +.. (151,342) +.. controls (180,342) and (211,319) +.. (211,291) +.. controls (211,265) and (197,248) +.. (181,248) +-- (153,248) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (52); +% the digit 4 +P1 := ((203,400) +-- (0,137) +-- (0,101) +-- (200,101) +-- (200,0) +-- (262,0) +-- (262,101) +-- (299,101) +-- (299,156) +-- (262,156) +-- (262,400) +-- cycle) ; +P2 := ((200,300) +-- (200,156) +-- (89,156) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (53); +% the digit 5 +P1 := ((28,198) +-- (85,180) +.. controls (98,206) and (120,217) +.. (148,217) +.. controls (186,217) and (225,194) +.. (225,148) +.. controls (225,69) and (150,58) +.. (111,58) +.. controls (83,58) and (64,65) +.. (44,76) +-- (13,18) +.. controls (34,9) and (69,-5) +.. (117,-4) +.. controls (209,-1) and (287,62) +.. (287,148) +.. controls (287,230) and (213,279) +.. (145,279) +.. controls (122,279) and (110,278) +.. (94,270) +-- (97,338) +-- (264,338) +-- (264,400) +-- (37,400) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (54); +% the digit 6 +P1 := ((171,404) +.. controls (65,325) and (11,211) +.. (11,126) +.. controls (11,32) and (88,-4) +.. (150,-4) +.. controls (212,-4) and (289,42) +.. (289,118) +.. controls (289,196) and (229,241) +.. (157,241) +.. controls (137,241) and (120,240) +.. (104,235) +.. controls (138,302) and (186,347) +.. (205,356) +-- cycle) ; +P2 := ((150,58) +.. controls (96,59) and (73,89) +.. (73,119) +.. controls (73,148) and (96,179) +.. (150,179) +.. controls (204,179) and (227,148) +.. (227,119) +.. controls (227,89) and (204,57) +.. (150,58) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (55); +% the digit 7 +P1 := ((163,0) +.. controls (169,160) and (228,282) +.. (286,333) +-- (286,400) +-- (14,400) +-- (14,338) +-- (207,338) +.. controls (136,243) and (99,123) +.. (101,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (56); +% the digit 8 +P1 := ((150,-4) +.. controls (230,-3) and (284,50) +.. (284,126) +.. controls (284,181) and (258,203) +.. (238,219) +.. controls (247,233) and (270,251) +.. (270,292) +.. controls (270,349) and (226,404) +.. (150,404) +.. controls (74,404) and (30,345) +.. (30,288) +.. controls (30,247) and (53,229) +.. (62,215) +.. controls (42,199) and (16,177) +.. (16,122) +.. controls (16,50) and (70,-5) +.. (150,-4) +-- cycle) ; +P2 := ((150,245) +.. controls (111,245) and (92,271) +.. (92,293) +.. controls (92,316) and (111,342) +.. (150,342) +.. controls (189,342) and (208,316) +.. (208,293) +.. controls (208,271) and (189,245) +.. (150,245) +-- cycle) ; +P3 := ((150,186) +.. controls (201,186) and (222,156) +.. (222,121) +.. controls (222,88) and (201,58) +.. (150,58) +.. controls (99,58) and (78,88) +.. (78,121) +.. controls (78,156) and (99,186) +.. (150,186) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (57); +% the digit 9 +P1 := ((120,-4) +.. controls (228,71) and (286,183) +.. (289,268) +.. controls (292,361) and (217,400) +.. (155,402) +.. controls (93,404) and (14,361) +.. (11,286) +.. controls (9,208) and (67,160) +.. (140,158) +.. controls (160,157) and (176,158) +.. (192,163) +.. controls (156,96) and (106,54) +.. (88,46) +-- cycle) ; +P2 := ((150,342) +.. controls (204,342) and (227,311) +.. (227,281) +.. controls (227,251) and (204,219) +.. (150,220) +.. controls (96,221) and (73,251) +.. (73,281) +.. controls (73,311) and (96,342) +.. (150,342) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (58); +% dot in square +P1 := ((560,150) +-- (560,650) +-- (60,650) +-- (60,150) +-- cycle) ; +P2 := ((80,170) +-- (80,630) +-- (540,630) +-- (540,170) +-- cycle) ; +P3 := ((255,400) +.. controls (255,369) and (279,345) +.. (310,345) +.. controls (341,345) and (365,369) +.. (365,400) +.. controls (365,431) and (341,455) +.. (310,455) +.. controls (279,455) and (255,431) +.. (255,400) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (59); +% dot in circle +P1 := ((60,400) +.. controls (60,260) and (170,150) +.. (310,150) +.. controls (450,150) and (560,260) +.. (560,400) +.. controls (560,540) and (450,650) +.. (310,650) +.. controls (170,650) and (60,540) +.. (60,400) +-- cycle) ; +P2 := ((80,400) +.. controls (80,529) and (181,630) +.. (310,630) +.. controls (439,630) and (540,529) +.. (540,400) +.. controls (540,271) and (439,170) +.. (310,170) +.. controls (181,170) and (80,271) +.. (80,400) +-- cycle) ; +P3 := ((255,400) +.. controls (255,369) and (279,345) +.. (310,345) +.. controls (341,345) and (365,369) +.. (365,400) +.. controls (365,431) and (341,455) +.. (310,455) +.. controls (279,455) and (255,431) +.. (255,400) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (60); +% hexagonal slab +P1 := ((468,157) +-- (568,208) +-- (670,402) +-- (546,643) +-- (209,643) +-- (112,593) +-- (30,384) +-- (130,157) +-- cycle) ; +P2 := ((145,177) +-- (52,387) +-- (129,583) +-- (467,583) +-- (568,384) +-- (462,177) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (61); +% signpost +P1 := ((140,640) +-- (30,640) +-- (30,610) +-- (140,610) +-- (140,0) +-- (170,0) +-- (170,610) +-- (264,610) +-- (264,389) +-- (486,389) +-- (486,610) +-- (584,610) +-- (584,640) +-- (170,640) +-- (170,750) +-- (140,750) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (62); +% small black circle on line, two of them, crossed +P1 := ((153,260) +.. controls (129,285) and (86,277) +.. (58,249) +.. controls (30,221) and (30,171) +.. (58,143) +.. controls (86,115) and (136,115) +.. (164,143) +.. controls (192,171) and (199,214) +.. (175,239) +-- (316,380) +-- (463,231) +.. controls (439,207) and (446,164) +.. (473,136) +.. controls (502,108) and (551,108) +.. (579,136) +.. controls (608,164) and (608,214) +.. (579,242) +.. controls (551,270) and (509,277) +.. (484,253) +-- (337,401) +-- (602,666) +-- (580,687) +-- (316,422) +-- (52,687) +-- (30,666) +-- (295,401) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (63); +% diagonally divided square +P1 := ((538,146) +-- (538,654) +-- (30,654) +-- (30,146) +-- cycle) ; +P2 := ((518,634) +-- (518,166) +-- (50,166) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (64); +% small white square +P1 := ((480,200) +-- (480,600) +-- (80,600) +-- (80,200) +-- cycle) ; +P2 := ((100,220) +-- (100,580) +-- (460,580) +-- (460,220) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (65); +% snowflake +P1 := ((342,372) +-- (463,303) +-- (469,194) +-- (498,192) +-- (493,286) +-- (579,236) +-- (593,261) +-- (506,311) +-- (590,354) +-- (573,376) +-- (477,328) +-- (357,401) +-- (477,472) +-- (573,423) +-- (590,446) +-- (506,489) +-- (593,539) +-- (579,564) +-- (493,514) +-- (498,608) +-- (469,605) +-- (463,497) +-- (342,428) +-- (342,567) +-- (432,626) +-- (420,652) +-- (342,601) +-- (342,701) +-- (312,701) +-- (312,601) +-- (234,652) +-- (223,626) +-- (312,567) +-- (312,428) +-- (192,497) +-- (186,605) +-- (156,608) +-- (161,514) +-- (75,564) +-- (60,539) +-- (148,489) +-- (63,446) +-- (81,423) +-- (176,472) +-- (297,401) +-- (176,328) +-- (81,376) +-- (63,354) +-- (148,311) +-- (60,261) +-- (75,236) +-- (161,286) +-- (156,192) +-- (186,194) +-- (192,303) +-- (312,372) +-- (312,233) +-- (223,174) +-- (234,148) +-- (312,199) +-- (312,99) +-- (342,99) +-- (342,199) +-- (420,148) +-- (432,174) +-- (342,233) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (66); +% cross on a circle +P1 := ((230,750) +-- (230,629) +-- (126,629) +-- (126,574) +-- (230,574) +-- (230,320) +.. controls (155,305) and (100,240) +.. (100,160) +.. controls (100,71) and (171,0) +.. (260,0) +.. controls (351,0) and (420,71) +.. (420,160) +.. controls (420,240) and (367,305) +.. (290,320) +-- (290,574) +-- (396,574) +-- (396,629) +-- (290,629) +-- (290,750) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (67); +% cityscape +P1 := ((150,50) +-- (30,50) +-- (30,0) +-- (860,0) +-- (860,50) +-- (740,50) +-- (740,608) +-- (670,608) +-- (670,420) +-- (630,420) +-- (630,524) +-- (580,614) +-- (530,524) +-- (530,265) +-- (490,265) +-- (490,700) +-- (360,700) +-- (360,360) +-- (290,360) +-- (290,200) +-- (250,200) +-- (250,490) +-- (150,490) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (68); +% closed tent +P1 := ((380,553) +-- (122,40) +-- (30,40) +-- (30,0) +-- (730,0) +-- (730,40) +-- (638,40) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (69); +% white star +P1 := ((347,697) +-- (260,471) +-- (30,471) +-- (206,329) +-- (141,102) +-- (347,236) +-- (553,102) +-- (478,329) +-- (664,471) +-- (435,471) +-- cycle) ; +P2 := ((416,451) +-- (595,451) +-- (450,340) +-- (510,157) +-- (347,267) +-- (184,157) +-- (237,340) +-- (99,451) +-- (279,451) +-- (347,634) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (70); +% hikers +P1 := ((109,538) +.. controls (109,511) and (130,491) +.. (157,491) +.. controls (183,491) and (204,511) +.. (204,538) +.. controls (204,564) and (183,585) +.. (157,585) +.. controls (130,585) and (109,564) +.. (109,538) +-- cycle) ; +P2 := ((416,491) +.. controls (416,466) and (436,447) +.. (460,447) +.. controls (485,447) and (504,466) +.. (504,491) +.. controls (504,515) and (485,535) +.. (460,535) +.. controls (436,535) and (416,515) +.. (416,491) +-- cycle) ; +P3 := ((284,511) +.. controls (278,525) and (272,526) +.. (260,519) +-- (250,514) +.. controls (237,507) and (236,503) +.. (243,489) +-- (301,379) +.. controls (307,366) and (313,365) +.. (326,372) +-- (335,376) +.. controls (348,384) and (350,388) +.. (343,401) +-- cycle) ; +P4 := ((580,463) +.. controls (575,474) and (570,475) +.. (559,470) +-- (551,465) +.. controls (540,460) and (538,455) +.. (544,444) +-- (595,349) +.. controls (600,338) and (604,337) +.. (615,343) +-- (624,348) +.. controls (635,353) and (636,357) +.. (631,368) +-- cycle) ; +P5 := ((350,-7) +-- (382,16) +-- (292,261) +.. controls (315,284) and (315,321) +.. (302,351) +-- (239,469) +.. controls (225,495) and (205,493) +.. (189,488) +.. controls (159,481) and (146,452) +.. (144,436) +-- (136,363) +-- (30,294) +-- (36,273) +-- (53,279) +-- (150,124) +-- (125,7) +-- (173,-9) +-- (189,62) +-- (226,0) +-- (254,0) +-- (195,95) +-- (204,140) +-- (245,206) +-- cycle) ; +P6 := ((519,0) +-- (546,0) +-- (494,91) +-- (509,148) +-- (538,181) +-- (630,-4) +-- (659,19) +-- (585,245) +.. controls (604,264) and (612,289) +.. (593,324) +-- (540,426) +.. controls (527,449) and (507,450) +.. (494,443) +.. controls (471,431) and (452,422) +.. (448,399) +-- (442,349) +-- (340,271) +-- (350,252) +-- (368,261) +-- (452,117) +-- (425,11) +-- (469,-4) +-- (486,57) +-- cycle) ; +P7 := ((207,290) +.. controls (188,269) and (170,222) +.. (157,157) +-- (75,287) +-- (164,320) +-- (175,355) +-- cycle) ; +P8 := ((509,271) +-- (470,194) +-- (459,152) +-- (390,273) +-- (458,310) +-- (477,349) +-- cycle) ; +drawthem 8; +endfig; + +beginfig (71); +% shelter +P1 := ((500,0) +-- (500,30) +-- (428,30) +-- (428,226) +-- (500,207) +-- (500,237) +-- (50,358) +-- (50,328) +-- (122,309) +-- (122,30) +-- (50,30) +-- (50,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (72); +% boat on ramp +P1 := ((150,309) +.. controls (146,310) and (141,307) +.. (140,303) +-- (138,292) +.. controls (137,287) and (140,283) +.. (144,282) +-- (412,225) +.. controls (416,224) and (421,227) +.. (422,231) +-- (424,243) +.. controls (425,247) and (421,252) +.. (418,253) +-- cycle) ; +P2 := ((641,206) +.. controls (637,207) and (632,204) +.. (631,200) +-- (629,189) +.. controls (628,184) and (631,180) +.. (635,179) +-- (903,122) +.. controls (907,121) and (912,124) +.. (913,128) +-- (915,140) +.. controls (916,144) and (912,149) +.. (909,150) +-- cycle) ; +P3 := ((523,292) +.. controls (479,292) and (450,263) +.. (450,219) +.. controls (450,175) and (479,146) +.. (523,146) +.. controls (567,146) and (596,175) +.. (596,219) +.. controls (596,263) and (567,292) +.. (523,292) +-- cycle) ; +P4 := ((996,24) +.. controls (996,30) and (990,35) +.. (984,36) +-- (71,227) +.. controls (40,233) and (30,224) +.. (30,206) +-- (30,0) +-- (460,0) +.. controls (482,0) and (507,14) +.. (520,35) +.. controls (533,14) and (558,0) +.. (580,0) +.. controls (602,0) and (627,14) +.. (640,35) +.. controls (653,14) and (678,0) +.. (700,0) +.. controls (722,0) and (747,14) +.. (760,35) +.. controls (773,14) and (798,0) +.. (820,0) +.. controls (842,0) and (867,14) +.. (880,35) +.. controls (893,14) and (918,0) +.. (940,0) +-- (996,0) +-- cycle) ; +P5 := ((427,504) +-- (427,524) +-- (414,524) +-- (326,445) +-- (120,488) +-- (114,456) +.. controls (103,397) and (187,337) +.. (245,325) +-- (442,284) +.. controls (462,280) and (484,320) +.. (544,307) +.. controls (602,294) and (607,251) +.. (626,246) +-- (892,190) +.. controls (912,186) and (925,199) +.. (928,217) +-- (940,289) +.. controls (943,305) and (933,317) +.. (915,321) +-- (354,439) +-- cycle) ; +P6 := ((523,269) +.. controls (553,269) and (573,249) +.. (573,219) +.. controls (573,189) and (553,169) +.. (523,169) +.. controls (493,169) and (473,189) +.. (473,219) +.. controls (473,249) and (493,269) +.. (523,269) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (73); +% white keystone +P1 := ((702,-58) +.. controls (736,-58) and (742,-50) +.. (753,-18) +-- (931,539) +.. controls (939,563) and (946,593) +.. (946,619) +.. controls (946,659) and (909,700) +.. (867,718) +-- (581,837) +.. controls (553,849) and (513,857) +.. (473,857) +.. controls (433,857) and (393,849) +.. (366,837) +-- (79,718) +.. controls (38,700) and (0,659) +.. (0,619) +.. controls (0,593) and (7,563) +.. (15,539) +-- (193,-18) +.. controls (205,-50) and (210,-58) +.. (245,-58) +-- cycle) ; +P2 := ((260,-28) +.. controls (227,-28) and (223,-21) +.. (216,0) +-- (45,530) +.. controls (38,552) and (30,580) +.. (30,605) +.. controls (30,642) and (67,680) +.. (105,697) +-- (373,808) +.. controls (398,820) and (436,827) +.. (473,827) +.. controls (510,827) and (548,820) +.. (574,808) +-- (841,697) +.. controls (880,680) and (916,642) +.. (916,605) +.. controls (916,580) and (908,552) +.. (901,530) +-- (731,0) +.. controls (724,-21) and (719,-28) +.. (687,-28) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (74); +% airplane +P1 := ((365,104) +-- (367,104) +-- (377,214) +-- (391,190) +-- (487,197) +-- (487,243) +.. controls (487,251) and (484,259) +.. (479,260) +-- (381,269) +-- (400,453) +-- (550,453) +-- (702,484) +-- (702,531) +.. controls (702,540) and (697,543) +.. (689,544) +-- (546,556) +-- (405,556) +.. controls (402,612) and (400,650) +.. (398,655) +.. controls (394,660) and (384,662) +.. (379,662) +.. controls (374,677) and (372,697) +.. (366,697) +.. controls (360,697) and (358,677) +.. (353,662) +.. controls (348,662) and (338,660) +.. (335,655) +.. controls (332,650) and (330,612) +.. (327,556) +-- (186,556) +-- (43,544) +.. controls (35,543) and (30,540) +.. (30,531) +-- (30,484) +-- (182,453) +-- (332,453) +-- (351,269) +-- (253,260) +.. controls (248,259) and (245,251) +.. (245,243) +-- (245,197) +-- (341,190) +-- (355,214) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (75); +% chevron +P1 := ((221,600) +-- (50,600) +-- (136,300) +-- (50,0) +-- (221,0) +-- (307,300) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (76); +% white rectangle +P1 := ((60,810) +.. controls (30,810) and (0,780) +.. (0,750) +-- (0,50) +.. controls (0,20) and (30,-8) +.. (60,-10) +-- (960,-10) +.. controls (990,-10) and (1020,20) +.. (1020,50) +-- (1020,750) +.. controls (1020,780) and (990,810) +.. (960,810) +-- cycle) ; +P2 := ((941,780) +.. controls (969,780) and (990,760) +.. (990,732) +-- (990,68) +.. controls (990,40) and (969,20) +.. (941,20) +-- (78,20) +.. controls (50,22) and (30,40) +.. (30,68) +-- (30,732) +.. controls (30,760) and (50,780) +.. (78,780) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (77); +% derrick +P1 := ((30,-52) +-- (61,-52) +-- (278,311) +-- (278,206) +.. controls (264,206) and (256,194) +.. (256,174) +-- (256,-52) +-- (330,-52) +-- (330,174) +.. controls (330,191) and (322,206) +.. (308,206) +-- (308,311) +-- (525,-52) +-- (556,-52) +-- (402,850) +-- (308,850) +-- (308,890) +-- (278,890) +-- (278,850) +-- (184,850) +-- cycle) ; +P2 := ((478,317) +-- (538,-32) +-- (533,-32) +-- (324,317) +-- cycle) ; +P3 := ((308,337) +-- (308,632) +-- (311,632) +-- (466,337) +-- cycle) ; +P4 := ((120,337) +-- (275,632) +-- (278,632) +-- (278,337) +-- cycle) ; +P5 := ((424,632) +-- (468,374) +-- (466,374) +-- (330,632) +-- cycle) ; +P6 := ((256,632) +-- (120,374) +-- (118,374) +-- (162,632) +-- cycle) ; +P7 := ((308,652) +-- (308,830) +-- (312,830) +-- (402,652) +-- cycle) ; +P8 := ((184,652) +-- (274,830) +-- (278,830) +-- (278,652) +-- cycle) ; +P9 := ((390,830) +-- (418,668) +-- (413,668) +-- (330,830) +-- cycle) ; +P10 := ((256,830) +-- (173,668) +-- (168,668) +-- (196,830) +-- cycle) ; +P11 := ((261,317) +-- (53,-32) +-- (48,-32) +-- (108,317) +-- cycle) ; +drawthem 11; +endfig; + +beginfig (78); +% radiation +P1 := ((459,511) +.. controls (414,539) and (367,554) +.. (317,554) +.. controls (267,554) and (220,539) +.. (175,511) +-- (276,337) +.. controls (292,345) and (302,351) +.. (317,351) +.. controls (332,351) and (350,345) +.. (366,337) +-- cycle) ; +P2 := ((414,251) +.. controls (413,233) and (410,214) +.. (403,201) +.. controls (396,187) and (386,181) +.. (371,171) +-- (478,0) +.. controls (524,27) and (559,61) +.. (582,105) +.. controls (606,150) and (615,198) +.. (611,251) +-- cycle) ; +P3 := ((31,251) +.. controls (27,198) and (36,150) +.. (60,105) +.. controls (83,61) and (118,27) +.. (164,0) +-- (271,171) +.. controls (256,181) and (246,187) +.. (239,201) +.. controls (232,214) and (229,233) +.. (228,251) +-- cycle) ; +P4 := ((273,254) +.. controls (273,227) and (294,206) +.. (321,206) +.. controls (348,206) and (369,227) +.. (369,254) +.. controls (369,281) and (348,302) +.. (321,302) +.. controls (294,302) and (273,281) +.. (273,254) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (79); +% white oval +P1 := ((0,411) +.. controls (0,194) and (311,22) +.. (721,22) +.. controls (1125,22) and (1442,194) +.. (1442,411) +.. controls (1442,628) and (1125,799) +.. (721,799) +.. controls (318,799) and (0,628) +.. (0,411) +-- cycle) ; +P2 := ((30,411) +.. controls (30,611) and (335,769) +.. (721,769) +.. controls (1108,769) and (1412,611) +.. (1412,411) +.. controls (1412,211) and (1108,52) +.. (721,52) +.. controls (328,52) and (30,211) +.. (30,411) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (80); +% large white triangle-down +P1 := ((52,899) +.. controls (0,899) and (-13,876) +.. (12,830) +-- (537,-66) +.. controls (563,-111) and (591,-111) +.. (617,-66) +-- (1142,830) +.. controls (1167,876) and (1154,899) +.. (1102,899) +-- cycle) ; +P2 := ((1065,869) +.. controls (1116,869) and (1125,858) +.. (1102,819) +-- (606,-28) +.. controls (584,-66) and (570,-66) +.. (548,-28) +-- (52,819) +.. controls (29,858) and (38,869) +.. (89,869) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (81); +% parthenon +P1 := ((95,80) +-- (149,80) +-- (149,452) +-- (95,452) +-- cycle) ; +P2 := ((203,80) +-- (257,80) +-- (257,452) +-- (203,452) +-- cycle) ; +P3 := ((311,80) +-- (365,80) +-- (365,452) +-- (311,452) +-- cycle) ; +P4 := ((419,80) +-- (473,80) +-- (473,452) +-- (419,452) +-- cycle) ; +P5 := ((527,80) +-- (581,80) +-- (581,452) +-- (527,452) +-- cycle) ; +P6 := ((338,750) +-- (30,482) +-- (646,482) +-- cycle) ; +P7 := ((626,0) +-- (626,50) +-- (50,50) +-- (50,0) +-- cycle) ; +drawthem 7; +endfig; + +beginfig (82); +% medium white circle +P1 := ((30,400) +.. controls (30,223) and (170,83) +.. (347,83) +.. controls (524,83) and (665,223) +.. (665,400) +.. controls (665,577) and (524,717) +.. (347,717) +.. controls (170,717) and (30,577) +.. (30,400) +-- cycle) ; +P2 := ((410,491) +-- (620,491) +-- (450,364) +-- (516,164) +-- (348,288) +-- (179,164) +-- (246,364) +-- (76,491) +-- (285,491) +-- (348,687) +-- cycle) ; +P3 := ((60,400) +.. controls (60,561) and (187,687) +.. (348,687) +.. controls (508,687) and (635,561) +.. (635,400) +.. controls (635,239) and (508,113) +.. (348,113) +.. controls (187,113) and (60,239) +.. (60,400) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (83); +% flying duck +P1 := ((677,505) +.. controls (673,538) and (762,498) +.. (819,500) +.. controls (871,504) and (876,544) +.. (933,557) +-- (933,560) +.. controls (832,569) and (706,704) +.. (567,704) +.. controls (507,704) and (410,633) +.. (341,633) +.. controls (278,633) and (226,713) +.. (187,713) +.. controls (122,713) and (108,617) +.. (38,628) +.. controls (27,629) and (27,613) +.. (38,612) +.. controls (99,600) and (75,602) +.. (125,600) +.. controls (165,600) and (194,633) +.. (215,633) +.. controls (248,633) and (276,609) +.. (302,583) +.. controls (342,543) and (403,522) +.. (403,494) +-- (403,258) +.. controls (403,204) and (380,140) +.. (347,87) +.. controls (410,117) and (524,187) +.. (550,266) +.. controls (567,316) and (642,448) +.. (671,448) +.. controls (761,448) and (722,431) +.. (772,431) +.. controls (788,431) and (803,429) +.. (819,426) +.. controls (811,436) and (796,440) +.. (784,442) +.. controls (781,455) and (779,465) +.. (767,465) +.. controls (745,465) and (712,460) +.. (680,469) +-- cycle) ; +fill P1 scaled FS; +endfig; + +beginfig (84); +% small white circle in medium white circle +P1 := ((30,400) +.. controls (30,223) and (170,83) +.. (347,83) +.. controls (524,83) and (665,223) +.. (665,400) +.. controls (665,577) and (524,717) +.. (347,717) +.. controls (170,717) and (30,577) +.. (30,400) +-- cycle) ; +P2 := ((60,400) +.. controls (60,561) and (187,687) +.. (348,687) +.. controls (508,687) and (635,561) +.. (635,400) +.. controls (635,239) and (508,113) +.. (348,113) +.. controls (187,113) and (60,239) +.. (60,400) +-- cycle) ; +P3 := ((531,400) +.. controls (531,508) and (456,584) +.. (348,584) +.. controls (240,584) and (164,508) +.. (164,400) +.. controls (164,292) and (240,216) +.. (348,216) +.. controls (456,216) and (531,292) +.. (531,400) +-- cycle) ; +P4 := ((501,400) +.. controls (501,309) and (438,246) +.. (348,246) +.. controls (257,246) and (194,309) +.. (194,400) +.. controls (194,491) and (257,554) +.. (348,554) +.. controls (438,554) and (501,491) +.. (501,400) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (85); +% fancy shield, black top +P1 := ((30,748) +.. controls (58,736) and (97,664) +.. (97,608) +.. controls (97,545) and (0,460) +.. (0,299) +.. controls (0,83) and (151,-88) +.. (265,-88) +.. controls (315,-88) and (344,-79) +.. (367,-69) +.. controls (391,-60) and (409,-50) +.. (425,-50) +.. controls (456,-50) and (499,-84) +.. (531,-122) +.. controls (563,-84) and (607,-50) +.. (638,-50) +.. controls (654,-50) and (672,-60) +.. (696,-69) +.. controls (719,-79) and (747,-88) +.. (798,-88) +.. controls (912,-88) and (1063,83) +.. (1063,299) +.. controls (1063,460) and (966,545) +.. (966,608) +.. controls (967,664) and (1006,736) +.. (1034,748) +-- (845,921) +.. controls (793,862) and (741,824) +.. (689,824) +.. controls (637,824) and (555,862) +.. (531,921) +.. controls (509,862) and (427,824) +.. (375,824) +.. controls (323,824) and (271,862) +.. (218,921) +-- cycle) ; +P2 := ((936,608) +.. controls (951,511) and (1033,452) +.. (1033,299) +.. controls (1033,124) and (911,-58) +.. (795,-58) +.. controls (764,-58) and (733,-55) +.. (710,-46) +.. controls (687,-37) and (670,-20) +.. (632,-20) +.. controls (595,-17) and (562,-53) +.. (531,-83) +.. controls (500,-53) and (467,-17) +.. (430,-20) +.. controls (392,-20) and (375,-37) +.. (352,-46) +.. controls (329,-55) and (298,-58) +.. (267,-58) +.. controls (151,-58) and (29,124) +.. (29,299) +.. controls (29,452) and (111,511) +.. (126,608) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (86); +% banner on square +P1 := ((420,0) +-- (420,320) +-- (275,320) +-- (275,499) +-- (420,625) +-- (245,750) +-- (245,320) +-- (100,320) +-- (100,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (87); +% black maple leaf +P1 := ((499,-48) +-- (499,134) +.. controls (499,158) and (512,180) +.. (528,180) +.. controls (554,180) and (659,145) +.. (711,137) +.. controls (704,158) and (700,186) +.. (700,202) +.. controls (700,226) and (856,332) +.. (938,394) +.. controls (896,396) and (846,396) +.. (846,428) +.. controls (846,472) and (872,520) +.. (890,554) +.. controls (824,530) and (778,518) +.. (746,518) +.. controls (730,518) and (734,583) +.. (739,607) +-- (737,609) +.. controls (678,529) and (624,440) +.. (596,440) +.. controls (564,440) and (577,482) +.. (584,513) +.. controls (603,592) and (628,676) +.. (645,750) +.. controls (612,722) and (586,700) +.. (566,700) +.. controls (534,700) and (500,780) +.. (485,848) +-- (483,848) +.. controls (468,780) and (434,700) +.. (402,700) +.. controls (382,700) and (356,722) +.. (323,750) +.. controls (340,676) and (365,592) +.. (384,513) +.. controls (391,482) and (404,440) +.. (372,440) +.. controls (344,440) and (290,529) +.. (231,609) +-- (229,607) +.. controls (234,583) and (238,518) +.. (222,518) +.. controls (190,518) and (144,530) +.. (78,554) +.. controls (96,520) and (122,472) +.. (122,428) +.. controls (122,396) and (72,396) +.. (30,394) +.. controls (112,332) and (268,226) +.. (268,202) +.. controls (268,186) and (264,158) +.. (257,137) +.. controls (309,145) and (414,180) +.. (440,180) +.. controls (456,180) and (469,158) +.. (469,134) +-- (469,-48) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (88); +% handicapped +P1 := ((170,428) +.. controls (114,412) and (30,358) +.. (30,228) +.. controls (30,105) and (128,0) +.. (256,0) +.. controls (372,0) and (450,62) +.. (489,117) +-- (469,175) +.. controls (428,100) and (353,50) +.. (258,50) +.. controls (164,50) and (83,131) +.. (83,227) +.. controls (83,321) and (132,364) +.. (172,378) +-- cycle) ; +P2 := ((260,440) +-- (256,566) +.. controls (282,566) and (318,593) +.. (318,633) +.. controls (318,680) and (284,700) +.. (244,700) +.. controls (200,700) and (175,666) +.. (176,633) +.. controls (177,612) and (192,604) +.. (193,582) +-- (203,290) +-- (460,290) +-- (538,66) +-- (672,113) +-- (655,163) +-- (576,135) +-- (505,340) +-- (264,340) +-- (262,390) +-- (433,390) +-- (431,440) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (89); +% white maple leaf in black shield +P1 := ((0,800) +-- (0,300) +.. controls (0,110) and (180,0) +.. (350,0) +.. controls (520,0) and (700,110) +.. (700,300) +-- (700,800) +-- cycle) ; +P2 := ((291,653) +.. controls (315,653) and (338,719) +.. (348,775) +-- (350,775) +.. controls (361,719) and (384,653) +.. (407,653) +.. controls (421,653) and (439,671) +.. (462,695) +.. controls (451,634) and (434,566) +.. (420,501) +.. controls (415,476) and (406,441) +.. (429,441) +.. controls (448,441) and (486,514) +.. (525,579) +-- (527,577) +-- (528,578) +.. controls (525,558) and (522,505) +.. (534,505) +.. controls (556,505) and (588,514) +.. (634,535) +.. controls (622,507) and (603,467) +.. (603,431) +.. controls (603,419) and (612,412) +.. (625,408) +.. controls (637,405) and (654,405) +.. (668,403) +.. controls (610,353) and (501,266) +.. (501,246) +.. controls (501,233) and (504,211) +.. (509,193) +.. controls (472,200) and (409,228) +.. (390,228) +.. controls (378,228) and (370,211) +.. (370,190) +-- (370,42) +-- (329,42) +-- (329,190) +.. controls (329,211) and (321,228) +.. (309,228) +.. controls (291,228) and (227,200) +.. (190,193) +.. controls (195,211) and (198,233) +.. (198,246) +.. controls (198,266) and (89,353) +.. (31,403) +.. controls (61,406) and (96,406) +.. (96,431) +.. controls (96,467) and (78,507) +.. (65,535) +.. controls (111,514) and (143,505) +.. (166,505) +.. controls (177,505) and (174,558) +.. (171,576) +-- (173,578) +-- (172,579) +.. controls (214,514) and (251,441) +.. (271,441) +.. controls (294,441) and (284,476) +.. (279,501) +.. controls (267,566) and (249,634) +.. (237,695) +.. controls (260,671) and (278,653) +.. (291,653) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (90); +% phone +P1 := ((206,503) +-- (253,503) +.. controls (266,503) and (272,512) +.. (272,528) +-- (272,675) +.. controls (272,691) and (266,700) +.. (253,700) +-- (206,700) +-- cycle) ; +P2 := ((182,197) +.. controls (168,197) and (153,203) +.. (146,228) +.. controls (139,252) and (137,283) +.. (137,350) +.. controls (137,417) and (139,448) +.. (146,472) +.. controls (153,497) and (168,503) +.. (182,503) +-- (182,700) +.. controls (142,692) and (112,655) +.. (76,598) +.. controls (34,532) and (30,412) +.. (30,350) +.. controls (30,288) and (34,168) +.. (76,102) +.. controls (112,45) and (142,8) +.. (182,0) +-- cycle) ; +P3 := ((203,0) +-- (250,0) +.. controls (263,0) and (269,9) +.. (269,25) +-- (269,172) +.. controls (269,188) and (263,197) +.. (250,197) +-- (203,197) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (91); +% north indicator +P1 := ((30,-98) +-- (32,-100) +-- (287,206) +-- (543,-100) +-- (545,-98) +-- (287,788) +-- cycle) ; +P2 := ((345,1088) +-- (379,1082) +-- (379,908) +-- (206,1100) +-- (141,1100) +-- (141,1088) +-- (173,1082) +-- (173,872) +-- (141,866) +-- (141,854) +-- (232,854) +-- (232,866) +-- (197,872) +-- (197,1056) +.. controls (236,1014) and (359,878) +.. (383,852) +-- (403,852) +-- (403,1082) +-- (434,1088) +-- (434,1100) +-- (345,1100) +-- cycle) ; +P3 := ((98,26) +-- (96,28) +-- (285,691) +-- (287,691) +-- (287,253) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (92); +% four points of the compass +P1 := ((927,772) +.. controls (846,757) and (736,671) +.. (722,566) +-- (436,503) +-- (436,501) +-- (722,438) +.. controls (736,333) and (846,247) +.. (927,233) +-- (990,-53) +-- (992,-53) +-- (1055,233) +.. controls (1136,247) and (1246,333) +.. (1260,438) +-- (1546,501) +-- (1546,503) +-- (1260,566) +.. controls (1246,671) and (1136,757) +.. (1055,771) +-- (992,1057) +-- (990,1057) +-- cycle) ; +P2 := ((1037,1394) +-- (1037,1384) +-- (1063,1379) +-- (1063,1240) +-- (929,1394) +-- (874,1394) +-- (874,1384) +-- (899,1379) +-- (899,1211) +-- (874,1207) +-- (874,1197) +-- (947,1197) +-- (947,1207) +-- (919,1211) +-- (919,1359) +.. controls (950,1325) and (1045,1216) +.. (1064,1195) +-- (1083,1195) +-- (1083,1379) +-- (1108,1384) +-- (1108,1394) +-- cycle) ; +P3 := ((1039,-194) +.. controls (1025,-193) and (1011,-188) +.. (997,-188) +.. controls (958,-188) and (932,-212) +.. (932,-242) +.. controls (932,-314) and (1027,-299) +.. (1027,-347) +.. controls (1027,-372) and (1011,-384) +.. (987,-384) +.. controls (975,-384) and (953,-378) +.. (947,-366) +.. controls (943,-358) and (939,-346) +.. (937,-330) +-- (928,-333) +-- (931,-380) +.. controls (945,-390) and (970,-395) +.. (989,-395) +.. controls (1031,-395) and (1057,-369) +.. (1057,-334) +.. controls (1057,-276) and (962,-286) +.. (962,-235) +.. controls (962,-214) and (974,-202) +.. (995,-202) +.. controls (1020,-202) and (1029,-218) +.. (1034,-238) +-- (1043,-238) +-- cycle) ; +P4 := ((138,603) +-- (138,593) +-- (165,588) +.. controls (163,578) and (159,567) +.. (155,556) +-- (120,447) +-- (80,588) +-- (107,593) +-- (107,603) +-- (30,603) +-- (30,593) +-- (52,588) +-- (105,401) +-- (120,401) +-- (170,549) +-- (217,401) +-- (232,401) +-- (292,588) +-- (311,593) +-- (311,603) +-- (246,603) +-- (246,593) +-- (275,588) +-- (231,448) +-- (196,558) +.. controls (193,568) and (190,578) +.. (187,588) +-- (215,593) +-- (215,603) +-- cycle) ; +P5 := ((1793,500) +-- (1798,478) +-- (1807,478) +.. controls (1805,494) and (1805,520) +.. (1807,535) +-- (1798,535) +-- (1793,514) +-- (1743,514) +-- (1743,585) +-- (1803,585) +-- (1811,559) +-- (1820,559) +-- (1816,603) +-- (1686,603) +-- (1686,593) +-- (1713,588) +-- (1713,420) +-- (1686,415) +-- (1686,406) +-- (1829,406) +-- (1841,454) +-- (1830,454) +-- (1819,424) +-- (1743,424) +-- (1743,500) +-- cycle) ; +P6 := ((746,502) +.. controls (746,639) and (834,747) +.. (991,747) +.. controls (1148,747) and (1236,639) +.. (1236,502) +.. controls (1236,365) and (1148,257) +.. (991,257) +.. controls (834,257) and (746,365) +.. (746,502) +-- cycle) ; +P7 := ((943,772) +-- (989,989) +-- (991,989) +-- (991,772) +-- cycle) ; +P8 := ((722,454) +-- (505,500) +-- (505,502) +-- (722,502) +-- cycle) ; +P9 := ((1039,233) +-- (993,16) +-- (991,16) +-- (991,233) +-- cycle) ; +P10 := ((1260,550) +-- (1478,504) +-- (1478,502) +-- (1260,502) +-- cycle) ; +drawthem 10; +endfig; + +beginfig (93); +% long north indicator +P1 := ((234,1650) +-- (268,1644) +-- (268,1470) +-- (95,1662) +-- (30,1662) +-- (30,1650) +-- (62,1644) +-- (62,1434) +-- (30,1428) +-- (30,1416) +-- (121,1416) +-- (121,1428) +-- (86,1434) +-- (86,1618) +.. controls (125,1576) and (248,1440) +.. (272,1414) +-- (292,1414) +-- (292,1644) +-- (323,1650) +-- (323,1662) +-- (234,1662) +-- cycle) ; +P2 := ((182,278) +.. controls (241,281) and (283,330) +.. (283,381) +.. controls (283,432) and (241,486) +.. (190,484) +-- (190,614) +-- (270,576) +-- (178,1338) +-- (175,1338) +-- (82,576) +-- (163,614) +-- (163,484) +.. controls (112,484) and (69,432) +.. (69,381) +.. controls (69,330) and (112,278) +.. (171,278) +-- (69,-662) +-- (176,-611) +-- (283,-662) +-- cycle) ; +P3 := ((270,380) +.. controls (265,335) and (230,286) +.. (178,291) +-- (178,380) +-- cycle) ; +P4 := ((176,1228) +-- (179,1228) +-- (253,602) +-- (176,636) +-- cycle) ; +P5 := ((85,-640) +-- (174,196) +-- (176,196) +-- (176,-597) +-- cycle) ; +P6 := ((175,382) +-- (82,382) +.. controls (82,439) and (123,468) +.. (175,471) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (94); +% alternative white explosion +P1 := ((1538,327) +-- (862,580) +-- (989,1035) +-- (987,1037) +-- (585,616) +-- (440,791) +-- (454,552) +-- (0,468) +-- (317,287) +-- (188,58) +-- (416,58) +-- (463,-237) +-- (661,65) +-- (918,-110) +-- (920,-108) +-- (788,150) +-- cycle) ; +P2 := ((759,164) +-- (867,-50) +-- (865,-52) +-- (656,92) +-- (474,-184) +-- (435,78) +-- (223,78) +-- (343,294) +-- (61,460) +-- (475,536) +-- (462,736) +-- (582,584) +-- (948,967) +-- (949,970) +-- (951,968) +-- (837,567) +-- (1472,332) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (95); +% windmill +P1 := ((475,0) +-- (405,472) +-- (602,357) +-- (612,375) +-- (401,498) +.. controls (397,520) and (393,540) +.. (382,540) +-- (382,542) +-- (612,672) +-- (602,690) +-- (342,540) +-- (329,540) +-- (64,694) +-- (54,676) +-- (288,540) +.. controls (277,540) and (273,520) +.. (269,498) +-- (54,374) +-- (64,358) +-- (265,473) +-- (195,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (96); +% pedestrian +P1 := ((378,333) +-- (410,333) +-- (410,506) +-- (260,575) +.. controls (237,585) and (226,586) +.. (210,579) +.. controls (194,572) and (173,563) +.. (168,540) +-- (157,485) +.. controls (146,485) and (144,462) +.. (136,427) +-- (30,365) +-- (42,333) +-- (164,384) +-- (198,446) +-- (242,358) +-- (168,232) +-- (113,18) +-- (173,0) +-- (219,177) +-- (274,255) +-- (386,0) +-- (428,29) +-- (332,324) +.. controls (340,346) and (345,369) +.. (337,397) +-- (313,483) +-- (364,480) +-- cycle) ; +P2 := ((129,639) +.. controls (129,610) and (152,588) +.. (181,588) +.. controls (208,588) and (231,610) +.. (231,639) +.. controls (231,668) and (208,691) +.. (181,691) +.. controls (152,691) and (129,668) +.. (129,639) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (97); +% skier +P1 := ((97,275) +.. controls (97,249) and (117,230) +.. (142,230) +.. controls (166,230) and (187,249) +.. (187,275) +.. controls (187,300) and (166,320) +.. (142,320) +.. controls (117,320) and (97,300) +.. (97,275) +-- cycle) ; +P2 := ((460,406) +.. controls (445,419) and (420,439) +.. (387,439) +.. controls (358,439) and (330,429) +.. (312,417) +.. controls (299,410) and (234,363) +.. (213,340) +.. controls (206,331) and (196,317) +.. (196,309) +.. controls (196,298) and (204,284) +.. (220,280) +.. controls (238,275) and (275,272) +.. (275,272) +-- (278,258) +-- (218,212) +-- (236,195) +-- (296,226) +-- (448,124) +-- (129,13) +.. controls (119,10) and (108,6) +.. (91,6) +.. controls (73,6) and (54,20) +.. (48,28) +.. controls (36,40) and (25,32) +.. (32,23) +.. controls (39,14) and (54,-6) +.. (86,-6) +.. controls (116,-6) and (129,-1) +.. (144,3) +-- (724,206) +-- (720,219) +-- (493,140) +-- (383,237) +-- (446,298) +.. controls (471,320) and (478,342) +.. (478,364) +.. controls (478,378) and (470,393) +.. (467,398) +-- (512,434) +-- (527,416) +-- (534,421) +-- (519,440) +-- (533,450) +-- (527,458) +-- (514,448) +-- (500,464) +-- (492,460) +-- (507,442) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (98); +% cross on square +P1 := ((420,0) +-- (420,320) +-- (290,320) +-- (290,574) +-- (396,574) +-- (396,629) +-- (290,629) +-- (290,750) +-- (230,750) +-- (230,629) +-- (124,629) +-- (124,574) +-- (230,574) +-- (230,320) +-- (100,320) +-- (100,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (99); +% world globe +P1 := ((30,340) +.. controls (30,150) and (180,0) +.. (370,0) +.. controls (560,0) and (710,150) +.. (710,340) +.. controls (710,530) and (560,680) +.. (370,680) +.. controls (180,680) and (30,530) +.. (30,340) +-- cycle) ; +P2 := ((355,499) +.. controls (322,501) and (286,509) +.. (253,521) +.. controls (272,567) and (297,609) +.. (324,646) +.. controls (335,648) and (345,649) +.. (355,649) +-- cycle) ; +P3 := ((355,355) +-- (213,355) +.. controls (215,402) and (226,449) +.. (244,496) +.. controls (282,480) and (321,470) +.. (355,468) +-- cycle) ; +P4 := ((355,325) +-- (355,212) +.. controls (321,210) and (282,200) +.. (244,184) +.. controls (226,232) and (215,280) +.. (213,325) +-- cycle) ; +P5 := ((355,31) +.. controls (345,31) and (335,32) +.. (324,34) +.. controls (296,71) and (272,115) +.. (254,160) +.. controls (288,172) and (323,179) +.. (355,181) +-- cycle) ; +P6 := ((228,149) +.. controls (242,111) and (261,75) +.. (284,44) +.. controls (237,55) and (195,79) +.. (160,111) +.. controls (179,125) and (202,138) +.. (228,149) +-- cycle) ; +P7 := ((183,325) +.. controls (184,283) and (196,228) +.. (217,174) +.. controls (187,161) and (160,147) +.. (139,132) +.. controls (93,183) and (65,250) +.. (62,325) +-- cycle) ; +P8 := ((62,355) +.. controls (65,430) and (93,497) +.. (139,548) +.. controls (160,533) and (187,519) +.. (217,506) +.. controls (197,452) and (185,398) +.. (183,355) +-- cycle) ; +P9 := ((227,532) +.. controls (201,543) and (178,556) +.. (160,569) +.. controls (195,601) and (237,625) +.. (284,637) +.. controls (262,607) and (242,570) +.. (227,532) +-- cycle) ; +P10 := ((385,649) +.. controls (395,649) and (405,648) +.. (416,646) +.. controls (443,609) and (468,567) +.. (487,521) +.. controls (454,509) and (418,501) +.. (385,499) +-- cycle) ; +P11 := ((385,468) +.. controls (419,470) and (458,480) +.. (496,496) +.. controls (514,449) and (525,402) +.. (527,355) +-- (385,355) +-- cycle) ; +P12 := ((527,325) +.. controls (525,280) and (514,232) +.. (496,184) +.. controls (458,200) and (419,210) +.. (385,212) +-- (385,325) +-- cycle) ; +P13 := ((385,181) +.. controls (417,179) and (452,172) +.. (486,160) +.. controls (468,115) and (444,71) +.. (416,34) +.. controls (405,32) and (395,31) +.. (385,31) +-- cycle) ; +P14 := ((513,532) +.. controls (498,570) and (478,607) +.. (456,637) +.. controls (503,625) and (545,601) +.. (580,569) +.. controls (562,556) and (539,543) +.. (513,532) +-- cycle) ; +P15 := ((557,355) +.. controls (555,398) and (543,452) +.. (523,506) +.. controls (553,519) and (580,533) +.. (601,548) +.. controls (647,497) and (675,430) +.. (678,355) +-- cycle) ; +P16 := ((678,325) +.. controls (675,250) and (647,183) +.. (601,132) +.. controls (580,147) and (553,161) +.. (523,174) +.. controls (544,228) and (556,283) +.. (557,325) +-- cycle) ; +P17 := ((512,149) +.. controls (538,138) and (561,125) +.. (580,111) +.. controls (545,79) and (503,55) +.. (456,44) +.. controls (479,75) and (498,111) +.. (512,149) +-- cycle) ; +drawthem 17; +endfig; + +beginfig (100); +% open tent +P1 := ((380,553) +-- (122,40) +-- (30,40) +-- (30,0) +-- (730,0) +-- (730,40) +-- (638,40) +-- cycle) ; +P2 := ((509,40) +-- (251,40) +-- (380,293) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (101); +% black star +P1 := ((347,698) +-- (260,472) +-- (30,472) +-- (206,330) +-- (141,103) +-- (347,237) +-- (553,103) +-- (478,330) +-- (664,472) +-- (435,472) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (102); +% cabin by pine tree +P1 := ((678,0) +-- (678,30) +-- (549,30) +-- (549,272) +-- (589,272) +-- (412,490) +-- (235,272) +-- (275,272) +-- (275,30) +-- (212,30) +-- (174,160) +-- (238,154) +.. controls (206,183) and (170,215) +.. (163,248) +.. controls (179,244) and (197,242) +.. (225,240) +.. controls (183,281) and (166,313) +.. (154,339) +.. controls (142,365) and (106,451) +.. (106,506) +-- (104,506) +.. controls (106,387) and (87,336) +.. (74,282) +.. controls (63,235) and (47,192) +.. (30,161) +.. controls (50,164) and (70,170) +.. (91,177) +.. controls (78,141) and (50,118) +.. (30,96) +.. controls (72,96) and (110,113) +.. (148,154) +.. controls (158,115) and (163,72) +.. (169,30) +-- (30,30) +-- (30,0) +-- cycle) ; +P2 := ((365,189) +-- (459,189) +-- (459,30) +-- (365,30) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (103); +% banner on building +P1 := ((300,481) +-- (300,616) +-- (418,683) +-- (280,750) +-- (280,481) +-- (50,276) +-- (170,276) +-- (170,0) +-- (410,0) +-- (410,276) +-- (530,276) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (104); +% anchor +P1 := ((313,61) +.. controls (236,61) and (182,109) +.. (120,188) +-- (153,207) +.. controls (163,213) and (158,216) +.. (145,226) +.. controls (113,248) and (46,277) +.. (39,273) +.. controls (35,270) and (27,197) +.. (31,158) +.. controls (33,142) and (33,136) +.. (44,142) +-- (77,161) +.. controls (117,83) and (230,0) +.. (341,0) +.. controls (452,0) and (565,83) +.. (605,161) +-- (638,142) +.. controls (649,136) and (649,142) +.. (651,158) +.. controls (655,197) and (647,270) +.. (643,273) +.. controls (636,277) and (569,248) +.. (537,226) +.. controls (524,216) and (519,213) +.. (529,207) +-- (562,188) +.. controls (500,109) and (446,61) +.. (369,61) +-- (369,454) +.. controls (422,467) and (446,506) +.. (445,554) +.. controls (444,602) and (404,650) +.. (341,650) +.. controls (278,650) and (238,602) +.. (237,554) +.. controls (237,530) and (242,508) +.. (255,491) +.. controls (268,474) and (287,461) +.. (313,454) +-- cycle) ; +P2 := ((292,551) +.. controls (292,579) and (314,600) +.. (341,600) +.. controls (368,600) and (390,579) +.. (390,551) +.. controls (390,524) and (368,503) +.. (341,503) +.. controls (314,503) and (292,524) +.. (292,551) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (105); +% shield, black top +P1 := ((503,-121) +.. controls (597,-121) and (767,-18) +.. (853,90) +.. controls (945,206) and (1005,346) +.. (1005,508) +.. controls (1005,663) and (930,835) +.. (850,921) +.. controls (793,882) and (735,860) +.. (677,860) +.. controls (619,860) and (561,882) +.. (503,921) +.. controls (446,882) and (387,860) +.. (329,860) +.. controls (271,860) and (213,882) +.. (154,921) +.. controls (75,835) and (0,663) +.. (0,508) +.. controls (0,346) and (59,206) +.. (153,90) +.. controls (238,-18) and (408,-121) +.. (503,-121) +-- cycle) ; +P2 := ((941,700) +.. controls (952,671) and (975,605) +.. (975,508) +.. controls (975,377) and (936,246) +.. (827,104) +.. controls (767,25) and (601,-91) +.. (503,-91) +.. controls (405,-91) and (238,25) +.. (178,104) +.. controls (70,246) and (30,377) +.. (30,508) +.. controls (30,605) and (54,671) +.. (64,700) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (106); +% jet fighter +P1 := ((191,58) +.. controls (176,45) and (167,35) +.. (167,26) +.. controls (167,16) and (178,12) +.. (189,12) +-- (274,12) +-- (276,38) +-- (295,38) +.. controls (300,13) and (311,-4) +.. (322,-7) +-- (329,-25) +-- (336,-7) +.. controls (347,-4) and (358,13) +.. (363,38) +-- (382,38) +-- (384,12) +-- (469,12) +.. controls (480,12) and (491,16) +.. (491,26) +.. controls (491,35) and (482,45) +.. (467,58) +-- (395,125) +-- (395,210) +-- (599,221) +-- (612,202) +-- (622,211) +-- (622,339) +-- (612,346) +-- (592,294) +-- (406,440) +.. controls (406,463) and (395,487) +.. (392,508) +-- (351,712) +.. controls (350,722) and (350,777) +.. (329,826) +.. controls (308,777) and (308,722) +.. (307,712) +-- (266,508) +.. controls (263,487) and (252,463) +.. (252,440) +-- (66,294) +-- (46,346) +-- (36,339) +-- (36,211) +-- (46,202) +-- (59,221) +-- (263,210) +-- (263,125) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (107); +% roads merging +P1 := ((180,400) +-- (25,210) +-- (91,210) +-- (246,400) +-- (91,590) +-- (25,590) +-- cycle) ; +P2 := ((615,429) +-- (615,474) +-- (317,474) +-- (222,590) +-- (156,590) +-- (288,429) +-- cycle) ; +P3 := ((288,371) +-- (156,210) +-- (222,210) +-- (317,326) +-- (615,326) +-- (615,371) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (108); +% large white square +P1 := ((50,800) +.. controls (20,800) and (0,780) +.. (0,750) +-- (0,50) +.. controls (0,20) and (20,0) +.. (50,0) +-- (750,0) +.. controls (780,0) and (800,20) +.. (800,43) +-- (800,750) +.. controls (800,780) and (780,800) +.. (750,800) +-- cycle) ; +P2 := ((730,770) +.. controls (758,770) and (770,758) +.. (770,730) +-- (770,64) +.. controls (770,43) and (758,30) +.. (730,30) +-- (71,30) +.. controls (43,30) and (30,43) +.. (30,70) +-- (30,730) +.. controls (30,758) and (43,770) +.. (71,770) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (109); +% barrel +P1 := ((55,45) +.. controls (43,39) and (30,34) +.. (30,20) +.. controls (30,-8) and (110,-32) +.. (300,-32) +.. controls (490,-32) and (570,-8) +.. (570,20) +.. controls (570,27) and (567,32) +.. (562,35) +.. controls (557,38) and (551,40) +.. (545,41) +-- (545,178) +.. controls (562,185) and (570,193) +.. (570,202) +.. controls (570,209) and (567,214) +.. (562,217) +.. controls (557,220) and (551,222) +.. (545,223) +-- (545,360) +.. controls (562,367) and (570,375) +.. (570,384) +.. controls (570,391) and (567,396) +.. (562,399) +.. controls (557,402) and (551,404) +.. (545,405) +-- (545,542) +.. controls (562,549) and (570,557) +.. (570,566) +.. controls (570,573) and (567,578) +.. (562,581) +.. controls (557,584) and (551,586) +.. (545,587) +-- (545,724) +.. controls (562,731) and (570,739) +.. (570,748) +.. controls (570,776) and (490,800) +.. (300,800) +.. controls (110,800) and (30,776) +.. (30,748) +.. controls (30,744) and (32,740) +.. (36,736) +.. controls (40,732) and (46,728) +.. (55,724) +-- (55,591) +.. controls (43,585) and (30,580) +.. (30,566) +.. controls (30,562) and (32,558) +.. (36,554) +.. controls (40,550) and (46,546) +.. (55,542) +-- (55,409) +.. controls (43,403) and (30,398) +.. (30,384) +.. controls (30,380) and (32,376) +.. (36,372) +.. controls (40,368) and (46,364) +.. (55,360) +-- (55,227) +.. controls (43,221) and (30,216) +.. (30,202) +.. controls (30,198) and (32,194) +.. (36,190) +.. controls (40,186) and (46,182) +.. (55,178) +-- cycle) ; +P2 := ((300,716) +.. controls (200,716) and (58,726) +.. (58,748) +.. controls (58,770) and (200,780) +.. (300,780) +.. controls (400,780) and (542,770) +.. (542,748) +.. controls (542,726) and (400,716) +.. (300,716) +-- cycle) ; +P3 := ((75,720) +.. controls (124,706) and (200,696) +.. (300,696) +.. controls (400,696) and (476,706) +.. (525,720) +-- (525,578) +.. controls (538,577) and (552,575) +.. (552,569) +.. controls (552,565) and (543,561) +.. (525,558) +.. controls (474,544) and (400,534) +.. (300,534) +.. controls (200,534) and (126,544) +.. (75,558) +.. controls (57,561) and (48,565) +.. (48,569) +.. controls (48,572) and (52,574) +.. (57,575) +.. controls (62,577) and (69,578) +.. (75,578) +-- cycle) ; +P4 := ((75,538) +.. controls (124,524) and (200,514) +.. (300,514) +.. controls (400,514) and (476,524) +.. (525,538) +-- (525,396) +.. controls (538,395) and (552,393) +.. (552,387) +.. controls (552,383) and (543,379) +.. (525,376) +.. controls (474,362) and (400,352) +.. (300,352) +.. controls (200,352) and (126,362) +.. (75,376) +.. controls (57,379) and (48,383) +.. (48,387) +.. controls (48,390) and (52,392) +.. (57,393) +.. controls (62,395) and (69,396) +.. (75,396) +-- cycle) ; +P5 := ((75,356) +.. controls (124,342) and (200,332) +.. (300,332) +.. controls (400,332) and (476,342) +.. (525,356) +-- (525,214) +.. controls (538,213) and (552,211) +.. (552,205) +.. controls (552,201) and (543,197) +.. (525,194) +.. controls (474,180) and (400,170) +.. (300,170) +.. controls (200,170) and (126,180) +.. (75,194) +.. controls (57,197) and (48,201) +.. (48,205) +.. controls (48,208) and (52,210) +.. (57,211) +.. controls (62,212) and (69,214) +.. (75,214) +-- cycle) ; +P6 := ((75,174) +.. controls (124,160) and (200,150) +.. (300,150) +.. controls (400,150) and (476,160) +.. (525,174) +-- (525,32) +.. controls (538,31) and (552,29) +.. (552,23) +.. controls (552,19) and (543,15) +.. (525,12) +.. controls (474,-2) and (400,-12) +.. (300,-12) +.. controls (200,-12) and (126,-2) +.. (75,12) +.. controls (57,15) and (48,19) +.. (48,23) +.. controls (48,26) and (52,28) +.. (57,29) +.. controls (62,30) and (69,32) +.. (75,32) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (110); +% atom +P1 := ((729,599) +.. controls (705,640) and (609,631) +.. (487,583) +.. controls (468,712) and (428,800) +.. (381,800) +.. controls (334,800) and (294,713) +.. (275,583) +.. controls (153,632) and (58,640) +.. (35,599) +.. controls (11,560) and (65,482) +.. (170,400) +.. controls (65,317) and (12,239) +.. (35,199) +.. controls (58,158) and (153,168) +.. (275,217) +.. controls (294,85) and (334,0) +.. (381,0) +.. controls (428,0) and (468,87) +.. (486,218) +.. controls (609,168) and (705,158) +.. (727,199) +.. controls (750,239) and (697,318) +.. (594,400) +.. controls (697,481) and (751,558) +.. (729,599) +-- cycle) ; +P2 := ((381,17) +.. controls (341,17) and (307,99) +.. (290,223) +.. controls (319,235) and (350,248) +.. (381,266) +.. controls (412,248) and (441,235) +.. (471,223) +.. controls (455,97) and (421,17) +.. (381,17) +-- cycle) ; +P3 := ((322,296) +.. controls (335,288) and (349,280) +.. (364,274) +.. controls (338,260) and (313,248) +.. (289,239) +.. controls (285,264) and (282,291) +.. (282,321) +.. controls (293,312) and (308,304) +.. (322,296) +-- cycle) ; +P4 := ((51,209) +.. controls (31,244) and (85,313) +.. (183,390) +.. controls (207,370) and (234,352) +.. (264,334) +.. controls (265,297) and (268,263) +.. (273,232) +.. controls (159,186) and (70,174) +.. (51,209) +-- cycle) ; +P5 := ((261,400) +.. controls (261,384) and (261,367) +.. (262,353) +.. controls (239,368) and (216,384) +.. (195,400) +.. controls (215,415) and (237,432) +.. (262,448) +.. controls (261,432) and (261,416) +.. (261,400) +-- cycle) ; +P6 := ((714,207) +.. controls (694,172) and (606,185) +.. (489,234) +.. controls (494,263) and (497,296) +.. (498,332) +.. controls (528,351) and (555,370) +.. (580,390) +.. controls (680,313) and (734,243) +.. (714,207) +-- cycle) ; +P7 := ((501,400) +.. controls (501,417) and (501,433) +.. (500,448) +.. controls (525,432) and (546,416) +.. (567,400) +.. controls (546,383) and (523,368) +.. (500,352) +.. controls (501,367) and (501,383) +.. (501,400) +-- cycle) ; +P8 := ((331,489) +.. controls (348,499) and (365,508) +.. (382,516) +.. controls (398,507) and (415,498) +.. (433,488) +.. controls (451,477) and (466,468) +.. (482,458) +.. controls (484,440) and (484,421) +.. (484,400) +.. controls (484,379) and (482,359) +.. (482,342) +.. controls (466,330) and (449,321) +.. (433,311) +.. controls (415,301) and (398,292) +.. (381,283) +.. controls (365,291) and (348,301) +.. (331,310) +.. controls (314,320) and (297,330) +.. (281,341) +.. controls (278,359) and (278,379) +.. (278,400) +.. controls (278,419) and (278,439) +.. (280,458) +.. controls (294,467) and (313,479) +.. (331,489) +-- cycle) ; +P9 := ((322,504) +.. controls (308,495) and (293,487) +.. (281,479) +.. controls (283,508) and (285,537) +.. (289,561) +.. controls (313,552) and (338,540) +.. (364,526) +.. controls (349,520) and (335,512) +.. (322,504) +-- cycle) ; +P10 := ((51,590) +.. controls (71,625) and (160,613) +.. (274,568) +.. controls (268,538) and (266,504) +.. (264,467) +.. controls (234,448) and (208,428) +.. (183,410) +.. controls (85,485) and (31,556) +.. (51,590) +-- cycle) ; +P11 := ((714,591) +.. controls (734,556) and (678,485) +.. (580,410) +.. controls (555,430) and (528,449) +.. (498,468) +.. controls (497,505) and (494,537) +.. (489,568) +.. controls (604,614) and (693,627) +.. (714,591) +-- cycle) ; +P12 := ((381,783) +.. controls (422,783) and (456,700) +.. (472,577) +.. controls (444,565) and (413,552) +.. (382,536) +.. controls (351,552) and (321,565) +.. (291,578) +.. controls (308,702) and (342,783) +.. (381,783) +-- cycle) ; +P13 := ((441,504) +.. controls (428,512) and (413,520) +.. (400,526) +.. controls (425,539) and (449,550) +.. (473,561) +.. controls (478,536) and (480,508) +.. (481,479) +.. controls (470,487) and (456,496) +.. (441,504) +-- cycle) ; +P14 := ((441,296) +.. controls (455,304) and (469,312) +.. (481,321) +.. controls (480,292) and (477,263) +.. (473,239) +.. controls (449,248) and (424,260) +.. (398,274) +.. controls (412,280) and (427,288) +.. (441,296) +-- cycle) ; +P15 := ((340,400) +.. controls (340,377) and (358,359) +.. (381,359) +.. controls (404,359) and (422,377) +.. (422,400) +.. controls (422,423) and (404,441) +.. (381,441) +.. controls (358,441) and (340,423) +.. (340,400) +-- cycle) ; +drawthem 15; +endfig; + +beginfig (111); +% large white circle +P1 := ((0,400) +.. controls (0,129) and (213,-85) +.. (485,-85) +.. controls (757,-85) and (970,129) +.. (970,400) +.. controls (970,671) and (757,885) +.. (485,885) +.. controls (213,885) and (0,671) +.. (0,400) +-- cycle) ; +P2 := ((30,400) +.. controls (30,654) and (230,855) +.. (485,855) +.. controls (740,855) and (940,654) +.. (940,400) +.. controls (940,146) and (740,-55) +.. (485,-55) +.. controls (230,-55) and (30,146) +.. (30,400) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (112); +% large white rhombus +P1 := ((17,436) +.. controls (-5,413) and (-5,385) +.. (17,364) +-- (512,-131) +.. controls (533,-152) and (561,-152) +.. (582,-131) +-- (1077,364) +.. controls (1099,385) and (1099,414) +.. (1077,435) +-- (582,930) +.. controls (561,951) and (533,952) +.. (512,930) +-- cycle) ; +P2 := ((514,892) +.. controls (533,912) and (559,911) +.. (579,892) +-- (1037,433) +.. controls (1058,414) and (1058,387) +.. (1037,367) +-- (579,-91) +.. controls (559,-111) and (533,-111) +.. (514,-91) +-- (55,367) +.. controls (35,387) and (35,413) +.. (55,434) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (113); +% scales +P1 := ((430,700) +-- (430,530) +-- (212,530) +-- (48,122) +.. controls (61,47) and (134,0) +.. (212,0) +.. controls (290,0) and (363,47) +.. (376,122) +-- (227,500) +-- (673,500) +-- (524,122) +.. controls (537,47) and (610,0) +.. (688,0) +.. controls (766,0) and (839,47) +.. (852,122) +-- (688,530) +-- (470,530) +-- (470,700) +-- cycle) ; +P2 := ((212,455) +-- (342,122) +-- (78,122) +-- cycle) ; +P3 := ((822,122) +-- (558,122) +-- (688,455) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (114); +% white star in black circle +P1 := ((30,400) +.. controls (30,223) and (170,83) +.. (347,83) +.. controls (524,83) and (665,223) +.. (665,400) +.. controls (665,577) and (524,717) +.. (347,717) +.. controls (170,717) and (30,577) +.. (30,400) +-- cycle) ; +P2 := ((348,687) +-- (414,492) +-- (624,492) +-- (455,366) +-- (507,162) +-- (348,289) +-- (188,162) +-- (240,366) +-- (71,492) +-- (281,492) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (115); +% deer +P1 := ((527,904) +.. controls (523,921) and (502,919) +.. (503,898) +.. controls (507,868) and (511,823) +.. (475,799) +.. controls (449,781) and (394,795) +.. (364,811) +.. controls (346,819) and (340,803) +.. (355,793) +.. controls (379,781) and (418,767) +.. (453,771) +.. controls (431,748) and (418,720) +.. (418,687) +.. controls (418,615) and (464,561) +.. (527,546) +.. controls (537,543) and (527,513) +.. (523,503) +-- (498,451) +.. controls (489,430) and (454,426) +.. (431,426) +-- (164,426) +.. controls (80,426) and (30,365) +.. (30,325) +.. controls (30,231) and (138,192) +.. (143,139) +-- (146,104) +.. controls (124,104) and (122,93) +.. (122,82) +.. controls (122,67) and (151,61) +.. (180,48) +-- (237,-60) +.. controls (245,-72) and (254,-84) +.. (263,-80) +.. controls (271,-74) and (269,-59) +.. (265,-47) +-- (232,28) +-- (369,-32) +-- (349,-84) +.. controls (343,-97) and (343,-113) +.. (353,-116) +.. controls (359,-119) and (371,-108) +.. (377,-94) +-- (407,-35) +.. controls (418,-12) and (437,14) +.. (444,35) +.. controls (457,67) and (472,105) +.. (479,132) +.. controls (484,158) and (499,165) +.. (521,165) +.. controls (554,165) and (560,153) +.. (560,147) +.. controls (560,136) and (546,117) +.. (534,106) +-- (484,43) +.. controls (475,31) and (472,13) +.. (476,7) +.. controls (484,2) and (503,13) +.. (514,23) +-- (572,96) +.. controls (606,137) and (637,162) +.. (637,189) +.. controls (637,210) and (567,221) +.. (567,252) +-- (567,304) +.. controls (567,331) and (589,378) +.. (602,423) +.. controls (610,451) and (654,451) +.. (698,459) +.. controls (718,461) and (732,466) +.. (732,485) +.. controls (732,501) and (718,509) +.. (705,513) +-- (559,572) +.. controls (547,665) and (612,709) +.. (689,711) +.. controls (709,712) and (709,726) +.. (689,729) +.. controls (666,730) and (645,726) +.. (627,722) +.. controls (642,746) and (641,769) +.. (636,789) +.. controls (633,799) and (618,798) +.. (618,782) +.. controls (618,759) and (620,730) +.. (592,711) +.. controls (567,695) and (531,709) +.. (511,717) +.. controls (497,722) and (493,709) +.. (503,703) +.. controls (519,695) and (542,686) +.. (563,687) +.. controls (540,661) and (524,624) +.. (529,578) +.. controls (475,596) and (451,642) +.. (451,691) +.. controls (451,758) and (516,807) +.. (596,820) +.. controls (605,821) and (605,834) +.. (596,836) +.. controls (573,838) and (542,833) +.. (516,820) +.. controls (525,836) and (529,851) +.. (531,865) +.. controls (532,879) and (530,893) +.. (527,904) +-- cycle) ; +P2 := ((386,173) +-- (386,144) +.. controls (386,118) and (406,93) +.. (406,65) +.. controls (406,50) and (393,27) +.. (379,-9) +-- (220,75) +.. controls (200,84) and (207,96) +.. (215,105) +.. controls (232,121) and (250,147) +.. (264,173) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (116); +% small black circle in medium white circle +P1 := ((30,400) +.. controls (30,223) and (170,83) +.. (347,83) +.. controls (524,83) and (665,223) +.. (665,400) +.. controls (665,577) and (524,717) +.. (347,717) +.. controls (170,717) and (30,577) +.. (30,400) +-- cycle) ; +P2 := ((60,400) +.. controls (60,561) and (187,687) +.. (348,687) +.. controls (508,687) and (635,561) +.. (635,400) +.. controls (635,239) and (508,113) +.. (348,113) +.. controls (187,113) and (60,239) +.. (60,400) +-- cycle) ; +P3 := ((531,400) +.. controls (531,508) and (456,584) +.. (348,584) +.. controls (240,584) and (164,508) +.. (164,400) +.. controls (164,292) and (240,216) +.. (348,216) +.. controls (456,216) and (531,292) +.. (531,400) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (117); +% fancy white shield +P1 := ((30,748) +.. controls (58,736) and (97,664) +.. (97,608) +.. controls (97,545) and (0,460) +.. (0,299) +.. controls (0,83) and (151,-88) +.. (265,-88) +.. controls (315,-88) and (344,-79) +.. (367,-69) +.. controls (391,-60) and (409,-50) +.. (425,-50) +.. controls (456,-50) and (499,-84) +.. (531,-122) +.. controls (563,-84) and (607,-50) +.. (638,-50) +.. controls (654,-50) and (672,-60) +.. (696,-69) +.. controls (719,-79) and (747,-88) +.. (798,-88) +.. controls (912,-88) and (1063,83) +.. (1063,299) +.. controls (1063,460) and (966,545) +.. (966,608) +.. controls (967,664) and (1006,736) +.. (1034,748) +-- (845,921) +.. controls (790,862) and (737,824) +.. (689,824) +.. controls (637,824) and (557,862) +.. (531,921) +.. controls (505,862) and (427,824) +.. (375,824) +.. controls (327,824) and (274,862) +.. (218,921) +-- cycle) ; +P2 := ((992,748) +.. controls (958,715) and (936,659) +.. (936,608) +.. controls (936,525) and (1033,458) +.. (1033,299) +.. controls (1033,124) and (911,-58) +.. (795,-58) +.. controls (764,-58) and (733,-55) +.. (710,-46) +.. controls (687,-37) and (670,-20) +.. (632,-20) +.. controls (595,-17) and (562,-53) +.. (531,-83) +.. controls (500,-53) and (467,-17) +.. (430,-20) +.. controls (392,-20) and (375,-37) +.. (352,-46) +.. controls (329,-55) and (298,-58) +.. (267,-58) +.. controls (151,-58) and (29,124) +.. (29,299) +.. controls (29,458) and (126,525) +.. (126,608) +.. controls (126,659) and (104,715) +.. (70,748) +-- (218,885) +.. controls (249,844) and (323,794) +.. (375,794) +.. controls (433,794) and (499,828) +.. (531,874) +.. controls (563,828) and (629,794) +.. (687,794) +.. controls (739,794) and (813,844) +.. (844,885) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (118); +% mortarboard cap +P1 := ((370,587) +-- (30,466) +-- (231,394) +-- (184,228) +-- (557,228) +-- (510,395) +-- (566,415) +-- (638,157) +-- (686,202) +-- (581,421) +-- (710,466) +-- cycle) ; +P2 := ((217,248) +-- (255,386) +-- (370,345) +-- (486,387) +-- (524,248) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (119); +% hammer and sicle +P1 := ((97,469) +-- (194,372) +-- (269,447) +-- (516,200) +.. controls (494,188) and (472,179) +.. (445,175) +.. controls (387,166) and (304,186) +.. (255,262) +-- (221,262) +-- (170,213) +.. controls (150,240) and (136,245) +.. (125,233) +.. controls (114,222) and (119,208) +.. (145,189) +.. controls (109,168) and (68,135) +.. (43,110) +.. controls (26,93) and (25,62) +.. (42,45) +.. controls (59,28) and (90,30) +.. (107,47) +.. controls (131,71) and (165,113) +.. (185,149) +.. controls (205,122) and (218,117) +.. (230,129) +.. controls (241,140) and (236,153) +.. (209,173) +-- (229,193) +.. controls (257,134) and (364,76) +.. (459,78) +.. controls (506,78) and (558,93) +.. (598,118) +-- (707,9) +.. controls (725,-9) and (747,-2) +.. (763,14) +.. controls (780,30) and (785,52) +.. (768,70) +-- (661,177) +.. controls (708,221) and (732,308) +.. (731,399) +.. controls (730,546) and (601,691) +.. (417,724) +-- (415,722) +.. controls (529,630) and (623,545) +.. (630,431) +.. controls (633,365) and (616,285) +.. (583,254) +-- (329,508) +-- (421,599) +-- (257,627) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (120); +% white cross in black circle +P1 := ((30,300) +.. controls (30,132) and (162,0) +.. (330,0) +.. controls (498,0) and (630,132) +.. (630,300) +.. controls (630,468) and (498,600) +.. (330,600) +.. controls (162,600) and (30,468) +.. (30,300) +-- cycle) ; +P2 := ((407,377) +-- (545,377) +-- (545,223) +-- (407,223) +-- (407,85) +-- (253,85) +-- (253,223) +-- (115,223) +-- (115,377) +-- (253,377) +-- (253,515) +-- (407,515) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (121); +% narrow white shield +P1 := ((700,856) +-- (568,921) +.. controls (529,899) and (496,884) +.. (459,884) +.. controls (423,884) and (371,899) +.. (350,921) +.. controls (329,899) and (277,884) +.. (241,884) +.. controls (205,884) and (171,899) +.. (132,921) +-- (0,856) +-- (0,606) +.. controls (16,555) and (34,503) +.. (34,451) +.. controls (34,425) and (30,399) +.. (23,373) +.. controls (17,347) and (8,322) +.. (0,296) +.. controls (0,196) and (41,101) +.. (106,21) +.. controls (166,-52) and (285,-122) +.. (350,-122) +.. controls (416,-122) and (534,-52) +.. (594,21) +.. controls (658,101) and (700,196) +.. (700,296) +.. controls (684,347) and (666,399) +.. (666,451) +.. controls (666,477) and (671,503) +.. (677,529) +.. controls (684,555) and (692,581) +.. (700,606) +-- cycle) ; +P2 := ((30,841) +-- (132,891) +.. controls (167,871) and (203,856) +.. (241,854) +.. controls (274,856) and (322,871) +.. (350,891) +.. controls (378,871) and (426,856) +.. (459,854) +.. controls (497,856) and (533,871) +.. (568,891) +-- (670,841) +-- (670,599) +.. controls (649,551) and (636,497) +.. (636,448) +.. controls (636,424) and (639,398) +.. (645,372) +.. controls (651,347) and (660,321) +.. (670,297) +.. controls (670,208) and (633,118) +.. (573,43) +.. controls (518,-26) and (406,-92) +.. (350,-92) +.. controls (294,-92) and (182,-26) +.. (127,43) +.. controls (67,118) and (30,208) +.. (30,297) +.. controls (51,345) and (64,399) +.. (64,448) +.. controls (64,473) and (61,498) +.. (55,524) +.. controls (49,550) and (41,575) +.. (30,599) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (122); +% bold italic i +P1 := ((56,192) +.. controls (49,175) and (15,93) +.. (15,45) +.. controls (15,7) and (40,-10) +.. (76,-10) +.. controls (177,-10) and (294,114) +.. (294,143) +.. controls (294,152) and (287,158) +.. (282,158) +.. controls (268,158) and (213,73) +.. (183,73) +.. controls (175,73) and (171,80) +.. (171,87) +.. controls (171,103) and (182,128) +.. (188,143) +-- (260,338) +.. controls (296,435) and (250,461) +.. (207,461) +.. controls (149,461) and (97,432) +.. (57,394) +.. controls (44,381) and (0,339) +.. (0,321) +.. controls (0,315) and (6,308) +.. (13,308) +.. controls (31,308) and (79,395) +.. (116,395) +.. controls (124,395) and (133,386) +.. (126,368) +-- cycle) ; +P2 := ((248,497) +.. controls (293,497) and (331,531) +.. (331,577) +.. controls (331,618) and (302,645) +.. (262,645) +.. controls (218,645) and (180,609) +.. (180,565) +.. controls (180,524) and (207,497) +.. (248,497) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (123); +% scale indicator +P1 := ((1811,0) +-- (1811,153) +-- (0,153) +-- (0,0) +-- cycle) ; +P2 := ((14,14) +-- (14,75) +-- (131,75) +-- (131,14) +-- cycle) ; +P3 := ((250,139) +-- (250,78) +-- (133,78) +-- (133,139) +-- cycle) ; +P4 := ((252,14) +-- (252,75) +-- (369,75) +-- (369,14) +-- cycle) ; +P5 := ((488,139) +-- (488,78) +-- (371,78) +-- (371,139) +-- cycle) ; +P6 := ((490,14) +-- (490,75) +-- (607,75) +-- (607,14) +-- cycle) ; +P7 := ((1202,139) +-- (1202,78) +-- (609,78) +-- (609,139) +-- cycle) ; +P8 := ((1204,75) +-- (1797,75) +-- (1797,14) +-- (1204,14) +-- cycle) ; +drawthem 8; +endfig; + +beginfig (124); +% northeast arrow +P1 := ((763,717) +-- (356,717) +-- (223,585) +-- (532,585) +-- (130,183) +-- (229,84) +-- (631,486) +-- (631,177) +-- (763,310) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (125); +% northwest arrow +P1 := ((130,310) +-- (262,177) +-- (262,486) +-- (664,84) +-- (763,183) +-- (361,585) +-- (670,585) +-- (537,717) +-- (130,717) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (126); +% walking children +P1 := ((322,630) +.. controls (322,602) and (344,580) +.. (373,580) +.. controls (401,580) and (423,602) +.. (423,630) +.. controls (423,659) and (401,681) +.. (373,681) +.. controls (344,681) and (322,659) +.. (322,630) +-- cycle) ; +P2 := ((534,392) +-- (514,390) +-- (518,438) +-- (457,556) +-- (416,568) +.. controls (403,573) and (378,569) +.. (368,561) +-- (341,541) +-- (311,428) +-- (253,409) +-- (224,472) +-- (191,485) +.. controls (176,491) and (158,491) +.. (147,483) +-- (119,460) +-- (88,368) +-- (30,314) +-- (42,292) +-- (107,340) +-- (125,381) +-- (138,339) +-- (83,211) +-- (100,204) +-- (54,35) +-- (76,24) +-- (140,198) +-- (167,193) +-- (246,27) +-- (273,38) +-- (213,196) +-- (251,208) +-- (217,288) +-- (282,292) +-- (272,354) +-- (239,352) +-- (258,381) +-- (320,390) +-- (347,430) +-- (366,330) +-- (320,213) +-- (306,9) +-- (352,0) +-- (364,169) +-- (399,244) +-- (414,158) +-- (500,-5) +-- (542,17) +-- (465,161) +-- (465,309) +-- (545,317) +-- cycle) ; +P3 := ((105,554) +.. controls (105,526) and (127,504) +.. (155,504) +.. controls (184,504) and (206,526) +.. (206,554) +.. controls (206,583) and (184,605) +.. (155,605) +.. controls (127,605) and (105,583) +.. (105,554) +-- cycle) ; +P4 := ((219,351) +-- (205,351) +-- (211,407) +-- (231,378) +-- cycle) ; +P5 := ((487,434) +-- (479,386) +-- (459,384) +-- (452,478) +-- cycle) ; +drawthem 5; +endfig; + +beginfig (161); +% black plumb bob +P1 := ((75,796) +.. controls (29,796) and (0,775) +.. (0,652) +.. controls (0,439) and (211,129) +.. (430,-66) +.. controls (471,-103) and (529,-103) +.. (570,-66) +.. controls (789,129) and (1000,439) +.. (1000,652) +.. controls (1000,775) and (971,796) +.. (925,796) +-- (629,796) +-- (629,859) +.. controls (629,881) and (615,894) +.. (593,894) +-- (407,894) +.. controls (384,894) and (371,881) +.. (371,859) +-- (371,796) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (162); +% small black diamond +P1 := ((563,400) +-- (280,683) +-- (-3,400) +-- (280,117) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (163); +% small black triangle +P1 := ((530,150) +-- (280,650) +-- (30,150) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (164); +% ship1 +P1 := ((2556,126) +-- (1500,126) +-- (1500,169) +-- (1488,169) +-- (1488,156) +-- (1469,156) +.. controls (1464,156) and (1458,161) +.. (1451,168) +.. controls (1446,173) and (1439,181) +.. (1430,181) +-- (1403,181) +-- (1403,161) +-- (1410,161) +-- (1410,126) +-- (1383,126) +-- (1383,260) +-- (1371,260) +-- (1371,344) +-- (1359,344) +-- (1359,260) +-- (1262,260) +-- (1262,226) +-- (1220,226) +-- (1220,240) +-- (1232,240) +-- (1220,253) +-- (1220,274) +.. controls (1238,289) and (1259,296) +.. (1259,308) +-- (1259,321) +-- (1307,321) +-- (1307,343) +-- (1220,343) +-- (1220,369) +-- (1241,369) +-- (1241,414) +-- (1238,414) +.. controls (1237,406) and (1227,393) +.. (1220,394) +-- (1220,447) +-- (1208,447) +-- (1208,395) +-- (1180,395) +-- (1208,369) +-- (1208,343) +.. controls (1207,343) and (1200,340) +.. (1200,333) +.. controls (1200,324) and (1207,321) +.. (1214,321) +-- (1214,309) +.. controls (1205,309) and (1197,303) +.. (1195,296) +-- (1174,296) +-- (1157,321) +-- (1147,321) +.. controls (1140,315) and (1141,297) +.. (1151,297) +-- (1163,297) +-- (1170,287) +-- (1170,274) +-- (1200,249) +-- (1200,226) +-- (1179,226) +-- (1167,240) +-- (1146,201) +-- (1131,201) +-- (1131,243) +-- (1116,259) +-- (1112,254) +-- (1123,242) +-- (1112,214) +-- (1086,214) +-- (1086,126) +-- (30,126) +-- (30,113) +-- (62,113) +.. controls (71,68) and (153,59) +.. (169,0) +-- (2484,0) +-- (2549,39) +-- (2518,39) +-- (2518,54) +-- (2502,73) +-- (2502,92) +-- (2570,92) +-- cycle) ; +P2 := ((1245,321) +-- (1245,309) +.. controls (1233,308) and (1225,310) +.. (1224,321) +-- cycle) ; +P3 := ((1423,161) +.. controls (1449,161) and (1474,140) +.. (1480,126) +-- (1423,126) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (165); +% ship2 +P1 := ((1284,160) +-- (1046,160) +-- (1046,275) +-- (1036,275) +-- (1036,160) +-- (868,160) +-- (868,241) +-- (858,241) +-- (858,160) +-- (274,160) +-- (192,262) +-- (192,299) +-- (182,299) +-- (182,160) +-- (30,160) +.. controls (28,117) and (91,95) +.. (96,73) +-- (114,0) +-- (1444,0) +.. controls (1550,0) and (1630,107) +.. (1646,160) +-- (1568,160) +-- (1568,197) +-- (1531,197) +-- (1531,234) +-- (1484,234) +-- (1428,372) +-- (1348,372) +-- (1368,234) +-- (1330,234) +-- (1330,264) +.. controls (1306,264) and (1284,246) +.. (1284,215) +-- cycle) ; +P2 := ((192,240) +-- (194,240) +-- (258,160) +-- (192,160) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (166); +% ship3 +P1 := ((41,116) +-- (30,116) +.. controls (30,96) and (28,14) +.. (60,0) +-- (1744,0) +-- (1770,48) +-- (1770,164) +-- (1758,164) +-- (1758,107) +-- (1743,87) +-- (1699,80) +-- (1699,123) +-- (1710,123) +-- (1710,134) +-- (1672,134) +-- (1672,123) +-- (1687,123) +-- (1687,77) +-- (1508,58) +-- (1508,83) +-- (1465,83) +-- (1465,145) +-- (1455,145) +-- (1455,83) +-- (1437,83) +-- (1437,145) +-- (1427,145) +-- (1427,83) +-- (1413,83) +-- (1413,58) +-- (1339,58) +-- (1339,86) +-- (1362,98) +-- (1362,114) +-- (1319,89) +-- (1319,58) +-- (1138,58) +-- (1138,72) +-- (1189,72) +-- (1189,84) +-- (1138,84) +-- (1112,94) +-- (1096,94) +-- (1108,79) +-- (1108,58) +-- (1064,58) +-- (1064,88) +-- (1025,88) +-- (1025,118) +-- (1034,123) +-- (1034,130) +-- (1016,134) +-- (1123,201) +-- (1118,207) +-- (1018,162) +-- (1018,188) +-- (1024,188) +-- (1024,200) +-- (1006,200) +-- (1006,172) +-- (991,172) +-- (991,194) +-- (979,194) +-- (979,172) +-- (969,172) +-- (956,213) +-- (966,213) +-- (966,234) +-- (944,234) +-- (944,205) +-- (906,205) +-- (906,251) +-- (944,251) +-- (944,279) +-- (938,302) +-- (938,318) +-- (948,318) +-- (948,326) +-- (927,326) +-- (927,312) +-- (895,312) +-- (895,339) +-- (908,339) +-- (908,370) +-- (870,370) +-- (870,339) +-- (883,339) +-- (883,312) +-- (871,312) +-- (851,332) +-- (851,394) +.. controls (858,397) and (863,401) +.. (864,408) +-- (898,408) +-- (898,419) +-- (864,419) +.. controls (863,426) and (858,432) +.. (851,433) +-- (851,499) +-- (840,499) +-- (840,433) +.. controls (832,432) and (827,426) +.. (826,419) +-- (792,419) +-- (792,408) +-- (826,408) +.. controls (827,401) and (832,397) +.. (840,394) +-- (840,293) +.. controls (840,286) and (845,277) +.. (853,270) +.. controls (859,263) and (868,256) +.. (877,251) +-- (877,205) +-- (844,205) +-- (844,214) +-- (851,218) +-- (839,230) +-- (826,218) +-- (832,214) +-- (832,205) +-- (823,205) +-- (823,172) +-- (782,172) +-- (763,123) +-- (683,123) +-- (663,210) +-- (692,227) +-- (692,309) +-- (703,313) +-- (703,328) +-- (697,332) +-- (697,424) +-- (685,424) +-- (685,333) +-- (672,333) +.. controls (671,341) and (667,345) +.. (659,345) +.. controls (655,345) and (651,342) +.. (651,336) +.. controls (651,330) and (653,325) +.. (659,325) +-- (680,325) +-- (680,263) +-- (651,263) +-- (651,277) +.. controls (660,278) and (668,285) +.. (668,291) +.. controls (668,298) and (663,305) +.. (645,305) +.. controls (627,305) and (624,298) +.. (624,291) +.. controls (624,285) and (629,278) +.. (639,277) +-- (639,263) +-- (631,238) +-- (613,238) +-- (611,217) +-- (626,217) +-- (623,170) +-- (595,170) +-- (589,143) +-- (551,143) +-- (536,175) +-- (536,187) +-- (545,187) +-- (545,194) +.. controls (524,196) and (520,211) +.. (520,225) +-- (508,225) +-- (508,215) +.. controls (508,205) and (514,194) +.. (522,187) +-- (522,175) +-- (505,145) +-- (490,145) +-- (473,183) +-- (457,188) +-- (457,243) +-- (446,243) +-- (446,82) +-- (427,79) +.. controls (425,87) and (413,94) +.. (403,94) +.. controls (390,94) and (377,90) +.. (375,82) +-- (331,82) +-- (331,75) +-- (375,68) +-- (375,58) +-- (281,58) +-- (281,70) +-- (292,83) +-- (292,95) +-- (244,95) +-- (244,83) +-- (255,70) +-- (255,58) +-- (41,83) +-- cycle) ; +P2 := ((457,175) +-- (465,175) +-- (480,142) +-- (465,130) +-- (457,136) +-- cycle) ; +P3 := ((680,255) +-- (680,241) +-- (659,227) +-- (652,255) +-- cycle) ; +P4 := ((902,277) +-- (902,293) +-- (913,301) +-- (927,301) +-- (927,269) +-- (913,269) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (167); +% black fish +P1 := ((933,595) +-- (930,595) +.. controls (923,566) and (756,421) +.. (749,421) +.. controls (726,421) and (515,576) +.. (344,576) +.. controls (188,576) and (30,436) +.. (30,400) +.. controls (30,364) and (188,224) +.. (344,224) +.. controls (515,224) and (726,379) +.. (749,379) +.. controls (756,379) and (923,234) +.. (930,205) +-- (933,205) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (168); +% another medium white circle +P1 := ((30,400) +.. controls (30,223) and (170,83) +.. (347,83) +.. controls (524,83) and (665,223) +.. (665,400) +.. controls (665,577) and (524,717) +.. (347,717) +.. controls (170,717) and (30,577) +.. (30,400) +-- cycle) ; +P2 := ((409,491) +-- (619,491) +-- (450,364) +-- (516,164) +-- (347,288) +-- (179,164) +-- (246,364) +-- (75,491) +-- (284,491) +-- (347,687) +-- cycle) ; +P3 := ((60,400) +.. controls (60,561) and (187,687) +.. (347,687) +.. controls (508,687) and (635,561) +.. (635,400) +.. controls (635,239) and (508,113) +.. (347,113) +.. controls (187,113) and (60,239) +.. (60,400) +-- cycle) ; +P4 := ((347,591) +-- (382,465) +-- (534,465) +-- (414,380) +-- (458,243) +-- (347,330) +-- (237,243) +-- (282,380) +-- (159,465) +-- (312,465) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (169); +% pine tree +P1 := ((218,750) +-- (50,248) +-- (203,248) +-- (203,30) +-- (50,30) +-- (50,0) +-- (386,0) +-- (386,30) +-- (233,30) +-- (233,248) +-- (386,248) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (170); +% small black square +P1 := ((480,200) +-- (480,600) +-- (80,600) +-- (80,200) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (171); +% faceted star +P1 := ((347,697) +-- (260,471) +-- (30,471) +-- (206,329) +-- (141,102) +-- (347,236) +-- (553,102) +-- (478,329) +-- (664,471) +-- (435,471) +-- cycle) ; +P2 := ((417,457) +-- (617,457) +-- (617,455) +-- (347,375) +-- cycle) ; +P3 := ((458,342) +-- (526,142) +-- (524,141) +-- (347,375) +-- cycle) ; +P4 := ((347,255) +-- (167,135) +-- (165,140) +-- (347,374) +-- cycle) ; +P5 := ((225,335) +-- (76,452) +-- (78,454) +-- (347,375) +-- cycle) ; +P6 := ((273,462) +-- (345,652) +-- (347,652) +-- (347,375) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (172); +% alternate white keystone +P1 := ((150,871) +.. controls (37,871) and (-7,835) +.. (1,757) +-- (88,62) +.. controls (99,-33) and (141,-71) +.. (222,-71) +-- (738,-71) +.. controls (819,-71) and (859,-33) +.. (872,62) +-- (958,757) +.. controls (968,835) and (923,871) +.. (810,871) +-- cycle) ; +P2 := ((799,841) +.. controls (905,841) and (934,807) +.. (925,734) +-- (845,84) +.. controls (834,-5) and (807,-41) +.. (731,-41) +-- (230,-41) +.. controls (154,-41) and (126,-5) +.. (115,84) +-- (34,734) +.. controls (25,807) and (56,841) +.. (162,841) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (173); +% castle +P1 := ((566,0) +-- (566,80) +-- (480,80) +-- (406,507) +-- (190,507) +-- (116,80) +-- (30,80) +-- (30,0) +-- cycle) ; +P2 := ((459,557) +-- (534,690) +-- (534,750) +-- (479,750) +-- (436,675) +-- (379,675) +-- (347,750) +-- (249,750) +-- (217,675) +-- (155,675) +-- (116,742) +-- (62,742) +-- (62,688) +-- (137,557) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (174); +% plus +P1 := ((235,265) +-- (0,265) +-- (0,235) +-- (235,235) +-- (235,0) +-- (265,0) +-- (265,235) +-- (500,235) +-- (500,265) +-- (265,265) +-- (265,500) +-- (235,500) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (175); +% white beehive +P1 := ((0,122) +.. controls (0,-80) and (189,-80) +.. (426,-80) +.. controls (665,-80) and (854,-80) +.. (854,122) +-- (854,272) +.. controls (854,441) and (818,594) +.. (722,679) +.. controls (584,801) and (491,851) +.. (426,880) +.. controls (362,851) and (270,801) +.. (131,679) +.. controls (35,594) and (0,441) +.. (0,272) +-- cycle) ; +P2 := ((30,280) +.. controls (30,430) and (63,581) +.. (152,661) +.. controls (281,776) and (367,822) +.. (426,850) +.. controls (487,822) and (573,776) +.. (701,661) +.. controls (791,581) and (824,430) +.. (824,280) +-- (824,131) +.. controls (824,-50) and (668,-50) +.. (426,-50) +.. controls (186,-50) and (30,-50) +.. (30,131) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (176); +% hexagon +P1 := ((424,150) +-- (569,400) +-- (424,650) +-- (136,650) +-- (-9,400) +-- (136,150) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (177); +% four-pointed star +P1 := ((92,180) +.. controls (215,241) and (386,241) +.. (509,180) +-- (520,192) +.. controls (463,314) and (459,486) +.. (520,608) +-- (509,620) +.. controls (386,559) and (215,559) +.. (92,620) +-- (80,608) +.. controls (137,486) and (141,314) +.. (80,192) +-- cycle) ; +P2 := ((300,526) +.. controls (370,526) and (430,550) +.. (485,587) +-- (487,585) +.. controls (450,529) and (426,471) +.. (426,400) +.. controls (426,328) and (450,271) +.. (487,215) +-- (485,214) +.. controls (430,251) and (367,274) +.. (300,274) +.. controls (227,274) and (171,251) +.. (116,214) +-- (114,215) +.. controls (151,271) and (174,326) +.. (174,400) +.. controls (174,466) and (151,529) +.. (114,585) +-- (116,587) +.. controls (171,550) and (229,526) +.. (300,526) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (178); +% radar dish +P1 := ((560,0) +-- (560,30) +-- (359,30) +-- (284,502) +-- (344,502) +.. controls (344,370) and (434,287) +.. (538,287) +-- (538,289) +.. controls (474,317) and (420,399) +.. (420,519) +.. controls (420,639) and (474,720) +.. (538,748) +-- (538,750) +.. controls (434,750) and (344,667) +.. (344,532) +-- (279,532) +-- (268,600) +-- (165,600) +-- (165,30) +-- (30,30) +-- (30,0) +-- cycle) ; +P2 := ((459,519) +.. controls (459,493) and (479,473) +.. (503,473) +.. controls (528,473) and (548,493) +.. (548,519) +.. controls (548,544) and (528,563) +.. (503,563) +.. controls (479,563) and (459,544) +.. (459,519) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (179); +% crossed digging tools +P1 := ((316,412) +-- (52,677) +-- (30,656) +-- (295,391) +-- (149,245) +-- (101,294) +-- (70,262) +.. controls (43,238) and (37,154) +.. (58,133) +.. controls (78,113) and (162,120) +.. (187,145) +-- (219,176) +-- (170,224) +-- (316,370) +-- (462,224) +-- (414,176) +-- (445,145) +.. controls (470,120) and (554,113) +.. (574,133) +.. controls (595,154) and (588,237) +.. (562,262) +-- (531,294) +-- (483,245) +-- (337,391) +-- (602,656) +-- (581,677) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (180); +% plain shield +P1 := ((0,800) +-- (0,300) +.. controls (0,110) and (180,0) +.. (350,0) +.. controls (520,0) and (700,110) +.. (700,300) +-- (700,800) +-- cycle) ; +P2 := ((670,770) +-- (670,308) +.. controls (670,138) and (505,30) +.. (350,30) +.. controls (195,30) and (30,138) +.. (30,308) +-- (30,770) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (181); +% mining cart +P1 := ((585,370) +-- (35,370) +-- (135,130) +-- (485,130) +-- cycle) ; +P2 := ((385,48) +.. controls (385,21) and (406,0) +.. (433,0) +.. controls (459,0) and (480,21) +.. (480,48) +.. controls (480,75) and (459,95) +.. (433,95) +.. controls (406,95) and (385,75) +.. (385,48) +-- cycle) ; +P3 := ((140,48) +.. controls (140,21) and (161,0) +.. (188,0) +.. controls (214,0) and (235,21) +.. (235,48) +.. controls (235,75) and (214,95) +.. (188,95) +.. controls (161,95) and (140,75) +.. (140,48) +-- cycle) ; +P4 := ((585,405) +.. controls (601,451) and (601,479) +.. (571,479) +.. controls (554,479) and (537,478) +.. (523,471) +.. controls (540,505) and (534,531) +.. (495,531) +.. controls (488,531) and (474,529) +.. (460,523) +.. controls (456,548) and (439,579) +.. (391,579) +.. controls (367,579) and (330,575) +.. (324,535) +.. controls (298,550) and (258,543) +.. (244,509) +.. controls (229,542) and (201,554) +.. (155,554) +.. controls (112,554) and (70,518) +.. (93,459) +.. controls (84,465) and (68,470) +.. (47,470) +.. controls (36,470) and (31,460) +.. (30,446) +.. controls (29,433) and (32,417) +.. (35,405) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (182); +% table +P1 := ((496,172) +-- (549,0) +-- (618,0) +-- (564,172) +-- (730,172) +-- (730,212) +-- (552,212) +-- (501,372) +-- (601,372) +-- (601,412) +-- (159,412) +-- (159,372) +-- (259,372) +-- (208,212) +-- (30,212) +-- (30,172) +-- (196,172) +-- (142,0) +-- (211,0) +-- (264,172) +-- cycle) ; +P2 := ((277,212) +-- (327,372) +-- (433,372) +-- (483,212) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (183); +% star-shaped badge +P1 := ((509,400) +-- (576,512) +.. controls (581,508) and (587,507) +.. (596,507) +.. controls (610,507) and (625,522) +.. (625,541) +.. controls (625,560) and (613,575) +.. (593,575) +.. controls (572,575) and (554,558) +.. (554,541) +-- (425,541) +-- (362,636) +.. controls (371,640) and (381,650) +.. (381,667) +.. controls (381,683) and (366,698) +.. (347,698) +.. controls (328,698) and (313,683) +.. (313,667) +.. controls (313,650) and (323,640) +.. (332,636) +-- (269,541) +-- (140,541) +.. controls (140,558) and (122,575) +.. (101,575) +.. controls (81,575) and (69,560) +.. (69,541) +.. controls (69,522) and (84,507) +.. (98,507) +.. controls (107,507) and (113,508) +.. (118,512) +-- (185,400) +-- (118,289) +.. controls (113,293) and (107,294) +.. (98,294) +.. controls (84,294) and (69,279) +.. (69,260) +.. controls (69,241) and (81,225) +.. (101,225) +.. controls (122,225) and (140,243) +.. (140,260) +-- (269,260) +-- (332,165) +.. controls (323,161) and (313,151) +.. (313,133) +.. controls (313,117) and (328,103) +.. (347,103) +.. controls (366,103) and (381,117) +.. (381,133) +.. controls (381,151) and (371,161) +.. (362,165) +-- (425,260) +-- (554,260) +.. controls (554,243) and (572,225) +.. (593,225) +.. controls (613,225) and (625,241) +.. (625,260) +.. controls (625,279) and (610,294) +.. (596,294) +.. controls (587,294) and (581,293) +.. (576,289) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (184); +% cross-hairs +P1 := ((1200,389) +-- (1200,409) +-- (883,409) +.. controls (880,559) and (762,678) +.. (610,682) +-- (610,1000) +-- (590,1000) +-- (590,682) +.. controls (438,678) and (320,559) +.. (317,409) +-- (0,409) +-- (0,389) +-- (317,389) +.. controls (321,240) and (440,120) +.. (590,116) +-- (590,-200) +-- (610,-200) +-- (610,116) +.. controls (760,120) and (879,240) +.. (883,389) +-- cycle) ; +P2 := ((590,136) +.. controls (450,139) and (340,250) +.. (337,389) +-- (590,389) +-- cycle) ; +P3 := ((610,389) +-- (863,389) +.. controls (860,250) and (750,139) +.. (610,136) +-- cycle) ; +P4 := ((610,662) +.. controls (752,659) and (861,549) +.. (863,409) +-- (610,409) +-- cycle) ; +P5 := ((590,409) +-- (337,409) +.. controls (339,549) and (448,659) +.. (590,662) +-- cycle) ; +drawthem 5; +endfig; + +beginfig (185); +% large white triangle-right +P1 := ((0,-74) +.. controls (0,-124) and (21,-130) +.. (58,-112) +-- (1044,374) +.. controls (1082,393) and (1083,413) +.. (1044,432) +-- (58,910) +.. controls (21,928) and (0,922) +.. (0,872) +-- cycle) ; +P2 := ((30,857) +.. controls (30,880) and (51,880) +.. (67,872) +-- (993,424) +.. controls (1024,409) and (1024,397) +.. (993,382) +-- (67,-74) +.. controls (51,-82) and (30,-82) +.. (30,-59) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (186); +% star in crescent on box +P1 := ((328,713) +-- (301,631) +-- (212,631) +-- (286,576) +-- (258,490) +-- (328,543) +-- (400,490) +-- (373,576) +-- (444,631) +-- (355,631) +-- cycle) ; +P2 := ((420,0) +-- (420,320) +-- (275,320) +-- (275,381) +.. controls (315,384) and (353,406) +.. (367,432) +.. controls (340,423) and (308,418) +.. (283,418) +.. controls (208,418) and (147,491) +.. (147,583) +.. controls (147,675) and (208,748) +.. (254,748) +-- (254,750) +.. controls (157,748) and (76,667) +.. (76,564) +.. controls (76,465) and (149,388) +.. (245,381) +-- (245,320) +-- (100,320) +-- (100,0) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (187); +% tank +P1 := ((275,0) +.. controls (305,0) and (336,22) +.. (350,55) +.. controls (364,22) and (395,0) +.. (425,0) +-- (574,0) +.. controls (605,0) and (644,14) +.. (666,34) +-- (758,126) +-- (758,190) +.. controls (758,207) and (732,212) +.. (712,212) +-- (712,232) +.. controls (712,242) and (702,242) +.. (688,241) +-- (545,229) +-- (517,289) +-- (827,517) +-- (810,543) +-- (499,314) +-- (333,314) +-- (322,337) +-- (249,337) +-- (249,305) +.. controls (206,305) and (168,287) +.. (165,261) +-- (159,200) +-- (44,180) +.. controls (26,177) and (22,137) +.. (32,112) +-- (62,34) +.. controls (69,16) and (112,0) +.. (137,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (188); +% guard +P1 := ((124,514) +.. controls (133,504) and (130,489) +.. (129,477) +.. controls (105,473) and (89,475) +.. (83,465) +-- (37,391) +.. controls (32,382) and (33,375) +.. (36,368) +-- (93,290) +-- (62,227) +-- (87,220) +-- (79,146) +-- (95,48) +-- (62,31) +.. controls (56,27) and (41,28) +.. (41,13) +.. controls (41,6) and (50,0) +.. (61,0) +.. controls (76,0) and (87,6) +.. (92,10) +-- (105,16) +-- (111,14) +-- (128,23) +-- (129,41) +-- (130,48) +-- (130,154) +-- (152,244) +-- (154,244) +-- (178,155) +-- (165,53) +-- (171,49) +-- (172,27) +-- (183,21) +-- (189,23) +-- (204,10) +.. controls (205,9) and (222,0) +.. (233,0) +.. controls (245,0) and (252,4) +.. (252,13) +.. controls (252,23) and (241,26) +.. (236,31) +-- (207,57) +-- (230,147) +-- (208,260) +-- (224,264) +-- (210,322) +-- (212,345) +-- (235,345) +.. controls (248,345) and (255,355) +.. (253,365) +-- (235,451) +.. controls (232,464) and (220,469) +.. (216,473) +-- (243,527) +-- (259,527) +-- (312,638) +.. controls (320,654) and (324,669) +.. (321,677) +.. controls (311,673) and (305,657) +.. (296,640) +-- (245,545) +-- (227,545) +-- (193,477) +-- (174,477) +.. controls (172,493) and (172,504) +.. (179,514) +-- (194,518) +-- (194,543) +.. controls (194,559) and (188,578) +.. (152,578) +.. controls (115,578) and (109,559) +.. (109,543) +-- (109,518) +-- cycle) ; +P2 := ((69,380) +-- (90,414) +.. controls (93,394) and (93,368) +.. (88,343) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (189); +% envelope +P1 := ((660,0) +-- (660,456) +-- (40,456) +-- (40,0) +-- cycle) ; +P2 := ((610,426) +-- (384,200) +.. controls (359,175) and (341,175) +.. (316,200) +-- (90,426) +-- cycle) ; +P3 := ((90,30) +-- (268,208) +.. controls (303,173) and (326,149) +.. (350,149) +.. controls (374,149) and (397,173) +.. (432,208) +-- (610,30) +-- cycle) ; +P4 := ((70,406) +-- (248,228) +-- (70,50) +-- cycle) ; +P5 := ((630,406) +-- (630,50) +-- (452,228) +-- cycle) ; +drawthem 5; +endfig; + +beginfig (190); +% diagonally crossed lines +P1 := ((250,271) +-- (64,458) +-- (43,436) +-- (229,250) +-- (43,64) +-- (64,43) +-- (250,229) +-- (436,43) +-- (457,64) +-- (271,250) +-- (457,436) +-- (436,458) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (191); +% white octagon +P1 := ((234,800) +-- (0,566) +-- (0,235) +-- (234,0) +-- (566,0) +-- (800,235) +-- (800,566) +-- (566,800) +-- cycle) ; +P2 := ((553,770) +-- (770,554) +-- (770,247) +-- (553,30) +-- (246,30) +-- (30,247) +-- (30,554) +-- (246,770) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (192); +% eight-pointed star +P1 := ((592,607) +-- (556,642) +-- (460,546) +.. controls (437,570) and (404,582) +.. (373,582) +-- (373,718) +-- (323,718) +-- (323,582) +.. controls (293,582) and (254,572) +.. (234,552) +-- (138,647) +-- (103,612) +-- (198,516) +.. controls (170,488) and (167,447) +.. (166,425) +-- (30,425) +-- (30,375) +-- (166,375) +.. controls (167,340) and (178,312) +.. (203,289) +-- (107,193) +-- (143,157) +-- (239,253) +.. controls (262,231) and (293,218) +.. (323,218) +-- (323,82) +-- (373,82) +-- (373,218) +.. controls (403,219) and (433,234) +.. (457,258) +-- (552,162) +-- (588,198) +-- (492,294) +.. controls (512,316) and (530,340) +.. (530,375) +-- (666,375) +-- (666,425) +-- (530,425) +.. controls (530,447) and (519,488) +.. (495,511) +-- cycle) ; +P2 := ((216,400) +.. controls (216,474) and (274,532) +.. (348,532) +.. controls (422,532) and (480,474) +.. (480,400) +.. controls (480,326) and (422,268) +.. (348,268) +.. controls (274,268) and (216,326) +.. (216,400) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (193); +% small black circle +P1 := ((30,400) +.. controls (30,260) and (140,150) +.. (280,150) +.. controls (420,150) and (530,260) +.. (530,400) +.. controls (530,540) and (420,650) +.. (280,650) +.. controls (140,650) and (30,540) +.. (30,400) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (194); +% upright white rectangle +P1 := ((0,-129) +.. controls (0,-165) and (30,-200) +.. (60,-200) +-- (760,-200) +.. controls (790,-200) and (820,-165) +.. (820,-129) +-- (820,929) +.. controls (820,965) and (790,1002) +.. (760,1000) +-- (60,1000) +.. controls (30,1000) and (0,965) +.. (0,929) +-- cycle) ; +P2 := ((30,910) +.. controls (30,944) and (50,970) +.. (78,970) +-- (742,970) +.. controls (770,971) and (790,944) +.. (790,910) +-- (790,-111) +.. controls (790,-145) and (770,-170) +.. (742,-170) +-- (78,-170) +.. controls (50,-170) and (30,-145) +.. (30,-111) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (195); +% six-pointed star on box +P1 := ((260,750) +-- (195,643) +-- (72,643) +-- (135,536) +-- (72,429) +-- (196,429) +-- (260,320) +-- (326,429) +-- (448,429) +-- (385,536) +-- (448,643) +-- (326,643) +-- cycle) ; +P2 := ((100,0) +-- (420,0) +-- (420,320) +-- (100,320) +-- cycle) ; +P3 := ((260,708) +-- (297,643) +-- (223,643) +-- cycle) ; +P4 := ((335,623) +-- (412,623) +-- (373,559) +-- cycle) ; +P5 := ((373,513) +-- (410,449) +-- (336,449) +-- cycle) ; +P6 := ((299,429) +-- (260,366) +-- (225,429) +-- cycle) ; +P7 := ((186,449) +-- (111,449) +-- (148,513) +-- cycle) ; +P8 := ((148,559) +-- (110,623) +-- (187,623) +-- cycle) ; +P9 := ((213,623) +-- (309,623) +-- (360,536) +-- (310,449) +-- (212,449) +-- (161,536) +-- cycle) ; +drawthem 9; +endfig; + +beginfig (196); +% bicycle +P1 := ((570,377) +-- (331,377) +-- (350,437) +-- (341,454) +-- (351,463) +-- (415,463) +-- (415,489) +-- (338,489) +-- (308,462) +-- (326,436) +-- (283,307) +.. controls (262,321) and (236,332) +.. (196,332) +.. controls (103,332) and (30,259) +.. (30,166) +.. controls (30,73) and (103,0) +.. (196,0) +.. controls (282,0) and (362,76) +.. (362,166) +.. controls (362,230) and (337,273) +.. (303,298) +-- (313,325) +-- (481,139) +.. controls (476,130) and (476,120) +.. (480,112) +.. controls (485,103) and (493,97) +.. (505,96) +-- (511,59) +-- (498,55) +-- (500,39) +-- (544,48) +-- (541,64) +-- (528,62) +-- (520,100) +.. controls (526,107) and (523,106) +.. (524,114) +-- (583,124) +.. controls (605,44) and (666,0) +.. (748,0) +.. controls (840,0) and (914,73) +.. (914,166) +.. controls (914,259) and (840,332) +.. (748,332) +.. controls (699,334) and (668,316) +.. (654,305) +-- (600,369) +-- (606,391) +.. controls (618,391) and (636,391) +.. (647,402) +-- (663,420) +.. controls (667,426) and (663,434) +.. (657,434) +-- (523,424) +.. controls (514,423) and (513,418) +.. (516,413) +.. controls (526,399) and (563,394) +.. (575,391) +-- cycle) ; +P2 := ((589,338) +-- (630,288) +.. controls (600,261) and (575,202) +.. (577,152) +-- (526,143) +-- cycle) ; +P3 := ((475,191) +-- (484,191) +-- (484,171) +-- (320,351) +-- (566,351) +-- (506,168) +-- (499,168) +-- (499,191) +-- (508,191) +-- (508,203) +-- (475,203) +-- cycle) ; +P4 := ((276,216) +-- (292,262) +.. controls (310,244) and (328,211) +.. (328,166) +.. controls (328,91) and (265,32) +.. (196,34) +.. controls (122,34) and (64,91) +.. (64,166) +.. controls (64,241) and (122,298) +.. (196,298) +.. controls (239,297) and (263,287) +.. (273,276) +-- (257,229) +-- (201,176) +-- (190,180) +.. controls (177,180) and (167,172) +.. (167,158) +.. controls (167,146) and (177,138) +.. (188,138) +.. controls (200,138) and (205,145) +.. (207,150) +-- cycle) ; +P5 := ((708,192) +.. controls (716,182) and (717,176) +.. (708,174) +-- (611,158) +.. controls (611,204) and (627,243) +.. (652,262) +-- cycle) ; +P6 := ((675,278) +.. controls (690,290) and (711,298) +.. (748,298) +.. controls (822,298) and (880,241) +.. (880,166) +.. controls (880,91) and (822,34) +.. (748,34) +.. controls (675,37) and (626,84) +.. (615,130) +-- (745,152) +.. controls (757,155) and (763,158) +.. (763,164) +.. controls (763,169) and (754,178) +.. (751,183) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (197); +% flask +P1 := ((300,530) +.. controls (290,566) and (288,591) +.. (288,619) +-- (288,683) +.. controls (296,685) and (303,688) +.. (309,692) +-- (309,716) +.. controls (309,731) and (256,739) +.. (212,739) +.. controls (168,739) and (115,731) +.. (115,717) +-- (115,692) +.. controls (121,688) and (128,685) +.. (136,683) +-- (136,619) +.. controls (136,591) and (134,566) +.. (124,530) +-- (38,211) +.. controls (33,192) and (30,173) +.. (30,160) +.. controls (30,146) and (37,137) +.. (52,122) +.. controls (67,107) and (111,61) +.. (212,61) +.. controls (313,61) and (357,107) +.. (372,122) +.. controls (387,137) and (394,146) +.. (394,160) +.. controls (394,173) and (391,192) +.. (386,211) +-- cycle) ; +P2 := ((263,611) +.. controls (263,586) and (263,563) +.. (272,530) +-- (347,239) +.. controls (352,221) and (361,198) +.. (361,181) +.. controls (361,168) and (358,149) +.. (337,131) +.. controls (319,120) and (291,91) +.. (212,91) +.. controls (133,91) and (105,120) +.. (87,131) +.. controls (66,149) and (63,168) +.. (63,181) +.. controls (63,198) and (72,221) +.. (77,239) +-- (152,530) +.. controls (161,563) and (161,586) +.. (161,611) +-- (161,689) +.. controls (155,691) and (150,694) +.. (145,698) +-- (145,707) +.. controls (145,717) and (183,720) +.. (212,720) +.. controls (241,720) and (279,717) +.. (279,707) +-- (279,698) +.. controls (274,694) and (269,691) +.. (263,689) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (198); +% airliner +P1 := ((521,-14) +-- (521,54) +-- (445,114) +-- (445,328) +-- (780,207) +-- (780,291) +-- (445,499) +-- (445,776) +.. controls (445,804) and (422,814) +.. (405,814) +.. controls (388,814) and (365,804) +.. (365,776) +-- (365,499) +-- (30,291) +-- (30,207) +-- (365,328) +-- (365,114) +-- (289,54) +-- (289,-14) +-- (405,39) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (199); +% southeast arrow +P1 := ((763,491) +-- (631,624) +-- (631,315) +-- (229,717) +-- (130,618) +-- (532,216) +-- (223,216) +-- (356,84) +-- (763,84) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (200); +% right arrow +P1 := ((859,400) +-- (571,688) +-- (384,688) +-- (602,470) +-- (34,470) +-- (34,330) +-- (602,330) +-- (384,112) +-- (571,112) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (201); +% dot in triangle +P1 := ((590,122) +-- (311,679) +-- (30,122) +-- cycle) ; +P2 := ((64,142) +-- (310,635) +-- (556,142) +-- cycle) ; +P3 := ((255,302) +.. controls (255,271) and (279,247) +.. (310,247) +.. controls (341,247) and (365,271) +.. (365,302) +.. controls (365,333) and (341,357) +.. (310,357) +.. controls (279,357) and (255,333) +.. (255,302) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (202); +% large black rhombus +P1 := ((17,436) +.. controls (-5,413) and (-5,385) +.. (17,364) +-- (512,-131) +.. controls (533,-152) and (561,-152) +.. (582,-131) +-- (1077,364) +.. controls (1099,385) and (1099,414) +.. (1077,435) +-- (582,930) +.. controls (561,951) and (533,952) +.. (512,930) +-- cycle) ; +P2 := ((0,0) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (203); +% alternate black keystone +P1 := ((150,871) +.. controls (37,871) and (-7,835) +.. (1,757) +-- (88,62) +.. controls (99,-33) and (141,-71) +.. (222,-71) +-- (738,-71) +.. controls (819,-71) and (859,-33) +.. (872,62) +-- (958,757) +.. controls (968,835) and (923,871) +.. (810,871) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (204); +% supine rectangle +P1 := ((60,810) +.. controls (30,810) and (0,780) +.. (0,750) +-- (0,50) +.. controls (0,20) and (30,-8) +.. (60,-10) +-- (960,-10) +.. controls (990,-10) and (1020,20) +.. (1020,50) +-- (1020,750) +.. controls (1020,780) and (990,810) +.. (960,810) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (205); +% black beehive +P1 := ((0,122) +.. controls (0,-80) and (189,-80) +.. (426,-80) +.. controls (665,-80) and (854,-80) +.. (854,122) +-- (854,272) +.. controls (854,441) and (818,594) +.. (722,679) +.. controls (584,801) and (491,851) +.. (426,880) +.. controls (362,851) and (270,801) +.. (131,679) +.. controls (35,594) and (0,441) +.. (0,272) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (206); +% square divided by three vertical lines +P1 := ((530,0) +-- (530,500) +-- (30,500) +-- (30,0) +-- cycle) ; +P2 := ((500,30) +-- (413,30) +-- (413,470) +-- (500,470) +-- cycle) ; +P3 := ((265,30) +-- (177,30) +-- (177,470) +-- (265,470) +-- cycle) ; +P4 := ((383,30) +-- (295,30) +-- (295,470) +-- (383,470) +-- cycle) ; +P5 := ((147,30) +-- (60,30) +-- (60,470) +-- (147,470) +-- cycle) ; +drawthem 5; +endfig; + +beginfig (207); +% roof above capital +P1 := ((626,0) +-- (626,50) +-- (50,50) +-- (50,0) +-- cycle) ; +P2 := ((338,750) +-- (30,482) +-- (646,482) +-- cycle) ; +P3 := ((533,80) +-- (533,181) +.. controls (533,236) and (626,221) +.. (626,320) +.. controls (626,397) and (573,452) +.. (486,452) +-- (191,452) +.. controls (104,452) and (50,397) +.. (50,320) +.. controls (50,221) and (143,236) +.. (143,181) +-- (143,80) +-- cycle) ; +P4 := ((193,130) +-- (193,185) +.. controls (193,233) and (295,200) +.. (295,304) +.. controls (295,341) and (265,377) +.. (219,377) +.. controls (173,377) and (150,343) +.. (150,311) +.. controls (150,290) and (161,281) +.. (174,281) +.. controls (186,281) and (200,290) +.. (200,304) +.. controls (200,317) and (203,334) +.. (223,334) +.. controls (239,334) and (245,318) +.. (245,299) +.. controls (245,271) and (218,248) +.. (180,248) +.. controls (137,248) and (100,280) +.. (100,323) +.. controls (100,366) and (137,399) +.. (180,402) +-- (497,402) +.. controls (540,399) and (576,366) +.. (576,323) +.. controls (576,280) and (540,248) +.. (497,248) +.. controls (460,248) and (431,271) +.. (431,299) +.. controls (431,318) and (438,334) +.. (454,334) +.. controls (475,334) and (476,317) +.. (476,304) +.. controls (476,290) and (491,281) +.. (504,281) +.. controls (516,281) and (526,290) +.. (526,311) +.. controls (526,343) and (505,377) +.. (459,377) +.. controls (413,377) and (381,341) +.. (381,304) +.. controls (381,200) and (483,233) +.. (483,185) +-- (483,130) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (208); +% crossed sabers +P1 := ((432,397) +-- (509,475) +.. controls (574,409) and (691,382) +.. (753,444) +.. controls (798,489) and (771,553) +.. (739,586) +-- (681,644) +.. controls (660,664) and (634,656) +.. (619,641) +-- (542,564) +-- (509,596) +.. controls (489,617) and (502,650) +.. (516,668) +.. controls (502,665) and (479,654) +.. (468,632) +.. controls (453,606) and (458,578) +.. (477,560) +-- (508,530) +-- (404,426) +-- (300,530) +-- (329,561) +.. controls (349,579) and (354,607) +.. (339,632) +.. controls (327,655) and (305,665) +.. (291,668) +.. controls (305,651) and (318,617) +.. (298,597) +-- (265,564) +-- (189,641) +.. controls (173,656) and (146,665) +.. (127,644) +-- (69,586) +.. controls (35,554) and (9,489) +.. (54,445) +.. controls (116,383) and (233,409) +.. (298,475) +-- (375,397) +-- (111,133) +.. controls (168,141) and (209,175) +.. (252,218) +-- (404,369) +-- (556,216) +.. controls (598,175) and (640,141) +.. (696,133) +-- cycle) ; +P2 := ((624,588) +.. controls (640,604) and (662,609) +.. (680,591) +-- (709,562) +.. controls (729,542) and (750,494) +.. (728,473) +.. controls (668,413) and (571,466) +.. (537,501) +-- cycle) ; +P3 := ((272,501) +.. controls (236,467) and (139,414) +.. (79,475) +.. controls (58,496) and (78,543) +.. (99,564) +-- (128,593) +.. controls (146,610) and (168,605) +.. (185,588) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (209); +% fortress +P1 := ((1230,0) +-- (1230,228) +-- (1005,228) +-- (1005,83) +-- (645,83) +-- (645,358) +-- (759,455) +-- (615,553) +-- (615,83) +-- (255,83) +-- (255,228) +-- (30,228) +-- (30,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (210); +% southwest arrow +P1 := ((130,84) +-- (537,84) +-- (670,216) +-- (361,216) +-- (763,618) +-- (664,717) +-- (262,315) +-- (262,624) +-- (130,491) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (211); +% left arrow +P1 := ((34,400) +-- (322,112) +-- (509,112) +-- (291,330) +-- (859,330) +-- (859,470) +-- (291,470) +-- (509,688) +-- (322,688) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (212); +% down arrow +P1 := ((447,-12) +-- (735,276) +-- (735,463) +-- (517,245) +-- (517,813) +-- (377,813) +-- (377,245) +-- (159,463) +-- (159,276) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (213); +% up arrow +P1 := ((447,813) +-- (159,525) +-- (159,338) +-- (377,556) +-- (377,-12) +-- (517,-12) +-- (517,556) +-- (735,338) +-- (735,525) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (214); +% supine Y +P1 := ((435,380) +-- (575,210) +-- (620,210) +-- (465,400) +-- (620,590) +-- (575,590) +-- (435,420) +-- (35,420) +-- (35,380) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (215); +% curly hat on box +P1 := ((420,0) +-- (420,320) +-- (275,320) +-- (275,509) +.. controls (363,509) and (433,555) +.. (458,641) +.. controls (338,560) and (288,628) +.. (262,750) +-- (260,750) +.. controls (234,628) and (184,560) +.. (64,641) +.. controls (89,556) and (157,509) +.. (245,509) +-- (245,320) +-- (100,320) +-- (100,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (216); +% black octagon +P1 := ((234,800) +-- (0,566) +-- (0,235) +-- (234,0) +-- (566,0) +-- (800,235) +-- (800,566) +-- (566,800) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (217); +% fancy black shield +P1 := ((30,748) +.. controls (58,736) and (97,664) +.. (97,608) +.. controls (97,545) and (0,460) +.. (0,299) +.. controls (0,83) and (151,-88) +.. (265,-88) +.. controls (315,-88) and (344,-79) +.. (367,-69) +.. controls (391,-60) and (409,-50) +.. (425,-50) +.. controls (456,-50) and (499,-84) +.. (531,-122) +.. controls (563,-84) and (607,-50) +.. (638,-50) +.. controls (654,-50) and (672,-60) +.. (696,-69) +.. controls (719,-79) and (747,-88) +.. (798,-88) +.. controls (912,-88) and (1063,83) +.. (1063,299) +.. controls (1063,460) and (966,545) +.. (966,608) +.. controls (967,664) and (1006,736) +.. (1034,748) +-- (845,921) +.. controls (790,862) and (737,824) +.. (689,824) +.. controls (637,824) and (557,862) +.. (531,921) +.. controls (505,862) and (427,824) +.. (375,824) +.. controls (327,824) and (274,862) +.. (218,921) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (218); +% medium black circle +P1 := ((30,400) +.. controls (30,223) and (170,83) +.. (347,83) +.. controls (524,83) and (665,223) +.. (665,400) +.. controls (665,577) and (524,717) +.. (347,717) +.. controls (170,717) and (30,577) +.. (30,400) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (219); +% black shield +P1 := ((503,-121) +.. controls (597,-121) and (767,-18) +.. (853,90) +.. controls (945,206) and (1005,346) +.. (1005,508) +.. controls (1005,663) and (930,835) +.. (850,921) +.. controls (793,882) and (735,860) +.. (677,860) +.. controls (619,860) and (561,882) +.. (503,921) +.. controls (446,882) and (387,860) +.. (329,860) +.. controls (271,860) and (213,882) +.. (154,921) +.. controls (75,835) and (0,663) +.. (0,508) +.. controls (0,346) and (59,206) +.. (153,90) +.. controls (238,-18) and (408,-121) +.. (503,-121) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (220); +% upright rectangle +P1 := ((0,-129) +.. controls (0,-165) and (30,-200) +.. (60,-200) +-- (760,-200) +.. controls (790,-200) and (820,-165) +.. (820,-129) +-- (820,929) +.. controls (820,965) and (790,1002) +.. (760,1000) +-- (60,1000) +.. controls (30,1000) and (0,965) +.. (0,929) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (221); +% large black circle +P1 := ((0,400) +.. controls (0,129) and (213,-85) +.. (485,-85) +.. controls (757,-85) and (970,129) +.. (970,400) +.. controls (970,671) and (757,885) +.. (485,885) +.. controls (213,885) and (0,671) +.. (0,400) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (222); +% black oval +P1 := ((0,411) +.. controls (0,194) and (311,22) +.. (721,22) +.. controls (1125,22) and (1442,194) +.. (1442,411) +.. controls (1442,628) and (1125,799) +.. (721,799) +.. controls (318,799) and (0,628) +.. (0,411) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (223); +% small white explosion +P1 := ((896,0) +-- (1054,154) +-- (1052,156) +-- (876,156) +-- (1044,516) +-- (1042,518) +-- (740,270) +-- (732,366) +-- (612,180) +-- (592,476) +-- (494,296) +-- (252,700) +-- (250,698) +-- (274,276) +-- (186,326) +-- (182,134) +-- (2,232) +-- (0,230) +-- (173,0) +-- cycle) ; +P2 := ((184,20) +-- (71,169) +-- (73,169) +-- (200,103) +-- (203,293) +-- (297,239) +-- (273,624) +-- (275,624) +-- (495,257) +-- (578,409) +-- (598,123) +-- (718,307) +-- (726,232) +-- (988,448) +-- (988,450) +-- (990,448) +-- (844,136) +-- (1007,136) +-- (888,20) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (224); +% large black square +P1 := ((50,800) +.. controls (20,800) and (0,780) +.. (0,750) +-- (0,50) +.. controls (0,20) and (20,0) +.. (50,0) +-- (750,0) +.. controls (780,0) and (800,20) +.. (800,43) +-- (800,750) +.. controls (800,780) and (780,800) +.. (750,800) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (225); +% narrow black shield +P1 := ((700,856) +-- (568,921) +.. controls (529,899) and (496,884) +.. (459,884) +.. controls (423,884) and (371,899) +.. (350,921) +.. controls (329,899) and (277,884) +.. (241,884) +.. controls (205,884) and (171,899) +.. (132,921) +-- (0,856) +-- (0,606) +.. controls (16,555) and (34,503) +.. (34,451) +.. controls (34,425) and (30,399) +.. (23,373) +.. controls (17,347) and (8,322) +.. (0,296) +.. controls (0,196) and (41,101) +.. (106,21) +.. controls (166,-52) and (285,-122) +.. (350,-122) +.. controls (416,-122) and (534,-52) +.. (594,21) +.. controls (658,101) and (700,196) +.. (700,296) +.. controls (684,347) and (666,399) +.. (666,451) +.. controls (666,477) and (671,503) +.. (677,529) +.. controls (684,555) and (692,581) +.. (700,606) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (226); +% plain black shield +P1 := ((0,800) +-- (0,300) +.. controls (0,110) and (180,0) +.. (350,0) +.. controls (520,0) and (700,110) +.. (700,300) +-- (700,800) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (227); +% very small black circle +P1 := ((531,400) +.. controls (531,508) and (456,584) +.. (348,584) +.. controls (240,584) and (164,508) +.. (164,400) +.. controls (164,292) and (240,216) +.. (348,216) +.. controls (456,216) and (531,292) +.. (531,400) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (228); +% black star inside white star +P1 := ((347,697) +-- (260,471) +-- (30,471) +-- (206,329) +-- (141,102) +-- (347,236) +-- (553,102) +-- (478,329) +-- (664,471) +-- (435,471) +-- cycle) ; +P2 := ((416,451) +-- (595,451) +-- (450,340) +-- (510,157) +-- (347,267) +-- (184,157) +-- (237,340) +-- (99,451) +-- (279,451) +-- (347,634) +-- cycle) ; +P3 := ((347,528) +-- (308,421) +-- (201,421) +-- (284,358) +-- (252,252) +-- (347,317) +-- (442,252) +-- (405,358) +-- (493,421) +-- (386,421) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (229); +% white circle inside black star +P1 := ((347,697) +-- (265,473) +-- (30,473) +-- (222,336) +-- (135,104) +-- (347,249) +-- (559,104) +-- (475,336) +-- (664,473) +-- (430,473) +-- cycle) ; +P2 := ((250,367) +.. controls (250,421) and (293,465) +.. (347,465) +.. controls (401,465) and (444,421) +.. (444,367) +.. controls (444,312) and (401,269) +.. (347,269) +.. controls (293,269) and (250,312) +.. (250,367) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (230); +% very small white circle +P1 := ((531,400) +.. controls (531,508) and (456,584) +.. (348,584) +.. controls (240,584) and (164,508) +.. (164,400) +.. controls (164,292) and (240,216) +.. (348,216) +.. controls (456,216) and (531,292) +.. (531,400) +-- cycle) ; +P2 := ((501,400) +.. controls (501,309) and (438,246) +.. (348,246) +.. controls (257,246) and (194,309) +.. (194,400) +.. controls (194,491) and (257,554) +.. (348,554) +.. controls (438,554) and (501,491) +.. (501,400) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (231); +% plain white house +P1 := ((849,-52) +.. controls (878,-52) and (907,-23) +.. (907,7) +-- (907,538) +.. controls (907,572) and (888,593) +.. (862,609) +-- (478,833) +.. controls (459,844) and (448,844) +.. (429,833) +-- (46,609) +.. controls (19,593) and (0,572) +.. (0,538) +-- (0,7) +.. controls (0,-23) and (29,-52) +.. (58,-52) +-- cycle) ; +P2 := ((71,-22) +.. controls (44,-22) and (30,-8) +.. (30,20) +-- (30,533) +.. controls (30,565) and (48,580) +.. (73,595) +-- (431,804) +.. controls (449,814) and (459,814) +.. (477,804) +-- (835,595) +.. controls (859,580) and (877,565) +.. (877,533) +-- (877,20) +.. controls (877,-8) and (863,-22) +.. (836,-22) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (232); +% white plumb bob +P1 := ((75,796) +.. controls (29,796) and (0,775) +.. (0,652) +.. controls (0,439) and (211,129) +.. (430,-66) +.. controls (471,-103) and (529,-103) +.. (570,-66) +.. controls (789,129) and (1000,439) +.. (1000,652) +.. controls (1000,775) and (971,796) +.. (925,796) +-- (629,796) +-- (629,859) +.. controls (629,881) and (615,894) +.. (593,894) +-- (407,894) +.. controls (384,894) and (371,881) +.. (371,859) +-- (371,796) +-- cycle) ; +P2 := ((401,766) +-- (401,841) +.. controls (401,857) and (408,864) +.. (425,864) +-- (575,864) +.. controls (591,864) and (599,857) +.. (599,841) +-- (599,766) +-- (899,766) +.. controls (942,766) and (970,741) +.. (970,637) +.. controls (970,465) and (773,156) +.. (563,-34) +.. controls (521,-72) and (479,-72) +.. (437,-34) +.. controls (227,156) and (30,465) +.. (30,637) +.. controls (30,741) and (57,766) +.. (100,766) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (233); +% traffic light +P1 := ((404,-40) +-- (404,840) +-- (30,840) +-- (30,-40) +-- cycle) ; +P2 := ((117,130) +.. controls (117,186) and (161,230) +.. (217,230) +.. controls (273,230) and (317,186) +.. (317,130) +.. controls (317,74) and (273,30) +.. (217,30) +.. controls (161,30) and (117,74) +.. (117,130) +-- cycle) ; +P3 := ((117,400) +.. controls (117,456) and (161,500) +.. (217,500) +.. controls (273,500) and (317,456) +.. (317,400) +.. controls (317,344) and (273,300) +.. (217,300) +.. controls (161,300) and (117,344) +.. (117,400) +-- cycle) ; +P4 := ((117,670) +.. controls (117,726) and (161,770) +.. (217,770) +.. controls (273,770) and (317,726) +.. (317,670) +.. controls (317,614) and (273,570) +.. (217,570) +.. controls (161,570) and (117,614) +.. (117,670) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (234); +% campfire +P1 := ((39,293) +.. controls (39,255) and (68,176) +.. (171,175) +.. controls (144,194) and (104,224) +.. (94,274) +.. controls (92,291) and (88,313) +.. (89,338) +.. controls (90,364) and (93,390) +.. (99,409) +.. controls (58,376) and (39,331) +.. (39,293) +-- cycle) ; +P2 := ((402,273) +.. controls (424,353) and (387,454) +.. (347,487) +.. controls (356,439) and (355,401) +.. (353,382) +.. controls (351,349) and (312,291) +.. (284,259) +.. controls (273,247) and (251,213) +.. (251,199) +.. controls (251,190) and (248,184) +.. (251,175) +.. controls (283,192) and (317,192) +.. (344,205) +.. controls (363,214) and (396,244) +.. (402,273) +-- cycle) ; +P3 := ((394,23) +.. controls (410,23) and (420,38) +.. (420,52) +.. controls (420,67) and (414,83) +.. (402,83) +.. controls (388,83) and (375,67) +.. (375,49) +.. controls (375,38) and (378,23) +.. (394,23) +-- cycle) ; +P4 := ((80,24) +.. controls (80,42) and (73,55) +.. (55,55) +.. controls (38,55) and (30,42) +.. (30,24) +.. controls (30,6) and (38,-6) +.. (55,-6) +.. controls (73,-6) and (80,6) +.. (80,24) +-- cycle) ; +P5 := ((182,52) +.. controls (155,63) and (127,78) +.. (100,78) +-- (67,65) +.. controls (93,50) and (94,29) +.. (88,2) +-- cycle) ; +P6 := ((410,131) +.. controls (417,151) and (406,165) +.. (387,172) +-- (336,160) +.. controls (314,155) and (279,151) +.. (243,132) +.. controls (269,122) and (312,112) +.. (338,109) +-- cycle) ; +P7 := ((195,132) +.. controls (157,138) and (75,148) +.. (64,150) +.. controls (46,133) and (44,117) +.. (49,96) +.. controls (49,96) and (109,92) +.. (140,83) +.. controls (171,74) and (191,58) +.. (228,54) +.. controls (270,49) and (302,43) +.. (317,42) +.. controls (331,40) and (347,30) +.. (365,28) +.. controls (356,57) and (362,77) +.. (384,87) +-- (384,90) +.. controls (361,90) and (314,99) +.. (267,111) +.. controls (240,117) and (219,128) +.. (195,132) +-- cycle) ; +P8 := ((117,355) +.. controls (117,255) and (165,205) +.. (209,172) +.. controls (215,201) and (235,236) +.. (257,263) +.. controls (267,276) and (294,306) +.. (303,322) +.. controls (314,341) and (327,360) +.. (327,420) +.. controls (327,501) and (273,616) +.. (243,649) +.. controls (243,605) and (231,580) +.. (210,551) +.. controls (195,532) and (117,429) +.. (117,355) +-- cycle) ; +drawthem 8; +endfig; + +beginfig (235); +% clamp +P1 := ((520,0) +-- (520,110) +-- (140,110) +-- (140,290) +-- (520,290) +-- (520,400) +-- (30,400) +-- (30,0) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (236); +% banner on oval +P1 := ((245,750) +-- (245,215) +.. controls (139,211) and (60,165) +.. (60,108) +.. controls (60,48) and (146,0) +.. (260,0) +.. controls (372,0) and (460,48) +.. (460,108) +.. controls (460,165) and (380,212) +.. (275,215) +-- (275,499) +-- (420,625) +-- cycle) ; +P2 := ((275,185) +.. controls (363,182) and (430,149) +.. (430,108) +.. controls (430,65) and (355,30) +.. (260,30) +.. controls (163,30) and (90,65) +.. (90,108) +.. controls (90,148) and (156,182) +.. (245,185) +-- (245,100) +-- (275,100) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (237); +% horseshoe +P1 := ((515,197) +.. controls (520,207) and (514,210) +.. (507,214) +-- (475,231) +.. controls (490,263) and (518,327) +.. (518,425) +.. controls (518,522) and (425,649) +.. (274,649) +.. controls (123,649) and (30,522) +.. (30,425) +.. controls (30,327) and (58,263) +.. (73,231) +-- (41,214) +.. controls (34,210) and (28,207) +.. (33,197) +-- (53,157) +.. controls (56,151) and (60,148) +.. (67,152) +-- (150,196) +.. controls (158,200) and (158,206) +.. (154,214) +.. controls (143,235) and (110,307) +.. (110,363) +.. controls (110,420) and (130,579) +.. (274,579) +.. controls (418,579) and (438,420) +.. (438,363) +.. controls (438,307) and (405,235) +.. (394,214) +.. controls (390,206) and (390,200) +.. (398,196) +-- (481,152) +.. controls (488,148) and (492,151) +.. (495,157) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (238); +% overpass +P1 := ((225,500) +-- (125,600) +-- (75,550) +-- (155,470) +-- (155,130) +-- (75,50) +-- (125,0) +-- (225,100) +-- cycle) ; +P2 := ((375,100) +-- (475,0) +-- (525,50) +-- (445,130) +-- (445,470) +-- (525,550) +-- (475,600) +-- (375,500) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (239); +% helicopter +P1 := ((601,210) +.. controls (611,210) and (621,220) +.. (621,230) +-- (621,250) +.. controls (621,260) and (611,270) +.. (601,270) +-- (301,270) +.. controls (291,270) and (281,260) +.. (281,250) +-- (281,230) +.. controls (281,220) and (291,210) +.. (301,210) +-- cycle) ; +P2 := ((595,458) +.. controls (586,486) and (555,510) +.. (516,510) +-- (401,510) +-- (401,570) +-- (433,570) +.. controls (439,570) and (446,562) +.. (456,562) +-- (602,562) +.. controls (612,562) and (620,569) +.. (620,576) +.. controls (620,583) and (612,590) +.. (602,590) +-- (456,590) +.. controls (446,590) and (439,582) +.. (433,582) +-- (343,582) +.. controls (337,582) and (330,590) +.. (320,590) +-- (174,590) +.. controls (164,590) and (156,583) +.. (156,576) +.. controls (156,569) and (164,562) +.. (174,562) +-- (320,562) +.. controls (330,562) and (337,570) +.. (343,570) +-- (376,570) +-- (376,510) +-- (149,510) +.. controls (141,531) and (120,548) +.. (92,548) +.. controls (57,548) and (30,520) +.. (30,485) +.. controls (30,450) and (57,423) +.. (92,423) +.. controls (120,423) and (138,435) +.. (149,448) +-- (288,397) +-- (307,350) +.. controls (315,329) and (325,320) +.. (341,320) +-- (589,320) +.. controls (629,320) and (630,349) +.. (620,379) +-- cycle) ; +P3 := ((401,410) +-- (401,490) +-- (451,490) +-- (451,410) +-- cycle) ; +P4 := ((471,410) +-- (471,490) +-- (521,490) +-- (521,410) +-- cycle) ; +P5 := ((541,410) +-- (541,490) +.. controls (567,481) and (587,449) +.. (591,410) +-- cycle) ; +P6 := ((98,510) +.. controls (84,510) and (78,504) +.. (78,494) +.. controls (78,488) and (85,478) +.. (94,473) +-- (132,454) +.. controls (124,444) and (110,438) +.. (92,438) +.. controls (65,438) and (45,459) +.. (45,485) +.. controls (45,512) and (65,533) +.. (92,533) +.. controls (112,533) and (125,524) +.. (130,510) +-- cycle) ; +drawthem 6; +endfig; + +beginfig (240); +% plain black house +P1 := ((849,-52) +.. controls (878,-52) and (907,-23) +.. (907,7) +-- (907,538) +.. controls (907,572) and (888,593) +.. (862,609) +-- (478,833) +.. controls (459,844) and (448,844) +.. (429,833) +-- (46,609) +.. controls (19,593) and (0,572) +.. (0,538) +-- (0,7) +.. controls (0,-23) and (29,-52) +.. (58,-52) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (241); +% large white "X" +P1 := ((0,664) +-- (264,400) +-- (0,136) +-- (140,-4) +-- (404,260) +-- (668,-4) +-- (808,136) +-- (544,400) +-- (808,664) +-- (668,804) +-- (404,540) +-- (140,804) +-- cycle) ; +P2 := ((140,762) +-- (404,498) +-- (668,761) +-- (765,664) +-- (502,400) +-- (765,136) +-- (668,39) +-- (404,302) +-- (140,39) +-- (43,136) +-- (306,400) +-- (42,664) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (242); +% circle with 4 handles +P1 := ((373,718) +-- (323,718) +-- (323,582) +.. controls (249,585) and (167,506) +.. (166,425) +-- (30,425) +-- (30,375) +-- (166,375) +.. controls (167,305) and (242,219) +.. (323,218) +-- (323,82) +-- (373,82) +-- (373,218) +.. controls (451,231) and (521,298) +.. (530,375) +-- (666,375) +-- (666,425) +-- (530,425) +.. controls (529,495) and (454,581) +.. (373,582) +-- cycle) ; +P2 := ((216,400) +.. controls (216,474) and (274,532) +.. (348,532) +.. controls (422,532) and (480,474) +.. (480,400) +.. controls (480,326) and (422,268) +.. (348,268) +.. controls (274,268) and (216,326) +.. (216,400) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (243); +% large black "X" +P1 := ((0,664) +-- (264,400) +-- (0,136) +-- (140,-4) +-- (404,260) +-- (668,-4) +-- (808,136) +-- (544,400) +-- (808,664) +-- (668,804) +-- (404,540) +-- (140,804) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (244); +% black "+" +P1 := ((389,526) +-- (237,526) +-- (237,339) +-- (50,339) +-- (50,187) +-- (237,187) +-- (237,0) +-- (389,0) +-- (389,187) +-- (576,187) +-- (576,339) +-- (389,339) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (245); +% cross +P1 := ((230,750) +-- (230,539) +-- (80,539) +-- (80,484) +-- (230,484) +-- (230,0) +-- (290,0) +-- (290,484) +-- (440,484) +-- (440,539) +-- (290,539) +-- (290,750) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (246); +% nuclear silos +P1 := ((680,0) +-- (680,27) +.. controls (623,30) and (595,51) +.. (565,122) +.. controls (542,176) and (498,286) +.. (498,454) +.. controls (498,500) and (499,580) +.. (519,643) +.. controls (480,664) and (417,672) +.. (355,672) +.. controls (293,672) and (230,664) +.. (191,643) +.. controls (211,580) and (212,500) +.. (212,454) +.. controls (212,286) and (168,176) +.. (145,122) +.. controls (115,51) and (87,30) +.. (30,27) +-- (30,0) +-- cycle) ; +P2 := ((713,0) +-- (1230,0) +-- (1230,21) +.. controls (1185,24) and (1162,41) +.. (1139,97) +.. controls (1120,140) and (1085,227) +.. (1085,361) +.. controls (1085,397) and (1086,461) +.. (1102,511) +.. controls (1071,528) and (1021,534) +.. (972,534) +.. controls (922,534) and (872,528) +.. (841,511) +.. controls (857,461) and (858,397) +.. (858,361) +.. controls (858,227) and (823,140) +.. (805,97) +.. controls (781,41) and (759,24) +.. (713,21) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (247); +% gemstone +P1 := ((30,400) +-- (255,50) +-- (480,400) +-- (255,750) +-- cycle) ; +P2 := ((453,410) +-- (337,410) +-- (285,670) +-- (287,672) +-- cycle) ; +P3 := ((317,410) +-- (193,410) +-- (254,724) +-- (256,724) +-- cycle) ; +P4 := ((173,410) +-- (57,410) +-- (223,672) +-- (225,670) +-- cycle) ; +P5 := ((337,390) +-- (453,390) +-- (287,128) +-- (285,130) +-- cycle) ; +P6 := ((193,390) +-- (317,390) +-- (256,76) +-- (254,76) +-- cycle) ; +P7 := ((57,390) +-- (173,390) +-- (225,130) +-- (223,128) +-- cycle) ; +drawthem 7; +endfig; + +beginfig (248); +% grain silos +P1 := ((780,50) +-- (780,610) +-- (714,610) +.. controls (706,696) and (650,750) +.. (579,750) +.. controls (528,750) and (479,721) +.. (456,674) +.. controls (430,723) and (384,750) +.. (335,750) +.. controls (262,750) and (195,689) +.. (195,610) +-- (195,50) +-- (30,50) +-- (30,0) +-- (884,0) +-- (884,50) +-- cycle) ; +P2 := ((618,610) +-- (618,50) +-- (538,50) +-- (538,610) +-- (472,610) +.. controls (472,661) and (518,720) +.. (579,720) +.. controls (634,720) and (678,670) +.. (684,610) +-- cycle) ; +P3 := ((376,610) +-- (376,50) +-- (225,50) +-- (225,610) +.. controls (225,661) and (271,720) +.. (332,720) +.. controls (390,720) and (436,670) +.. (442,610) +-- cycle) ; +drawthem 3; +endfig; + +beginfig (249); +% factory +P1 := ((780,260) +-- (730,260) +-- (730,700) +-- (650,700) +-- (650,260) +-- (600,260) +-- (600,440) +-- (410,260) +-- (410,440) +-- (220,260) +-- (220,440) +-- (30,260) +-- (30,0) +-- (860,0) +-- (860,700) +-- (780,700) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (250); +% boat +P1 := ((556,245) +-- (385,245) +-- (374,280) +-- (227,280) +-- (158,98) +-- (30,98) +-- (80,0) +-- (976,0) +-- (1012,98) +-- (758,98) +-- (732,181) +-- (576,181) +-- cycle) ; +P2 := ((364,215) +-- (539,215) +-- (558,151) +-- (708,151) +-- (725,98) +-- (191,98) +-- (249,250) +-- (352,250) +-- cycle) ; +P3 := ((514,151) +-- (506,181) +-- (377,181) +-- (387,151) +-- cycle) ; +P4 := ((269,211) +.. controls (269,199) and (279,189) +.. (291,189) +.. controls (304,189) and (314,199) +.. (314,211) +.. controls (314,224) and (304,234) +.. (291,234) +.. controls (279,234) and (269,224) +.. (269,211) +-- cycle) ; +drawthem 4; +endfig; + +beginfig (251); +% crossed flags +P1 := ((447,408) +-- (546,507) +-- (674,380) +-- (822,529) +-- (674,677) +-- (426,430) +-- (178,677) +-- (30,529) +-- (178,380) +-- (306,507) +-- (405,409) +-- (141,144) +-- (162,123) +-- (426,387) +-- (691,123) +-- (712,144) +-- cycle) ; +P2 := ((179,635) +-- (285,529) +-- (179,423) +-- (73,529) +-- cycle) ; +drawthem 2; +endfig; + +beginfig (252); +% black keystone +P1 := ((702,-58) +.. controls (736,-58) and (742,-50) +.. (753,-18) +-- (931,539) +.. controls (939,563) and (946,593) +.. (946,619) +.. controls (946,659) and (909,700) +.. (867,718) +-- (581,837) +.. controls (553,849) and (513,857) +.. (473,857) +.. controls (433,857) and (393,849) +.. (366,837) +-- (79,718) +.. controls (38,700) and (0,659) +.. (0,619) +.. controls (0,593) and (7,563) +.. (15,539) +-- (193,-18) +.. controls (205,-50) and (210,-58) +.. (245,-58) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (253); +% large black triangle-down +P1 := ((52,899) +.. controls (0,899) and (-13,876) +.. (12,830) +-- (537,-66) +.. controls (563,-111) and (591,-111) +.. (617,-66) +-- (1142,830) +.. controls (1167,876) and (1154,899) +.. (1102,899) +-- cycle) ; +drawthem 1; +endfig; + +beginfig (254); +% large black triangle-right +P1 := ((0,-74) +.. controls (0,-124) and (21,-130) +.. (58,-112) +-- (1044,374) +.. controls (1082,393) and (1083,413) +.. (1044,432) +-- (58,910) +.. controls (21,928) and (0,922) +.. (0,872) +-- cycle) ; +drawthem 1; +endfig; + +end. diff --git a/Master/texmf-dist/metapost/piechartmp/piechartmp.mp b/Master/texmf-dist/metapost/piechartmp/piechartmp.mp new file mode 100644 index 00000000000..2c1631e424a --- /dev/null +++ b/Master/texmf-dist/metapost/piechartmp/piechartmp.mp @@ -0,0 +1,1108 @@ +%H package name: piechartMP +%H description: Metapost package for 2D/3D pie charts +%H file: piechartmp.mp +%H author: Jens-Uwe Morawski <morawski@gmx.net> +%H version: 0.3.0 2002/05/14 + +%L Copyright 2002, Jens-Uwe Morawski +%L License: LPPL 1.0, see LEGAL + + +%I * all user commands start with uppercase letters: +%I Segment, SegmentState, +%I SetupColors, SetupNumbers, SetupText, +%I SetupValue, SetupPercent, SetupName, +%I PieChart, Label +%I * user variables start with uppercase letters: +%I PiechartBBox, R +%I * all internal functions start with '_' except +%I SegmentColor, SegmentPoint +%I * all internal variables start with 'pc_' except +%I auto, hidden, normal, invisible, this, +%I inwards, outwards, name, percent, value + +%\ +% initialisation +%\ +if known piechart_module: endinput ; fi ; +boolean piechart_module ; piechart_module := true ; + +% === data / input routines === (pc-input.mp) +%\ +% vars / internals +%\ +newinternal hidden ; hidden := -1 ; +newinternal invisible ; invisible := 0 ; +newinternal normal ; normal := 1 ; + +%\ +% data input/ user values / segment state +%\ +numeric pc_Count ; pc_Count := 0 ; % number of defined segments +numeric pc_xValue[], pc_xOffset[], pc_xState[]; +color pc_xFill[] ; +string pc_n_Label[], pc_v_Label[] ; + +def Segment(text s) = + begingroup; + save i ; numeric i ; i:=0; + pc_Count := pc_Count + 1 ; + for e=s: + i := i+1 ; + if i=1: + pc_xValue[pc_Count] := e ; + pc_n_Label[pc_Count] := _numericToString(pc_Count, -1) ; + pc_xFill[pc_Count] := auto ; + pc_v_Label[pc_Count] := _numericToString(e, -1) ; + elseif i=2: + pc_n_Label[pc_Count] := e ; + elseif i=3: + pc_xFill[pc_Count] := _applyColorOrPattern(e) ; + elseif i=4: + pc_v_Label[pc_Count] := e ; + fi; + endfor; + + if i=0: + errmessage "Segment: too few arguments for segment " & + (decimal pc_Count) ; + fi; + + pc_xState[pc_Count] := normal ; + pc_xOffset[pc_Count] := 0 ; + endgroup; +enddef; + +def SegmentState(expr s, st, sh ) = + if not _isThis(st): + pc_xState[s] := st ; + fi; + + if not _isThis(sh): + pc_xOffset[s] := sh ; + fi; +enddef; + +%C reset diagramm data +def ResetSegments = + pc_Count := 0 ; +enddef; + +% === drawing routines === (pc-draw.mp) +%\ +% vars / internals +%\ + +newinternal R; +pair pc_Centre; pc_Centre := origin ; +numeric pc_Offset ; +numeric pc_Depth ; +numeric pc_View ; +numeric pc_Sum ; +numeric pc_xStart[], pc_xEnd[] ; + + +boolean pc_Metafun ; pc_Metafun := false ; +if known context_spec : pc_Metafun := true ; fi ; + + +%\ +% diagram drawing +%\ + +%C PieChart(<diagramm radius>, <thickness in R>, <angle>, <rotation>,<global offset in R>) +def PieChart (expr u, d, va, r, go) = + begingroup ; + save rot, pointer ; numeric rot , pointer; + R := u ; + if ( va < 90 ) and ( va >= 0 ): + pc_View := va ; + else: + message "Warning: Observation angle of " & ( decimal va ) & " is not valid. Substituted with 65." ; + pc_View := 65 ; + fi ; + + pc_Offset := go ; + + pc_Sum := 0 ; + for i=1 upto pc_Count: + if (pc_xState[i] >= 0): + pc_Sum := pc_Sum + pc_xValue[i] ; + fi ; + endfor; + + if (( r >= 0 ) and ( r <= 359 )): + rot := r ; + else: + rot := 0 ; + message "Warning: Rotation " & (decimal r) & " is not within 0-359. Defaults to 0" ; + fi ; + pointer := rot ; + for i=1 upto pc_Count: + if ( pc_xState[i] >= 0 ): + pc_xStart[i] := pointer ; + pc_xEnd[i] := pc_xStart[i] + (pc_xValue[i] / pc_Sum)*360.00 ; + else: + pc_xStart[i] := pointer ; + pc_xEnd[i] := pointer ; + fi ; + pointer := pc_xEnd[i] ; + endfor; + + pc_Depth := d*R*(sind pc_View) ; + if (pc_View > 0): _drawSides ; fi ; + _drawTop ; + endgroup ; +enddef; + +%C draws top sides of all visible segments +def _drawTop = + begingroup ; + save c , a, e, p ; path c, a, e ; picture p ; + for i=1 upto pc_Count: + if ( pc_xState[i] > 0) : + c := fullcircle rotated (pc_xStart[i]) scaled (2*R) ; + e := origin--(1.1*R*(cosd pc_xEnd[i]) , 1.1*R*(sind pc_xEnd[i]) ) ; + c := c cutafter e ; c := origin--c--cycle ; + fill ( c yscaled (cosd pc_View) ) shifted _calcSegmentShift(i) withcolor SegmentColor(i) ; + if ( greenpart pc_xFill[i]) = -2 : + p := _makePattern(i, c) ; + draw ( p yscaled (cosd pc_View) ) shifted _calcSegmentShift(i) withcolor _patternColor(i) ; + fi; + fi ; + endfor; + endgroup ; +enddef; + +%C visual ordering of side elements +def _drawSides = + begingroup ; + save _etd, c , a , e; + numeric _etd[][] , c , a , e; + c := 0 ; + for i=1 upto pc_Count: + if (pc_xState[i] > 0) : + if _visibleStart(i): + c := c + 1 ; + _etd[c][1] := 1 ; + _etd[c][2] := sind ( _normalizeAngle(pc_xStart[i])) ; + _etd[c][3] := i ; + _etd[c][4] := _normalizeAngle(pc_xStart[i]) ; + fi + if _visibleEnd(i): + c := c + 1 ; + _etd[c][1] := 1 ; + _etd[c][2] := sind ( _normalizeAngle(pc_xEnd[i])) ; + _etd[c][3] := i ; + _etd[c][4] := _normalizeAngle(pc_xEnd[i]) ; + fi + if _visibleOutside(i): + c := c + 1 ; + if _outsideIsDivided(i): + _etd[c][1] := 2 ; + _etd[c][3] := i ; + _etd[c][4] := _normalizeAngle(pc_xStart[i]) ; + _etd[c][5] := 360 ; + c := c + 1 ; + _etd[c][1] := 2 ; + _etd[c][3] := i ; + _etd[c][4] := 180 ; + _etd[c][5] := _normalizeAngle(pc_xEnd[i]) ; + else : + a := pc_xStart[i] ; + e := pc_xEnd[i] ; + + if ( (sind a) >= 0 ): + a := 180 ; + fi ; + if ( (sind e) >= 0 ) : + e := 360 ; + fi ; + + _etd[c][1] := 2 ; + _etd[c][3] := i ; + _etd[c][4] := _normalizeAngle(a) ; + _etd[c][5] := _normalizeAngle(e) ; + fi + fi + fi + endfor; + + for i=1 upto c: + if (_etd[i][1] = 2 ): + if (( (cosd _etd[i][4])*(cosd _etd[i][5]) ) >= 0): + _etd[i][2] := sind (0.5*(_etd[i][4] + _etd[i][5])); + else : + _etd[i][2] := -1 ; + fi + fi + endfor; + + for i=1 upto c : + a := -2 ; e := 0 ; + for j=1 upto c: + if (_etd[j][1] > 0) and (_etd[j][2] > a): + e := j ; + a := _etd[j][2] ; + fi + endfor; + if (e > 0): + if (_etd[e][1] = 1): + _drawInside(_etd[e][3],_etd[e][4]) ; + else: + _drawOutside(_etd[e][3],_etd[e][4],_etd[e][5]) ; + fi + _etd[e][1] := 0 ; + fi + endfor; + endgroup ; +enddef; + +def _drawInside (expr s, a) = + begingroup ; + save b, e; path e, b; + + e := origin--(R*(cosd a), R*(sind a)*(cosd pc_View) ) ; + b := (R*(cosd a), R*(sind a)*(cosd pc_View) )--origin ; + %if ( (sind a) > 0): b := b yscaled (1 + (0.1*(sind a)*(sind pc_View))); fi ; + + b := b shifted (0, -pc_Depth) ; + e := b--e--cycle ; e := e shifted _calcSegmentShift(s) ; + fill e withcolor _calcInsideColor(s,a) ; + endgroup ; +enddef; + + +def _drawOutside (expr s, a, e) = + begingroup ; + save p, h, g ; + path p, h, g ; + if (pc_Metafun and (a < 270) and (e > 270)) : + _drawOutside(s,a,270) ; + _drawOutside(s,270,e) ; + else : + g := fullcircle xscaled (2*R) yscaled (2*R*(cosd pc_View)); + g := subpath (4,8) of g ; %top + h := g shifted (0, -pc_Depth) ; % below + g := g xscaled -1 ; % in the reverse direction + + p := (R*(cosd e),0)--(R*(cosd e),-1.1*(R*(cosd pc_View)+pc_Depth)) ; + h := h cutafter p ; + g := g cutbefore p ; + + p := (R*(cosd a),0)--(R*(cosd a),-1.1*(R*(cosd pc_View)+pc_Depth)) ; + h := h cutbefore p ; + g := g cutafter p ; + + p := h--g--cycle ; p := p shifted _calcSegmentShift(s) ; + if pc_Metafun: + linear_shade(p,0,_calcOutsideColor(s,a),_calcOutsideColor(s,e)) ; + else : + fill p withcolor _calcOutsideColor(s, (0.5*(a+e)) ) ; + fi ; + fi ; + endgroup ; +enddef; + +%\ +% help macros +%\ + +vardef _visibleStart (expr s) = + save b; boolean b; + b:= ( ( cosd ( _normalizeAngle(pc_xStart[s]) )) > 0 ) and + ( (pc_Offset > 0) or (pc_xOffset[s] > 0) or + (pc_xState[ _prevSegment(s) ] = 0) or + (pc_xOffset[_prevSegment(s)] > 0) ); + b +enddef; + +vardef _visibleEnd (expr s) = + save b; boolean b; + b:= ( ( cosd ( _normalizeAngle(pc_xEnd[s]) )) < 0 ) and + ( (pc_Offset > 0) or (pc_xOffset[s] > 0) or + (pc_xState[ _nextSegment(s) ] = 0) or + (pc_xOffset[_nextSegment(s)] > 0) ); + b +enddef; + +vardef _visibleOutside (expr s) = + save b; boolean b; + b := ((sind pc_xStart[s] < 0) or (sind (pc_xEnd[s]) < 0) or + (sind (0.5*(pc_xStart[s] + pc_xEnd[s])) < 0)) ; + b +enddef; + +vardef _outsideIsDivided (expr s) = + save b; boolean b; + b := ( ( (sind pc_xStart[s]) < 0 ) and + ( (sind pc_xEnd[s] ) < 0 ) and + ( (sind (0.5*(pc_xStart[s]+pc_xEnd[s])) ) >= 0 ) ); + b +enddef; + +% === colors ==== (pc-color.mp) +%\ +% vars / internals +%\ +color auto ; auto := (-1,-1,-1) ; + +%\ +% color +%\ + +%C returns the color of the segment with number s; +%C if the segment uses pattern fill it returns the +%C background color +vardef SegmentColor(expr s) = + save tC; color tC; + if pc_xFill[s] = (-1,-1,-1): + tC := _autoColor( 0.5*(pc_xStart[s]+pc_xEnd[s]) - pc_xStart[1] ) ; + elseif ( (greenpart pc_xFill[s]) = -2 ) : + tC := pc_patternBGColor[(bluepart pc_xFill[s])] ; + if tC = (-1,-1,-1): + tC := _autoColor( 0.5*(pc_xStart[s]+pc_xEnd[s]) - pc_xStart[1] ) ; + fi ; + else: + tC := pc_xFill[s] ; + fi; + if pc_sGrayscale: + tC := (0.3*(redpart tC) + 0.59*(greenpart tC) + 0.11*(bluepart tC))*white ; + fi ; + tC +enddef; + +%C returns the foreground color of the pattern +vardef _patternColor (expr s) = + save tC, v, h ; color tC; numeric v, h ; + tC := pc_patternFGColor[(bluepart pc_xFill[s])] ; + if tC = (-1,-1,-1): + tC := SegmentColor(s) ; + tC := _rgbToHsv(tC) ; + h := redpart tC ; + h := h - 180 ; + if h<0: h := h + 360 ; fi ; + v := bluepart tC ; + v := 1 - v ; + tC := ( h , greenpart tC , v) ; + tC := _hsvToRgb(tC) ; + fi; + if pc_sGrayscale: + tC := (0.3*(redpart tC) + 0.59*(greenpart tC) + 0.11*(bluepart tC))*white ; + fi ; + tC +enddef; + +%C returns the color of the insides in 3D view of the segment s +%C a is the angle/direction of the side in the diagram +vardef _calcInsideColor (expr s, a) = + save tC, f; color tC; numeric f ; + f := cosd ( (abs(cosd a))*pc_View ) ; + tC := SegmentColor(s) + f*(xpart pc_sShadeSV)*( _minSaturation(SegmentColor(s)) - SegmentColor(s) ) ; + tC := tC + f*(ypart pc_sShadeSV)*( black - tC ) ; + tC +enddef; + +%C returns the color of the outsides in 3D view of the segment s +%C a is the angle/direction of the side in the diagram +vardef _calcOutsideColor (expr s, a) = + save tC, f; color tC; numeric f ; + f := cosd ( (abs(sind a))*pc_View ) ; + tC := SegmentColor(s) + f*(xpart pc_sShadeSV)*( _minSaturation(SegmentColor(s)) - SegmentColor(s) ) ; + tC := tC + f*(ypart pc_sShadeSV)*( black - tC ) ; + tC +enddef; + +%\ +% help macros +%\ + +%C return a color from c as if saturation is set to zero +vardef _minSaturation (expr c)= + save sat; numeric sat; sat := 0 ; + sat := 0.3*(redpart c) + 0.59*(greenpart c) + 0.11*(bluepart c) ; + sat*white +enddef; + + +%C automatic color values +vardef _autoColor(expr a) = + _hsvToRgb( (a, (xpart pc_sAutoSV), (ypart pc_sAutoSV)) ) +enddef; + +vardef _hsvToRgb(expr c) = + save h,s,v, H,o, b, d, pc, sc; + numeric h,s,v,H, o, b, d, pc, sc ; + + h := redpart c ; + s := greenpart c ; + v := bluepart c ; + + H := _normalizeAngle(h) / 60 ; + pc := floor H ; + sc := H - pc ; + o := (1 - s)*v ; + b := (1 - (sc*s) )*v; + d := (1 - ((1-sc)*s) )*v ; + + if (pc = 0) or (pc = 6): + (v,d,o) + elseif pc = 1: + (b,v,o) + elseif pc = 2: + (o,v,d) + elseif pc = 3: + (o,b,v) + elseif pc = 4: + (d,o,v) + else: + (v,o,b) + fi +enddef; + +vardef _rgbToHsv (expr c) = + save r,g,b,h,s,v, _r, _g, _b, min, max ; + numeric r,g,b,h,s,v, _r, _g, _b, min, max ; + + r := redpart c ; + g := greenpart c ; + b := bluepart c ; + + min := r ; max := r ; + + if (g < min): min := g ; fi ; + if (g > max): max := g ; fi ; + if (b < min): min := b ; fi ; + if (b > max): max := b ; fi ; + + if max > 0: + s := (max - min)/max ; v := max ; + else: + s := 0; v := 0 ; + fi ; + + + if (s = 0): + h := 0 ; % is undefined + else: + _r := (max - r)/(max - min) ; + _g := (max - g)/(max - min) ; + _b := (max - b)/(max - min) ; + + if ((r = max ) and (g = min)): h := 5 + _b ; + elseif ((r = max ) and (g <> min)): h := 1 - _g ; + elseif ((g = max ) and (b = min)): h := 1 + _r ; + elseif ((g = max ) and (b <> min)): h := 3 - _b ; + elseif (r = max): h := 3 + _g ; + else: h := 5 - _r ; + fi ; + fi ; + h := 60 * h ; + (h,s,v) +enddef; +% === pattern routines === (pc-pattr.mp) + +%\ +% vars +%\ +numeric pc_patternType[] ; +color pc_patternFGColor[], pc_patternBGColor[] ; +pair pc_patternDimen[] ; + +%\ +% routines +%\ + +%C called via Segment(); +vardef _applyColorOrPattern (expr c) = + if color c: + c + else: + if ( numeric c ): + if known pc_patternType[c]: + (-1,-2,c) + else: + errmessage "Pattern number " & (decimal c) & " not defined" ; + (-1,-1,-1) + fi + else: + show c ; + hide(errmessage "Not a valid pattern number.") ; + (-1,-1,-1) + fi + fi +enddef; + +%C defines a pattern with number n, of type t +%C with foreground color f and background color b +%C with dimensions (pair) d +def DefinePattern (expr n, t, b, f, d) = + pc_patternType[n] := t ; + pc_patternFGColor[n] := f ; + pc_patternBGColor[n] := b ; + pc_patternDimen[n] := d ; +enddef; + + +%C returns a picture including the pattern +%C for segment s in path p +vardef _makePattern (expr s, p) = + save o, u, type, spacing, dimen, b, xs, ys, q ; + pair o, u ; numeric type, spacing, dimen ; + picture b ; + b := nullpicture ; + type := pc_patternType[(bluepart pc_xFill[s])] ; + dimen := ypart pc_patternDimen[(bluepart pc_xFill[s])] ; + spacing := xpart pc_patternDimen[(bluepart pc_xFill[s])] ; + o := ulcorner p ; + u := lrcorner p ; + + if type = 0: + b := PrivatePattern (o, u, spacing, dimen) ; + elseif type = 1: + numeric ys ; path line ; + ys := ( ypart o ) + ypart (o - u ) - spacing ; + forever: + exitif ( ys <= ypart u ) ; + line := (xpart o, ys)--(xpart u, ys - ypart(o-u)) ; + addto b doublepath line withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + elseif type = 2: + numeric ys ; path line ; + ys := ( ypart o ) + ypart (o - u ) - spacing ; + forever: + exitif ( ys <= ypart u ) ; + line := (xpart o, ys - ypart(o-u) )--(xpart u, ys ) ; + addto b doublepath line withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + elseif type = 3: + numeric ys ; path line ; + ys := ( ypart o ) + ypart (o - u ) - spacing ; + forever: + exitif ( ys <= ypart u ) ; + line := (xpart o, ys - ypart(o-u) )--(xpart u, ys ) ; + addto b doublepath line withpen pencircle scaled dimen ; + line := (xpart o, ys )--(xpart u, ys - ypart(o-u) ) ; + addto b doublepath line withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + elseif type = 4: + numeric ys ; path line ; + ys := ( ypart o ) - spacing ; + forever: + exitif ( ys <= ypart u ) ; + line := (xpart o, ys )--(xpart u, ys ) ; + addto b doublepath line withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + elseif type = 5: + numeric xs ; path line ; + xs := ( xpart o ) - spacing ; + forever: + exitif ( xs >= xpart u ) ; + line := (xs, ypart o)--(xs, ypart u) ; + addto b doublepath line withpen pencircle scaled dimen ; + xs := xs + spacing ; + endfor; + elseif type = 6: + numeric xs, ys ; path line ; + xs := ( xpart o ) - spacing ; + forever: + exitif ( xs >= xpart u ) ; + line := (xs, ypart o)--(xs, ypart u) ; + addto b doublepath line withpen pencircle scaled dimen ; + xs := xs + spacing ; + endfor; + ys := ( ypart o ) - spacing ; + forever: + exitif ( ys <= ypart u ) ; + line := (xpart o, ys )--(xpart u, ys ) ; + addto b doublepath line withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + elseif type = 7: + numeric xs, ys ; + xs := ( xpart o ) ; + forever: + exitif ( xs >= xpart u ) ; + ys := ( ypart o ) ; + forever: + exitif ( ys <= ypart u ) ; + addto b doublepath (xs,ys) withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + xs := xs + spacing ; + endfor; + elseif type = 8: + numeric xs, ys ; + xs := ( xpart o ) ; + forever: + exitif ( xs >= xpart u ) ; + ys := ( ypart o ) ; + forever: + exitif ( ys <= ypart u ) ; + addto b doublepath (xs,ys) withpen pencircle scaled dimen ; + addto b doublepath (xs+.5*spacing,ys+.5*spacing) withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + xs := xs + spacing ; + endfor; + elseif type = 9: + numeric xs, ys ; path q[] ; + q1 := (0,0){curl 0}..(0.25*spacing, -0.2*spacing )..{curl 0}(0.5*spacing, 0) ; + q2 := q1..(q1 yscaled -1 shifted (.5*spacing, 0)) ; + xs := ( xpart o ) ; + forever: + exitif ( xs >= xpart u ) ; + ys := ( ypart o ) ; + forever: + exitif ( ys <= ypart u ) ; + addto b doublepath (q[2] shifted (xs,ys)) withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + xs := xs + spacing ; + endfor; + elseif type = 10: + numeric xs, ys ; path q ; + q := (0,0)--(0.5*spacing, -0.5*spacing )--(0,-spacing) ; + xs := ( xpart o ) ; + forever: + exitif ( xs >= xpart u ) ; + ys := ( ypart o ) ; + forever: + exitif ( ys <= ypart u ) ; + addto b doublepath (q shifted (xs,ys)) withpen pencircle scaled dimen ; + ys := ys - spacing ; + endfor; + xs := xs + spacing ; + endfor; + else: + errmessage "pattern type " & (decimal type) & " not defined." + b := nullpicture; + fi; + clip b to p ; + b +enddef; + +vardef PrivatePattern (expr ulc, lrc, spc, lwd) = + save pic, cntr, c, k ; + picture pic ; pic := nullpicture ; + pair cntr ; + numeric c ; + path k ; + + cntr := 0.5*( lrc + ulc ) ; + + c := ((xpart (ulc - cntr))++(ypart (ulc - cntr))) / spc ; + c := ( floor c ) ; + + for i=1 upto c: + k := fullcircle scaled (i*2*spc) shifted cntr ; + addto pic doublepath k withpen pencircle scaled lwd ; + endfor; + pic +enddef; + +% === label commands === (pc-label.mp) + +%\ +% vars +%\ + + +%C +color name, percent, value ; +name := (-1,-4,1) ; percent := (-1,-4,2) ; value := (-1,-4,3) ; +%C additional label positioning parameters +pair laboff.auto; laboff.auto=(-3,-3) ; +labxf.auto=0; labyf.auto=0; + +%\ +% text / labels / legend +%\ + +def Label = draw _theLabel enddef ; + +vardef _theLabel@#(text t)(text d)(expr sp, sh) = + save pic ; picture pic ; pic := nullpicture ; + for S=t: + if S=0: + for i=1 upto pc_Count: + if pc_xState[i] = 1: + addto pic also _makeSegLabel.@#(i,sp,sh)(d) ; + fi; + endfor; + else: + if (S > 0) and (S <= pc_Count): + if pc_xState[S]= 1 : + addto pic also _makeSegLabel.@#(S,sp,sh)(d) ; + fi; + else: + message "Label: segment " & (decimal S) & " not defined."; + fi; + fi; + endfor; + pic +enddef; + + + +vardef _makeSegLabel@# (expr s, sp, sh)(text dat) = + save d , t, p, o , pic, l; + numeric l; + pair p, o ; + picture t, pic ; pic := nullpicture ; + string d ; d := "" ; + + for f=dat: + if color f: + if (bluepart f = 1 ):% name of segment + d := d & pc_n_Pre & pc_n_Label[s] & pc_n_Post ; + elseif (bluepart f = 2 ):% percent value + d := d & pc_p_Pre & + _numericToString( 100*(pc_xValue[s]/pc_Sum), pc_sPrecision) & + pc_p_Post ; + elseif (bluepart f = 3 ):%segment value + d := d & pc_v_Pre & pc_v_Label[s] & pc_v_Post ; + fi; + elseif string f:% free string + d := d & f ; + else: + errmessage "Not a valid label-data: "; show f ; + fi; + endfor; + + t := _makeText(d) ; + + if pair sh : + if sh = (0,0): + o := SegmentPoint(s,(0,0)) ; + p := SegmentPoint(s,sp) ; + addto pic doublepath p withpen currentpen ; + else: + o := SegmentPoint(s,sp) ; + p := o shifted sh ; + addto pic doublepath o--p withpen currentpen ; + fi; + else: + p := SegmentPoint(s,sp) ; + o := SegmentPoint(s,(0,0)) ; + + fi; + + if laboff.@# = (-3,-3): % auto justification + + l := _normalizeAngle( angle(p-o) ) ; + laboff.auto := ((cosd l),(sind l)) ; + labxf.auto := ((cosd l) - 1) / -2 ; + labyf.auto := ((sind l) - 1) / -2 ; + + if (not pair sh) and ((xpart sp) >= 1): + if (sind _normalizeAngle( angle(p-o) )) < 0 : + p := p + (0,-pc_Depth) ; + fi; + fi; + + fi; + addto pic also thelabel.@#(t,p) ; + + laboff.auto := (-3,-3) ; + pic +enddef; + + +%\ +% help functions +%\ + +vardef _numericToString (expr n , c) = + save l, s ; + string l, s ;l := ""; + if (c < 0): + s := decimal n ; + for i=1 upto (length s): + if ((substring (i-1,i) of s) = "."): + l := l & pc_sDelimiter; + else: + l := l & (substring (i-1,i) of s); + fi; + endfor; + elseif ( (c=3) and (n>32.767) ): + hide(message("Warning: Decrease precision for value " & decimal n & " to 2.")) ; + s := decimal ( round(n*(10**(c-1))) ) ; + l := substring (0,(length s)-2) of s & + pc_sDelimiter & + substring ((length s)-2,length s) of s ; + else: + s := decimal ( round(n*(10**c)) ) ; + if (c>0): + l := substring (0,(length s)-c) of s & + pc_sDelimiter & + substring ((length s)-c,length s) of s ; + else: + l := substring (0,(length s)-c) of s ; + fi ; + fi; + l +enddef; + +% === text routines === (pc-text.mp) +%\ +% vars +%\ +string pc_TeXFile ; +pc_TeXFile := jobname & ".pct" ; + + +%\ +% TeX +%\ + +vardef _makeText primary s = + if ( pc_sTextScheme > 0 ) : + write "verbatimtex" to pc_TeXFile ; + if ( pc_sTextScheme = 3 ): + write "%&latex" to pc_TeXFile ; + else: + write pc_sTeXFormat to pc_TeXFile ; + fi; + if ( pc_sTextScheme > 1 ): + write "\documentclass{minimal}" to pc_TeXFile ; + write pc_sTeXSettings to pc_TeXFile ; + write "\begin{document}" to pc_TeXFile ; + else: + write pc_sTeXSettings to pc_TeXFile ; + fi; + write "etex" to pc_TeXFile ; + write "btex "&s&" etex" to pc_TeXFile; + write EOF to pc_TeXFile; + scantokens ("input " & pc_TeXFile ) + else: + s infont defaultfont scaled defaultscale + fi +enddef; + +% === support routines === (pc-supp.mp) +%\ +% vars / internals +%\ +pair inwards, outwards ; +inwards := (.66, .5) ; outwards := (1.05, .5) ; + +%\ +% macros +%\ +vardef SegmentPoint (expr s, t) = + save p, a ; pair p ; + numeric a ; + if (( ( xpart t) >=0 ) and + ( ( ypart t) >=0 ) and + ( ( ypart t) <=1 ) ): + a := pc_xStart[s] + (ypart t)*(pc_xEnd[s] - pc_xStart[s]) ; + p := ( ( xpart t)*R*(cosd a) , ( xpart t)*R*(sind a)*(cosd pc_View) ) ; + p := p + _calcSegmentShift(s) ; + else : + errmessage "SegmentPoint: point definition for segment " & (decimal s) & " is not valid. Substituted with default." ; + p := SegmentPoint(s,(1,0.5)) ; + fi ; + p +enddef; + +vardef _calcSegmentShift(expr s) = + save o, x, y ; + numeric o, x, y ; + o := R*(pc_Offset + pc_xOffset[s]) ; + x := o*(cosd (0.5*(pc_xStart[s] + pc_xEnd[s]))) ; + y := o*(sind (0.5*(pc_xStart[s] + pc_xEnd[s])))*(cosd pc_View) ; + (x,y) + pc_Centre +enddef; + +vardef _normalizeAngle (expr a) = + if a > 360: + a - 360 + elseif a < 0: + 360 + a + else: + a + fi +enddef; + +vardef _nextSegment(expr s) = + if s < pc_Count: + if pc_xState[s+1] >= 0: + s+1 + else: + _nextSegment(s+1) + fi + else: + if pc_xState[1] >= 0: + 1 + else: + _nextSegment(1) + fi + fi +enddef; + +vardef _prevSegment(expr s) = + if s = 1: + if pc_xState[pc_Count] >= 0: + pc_Count + else: + _prevSegment(pc_Count) + fi + else: + if pc_xState[s-1] >= 0: + s-1 + else: + _prevSegment(s-1) + fi + fi +enddef; + +% === setup routines === (pc-setup.mp) + +%\ +% vars +%\ + +boolean pc_sGrayscale ; pc_sGrayscale := false ; +pair pc_sAutoSV ; pc_sAutoSV := (1,1) ; +pair pc_sShadeSV ; pc_sShadeSV := (.4,.3) ; + +numeric pc_sPrecision ; pc_sPrecision := 0 ; +string pc_sDelimiter ; pc_sDelimiter := "." ; + +string pc_sTeXFormat, pc_sTeXSettings ; +pc_sTeXFormat := "" ; pc_sTeXSettings := "" ; +numeric pc_sTextScheme ; pc_sTextScheme := 0 ; + + +string pc_p_Pre, pc_p_Post, pc_v_Pre, pc_v_Post, + pc_n_Pre, pc_n_Post ; +pc_p_Pre := "" ; pc_p_Post := "" ; +pc_v_Pre := "" ; pc_v_Post := "" ; +pc_n_Pre := "" ; pc_n_Post := "" ; + + +color this ; this := (-9,-9,-9) ; + +vardef _isThis (expr t) = + if color t : + if t = this: + true + else: + false + fi + else: + false + fi +enddef; + +def SetupColors (expr a, s, g) = + if not _isThis(a) : pc_sAutoSV := a ; fi ; + if not _isThis(s) : pc_sShadeSV := s ; fi ; + if not _isThis(g) : pc_sGrayscale := g ; fi ; +enddef; + +def SetupNumbers (expr p, d) = + if not _isThis(p) : pc_sPrecision := p ; fi ; + if not _isThis(d) : pc_sDelimiter := d ; fi ; +enddef; + +def SetupText (expr l, f, s) = + if not _isThis(l) : pc_sTextScheme := l ; fi ; + if not _isThis(f) : pc_sTeXFormat := f ; fi ; + if not _isThis(s) : pc_sTeXSettings := s ; fi ; +enddef; + +def SetupPercent (expr r, o) = + if not _isThis(r) : pc_p_Pre := r ; fi ; + if not _isThis(o) : pc_p_Post := o ; fi ; +enddef; + +def SetupValue (expr r, o) = + if not _isThis(r) : pc_v_Pre := r ; fi ; + if not _isThis(o) : pc_v_Post := o ; fi ; +enddef; + +def SetupName (expr r, o) = + if not _isThis(r) : pc_n_Pre := r ; fi ; + if not _isThis(o) : pc_n_Post := o ; fi ; +enddef; + +%C only activate bounding box code if PiechartBBox variable +%C is set by user +if not known PiechartBBox: endinput ; fi; +% === Bounding Box === (pc-bbox.mp) +%\ +% vars +%\ + +pair pc_bULC, pc_bLRC ; +string pc_BBoxFile ; pc_BBoxFile := jobname & ".pcb" ; + +%\ +% init +%\ +begingroup; +save L ; string L ; +L := readfrom pc_BBoxFile ; +if ( L = EOF ): % file not readable + pc_bULC := origin ; pc_bLRC := origin ; +else: + scantokens L ; + L := readfrom pc_BBoxFile ; + scantokens L ; +fi ; +endgroup; + +%\ +% macros +%\ + +extra_endfig := extra_endfig & "_pcFitBBox ;" ; + +%C merges bbox size of current picture with +%C the size saved in variables pc_bULC/LRC to obtain +%C ths size of a maximum bbox +def _pcFitBBox = + begingroup; + save L, YO, YU, XR, XL ; string L ; + numeric YO, YU, XR, XL ; + + + if (xpart (ulcorner currentpicture)) < (xpart pc_bULC) : + XL := xpart ( ulcorner currentpicture ) ; + else: + XL := xpart pc_bULC ; + fi ; + if (ypart (ulcorner currentpicture)) > (ypart pc_bULC) : + YO := ypart ( ulcorner currentpicture ) ; + else: + YO := ypart pc_bULC ; + fi ; + if (xpart ( lrcorner currentpicture)) > (xpart pc_bLRC) : + XR := xpart ( lrcorner currentpicture ) ; + else: + XR := xpart pc_bLRC ; + fi ; + if (ypart ( lrcorner currentpicture)) < (ypart pc_bLRC) : + YU := ypart ( lrcorner currentpicture ) ; + else: + YU := ypart pc_bLRC ; + fi ; + + setbounds currentpicture to (XL,YO)--(XR,YO)--(XR,YU)--(XL,YU)--cycle ; + write "pc_bULC := ( " & + decimal (xpart (ulcorner currentpicture)) & " , " & + decimal (ypart (ulcorner currentpicture)) & " )" to pc_BBoxFile ; + write "pc_bLRC := ( " & + decimal (xpart (lrcorner currentpicture)) & " , " & + decimal (ypart (lrcorner currentpicture)) & " )" to pc_BBoxFile ; + write EOF to pc_BBoxFile ; + + pc_bULC := (XL, YO) ; pc_bLRC := (XR, YU) ; + endgroup; +enddef;
\ No newline at end of file diff --git a/Master/texmf-dist/metapost/slideshow/pathalong.mp b/Master/texmf-dist/metapost/slideshow/pathalong.mp new file mode 100644 index 00000000000..bc57cd6e262 --- /dev/null +++ b/Master/texmf-dist/metapost/slideshow/pathalong.mp @@ -0,0 +1,53 @@ +%% draw some text (t) along a curve (p) + +vardef pathalong (expr _p, t) = + save l, ll, del,let, pos, p; + picture let, ll; + path del, p; + + l := length(t) - 1; + pos = 0; + p := _p; + + ll := nullpicture; + + for i := 0 upto l: + + let := substring (i,i+1) of t infont defaultfont scaled defaultscale; + + addto ll also (let rotated(angle(direction pos of p))) + shifted point pos of p; + + del := (((xpart urcorner let, infinity)--(xpart urcorner let, -infinity)) + rotated(angle(direction pos of p))) + shifted point pos of p; + + p := subpath(pos,length(p)) of p; + pos := ypart (del intersectiontimes p); + exitif pos <= 0; + + endfor; + + ll +enddef; + +%% draw the text contained in t so that the bottoms of the letters are on +%% the base-line and the tops abut path p +vardef textunder(expr p,t) = + save l, ll, pos, h, i; + picture l, ll; + numeric pos, h, i; + ll := nullpicture; + pos := 0; + for i = 0 upto (length t - 1): + l := substring(i, i+1) of t infont defaultfont scaled defaultscale; + h := ypart urcorner l; + if h > 0: + addto ll also (l yscaled ((ypart (((pos,-infinity)--(pos,infinity)) intersectionpoint p)) / ypart ulcorner l)) shifted (pos, 0); + fi; + pos := pos + xpart lrcorner l; + endfor; + + ll +enddef; + diff --git a/Master/texmf-dist/metapost/slideshow/slideshow.mp b/Master/texmf-dist/metapost/slideshow/slideshow.mp new file mode 100644 index 00000000000..f7afbfadb4c --- /dev/null +++ b/Master/texmf-dist/metapost/slideshow/slideshow.mp @@ -0,0 +1,387 @@ +%% simple metapost slide show +%% +%% Copyright 2001, Patrick TJ McPhee +%% everyone is welcome to use this code for any purpose, to modify it, and +%% to copy it in whole or in part for use in other macro sets, with the +%% conditions that this copyright notice be preserved with any significant +%% portion of the code, and that modifications to this file be clearly +%% marked. +%% +%% see the file slideshow.txt for documentation +%% $Header: /usr/home/ptjm/texmf/metapost/RCS/slideshow.mp 1.8 2001/08/06 18:48:17 pmcphee Exp $ + +newinternal slideshowversion; +slideshowversion := 1.0; + +%% +%% basic figure handling +%% + +picture lastpicture, background; + +% set the aspect ratio of the picture to match a 640x480 screen +if not known lawidth: + lawidth := 6.4in; + laheight := 4.8in; +fi; + +% make a sophisticated gradient background -- note that this can be done +% natively in pdf 1.3 if you know how.... +def drawgradient(expr topcolour, botcolour) := + save pw,l,r,t,b,shade,grad; + + numeric l,r,t,b,pw; + color shade, grad; + + % we will draw 100 coloured stripes across the screen + pw = laheight/100; + pickup pensquare scaled pw; + lft l = 0 = bot b; + rt r = lawidth; + t = laheight; % don't say `top t' because I want to over-extend + + % shade is the colour of the current stripe, while grad + % is the amount to change on each stripe + shade := botcolour; + grad := (1/100)*(topcolour - botcolour); + + for ypos := b step pw until t: + draw (l, ypos)--(r, ypos) withcolor shade; + shade := shade + grad; + endfor; +enddef; + +% draw the background -- we'll make it blue, just like power point +background := image(drawgradient((0,0,.3), (0,0,.5));); + +% `keep track' of figure numbers +def nextfig := beginfig(charcode+1) enddef; + +% always save the current picture at the end of each figure, +% so it can be used in the next one +extra_endfig := extra_endfig & "lastpicture := currentpicture; currentpicture := background; if known lastpicture: draw lastpicture; fi;"; + +% continue overlays the current picture with the last picture shipped out +% this allows slides to be built up +newinternal continuations; +continuations := 0; +def docontinue = if known lastpicture and (continuations = 1): currentpicture := lastpicture; bpos := bpos.prev; else: bpos := 0; fi; enddef; +extra_beginfig := extra_beginfig & "docontinue;"; + +% one might want to do that by default +def continue = continuations := 1; enddef; +% or not +def endcontinue = continuations := 0; enddef; + +% break in continuation +def discontinue = clearit; lastpicture := nullpicture; bpos := 0; bpos.prev := 0; enddef; + + +%% +%% drawing assists +%% + + +% we'll use two pens to draw figures +pickup pencircle xscaled 5 pt yscaled 4 pt rotated 20; +thick nib := savepen; + +pickup pencircle xscaled 2 pt yscaled 1 pt rotated 20; +thin nib := savepen; + +%% +%% text manipulation assists +%% + + +% and we'll make the text yellow, just like power-point +color textcolour; +textcolour := red+green; +defaultfont := "phvr8r"; + + +% this is the thing we use as a bullet +picture bulletpic; +bulletpic := image(draw char(226) infont "pzdr" withcolor textcolour;); + +pair headerpos, footerpos, boff, borigin, borigin.in, blimit; +numeric baselineskip, parskip, parskip.in, bpos; + +% positions of the bottom left corner of the header, and the bottom right +% corner of the footer +headerpos = (1in, 4in); +footerpos = (6in, .2in); + +% offset of text from the bullet +boff = (20bp, 0); + +% upper-left start position for bulletted text +borigin = (1.5in,3.4in); + +% upper-left start position for indented bulletted text +borigin.in = borigin + boff; + +% lower-right limit of bulletted text +blimit = (4.4in,1in); + +% distance between baselines in bulletted text +baselineskip = 11bp; + +% distance between bullet points for normal bullets +parskip = 5 pt; + +% distance between bullet points for indented bullets +parskip.in = 1pt; + +% current bullet position +bpos = 0; + +% internal use - bullet position at the end of the last slide +bpos.prev = 0; + +vardef breaktowidth(expr s, w)(text sheight) = + save p; + picture p; + + p := s infont defaultfont scaled defaultscale; + % if the string is too long to fit within bounds, we break it up on + % word boundaries. + if xpart(lrcorner p - llcorner p) > w: + save q, offs, len, goodlen; picture q; numeric offs, len, goodlen; + picture q; + p := nullpicture; + offs := 0; + len := 1; + goodlen := 0; + forever: + exitunless len < length(s); + q := (substring(offs, len) of s) infont defaultfont scaled defaultscale; + if xpart (lrcorner q - llcorner q) > w: + sheight := sheight + baselineskip; + p := image(draw p shifted (0, baselineskip); + draw (substring(offs, goodlen) of s) infont defaultfont + scaled defaultscale;); + offs := goodlen + 1; + len := offs + 1; + fi; + if substring(len, len+1) of s = " ": goodlen := len; fi; + len := len + 1; + endfor; + + p := image(draw p shifted (0, baselineskip); + draw (substring(offs, length s) of s) infont defaultfont + scaled defaultscale;); + fi; + p +enddef; + +% bullet(text) or bullet(picture) writes bulletpic and text or picture +% in the next bullet position on the screen +% bullet.in(text) does the same thing, but indented. This can be +% extended for arbitrary suffix tag by defining a pair called borigin.tag, +% and a numeric called parskip.tag. Note that bpos is shared, so this really +% only works for additional levels of indentation +vardef bullet@#(expr s) = + save p, sheight; + numeric sheight; + picture p; + + % add the parskip for this bullet type, unless we're at the top + if bpos > 0: bpos := bpos + parskip@#; fi + + if picture s: + p := s; + sheight := ypart(ulcorner p - llcorner p) - baselineskip; + else: + sheight := 0; + p := image(draw breaktowidth(s, xpart(blimit - borigin@#))(sheight) + withcolor textcolour;); + fi; + + % start a new slide if this bullet won't fit. If we're in continuation mode, + % the previous slide already has the previous bullets, so just clear this + % slide and put the bullet at the top. In discontinous mode, we need to end + % the figure, but this causes some problems as it ends the group started by + % vardef, so we lose p and sheight (which were saved). + if ypart borigin@# - sheight - bpos < ypart blimit: + if continuations = 1: discontinue; + else: + begingroup; + endfig; + bpos.prev := 0; + nextfig; + endgroup; + fi; + fi; + draw bulletpic shifted (borigin@# - (0, bpos)); + draw p shifted (borigin@# + boff - (0, bpos+sheight)); + bpos := bpos + sheight + baselineskip; + bpos.prev := bpos; +enddef; + +% handy abbreviation for a common paradigm +vardef bpoint@#(expr s) = nextfig; bullet@#(s); endfig; enddef; + +% the same as the plain metapost label, but using textcolour +vardef blabel@#(expr s,z) = draw thelabel@#(s,z) withcolor textcolour; enddef; + +vardef dotblabel@#(expr s,z) = + blabel@#(s,z); + interim linecap:=rounded; + draw z withpen pencircle scaled dotlabeldiam withcolor textcolour; +enddef; + +% a label which is also a hyperlink +def dolink(expr p, n) = + special "[ /Rect [ " & decimal xpart llcorner p & " " & + decimal ypart llcorner p & " " & + decimal xpart urcorner p & " " & + decimal ypart urcorner p & " ] /Dest /" & n & + " /Border [ 0 0 0 ] /Subtype /Link /ANN pdfmark"; +enddef; + +vardef hyperlabel@#(expr s,z, n) = + save p; + picture p; + p := thelabel@#(s,z); + dolink(p, n); + draw p withcolor textcolour; +enddef; + +vardef hyperbullet@#(expr s, n) = + save p; + picture p; + p := image(bullet@#(s);); + dolink(p, n); + draw p; +enddef; + +def hyperdest(expr n) = special "[ /Dest /" & n & " /View [ /Fit ] /DEST pdfmark"; enddef; + + +picture headerpic, footerpic; + +% header saves a string or picture which will be displayed at headerpos +% on each slide. The header is added after the slide is saved to lastpicture +def header(expr s) = + if picture s: headerpic := s; + else: headerpic := image( + draw s infont defaultfont scaled (defaultscale*magstep1) + shifted headerpos + withcolor textcolour;); + fi; +enddef; + +def drawheader = if known headerpic: draw headerpic; fi; enddef; + +% header saves a string or picture which will be displayed to the left of +% footerpos on each slide. The footer is added after the slide is saved +% to lastpicture +def footer(expr s) = + if picture s: footerpic := s; + else: footerpic := s infont defaultfont scaled defaultscale; + footerpic := image( + draw footerpic + shifted (footerpos - (lrcorner footerpic - llcorner footerpic)) + withcolor textcolour;); + fi; +enddef; + +def drawfooter = if known footerpic: draw footerpic; fi; enddef; +extra_endfig := extra_endfig & "drawheader; drawfooter;"; + +% current slide number +def folio = decimal charcode enddef; + +%% +%% font encoding -- currently, only to 8r (I just couldn't bear putting this in +%% a source file) +%% +def encodefont(expr tfm, fn) = + special "/" & tfm & " /" & fn & "8r def"; + special "/" & fn & " findfont dup length dict copy dup /Encoding"; + special "[ /.notdef /dotaccent /fi /fl /fraction /hungarumlaut /Lslash /lslash"; + special "/ogonek /ring /.notdef /breve /minus /.notdef /Zcaron /zcaron /caron /dotlessi"; + special "/dotlessj /ff /ffi /ffl /.notdef /.notdef /.notdef /.notdef"; + special "/.notdef /.notdef /.notdef /.notdef /grave /quotesingle /space /exclam /quotedbl /numbersign"; + special "/dollar /percent /ampersand /quoteright /parenleft /parenright /asterisk /plus /comma /hyphen /period /slash"; + special "/zero /one /two /three /four /five /six /seven /eight /nine /colon /semicolon /less /equal /greater /question"; + special "/at /A /B /C /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z"; + special "/bracketleft /backslash /bracketright /asciicircum /underscore /quoteleft"; + special "/a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s /t /u /v /w /x /y /z"; + special "/braceleft /bar /braceright /asciitilde /.notdef /.notdef /.notdef /quotesinglbase /florin"; + special "/quotedblbase /ellipsis /dagger /daggerdbl /circumflex /perthousand /Scaron /guilsinglleft"; + special "/OE /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /quotedblleft /quotedblright /bullet /endash /emdash"; + special "/tilde /trademark /scaron /guilsinglright /oe /.notdef /.notdef /Ydieresis /.notdef"; + special "/exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft"; + special "/logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior"; + special "/acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright"; + special "/onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla"; + special "/Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis"; + special "/Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex"; + special "/Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla"; + special "/egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis"; + special "/eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex"; + special "/udieresis /yacute /thorn /ydieresis ] put /" & fn & "8r exch definefont pop"; +enddef; + +%% +%% pdf macros and assists +%% + + +% maintain a ps file which loads all the slides in order +% this is specific to gs +string psfile; +psfile := jobname & ".ps"; + +extra_endfig := extra_endfig & "write " & ditto & "(" & ditto & "& jobname &" + & ditto & "." & ditto + & "& folio &" & ditto & ") run" & ditto & " to psfile;"; + +% put the viewer into full screen mode by default, and define a document-default +% page transition (I'm using the random transition with 1/2 second duration) +% since there is no way to specify a document-default, the transition has to be +% added to each page dictionary +special "[ /PageMode /FullScreen /DOCVIEW pdfmark"; + +special "[ /_objdef {mytrans} /type /dict /OBJ pdfmark"; +special "[ {mytrans} << /Type /Trans /D .5 /S /Random /Dm /H /M /O /Di 315 >> /PUT pdfmark "; + +extra_endfig := extra_endfig & "special " & ditto + & "[ {ThisPage} << /Trans {mytrans} >> /PUT pdfmark" & ditto & ";"; + +special "[ /CropBox [ 0 0 " & decimal(lawidth) & " " & decimal(laheight) & " ] /PAGES pdfmark"; + +% allow the user to specify document info +def author(expr s) := + special "[ /Author (" & s & ") /DOCINFO pdfmark"; +enddef; +def title(expr s) := + special "[ /Title (" & s & ") /DOCINFO pdfmark"; +enddef; +def subject(expr s) := + special "[ /Subject (" & s & ") /DOCINFO pdfmark"; +enddef; +def keywords(expr s) := + special "[ /Keywords (" & s & ") /DOCINFO pdfmark"; +enddef; +def copyright(expr s) := + special "[ /Copyright (" & s & ") /DOCINFO pdfmark"; +enddef; + +def moddate(expr s) := + special "[ /ModificationDate (" & s & ") /DOCINFO pdfmark"; +enddef; + +def createdate(expr s) := + special "[ /CreationDate (" & s & ") /DOCINFO pdfmark"; +enddef; + +% except for the document info we specify ourselves +createdate("D:" & decimal year & decimal month & if day < 10: "0" fi & decimal(day) & decimal time); +special "[ /Creator (Metapost " & base_name & " base, version " & base_version & ") /DOCINFO pdfmark"; + +% gs will need this +prologues:=2; + diff --git a/Master/texmf-dist/metapost/slideshow/sshowex.mp b/Master/texmf-dist/metapost/slideshow/sshowex.mp new file mode 100644 index 00000000000..dc1414ced8e --- /dev/null +++ b/Master/texmf-dist/metapost/slideshow/sshowex.mp @@ -0,0 +1,42 @@ + input slideshow; + pair points[]; + nextfig; + points0 = (.5lawidth, .9laheight); + ypart points1 = ypart points2 = .1laheight; + xpart points1 = lawidth - xpart points2 = .3lawidth; + + pickup thin nib; + + draw points1..points0 withcolor textcolour; + hyperdest("start"); + endfig; + + % build on previous slide for next few + continue; + nextfig; + pickup thin nib; + + draw points0..points2 withcolor textcolour; + endfig; + nextfig; + pickup thin nib; + + draw points2..points1 withcolor textcolour; + endfig; + + nextfig; + blabel.top("A", points0); + endfig; + nextfig; + blabel.lft("B", points1); + endfig; + nextfig; + blabel.rt("C", points2); + endfig; + + % new sequence of slides ... + discontinue; + nextfig; + hyperlabel("The End" infont defaultfont scaled magstep 2, (.5lawidth, .5laheight), "start"); + endfig; + end diff --git a/Master/texmf-dist/metapost/slideshow/sshowex2.mp b/Master/texmf-dist/metapost/slideshow/sshowex2.mp new file mode 100644 index 00000000000..788bbf55b9e --- /dev/null +++ b/Master/texmf-dist/metapost/slideshow/sshowex2.mp @@ -0,0 +1,36 @@ +%% +%% slide-show example which demonstrates text wrapping, and changing the background +%% on the fly +%% + + +input slideshow; + +% start with a blue to red gradient, then `gradually' shift it to red to blue +noslides := 11; +def doback = + background := image(drawgradient((charcode/noslides)[blue,red], (charcode/noslides)[red,blue]);); +enddef; + +doback; + +extra_endfig := extra_endfig & "doback;"; + +continue; +nextfig; + header("A Walk in the Park"); +endfig; +bpoint("I was walking in the park one day, when the most remarkable thing happened."); +bpoint("There was a lady there, well, I say lady because I was brought up to believe one should use this term to refer to adult members of the fair sex, but from her behaviour, I'm not sure it's the right term at all."); +bpoint("This lady, as I call her, was conveying herself by way of two-wheeled roller skates, and she was wearing a tiny pair of short pants, and a top which, although it completely covered her torso, was extremely revealing as to her form."); +bpoint("Well, she noticed that she had my attention, and behaved in a manner which I can only describe as provacative in the extreme."); +bpoint(ditto & "Do you want a closer look, Jack?" & ditto & " she asked (but my name is not Jack, nor John for that matter), and then she lifted her top, exposing the most disgusting protuberances."); +bpoint("Needless to say, I was shocked."); +bpoint("I quickly found a park warden and reported the vixen (I can't bring myself to call her a lady again)."); +bpoint(ditto & "What, the one in the white spandex top?" & ditto & " he exclaimed."); +bpoint("I supposed that's what that material was, and he assured me that he would seek her out and speak to her about the matter."); +bpoint("It seemed to me that more severe handling was suggested by the circumstances, but he was eager to do the job, so I left him to it."); + + + +end diff --git a/Master/texmf-dist/metapost/slideshow/sshowex3.mp b/Master/texmf-dist/metapost/slideshow/sshowex3.mp new file mode 100644 index 00000000000..7e65e918bdf --- /dev/null +++ b/Master/texmf-dist/metapost/slideshow/sshowex3.mp @@ -0,0 +1,23 @@ +%% +%% slide-show example which demonstrates text wrapping in discontinous mode +%% + +input slideshow; + +nextfig; + header("A Walk in the Park"); + +bullet("I was walking in the park one day, when the most remarkable thing happened."); +bullet("There was a lady there, well, I say lady because I was brought up to believe one should use this term to refer to adult members of the fair sex, but from her behaviour, I'm not sure it's the right term at all."); +bullet("This lady, as I call her, was conveying herself by way of two-wheeled roller skates, and she was wearing a tiny pair of short pants, and a top which, although it completely covered her torso, was extremely revealing as to her form."); +bullet("Well, she noticed that she had my attention, and behaved in a manner which I can only describe as provacative in the extreme."); +bullet(ditto & "Do you want a closer look, Jack?" & ditto & " she asked (but my name is not Jack, nor John for that matter), and then she lifted her top, exposing the most disgusting protuberances."); +bullet("Needless to say, I was shocked."); +bullet("I quickly found a park warden and reported the vixen (I can't bring myself to call her a lady again)."); +bullet(ditto & "What, the one in the white spandex top?" & ditto & " he exclaimed."); +bullet("I supposed that's what that material was, and he assured me that he would seek her out and speak to her about the matter."); +bullet("It seemed to me that more severe handling was suggested by the circumstances, but he was eager to do the job, so I left him to it."); +endfig; + + +end diff --git a/Master/texmf-dist/metapost/slideshow/sshowintro.mp b/Master/texmf-dist/metapost/slideshow/sshowintro.mp new file mode 100644 index 00000000000..7dd856ec52e --- /dev/null +++ b/Master/texmf-dist/metapost/slideshow/sshowintro.mp @@ -0,0 +1,206 @@ +%% +%% A quick presentation about the macros +%% + +input pathalong; +input slideshow; + +author("Patrick TJ McPhee"); +title("Introducing slide-show macros"); +keywords("presentations metapost"); +copyright("Copyright 2001 Patrick TJ McPhee. You may redistribute and modify for any purpose, but must acknowledge significant quotation."); + +continue; + +nextfig; + defaultscale := 2; + draw textunder((0,.5in){up}..{right}(2in,1in), "Introducing") shifted (1in,3in) withcolor textcolour; +endfig; + +nextfig; + blabel.rt("Slide Show Macros", (2in,2in)); +endfig; + +defaultscale := 1; + +nextfig; + draw pathalong((0,.5in){up}..{right}(2in,1in), "by Patrick TJ McPhee") shifted (1in,3in) withcolor textcolour; + hyperdest("Start"); +endfig; + +discontinue; + +header("Rationale"); + +bpoint("Primarily an intellectual exercise"); +bpoint("But may be useful for graphics-intensive presentations which don't use much text"); +bpoint("Slideshow provides support for this irritating style of bullet presentation"); +bpoint("And writes out some pdfmarks, which you would otherwise have to look up yourself"); + +picture dimtieb; +dimtieb := image(draw pathalong((0,.5in){up}..(.5in,1in){right}..(.5in, 0in){-1,-1}..{.1,-1}(.5in,-.5in), + "Did I mention the intellectual exercise bit?") withcolor textcolour;); +dimtieb := dimtieb rotatedaround(center dimtieb, 90); +dimtieb := dimtieb shifted - llcorner dimtieb; + +bpoint(dimtieb); + +discontinue; + +header("Current practice"); + +bpoint("A presentation might have several components:"); + +vardef procbox(expr s) = + save p; + picture p; + + p := s infont defaultfont scaled defaultscale; + pickup thin nib; + addto p doublepath bbox p withpen currentpen; + p +enddef; + +vardef resultbox(expr s) = + save p; + picture p; + + p := s infont defaultfont scaled defaultscale; + pickup thin nib; + addto p doublepath (ulcorner p)..tension 2..(urcorner p)..(lrcorner p).. + tension 2..(llcorner p)..cycle + withpen currentpen; + p +enddef; + +picture lt, mp, dvi, gs, postp, vres, pres, fpres; + +lt := procbox("laTeX") shifted (.05 lawidth, .2laheight); +mp := procbox("metapost") shifted (.05 lawidth, .1laheight); +dvi := procbox("DVI processor") shifted (.2 lawidth, .15laheight); +vres := resultbox("viewable result") shifted (.4 lawidth, .15 laheight); +gs := procbox("distiller") shifted (.65 lawidth, .15laheight); +pres := resultbox("presentation") shifted (.8 lawidth, .15laheight); +postp := procbox("post-processor") shifted (.7 lawidth, .3laheight); +fpres := resultbox("final presentation") shifted (.45 lawidth, .3laheight); + +nextfig; + bullet.in("text prepared with laTeX"); + draw lt withcolor white; +endfig; + +nextfig; + bullet.in("graphics prepared with metapost (okay, 2 components)"); + draw mp withcolor red; +endfig; + +nextfig; + bullet.in("which are combined with dvi processing software"); + pickup thin nib; + drawarrow (.5[lrcorner mp,urcorner mp]){right}..{right}(.5[llcorner dvi,ulcorner dvi]) + withcolor .25[red,white]; + drawarrow (.5[lrcorner lt,urcorner lt]){right}..{right}(.5[llcorner dvi,ulcorner dvi]) + withcolor .25[white,red]; + + draw dvi withcolor .5[white,red]; +endfig; + +nextfig; + bullet.in("the resulting postscript is viewable, but must be distilled into the presentation"); + pickup thin nib; + drawarrow (.5[lrcorner dvi,urcorner dvi])..(.5[llcorner vres,ulcorner vres]) + withcolor .1[.5[red,white],green]; + draw vres withcolor .5[.5[white,red],green]; +endfig; + +nextfig; + pickup thin nib; + drawarrow (.5[lrcorner vres,urcorner vres])..(.5[llcorner gs,ulcorner gs]) + withcolor .6[.5[red,white],green]; + draw gs withcolor .75[.5[white,red],green]; +endfig; + +nextfig; + pickup thin nib; + drawarrow (.5[lrcorner gs,urcorner gs])..(.5[llcorner pres,ulcorner pres]) + withcolor .75[.5[white,red],green]; + draw pres withcolor green; +endfig; + +nextfig; + pickup thin nib; + bullet.in("and it's often post-processed to make it slick and professional-looking like this one"); + pickup thin nib; + drawarrow (.5[lrcorner pres,urcorner pres]){right}..{left}(.5[lrcorner postp,urcorner postp]) + withcolor .5[green,white]; + draw postp withcolor .75[green,white]; +endfig; + +nextfig; + pickup thin nib; + drawarrow (.5[llcorner postp,ulcorner postp])..(.5[lrcorner fpres,urcorner fpres]) + withcolor .95[green,white]; + draw fpres withcolor white; +endfig; + +discontinue; + +header("The slideshow advantage"); +bpoint("With the slideshow macros:"); + +nextfig; + bullet.in("Only one input format is possible"); + draw mp withcolor red; +endfig; + +nextfig; + bullet.in("Which converts rapidly into viewable output"); + pickup thick nib; + drawarrow (.5[lrcorner mp,urcorner mp]){right}..{right}(.5[llcorner vres,ulcorner vres]) + withcolor .5[red,.5[.5[white,red],green]]; + % I hope it's clear by this point that I'm playing this for laughs + draw vres withcolor .5[.5[white,red],green]; +endfig; + +nextfig; + bullet.in("And then distills into the presentation"); + pickup thick nib; + drawarrow (.5[lrcorner vres,urcorner vres]){right} + ..{right}(.5[llcorner fpres,ulcorner fpres]) + withcolor .5[.5[.5[white,red],green],white]; + draw fpres withcolor white; +endfig; + +nextfig; + bullet.in("From which no post-processing is needed, since there are no post-processors supporting these macros"); +endfig; + +discontinue; +header("Limitations"); + +bpoint("Metapost doesn't handle text very well"); +bpoint("It's difficult to include non-metapost graphics (e.g., bit-maps)"); +bpoint("There's no provision for producing print-only versions of the information"); +bpoint("There's no concept of presentation styles"); +bpoint("It generally requires some configuration of ghostscript and metapost, especially if you use math"); +bpoint("The other methods for producing presentations using TeX-family tools aren't as complicated as I suggested"); +bpoint.in("I personally use my own plain-TeX style with just TeX, metapost, and dvipdfm"); + +discontinue; +header("Strengths"); + +bpoint("Measurably less complex than metaobj"); +bpoint("Small and simple, so shouldn't conflict with too many truly useful metapost packages"); +bpoint("The ability to build up drawings can be helpful"); +bpoint("And so are the pdfmarks"); +bpoint("It's useful for cases where laTeX is used as a framework for a bunch of metapost slides"); +bpoint("So it was worth uploading to CTAN, but it's not going to change the world"); + +discontinue; +header(nullpicture); + +nextfig; + hyperlabel(breaktowidth("Thanks for sticking to the end. Click on this text to start over.", .5lawidth)(ignore), (.5lawidth, .5laheight), "Start"); +endfig; + +end diff --git a/Master/texmf-dist/metapost/support/charlib/12 b/Master/texmf-dist/metapost/support/charlib/12 new file mode 100644 index 00000000000..f575c6a88c9 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/12 @@ -0,0 +1,9 @@ +vardef C.xii(expr n) = + save s,t,p,q; + q=fontsize n; + def s=infont "Times" scaled(q/fontsize"Times"/2)enddef; + def t=shifted(xpart urcorner p,0)enddef; + picture p; p="1"s shifted(0,q/3); + addto p also char164 s scaled2 t; + addto p also "2"s t; + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/14 b/Master/texmf-dist/metapost/support/charlib/14 new file mode 100644 index 00000000000..c27b0c37ae1 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/14 @@ -0,0 +1,9 @@ +vardef C.xiv(expr n) = + save s,t,p,q; + q=fontsize n; + def s=infont "Times" scaled(q/fontsize"Times"/2)enddef; + def t=shifted(xpart urcorner p,0)enddef; + picture p; p="1"s shifted(0,q/3); + addto p also char164 s scaled2 t; + addto p also "4"s t; + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/34 b/Master/texmf-dist/metapost/support/charlib/34 new file mode 100644 index 00000000000..c6ab4cde7dd --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/34 @@ -0,0 +1,9 @@ +vardef C.xxxiv(expr n) = + save s,t,p,q; + q=fontsize n; + def s=infont "Times" scaled(q/fontsize"Times"/2)enddef; + def t=shifted(xpart urcorner p,0)enddef; + picture p; p="3"s shifted(0,q/3); + addto p also char164 s scaled2 t; + addto p also "4"s t; + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/Ao b/Master/texmf-dist/metapost/support/charlib/Ao new file mode 100644 index 00000000000..2bdc39bed1b --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/Ao @@ -0,0 +1,7 @@ +vardef C.Ao(expr n) = + save p,q; picture p,q; + p="A"infont n; + q=char202 infont n; + addto p also q + shifted(xpart(urcorner p-urcorner q)/2,.3*fontsize n); + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/Fi b/Master/texmf-dist/metapost/support/charlib/Fi new file mode 100644 index 00000000000..6979477afe4 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/Fi @@ -0,0 +1,7 @@ +vardef C.Fi(expr n) = + save p; + picture p; p="f"infont n; + for c="f","i": + addto p also c infont n shifted(xpart urcorner p-fontsize n/20,0); + endfor + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/Fl b/Master/texmf-dist/metapost/support/charlib/Fl new file mode 100644 index 00000000000..67838aaf24e --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/Fl @@ -0,0 +1,7 @@ +vardef C.Fl(expr n) = + save p; + picture p; p="f"infont n; + for c="f","l": + addto p also c infont n shifted(xpart urcorner p-fontsize n/20,0); + endfor + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/L1 b/Master/texmf-dist/metapost/support/charlib/L1 new file mode 100644 index 00000000000..d295e28e577 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/L1 @@ -0,0 +1,40 @@ +vardef C.Li(expr n) = + save p,a,e; + picture p; p=nullpicture; + def a=addto p contour enddef; + def e=withcolor (1,1,1)enddef; + a(160,0)--(160,150)--(85,150)--(85,149)--(91,149)-- + (97,147.5)--(104.5,145)--(112.9,141.4)--(117,138.667)--(117,138)-- + (84,138)--(68,140)--(47,140)--(41,139)--(41,140)--(47,143)--(54.5,146)-- + (59,147.5)--(66.5,149)--(72,149)--(72,150)--(0,150)--(0,0)--(71,0)-- + (71,1)--(66,1)--(56,3.5)--(54.5,4)--(47,7)--(45,8)--(40,11.3333)-- + (40,12)--(118,12)--(118,11.6667)--(114,9)--(110,7)--(102.5,4)--(101,3.5)-- + (91,1)--(85,1)--(85,0)--(160,0)--cycle; + a(100.5,123)--(87,124.5)--(66,126)--(43,126)--(23,124.333)--(23,125.5)-- + (29.5,132)--(40.5,131)--(70,131)--(82,132.5)--(91,134)--(123,134)-- + (126,132.5)--(134,124.5)--(134,123)--(100.5,123)--cycle e; + a(109,108)--(85,110)-- + (27,110)--(13,109)--(13,111)--(16,117)--(30,116)--(86.5,116)--(97,117.5)-- + (106,119)--(138.5,119)--(144,109.833)--(144,108)--(109,108)--cycle e; + a(120,92)-- + (84,95)--(25.5,95)--(7.5,93)--(6.25,93)--(7.5,98)--(8.71765,101.653)-- + (55,100)--(80,100)--(98,101.5)--(118,104)--(146.5,104)--(148.5,100)-- + (150,95.5)--(150,92)--(120,92)--cycle e; + a(111,77)--(96,78.5)--(76.5,80)--(41.5,80)-- + (16,78.5)--(5.5,77)--(4,77)--(4,82.5)--(5.40541,86.7162)--(26,85)-- + (83.5,85)--(97,86.5)--(105,87.5)--(124.5,89)--(151.167,89)--(153,78)-- + (153,77)--(111,77)--cycle e; + a(104.5,62)--(78.5,64)--(27,64)--(7,62)--(5.5,62)-- + (4,68)--(4,72)--(8.5,72)--(26.5,70)--(79,70)--(109,73)--(153,73)-- + (153,71)--(151.5,62)--(104.5,62)--cycle e; + a(11,45)--(10.5,45)--(8.5,49)--(7.5,52)-- + (6.25,57)--(11,57)--(39,55)--(65,55)--(67,56)--(68,56)--(68,55.4)-- + (79,56.5)--(103,58)--(150,58)--(150,53.5)--(147.833,47)--(61,47)-- + (53,48)--(29,46.5)--(11,45)--cycle e; + a(22.5,30)--(19.5,30)--(17,32.5)--(13.25,38.75)-- + (12,42.5)--(12,42.8158)--(46.5,41)--(53.5,41)--(91.5,43)--(145,43)-- + (145,42.5)--(143.667,38.5)--(138.667,31)--(69.5,31)--(48.5,32)--(22.5,30)-- + cycle e; + a(33,16)--(27,20.5)--(25,22.5)--(22,27)--(135,27)--(133.5,24)--(128.5,19)-- + (124,16)--(33,16)--cycle e; + p scaled (fontsize n/150) enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/LH b/Master/texmf-dist/metapost/support/charlib/LH new file mode 100644 index 00000000000..6fde7f6614c --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/LH @@ -0,0 +1,142 @@ +vardef C.LH(expr n) = + save p,a,e; + picture p; p=nullpicture; + def a=addto p contour enddef; + def e=withcolor (1,1,1)enddef; + a(68,149)--(68,149)--(60,148)--(55,147)--(52,146)--(49,145)--(47,144)-- + (44,143)--(42,142)--(40,141)--(38,140)--(37,139)--(39,139)--(53,140)-- + (68,139)--(76,138)--(112,138)--(111,139)--(109,140)--(108,141)--(105,142)-- + (103,143)--(101,144)--(98,145)--(95,146)--(92,147)--(88,148)--(80,149)-- + cycle; + a(84,133)--(84,133)--(78,132)--(70,131)--(50,130)--(30,131)--(25,131)-- + (24,130)--(23,129)--(22,128)--(21,127)--(20,126)--(19,125)--(19,124)-- + (20,124)--(32,125)--(50,126)--(69,125)--(83,124)--(92,123)--(129,123)-- + (129,124)--(128,125)--(127,126)--(126,127)--(125,128)--(124,129)-- + (123,130)--(122,131)--(121,132)--(119,133)--cycle; + a(99,118)--(99,118)--(93,117)-- + (86,116)--(52,115)--(18,116)--(12,116)--(11,115)--(11,114)--(10,113)-- + (10,112)--(9,111)--(9,110)--(9,109)--(15,109)--(51,110)--(87,109)-- + (99,108)--(139,108)--(139,109)--(139,110)--(138,111)--(137,112)-- + (137,113)--(136,114)--(136,115)--(135,116)--(134,117)--(134,118)-- + cycle; + a(110,103)--(110,103)--(102,102)--(94,101)--(82,100)--(59,99)--(36,100)-- + (8,101)--(5,101)--(4,100)--(4,99)--(4,98)--(3,97)--(3,96)--(3,95)-- + (3,94)--(2,93)--(7,93)--(16,94)--(51,95)--(86,94)--(98,93)--(110,92)-- + (145,92)--(145,93)--(145,94)--(145,95)--(145,96)--(144,97)--(144,98)-- + (144,99)--(143,100)--(143,101)--(142,102)--(142,103)--cycle; + a(178,101)-- + (178,101)--(178,100)--(177,99)--(177,98)--(177,97)--(176,96)--(176,95)-- + (176,94)--(175,93)--(175,92)--(175,91)--(174,90)--(174,89)--(174,88)-- + (173,87)--(173,86)--(173,85)--(172,84)--(172,83)--(172,82)--(171,81)-- + (171,80)--(171,79)--(170,78)--(170,77)--(170,76)--(169,75)--(169,74)-- + (169,73)--(168,72)--(168,71)--(168,70)--(167,69)--(167,68)--(167,67)-- + (166,66)--(166,65)--(166,64)--(165,63)--(165,62)--(165,61)--(164,60)-- + (164,59)--(164,58)--(163,57)--(163,56)--(163,55)--(162,54)--(162,53)-- + (162,52)--(161,51)--(161,50)--(161,49)--(160,48)--(174,48)--(174,49)-- + (175,50)--(175,51)--(175,52)--(176,53)--(176,54)--(176,55)--(177,56)-- + (185,57)--(194,56)--(194,55)--(195,54)--(195,53)--(195,52)--(195,51)-- + (196,50)--(196,49)--(196,48)--(210,48)--(209,49)--(209,50)--(209,51)-- + (208,52)--(208,53)--(208,54)--(208,55)--(207,56)--(207,57)--(207,58)-- + (206,59)--(206,60)--(206,61)--(205,62)--(205,63)--(205,64)--(204,65)-- + (204,66)--(204,67)--(203,68)--(203,69)--(203,70)--(202,71)--(202,72)-- + (202,73)--(202,74)--(201,75)--(201,76)--(201,77)--(200,78)--(200,79)-- + (200,80)--(199,81)--(199,82)--(199,83)--(198,84)--(198,85)--(198,86)-- + (197,87)--(197,88)--(197,89)--(197,90)--(196,91)--(196,92)--(196,93)-- + (195,94)--(195,95)--(195,96)--(194,97)--(194,98)--(194,99)--(193,100)-- + (193,101)--cycle; + a(200,101)--(200,101)--(200,100)--(200,99)--(200,98)--(200,97)-- + (200,96)--(200,95)--(200,94)--(200,93)--(200,92)--(200,91)--(200,90)-- + (214,89)--(214,88)--(214,87)--(214,86)--(214,85)--(214,84)--(214,83)-- + (214,82)--(214,81)--(214,80)--(214,79)--(214,78)--(214,77)--(214,76)-- + (214,75)--(214,74)--(214,73)--(214,72)--(214,71)--(214,70)--(214,69)-- + (214,68)--(214,67)--(214,66)--(214,65)--(214,64)--(214,63)--(214,62)-- + (214,61)--(214,60)--(214,59)--(214,58)--(214,57)--(214,56)--(214,55)-- + (214,54)--(214,53)--(214,52)--(214,51)--(214,50)--(214,49)--(214,48)-- + (228,48)--(228,49)--(228,50)--(228,51)--(228,52)--(228,53)--(228,54)-- + (228,55)--(228,56)--(228,57)--(228,58)--(228,59)--(228,60)--(228,61)-- + (228,62)--(228,63)--(228,64)--(228,65)--(228,66)--(228,67)--(228,68)-- + (228,69)--(228,70)--(228,71)--(228,72)--(228,73)--(228,74)--(228,75)-- + (228,76)--(228,77)--(228,78)--(228,79)--(228,80)--(228,81)--(228,82)-- + (228,83)--(228,84)--(228,85)--(228,86)--(228,87)--(228,88)--(228,89)-- + (241,90)--(241,91)--(241,92)--(241,93)--(241,94)--(241,95)--(241,96)-- + (241,97)--(241,98)--(241,99)--(241,100)--(241,101)--cycle; + a(266,101)--(266,101)-- + (266,100)--(266,99)--(266,98)--(266,97)--(266,96)--(266,95)--(266,94)-- + (266,93)--(266,92)--(266,91)--(266,90)--(280,89)--(280,88)--(280,87)-- + (280,86)--(280,85)--(280,84)--(280,83)--(280,82)--(280,81)--(280,80)-- + (280,79)--(280,78)--(280,77)--(280,76)--(280,75)--(280,74)--(280,73)-- + (280,72)--(280,71)--(280,70)--(280,69)--(280,68)--(280,67)--(280,66)-- + (280,65)--(280,64)--(280,63)--(280,62)--(280,61)--(280,60)--(280,59)-- + (280,58)--(280,57)--(280,56)--(280,55)--(280,54)--(280,53)--(280,52)-- + (280,51)--(280,50)--(280,49)--(280,48)--(294,48)--(294,49)--(294,50)-- + (294,51)--(294,52)--(294,53)--(294,54)--(294,55)--(294,56)--(294,57)-- + (294,58)--(294,59)--(294,60)--(294,61)--(294,62)--(294,63)--(294,64)-- + (294,65)--(294,66)--(294,67)--(294,68)--(294,69)--(294,70)--(294,71)-- + (294,72)--(294,73)--(294,74)--(294,75)--(294,76)--(294,77)--(294,78)-- + (294,79)--(294,80)--(294,81)--(294,82)--(294,83)--(294,84)--(294,85)-- + (294,86)--(294,87)--(294,88)--(294,89)--(308,90)--(308,91)--(308,92)-- + (308,93)--(308,94)--(308,95)--(308,96)--(308,97)--(308,98)--(308,99)-- + (308,100)--(308,101)--cycle; + a(251,91)--(251,91)--(245,90)--(243,89)--(241,88)-- + (240,87)--(239,86)--(239,85)--(238,84)--(238,83)--(237,82)--(237,81)-- + (237,80)--(237,79)--(237,78)--(238,77)--(238,76)--(238,75)--(239,74)-- + (239,73)--(240,72)--(239,71)--(238,70)--(237,69)--(237,68)--(237,67)-- + (236,66)--(236,65)--(235,64)--(235,63)--(235,62)--(235,61)--(235,60)-- + (235,59)--(235,58)--(236,57)--(236,56)--(237,55)--(237,54)--(238,53)-- + (239,52)--(240,51)--(241,50)--(243,49)--(245,48)--(249,47)--(259,47)-- + (262,48)--(265,49)--(267,50)--(270,49)--(272,48)--(276,48)--(276,49)-- + (276,50)--(276,51)--(276,52)--(276,53)--(276,54)--(276,55)--(276,56)-- + (276,57)--(273,58)--(273,59)--(274,60)--(274,61)--(274,62)--(274,63)-- + (274,64)--(274,65)--(274,66)--(274,67)--(274,68)--(274,69)--(274,70)-- + (274,71)--(274,72)--(274,73)--(274,74)--(264,75)--(264,76)--(264,77)-- + (264,78)--(264,79)--(264,80)--(264,81)--(264,82)--(264,83)--(263,84)-- + (263,85)--(263,86)--(262,87)--(261,88)--(260,89)--(258,90)--(253,91)-- + cycle; + a(114,88)--(114,88)--(101,87)--(93,86)--(84,85)--(49,84)--(15,85)-- + (3,86)--(1,86)--(1,85)--(1,84)--(0,83)--(0,82)--(0,81)--(0,80)--(0,79)-- + (0,78)--(0,77)--(4,77)--(11,78)--(28,79)--(53,80)--(79,79)--(92,78)-- + (102,77)--(148,77)--(148,78)--(148,79)--(148,80)--(147,81)--(147,82)-- + (147,83)--(147,84)--(147,85)--(147,86)--(146,87)--(146,88)--cycle; + a(185,82)-- + (185,82)--(186,83)--(187,82)--(187,81)--(187,80)--(188,79)--(188,78)-- + (188,77)--(188,76)--(189,75)--(189,74)--(189,73)--(189,72)--(190,71)-- + (190,70)--(190,69)--(185,68)--(181,69)--(181,70)--(181,71)--(182,72)-- + (182,73)--(182,74)--(183,75)--(183,76)--(183,77)--(184,78)--(184,79)-- + (184,80)--(184,81)--cycle e; + a(250,82)--(250,82)--(251,83)--(253,82)--(254,81)-- + (254,80)--(254,79)--(254,78)--(254,77)--(254,76)--(254,75)--(252,74)-- + (251,75)--(250,76)--(249,77)--(249,78)--(249,79)--(249,80)--(249,81)-- + cycle e; + a(254,73)--(254,73)--(259,74)--(264,73)--(264,72)--(264,71)--(264,70)-- + (264,69)--(264,68)--(264,67)--(264,66)--(263,65)--(262,66)--(261,67)-- + (260,68)--(258,69)--(257,70)--(256,71)--(255,72)--cycle e; + a(100,72)--(100,72)-- + (90,71)--(80,70)--(48,69)--(17,70)--(8,71)--(0,71)--(0,70)--(0,69)-- + (0,68)--(0,67)--(0,66)--(1,65)--(1,64)--(1,63)--(1,62)--(7,62)--(17,63)-- + (49,64)--(81,63)--(94,62)--(147,62)--(147,63)--(147,64)--(147,65)-- + (147,66)--(147,67)--(148,68)--(148,69)--(148,70)--(148,71)--(148,72)-- + cycle; + a(246,64)--(246,64)--(247,65)--(249,64)--(250,63)--(252,62)--(253,61)-- + (254,60)--(255,59)--(255,58)--(252,57)--(250,58)--(248,59)--(247,60)-- + (247,61)--(246,62)--(246,63)--cycle e; + a(91,57)--(91,57)--(75,56)--(65,55)-- + (64,54)--(63,55)--(62,55)--(44,54)--(27,55)--(13,56)--(2,56)--(3,55)-- + (3,54)--(3,53)--(3,52)--(4,51)--(4,50)--(4,49)--(5,48)--(5,47)--(6,46)-- + (6,45)--(12,45)--(24,46)--(40,47)--(46,48)--(53,47)--(143,47)--(143,48)-- + (144,49)--(144,50)--(144,51)--(145,52)--(145,53)--(145,54)--(145,55)-- + (145,56)--(145,57)--cycle; + a(8,42)--(8,42)--(8,41)--(9,40)--(9,39)--(9,38)-- + (10,37)--(11,36)--(11,35)--(12,34)--(12,33)--(13,32)--(14,31)--(15,30)-- + (24,30)--(37,31)--(46,32)--(55,31)--(134,31)--(135,32)--(135,33)-- + (136,34)--(137,35)--(137,36)--(138,37)--(139,38)--(139,39)--(139,40)-- + (140,41)--(140,42)--(78,42)--(59,41)--(45,40)--(32,41)--(13,42)-- + cycle; + a(18,26)--(18,26)--(19,25)--(20,24)--(20,23)--(21,22)--(22,21)--(23,20)-- + (24,19)--(26,18)--(27,17)--(28,16)--(120,16)--(121,17)--(123,18)-- + (124,19)--(125,20)--(126,21)--(127,22)--(128,23)--(129,24)--(129,25)-- + (130,26)--cycle; + a(36,11)--(36,11)--(37,10)--(39,9)--(40,8)--(42,7)--(44,6)-- + (47,5)--(49,4)--(52,3)--(56,2)--(60,1)--(67,0)--(80,0)--(88,1)--(92,2)-- + (96,3)--(99,4)--(101,5)--(104,6)--(106,7)--(108,8)--(110,9)--(111,10)-- + (113,11)--cycle; + p scaled (fontsize n/150) enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/Lb b/Master/texmf-dist/metapost/support/charlib/Lb new file mode 100644 index 00000000000..a57e688f85f --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/Lb @@ -0,0 +1,55 @@ +vardef C.Lb(expr n) = + save p,a,e; + picture p; p=nullpicture; + def a=addto p contour enddef; + def e=withcolor(1,1,1)enddef; + a(312,0)--(312,150)--(81,150)--(81,149)--(87,149)--(93,147.5)--(100.5,145)-- + (108.9,141.4)--(113,138.667)--(113,138)--(80,138)--(64,140)--(43,140)-- + (37,139)--(37,140)--(43,143)--(50.5,146)--(55,147.5)--(62.5,149)-- + (68,149)--(68,150)--(0,150)--(0,84)--(1,84)--(1,86.75)--(22,85)-- + (79.5,85)--(93,86.5)--(101,87.5)--(120.5,89)--(147.167,89)--(149,78)-- + (149,77)--(107,77)--(92,78.5)--(72.5,80)--(37.5,80)--(12,78.5)-- + (0,76.7857)--(0,72.5)--(22.5,70)--(75,70)--(105,73)--(149,73)--(149,71)-- + (147.5,62)--(100.5,62)--(74.5,64)--(23,64)--(3,62)--(1,62)--(1,66)-- + (0,66)--(0,0)--(67,0)--(67,1)--(62,1)--(52,3.5)--(50.5,4)--(43,7)-- + (41,8)--(36,11.3333)--(36,12)--(114,12)--(114,11.6667)--(110,9)-- + (106,7)--(98.5,4)--(97,3.5)--(87,1)--(81,1)--(81,0)--(312,0)--cycle; + a(96.5,123)--(83,124.5)--(62,126)--(39,126)--(19,124.333)--(19,125.5)-- + (25.5,132)--(36.5,131)--(66,131)--(78,132.5)--(87,134)--(119,134)-- + (122,132.5)--(130,124.5)--(130,123)--(96.5,123)--cycle e; + a(105,108)--(81,110)--(23,110)--(9,109)--(9,111)--(12,117)--(26,116)-- + (82.5,116)--(93,117.5)--(102,119)--(134.5,119)--(140,109.833)--(140,108)-- + (105,108)--cycle e; + a(116,92)--(80,95)--(21.5,95)--(3.5,93)--(2.25,93)--(3.5,98)--(4.71765,101.653)-- + (51,100)--(76,100)--(94,101.5)--(114,104)--(142.5,104)--(144.5,100)-- + (146,95.5)--(146,92)--(116,92)--cycle e; + a(210.871,48)--(196.25,48)--(194,57)--(177.833,57)--(174.833,48)-- + (160.167,48)--(178.167,102)--(193.833,102)--(195,98.5)--(210.871,48)-- + cycle e; + a(214,48)--(214,90)--(200,90)--(200,102)--(242,102)--(242,90)--(229,90)-- + (229,48)--(214,48)--cycle e; + a(280,48)--(280,90)--(266,90)--(266,102)--(309,102)--(309,90)--(295,90)-- + (295,48)--(280,48)--cycle e; + a(251,47)--(245,48.5)--(241,50.5)--(237.5,54)--(235,59)--(235,63.5)-- + (237.667,70.1667)--(239.833,72.3333)--(238.5,75)--(237,79.5)--(237,82)-- + (239.5,87)--(241,88.5)--(245,90.5)--(252.636,91.7727)--(259,90.5)-- + (261,89.5)--(263.5,87)--(265,82.5)--(265,75)--(275,75)--(275,62)-- + (274,58)--(277,58)--(277,48)--(273,48)--(269,50)--(267.5,50)--(258.5,47)-- + (251,47)--cycle e; + a(254,75)--(254,81.5)--(252.5,83)--(251.5,83)--(250,81.5)--(250,77.5)-- + (252.5,75)--(254,75)--cycle; + a(190,69)--(190,70)--(186.75,83)--(185.9,83)--(182,70)--(182,69)-- + (190,69)--cycle; + a(264,66)--(264,74)--(255,74)--(255,73.5)--(258,70.5)--(264,66)-- + cycle; + a(255,58)--(255,59.5)--(252.5,62)--(248,65)--(247,65)--(247,63)-- + (248.5,60)--(249,59.5)--(252,58)--(255,58)--cycle; + a(7,45)--(6.5,45)--(4.5,49)--(3.5,52)--(2.25,57)--(7,57)--(35,55)-- + (61,55)--(63,56)--(64,56)--(64,55.4)--(75,56.5)--(99,58)--(146,58)-- + (146,53.5)--(143.833,47)--(57,47)--(49,48)--(25,46.5)--(7,45)--cycle e; + a(18.5,30)--(15.5,30)--(13,32.5)--(9.25,38.75)--(8,42.5)--(8,42.8158)-- + (42.5,41)--(49.5,41)--(87.5,43)--(141,43)--(141,42.5)--(139.667,38.5)-- + (134.667,31)--(65.5,31)--(44.5,32)--(18.5,30)--cycle e; + a(29,16)--(23,20.5)--(21,22.5)--(18,27)--(131,27)--(129.5,24)--(124.5,19)-- + (120,16)--(29,16)--cycle e; + p scaled (fontsize n/150) enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/Sl b/Master/texmf-dist/metapost/support/charlib/Sl new file mode 100644 index 00000000000..5e1202e6129 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/Sl @@ -0,0 +1,22 @@ +vardef C.Sl(expr n) = + save p; + picture p; p=nullpicture; + addto p contour + (14,93)--(14,96)--(29,110)--(44,121)--(54,127)-- + (97,152)--(112,162)--(127,175)--(142,190)--(155,204)--(165,218)-- + (174,233)--(181,246)--(186,260)--(187,264)--(187,279)--(186,283)-- + (181,291)--(171,298)--(157,298)--(144,290)--(132,275)--(124,261)-- + (118,246)--(113,232)--(109,218)--(106,205)--(103,190)--(101,178)-- + (99,166)--(97,153)--(97,152)-- + (94,131)--(93,123)--(92,112)--(91,103)--(90,93)-- + (89,81)--(89,40)--(92,28)--(97,18)--(108,10)--(122,10)--(134,18)-- + (145,33)--(152,48)--(158,62)--(168,58)--(168,59)--(163,45)--(157,31)-- + (148,16)--(133,3)--(118,-1)--(103,0)--(88,5)--(73,18)--(64,31)-- + (58,46)--(55,59)--(53,73)--(52,111)--(54,127)--(55,132)--(57,146)-- + (59,157)--(62,171)--(66,186)--(70,199)--(75,213)--(81,228)--(88,243)-- + (96,257)--(106,272)--(118,287)--(133,300)--(148,307)--(163,308)-- + (178,304)--(191,293)--(197,281)--(198,277)--(198,260)--(194,246)-- + (187,231)--(179,217)--(168,202)--(155,187)--(141,172)--(126,158)-- + (111,146)--(96,136)--(94,131)--(52,111)--(37,101)--(22,86)--(14,93)-- + cycle; + p scaled (.0022*fontsize n) enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/ao.x b/Master/texmf-dist/metapost/support/charlib/ao.x new file mode 100644 index 00000000000..07e7562e241 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/ao.x @@ -0,0 +1,7 @@ +vardef C.ao(expr n) = + save p,q; picture p,q; + p="a"infont n; + q=char202 infont n; + addto p also q + shifted(xpart(urcorner p-urcorner q)/2,.05*fontsize n); + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/bx b/Master/texmf-dist/metapost/support/charlib/bx new file mode 100644 index 00000000000..e7e7cdc3885 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/bx @@ -0,0 +1,6 @@ +vardef C.bx(expr n) = + save p; picture p; + p=nullpicture; + addto p contour ((0,0)--(1,0)--(1,1)--(0,1)--cycle) + scaled (fontsize n/2); + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/ci b/Master/texmf-dist/metapost/support/charlib/ci new file mode 100644 index 00000000000..abe2a8e6367 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/ci @@ -0,0 +1,7 @@ +vardef C.ci(expr n) = + save p; picture p; + p=nullpicture; + addto p doublepath makepath pencircle shifted(.5,.5) + withpen pencircle scaled.0444; + p scaled(.75*fontsize n) +enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/ff b/Master/texmf-dist/metapost/support/charlib/ff new file mode 100644 index 00000000000..6ad6c93cd47 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/ff @@ -0,0 +1,5 @@ +vardef C.ff(expr n) = + save p; + picture p; p="f"infont n; + addto p also "f"infont n shifted(xpart urcorner p-fontsize n/20,0); + p enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/lh.x b/Master/texmf-dist/metapost/support/charlib/lh.x new file mode 100644 index 00000000000..b856d87229d --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/lh.x @@ -0,0 +1,31 @@ +vardef C.lh(expr n) = + save p,a; + picture p; p=nullpicture; + def a expr q = + addto p doublepath q withpen pencircle scaled15 enddef; + a(16,177)--(16,188)--(21,193)--(30,193)--(34,189)--(36,183)--(36,180)-- + (34,174)--(27,170)--(19,172)--(16,177)--cycle; + a(38,194)--(38,196)--(53,199)--(68,201)--(83,202)--(98,203)--(113,204)-- + (128,204)--(143,205)--(158,205)--(173,205)--(188,204)--(203,203)-- + (218,202)--(233,200)--(248,198)--(263,196)--(278,194)--(293,190)-- + (308,186)--(323,181)--(338,176)--(353,168)--(361,162)--(364,153)-- + (366,138)--(367,126)--(368,106)--(369,80)--(369,74)--(368,60)--(367,54)-- + (362,43)--(348,34)--(333,28)--(318,25)--(303,26)--(288,29)--(273,31)-- + (258,32)--(243,32)--(228,30)--(213,27)--(198,24)--(183,23)--(168,23)-- + (153,27)--(148,34)--(148,47)--(153,54)--(168,58)--(183,58)--(198,58)-- + (213,59)--(226,60)--(228,62)--(228,67)--(223,71)--(208,71)--(193,70)-- + (178,70)--(163,70)--(148,70)--(133,71)--(123,76)--(120,84)--(120,91)-- + (122,98)--(129,104)--(144,106)--(159,107)--(174,107)--(189,107)-- + (202,108)--(204,110)--(204,117)--(201,119)--(186,119)--(171,119)-- + (156,119)--(141,119)--(126,119)--(111,121)--(103,128)--(101,137)-- + (101,142)--(103,150)--(111,158)--(126,161)--(141,161)--(156,162)-- + (171,163)--(186,163)--(191,165)--(192,167)--(192,171)--(190,174)-- + (176,175)--(161,175)--(146,175)--(131,174)--(116,174)--(101,174)-- + (86,173)--(71,172)--(56,171)--(41,171)--(41,174)--(43,178)--(43,187)-- + (38,194)--cycle; + a(373,169)--(373,176)--(375,182)--(386,190)--(401,193)--(408,191)-- + (411,185)--(412,181)--(414,167)--(415,158)--(416,144)--(417,128)-- + (418,110)--(418,60)--(417,45)--(415,37)--(409,34)--(394,31)--(381,35)-- + (379,42)--(379,52)--(380,67)--(380,77)--(379,77)--(378,106)--(377,121)-- + (376,133)--(375,147)--(374,158)--(373,169)--cycle; + p scaled(.0022*fontsize n) enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/ob b/Master/texmf-dist/metapost/support/charlib/ob new file mode 100644 index 00000000000..beb76d68547 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/ob @@ -0,0 +1,7 @@ +vardef C.ob(expr n) = + save p; picture p; + p=nullpicture; + addto p doublepath makepath pencircle shifted(.5,.5) + withpen pencircle scaled.0889; + p scaled(.375*fontsize n) +enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/rh b/Master/texmf-dist/metapost/support/charlib/rh new file mode 100644 index 00000000000..1f41bdffdd6 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/rh @@ -0,0 +1,29 @@ +vardef C.rh(expr n) = + save p,a; + picture p; p=nullpicture; + def a expr q = + addto p doublepath q withpen pencircle scaled15 enddef; + a(15,66)--(15,86)--(16,131)--(17,146)--(18,158)--(19,167)--(21,181)-- + (24,190)--(34,193)--(49,189)--(58,182)--(60,177)--(60,166)--(59,156)-- + (58,143)--(57,130)--(56,117)--(55,102)--(54,42)--(53,39)--(49,35)-- + (34,34)--(19,39)--(16,47)--(15,66)--cycle; + a(65,60)--(65,111)--(66,127)--(67,139)--(69,153)--(72,163)--(83,171)-- + (98,177)--(113,182)--(128,187)--(143,190)--(158,194)--(173,196)-- + (188,199)--(203,201)--(218,203)--(233,205)--(248,205)--(263,206)-- + (278,206)--(293,206)--(308,206)--(323,206)--(338,205)--(353,203)-- + (368,202)--(383,200)--(394,197)--(389,190)--(389,180)--(391,176)-- + (391,173)--(380,173)--(365,173)--(350,174)--(335,175)--(320,176)-- + (305,176)--(290,176)--(275,177)--(260,177)--(245,177)--(240,173)-- + (240,170)--(245,165)--(260,164)--(275,164)--(290,164)--(305,163)-- + (320,160)--(327,155)--(330,149)--(330,134)--(328,129)--(323,124)-- + (309,121)--(294,121)--(279,121)--(264,121)--(249,121)--(234,121)-- + (228,118)--(228,112)--(234,109)--(249,109)--(264,109)--(279,108)-- + (294,108)--(306,104)--(311,97)--(312,91)--(312,88)--(311,82)--(305,74)-- + (290,72)--(275,72)--(260,72)--(245,73)--(230,73)--(215,73)--(205,70)-- + (205,63)--(217,60)--(232,60)--(247,60)--(262,60)--(277,57)--(283,52)-- + (285,44)--(285,41)--(284,35)--(280,30)--(268,26)--(253,25)--(238,26)-- + (223,28)--(208,31)--(193,33)--(178,34)--(163,33)--(148,31)--(133,28)-- + (118,27)--(103,28)--(88,34)--(73,43)--(67,52)--(65,60)--cycle; + a(396,180)--(396,188)--(399,194)--(410,196)--(416,190)--(416,180)-- + (415,177)--(411,173)--(400,173)--(396,180)--cycle; + p scaled(.0022*fontsize n) enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/sq b/Master/texmf-dist/metapost/support/charlib/sq new file mode 100644 index 00000000000..b945f55161b --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/sq @@ -0,0 +1,9 @@ +vardef C.sq(expr n) = + save p,q; + picture p; p=nullpicture; + path q; q=(0,0)--(1,0)--(1,1)--(0,1)--cycle; + addto p + if n="Times-Bold": contour q + else: doublepath q withpen pencircle scaled.0667 fi; + p scaled (fontsize n/2) +enddef; diff --git a/Master/texmf-dist/metapost/support/charlib/twiddle b/Master/texmf-dist/metapost/support/charlib/twiddle new file mode 100644 index 00000000000..11765cb7a98 --- /dev/null +++ b/Master/texmf-dist/metapost/support/charlib/twiddle @@ -0,0 +1,5 @@ +vardef C.~eq(expr n) = + save p; + picture p; p="~"infont n; + addto p also "-"infont n shifted(0,-.15*fontsize n); + p enddef; diff --git a/Master/texmf-dist/metapost/support/trchars.adj b/Master/texmf-dist/metapost/support/trchars.adj new file mode 100644 index 00000000000..df000057025 --- /dev/null +++ b/Master/texmf-dist/metapost/support/trchars.adj @@ -0,0 +1,15 @@ +S + 96 -.530 0 + 165 -.015 -.075 + 214 -.010 0 + 231 -.060 -.170 + 233 .201 0 + 235 .201 0 + 238 .002 0 + 242 .098 -.050 + 249 -.103 0 + 250 -.085 -.125 + 251 -.103 0 +S1 + 95 0 .080 + 177 .014 .090 diff --git a/Master/texmf-dist/metapost/support/trfonts.map b/Master/texmf-dist/metapost/support/trfonts.map new file mode 100644 index 00000000000..17560ec6996 --- /dev/null +++ b/Master/texmf-dist/metapost/support/trfonts.map @@ -0,0 +1,48 @@ +AB AvantGarde-Demi pagd8r +AI AvantGarde-BookOblique pagko8r +AR AvantGarde-Book pagk8r +AX AvantGarde-DemiOblique pagdo8r +B Times-Bold ptmb8r +BI Times-BoldItalic ptmbi8r +CB Courier-Bold pcrb8r +CI Courier-Oblique pcrro8r +CO Courier pcrr8r +CW Courier pcrr8r +CX Courier-BoldOblique pcrbo8r +CaslonI CaslonFiveForty-Italic +CaslonR CaslonFiveForty-Roman +GR Symbol psyr +H Helvetica phvr8r +HB Helvetica-Bold phvb8r +HI Helvetica-Oblique phvro8r +HX Helvetica-BoldOblique phvbo8r +Hb Helvetica-Narrow-Bold phvbrn8r +Hi Helvetica-Narrow-Oblique phvron8r +Hr Helvetica-Narrow phvrrn8r +Hx Helvetica-Narrow-BoldOblique phvbon8r +I Times-Italic ptmri8r +KB Bookman-Demi pbkd8r +KI Bookman-LightItalic pbkli8r +KR Bookman-Light pbkl8r +KX Bookman-DemiItalic pbkdi8r +MU Sonata +NB NewCenturySchlbk-Bold pncb8r +NI NewCenturySchlbk-Italic pncri8r +NR NewCenturySchlbk-Roman pncr8r +NX NewCenturySchlbk-BoldItalic pncbi8r +PA Palatino-Roman pplr8r +PB Palatino-Bold pplb8r +PI Palatino-Italic pplri8r +PX Palatino-BoldItalic pplbi8r +R Times-Roman ptmr8r +S Symbol psyr +S1 Times-Roman ptmr8r +Sonata Sonata +UnivMath1 Universal-MathOne M1 +UnivMath2 Universal-MathTwo M2 +UnivMath3 Universal-MathThree M3 +UnivMath4 Universal-MathFour M4 +UnivMath5 Universal-MathFive M5 +UnivMath6 Universal-MathSix M6 +ZD ZapfDingbats pzdr +ZI ZapfChancery-MediumItalic pzcmi8r diff --git a/Master/texmf-dist/metapost/tabvar/tabvar.mp b/Master/texmf-dist/metapost/tabvar/tabvar.mp new file mode 100644 index 00000000000..7b9691270e0 --- /dev/null +++ b/Master/texmf-dist/metapost/tabvar/tabvar.mp @@ -0,0 +1,17 @@ +%%% tabvar.mp +numeric w, h ; +w=24pt ; h=12pt ; +beginfig(1); +pickup pencircle scaled .2pt; +drawarrow (0,0) -- (w,h); +endfig; +beginfig(2); +pickup pencircle scaled .2pt; +drawarrow (0,h) -- (w,0); +endfig; +beginfig(3); +pickup pencircle scaled .2pt; +drawarrow (0,0) -- (w,0); +endfig; +end. +endinput; diff --git a/Master/texmf-dist/metapost/texpower/fig-1.mps b/Master/texmf-dist/metapost/texpower/fig-1.mps new file mode 100644 index 00000000000..940642202f1 --- /dev/null +++ b/Master/texmf-dist/metapost/texpower/fig-1.mps @@ -0,0 +1,22 @@ +%!PS +%%BoundingBox: 0 0 58 58 +%%Creator: MetaPost +%%CreationDate: 2004.03.23:0921 +%%Pages: 1 +%%EndProlog +%%Page: 1 1 + 1 0 0 setrgbcolor +newpath 0.25 28.59645 moveto +0.25 12.94115 12.94115 0.25 28.59645 0.25 curveto +44.25175 0.25 56.9429 12.94115 56.9429 28.59645 curveto +56.9429 40.7281 36.86218 45.12794 28.59645 28.59645 curveto +20.33072 12.06496 0.25 16.4648 0.25 28.59645 curveto closepath fill + 0 0.5 dtransform truncate idtransform setlinewidth pop [] 0 setdash + 1 setlinejoin 10 setmiterlimit +newpath 0.25 28.59645 moveto +0.25 12.94115 12.94115 0.25 28.59645 0.25 curveto +44.25175 0.25 56.9429 12.94115 56.9429 28.59645 curveto +56.9429 44.25175 44.25175 56.9429 28.59645 56.9429 curveto +12.94115 56.9429 0.25 44.25175 0.25 28.59645 curveto closepath stroke +showpage +%%EOF diff --git a/Master/texmf-dist/metapost/texpower/fig-2.mps b/Master/texmf-dist/metapost/texpower/fig-2.mps new file mode 100644 index 00000000000..308793a3876 --- /dev/null +++ b/Master/texmf-dist/metapost/texpower/fig-2.mps @@ -0,0 +1,121 @@ +%!PS +%%BoundingBox: 0 0 310 204 +%%Creator: MetaPost +%%CreationDate: 2004.03.24:1259 +%%Pages: 1 +%%EndProlog +%%Page: 1 1 + 0 0.1 1 setrgbcolor +newpath 0 112.92435 moveto +14.17323 88.37553 lineto +42.51968 88.37553 lineto +28.34645 112.92435 lineto + closepath fill + 1 0 0 setrgbcolor +newpath 34.01566 112.92435 moveto +48.18889 88.37553 lineto +76.53534 88.37553 lineto +62.3621 112.92435 lineto + closepath fill + 0 0.1 1 setrgbcolor +newpath 68.03131 112.92435 moveto +82.20454 88.37553 lineto +110.551 88.37553 lineto +96.37776 112.92435 lineto + closepath fill +newpath 102.04697 112.92435 moveto +116.2202 88.37553 lineto +144.56665 88.37553 lineto +130.39342 112.92435 lineto + closepath fill +newpath 17.00783 83.46584 moveto +31.18106 58.91702 lineto +59.52751 58.91702 lineto +45.35428 83.46584 lineto + closepath fill +newpath 51.02348 83.46584 moveto +65.19672 58.91702 lineto +93.54317 58.91702 lineto +79.36993 83.46584 lineto + closepath fill +newpath 85.03914 83.46584 moveto +99.21237 58.91702 lineto +127.55882 58.91702 lineto +113.38559 83.46584 lineto + closepath fill +newpath 119.0548 83.46584 moveto +133.22803 58.91702 lineto +161.57448 58.91702 lineto +147.40125 83.46584 lineto + closepath fill +newpath 34.01566 54.00732 moveto +48.18889 29.45851 lineto +76.53534 29.45851 lineto +62.3621 54.00732 lineto + closepath fill +newpath 68.03131 54.00732 moveto +82.20454 29.45851 lineto +110.551 29.45851 lineto +96.37776 54.00732 lineto + closepath fill +newpath 102.04697 54.00732 moveto +116.2202 29.45851 lineto +144.56665 29.45851 lineto +130.39342 54.00732 lineto + closepath fill +newpath 136.06262 54.00732 moveto +150.23586 29.45851 lineto +178.5823 29.45851 lineto +164.40907 54.00732 lineto + closepath fill +newpath 51.02348 24.54881 moveto +65.19672 0 lineto +93.54317 0 lineto +79.36993 24.54881 lineto + closepath fill +newpath 85.03914 24.54881 moveto +99.21237 0 lineto +127.55882 0 lineto +113.38559 24.54881 lineto + closepath fill +newpath 119.0548 24.54881 moveto +133.22803 0 lineto +161.57448 0 lineto +147.40125 24.54881 lineto + closepath fill +newpath 153.07045 24.54881 moveto +167.24368 0 lineto +195.59013 0 lineto +181.4169 24.54881 lineto + closepath fill + 0 0.7 1 setrgbcolor +newpath 182.83432 203.75488 moveto +133.22803 117.83403 lineto +138.18874 109.24179 lineto +192.75575 203.75488 lineto + closepath fill + 0 0.5 1 setrgbcolor +newpath 216.84998 203.75488 moveto +199.84215 174.29637 lineto +150.23586 88.37552 lineto +157.67693 75.48715 lineto +212.24394 170.00024 lineto +231.73213 203.75488 lineto + closepath fill + 0 0.3 1 setrgbcolor +newpath 250.86565 203.75488 moveto +216.84998 144.83786 lineto +167.24368 58.917 lineto +177.16512 41.73251 lineto +231.73213 136.2456 lineto +270.70853 203.75488 lineto + closepath fill + 0 0.1 1 setrgbcolor +newpath 284.8813 203.75488 moveto +233.8578 115.37935 lineto +184.25151 29.4585 lineto +198.42474 4.90968 lineto +309.6849 203.75488 lineto + closepath fill +showpage +%%EOF diff --git a/Master/texmf-dist/metapost/texpower/fig-3.mps b/Master/texmf-dist/metapost/texpower/fig-3.mps new file mode 100644 index 00000000000..ab237da83b2 --- /dev/null +++ b/Master/texmf-dist/metapost/texpower/fig-3.mps @@ -0,0 +1,25 @@ +%!PS +%%BoundingBox: 0 0 296 26 +%%Creator: MetaPost +%%CreationDate: 2004.03.24:1531 +%%Pages: 1 +%*Font: lcmssb8 8.504 7.97011 41:988e7c0000000002 +%%EndProlog +%%Page: 1 1 + 0.4 0.7 1 setrgbcolor +newpath 0 0 moveto +283.46451 0 lineto +295.44437 25.6907 lineto +11.97986 25.6907 lineto + closepath fill + 1 setgray +23.16316 9.27249 moveto +(UNIVERSIT) lcmssb8 8.504 fshow +82.72096 10.5127 moveto +(\177) lcmssb8 8.504 fshow +81.86467 9.27249 moveto +(AT) lcmssb8 8.504 fshow +101.67796 9.27249 moveto +(DORTMUND) lcmssb8 8.504 fshow +showpage +%%EOF diff --git a/Master/texmf-dist/metapost/venn/venn.mp b/Master/texmf-dist/metapost/venn/venn.mp new file mode 100644 index 00000000000..8f1ff12e9f3 --- /dev/null +++ b/Master/texmf-dist/metapost/venn/venn.mp @@ -0,0 +1,218 @@ +% venn.mp +% MetaPost input file for venn diagrams. +% +% LICENSE +% This is released under the LaTeX Project Public License. +% +% HISTORY +% 2001-Apr-15 Jim Hefferon jim@joshua.smcvt.edu Written +% + +%defaultscale := 9pt/fontsize defaultfont; + +newinternal venn_width, venn_height; +venn_width := 100pt; venn_height := .618venn_width; +newinternal venn_circle_diameter; +venn_circle_diameter := .5venn_height; +newinternal venn_pen; +venn_pen := 0.4pt; +vardef venn_shade = .9white enddef; +vardef venn_unshade = white enddef; + +path venn_box; % box that borders a Venn diagram; `U' + venn_box = (0,0)--(venn_width,0)--(venn_width,venn_height) + --(0,venn_height)--cycle; +newinternal venn_circle_left_shift, + venn_circle_right_shift, + venn_circle_top_shift, + venn_circle_bottom_shift; +venn_circle_left_shift := .5venn_width; +venn_circle_right_shift := venn_width-venn_circle_left_shift; +venn_circle_top_shift := .5venn_height; +venn_circle_bottom_shift := venn_height-venn_circle_bottom_shift; + + +% ..... venn_color ....... +% Return either venn_shade or venn_unshade, as chosen. +% ARGS +% b A boolean +% RETURNS +% a color +% USAGE +% fill circle withcolor venn_color(true); +% +def venn_color(expr b) = + if b: venn_shade else: venn_unshade fi +enddef; + +% ...... draw_venn_none ........... +% Draw a Venn diagram with no enclosed circles (just the universal set) +% ARGS +% univ A boolean; color the set or not? +% RETURNS +% -- +% USAGE +% draw_venn_none(true); +% draws a shaded set. +% +def draw_venn_none(expr univ)text t = + begingroup + fill venn_box t withcolor venn_color(univ); + pickup pensquare scaled venn_pen; draw venn_box t; + endgroup +enddef; + +% ...... draw_venn_one ........... +% Draw a Venn diagram with one enclosed circle +% ARGS +% univ A boolean; color the universal set or not? +% cl A boolean; color the circle? +% RETURNS +% -- +% USAGE +% draw_venn_one(true,false); +% draws a shaded set with the unshaded circle. +% +def draw_venn_one(expr univ, cl)text t = + begingroup + venn_circle_left_shift := .5venn_width; + venn_circle_right_shift := venn_width-venn_circle_left_shift; + venn_circle_top_shift := .5venn_height; + venn_circle_bottom_shift := venn_height-venn_circle_top_shift; + + fill venn_box t withcolor venn_color(univ); + pickup pensquare scaled venn_pen; draw venn_box t; + + save circle; path circle; + circle = fullcircle scaled venn_circle_diameter + shifted (venn_circle_left_shift,venn_circle_top_shift) t; + fill circle withcolor venn_color(cl); + pickup pencircle scaled venn_pen; draw circle; + endgroup +enddef; + +% ...... draw_venn_two ........... +% Draw a Venn diagram with two enclosed circles +% ARGS +% univ A boolean; color the universal set or not? +% cl A boolean; color the left circle? +% lr A boolean; color the intersection wedge? +% cr A boolean; color the right circle? +% RETURNS +% -- +% USAGE +% draw_venn_two(true,false,true,false) shifted (2in,1in); +% draws a diagram, shifted. +% NOTE +% The trick here is to use mpost's buildcycle to define the +% path `lr' outlining the intersection of the left and right +% circles. Below the left circle is defined to be rotated -180. +% That's because otherwise the intersection with the right +% circle occurs on top early in the path, and on bottom late in +% the path, and so the left of the lr region crosses through the +% `point 0 of circle_left' boundary, which confuses buildcycle. +% So, it's a hack. +% +def draw_venn_two(expr univ, cl, lr, cr)text t = + begingroup + venn_circle_left_shift := .4venn_width; + venn_circle_right_shift := venn_width-venn_circle_left_shift; + venn_circle_top_shift := .5venn_height; + venn_circle_bottom_shift := venn_height-venn_circle_top_shift; + + fill venn_box t withcolor venn_color(univ); + pickup pensquare scaled venn_pen; draw venn_box t; + + save circle_left, circle_right; path circle_left, circle_right; + circle_left = fullcircle rotated -180 scaled venn_circle_diameter + shifted (venn_circle_left_shift,venn_circle_top_shift) t; + circle_right = fullcircle scaled venn_circle_diameter + shifted (venn_circle_right_shift,venn_circle_top_shift) t; + save area_lr; path area_lr; + area_lr = buildcycle(circle_left,circle_right); + + fill circle_left withcolor venn_color(cl); + fill circle_right withcolor venn_color(cr); + fill area_lr withcolor venn_color(lr); + pickup pencircle scaled venn_pen; + draw circle_left; draw circle_right; + endgroup +enddef; + + + +% ...... draw_venn_three ........... +% Draw a Venn diagram with three enclosed circles +% ARGS +% univ A boolean; color the universal set or not? +% cl A boolean; color the left circle? +% lr A boolean; color the intersection wedge? +% cr A boolean; color the right circle? +% lb A boolean; color the intersection of left and bot right circles? +% rb A boolean; color the intersection of right and bot circles? +% lrb A boolean; color the intersection of all three circles? +% cb A boolean; color the bottom circle? +% RETURNS +% -- +% USAGE +% draw_venn_three(true,false, ...) shifted (2in,1in); +% draws a diagram, shifted. +% NOTE +% The trick here is to use mpost's buildcycle to define the +% paths `lr' (outlining the intersection of the left and right +% circles), `rb', `lb', and `lrb'. +% To do that I had to fiddle with the times along the circles. +% So, it's a hack. +% +def draw_venn_three(expr univ, cl, lr, cr, lb, rb, lrb, cb)text t = + begingroup + venn_circle_left_shift := .4venn_width; + venn_circle_right_shift := venn_width-venn_circle_left_shift; + venn_circle_top_shift := .63venn_height; + venn_circle_bottom_shift := venn_height-venn_circle_top_shift; + + fill venn_box t withcolor venn_color(univ); + pickup pensquare scaled venn_pen; draw venn_box t; + + save circle_left, circle_right, circle_bottom; + path circle_left, circle_right, circle_bottom; + circle_left = (reverse fullcircle) rotated -180 scaled venn_circle_diameter + shifted (venn_circle_left_shift,venn_circle_top_shift) t; + circle_right = (reverse fullcircle) scaled venn_circle_diameter + shifted (venn_circle_right_shift,venn_circle_top_shift) t; + circle_bottom = (reverse fullcircle) rotated -90 scaled venn_circle_diameter + shifted (.5venn_width,venn_circle_bottom_shift) t; + save area_lr, area_lb, area_rb, area_lrb; + path area_lr, area_lb, area_rb, area_lrb; + area_lr = buildcycle(circle_left,circle_right); + area_lb = buildcycle(circle_left,circle_bottom); + area_rb = buildcycle(circle_right,circle_bottom); + area_lrb = buildcycle(circle_left,circle_right,circle_bottom); + + fill circle_left withcolor venn_color(cl); + fill circle_right withcolor venn_color(cr); + fill circle_bottom withcolor venn_color(cb); + fill area_lr withcolor venn_color(lr); + fill area_lb withcolor venn_color(lb); + fill area_rb withcolor venn_color(rb); + fill area_lrb withcolor venn_color(lrb); + pickup pencircle scaled venn_pen; + draw circle_left; draw circle_right; draw circle_bottom; + endgroup +enddef; + + +% test: This works for me under Linux (2001-Apr-15) +% > mpost venn +% > tex mproof venn.0 +% > dvips -Pwww -omproof.ps mproof +% results in a document mproof.ps in PostScript that I can see with +% > gv mproof.ps (type that from an XWindow xterm). + +% To run the test, uncomment the next five lines (including the `end'). +%beginfig(0); +% draw_venn_three(false,true,false,true,false,true,true,false); +% draw_venn_three(false,true,false,true,false,true,true,false) shifted (2in,3in); +%endfig; +%end + |