summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost/base/mfplain.mp
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/metapost/base/mfplain.mp')
-rw-r--r--Master/texmf-dist/metapost/base/mfplain.mp579
1 files changed, 579 insertions, 0 deletions
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