% mathematical symbols by Anthony Phan.
% file: mathbase.mf (base file)
% last modification: May 16, 2005.

mathbase := 1; % when |mathbase| is known, this file has been input

newinternal slant, currentbreadth, math_spread, superness, stress;
slant := 0; superness := 1/sqrt 2; stress := 0.5;

string main_name_string, tmp_string, 
extra_beginchar_save, extra_endchar_save;

picture tmp_picture;
path tmp_path, tmpp_path;

boolean true_size, tmp_boolean, dagesh;
true_size := false;% see mathhbrw.mf

pair both; both = (1, 1);

def autorounded = interim autorounding := 2 enddef;

def localtransform = save currenttransform;
  transform currenttransform; currenttransform
enddef;

numeric currentlocation_;

vardef currentlocation = 
  currentlocation_ := currentlocation_+1;
  currentlocation_-1
enddef;

def main_name_with(suffix $) = 
  scantokens(main_name_string & str$)
enddef;

def math_setup = 
  autorounding := 0; smoothing := 0;
  appr# := u#+letter_fit#; Appr# := 1.5u#+letter_fit#;
  numeric paren_depth#, asc_depth#, body_depth#;
  0.5[body_height#, -paren_depth#] = math_axis#;
  0.5[asc_height#, -asc_depth#] = math_axis#;
  body_depth# := desc_depth#+body_height#-asc_height#;
  %
  define_pixels(u, dh, dish, stem_corr, vair_corr);
  define_whole_blacker_pixels(hair, stem, curve, 
    cap_hair, cap_stem, cap_curve, dtsz, ast_curve, ast_stem);
  define_whole_vertical_blacker_pixels(vair, slab);% cap_bar...
  define_whole_vertical_pixels(body_height, asc_height, 
    cap_height, fig_height, x_height, desc_depth, 
    asc_depth, body_depth, paren_depth);
  define_whole_pixels(letter_fit, appr, Appr, 
    crisp, tiny, fine, ast_size);
  define_corrected_pixels(o);
  define_horizontal_corrected_pixels(ho);
  lowres_fix(stem, curve) 1.2;
  lowres_fix(cap_stem, cap_curve) 1.2;
  lowres_fix(hair, cap_hair) 1.2;
  oo := vround(0.5o#*hppp*o_correction)+eps;
  dw := (curve#-stem#)*hppp; bold := curve#*hppp+blacker;
  vair' := vround(vair+vair_corr);
  % 
  % usual pens.
  %
  clear_pen_memory;
  if fine = 0: fine := 1; fi
  null := 0;
  forsuffixes $ = null, crisp, tiny, fine:
    $.breadth := $;
    pickup if $ = 0: nullpen else: pencircle scaled $ fi;
    $ := $-eps; $.nib := savepen; breadth_[$.nib] := $;
  endfor
  $ := 0;
  forever:
    exitif unknown rth[$].#;
    rth[$] := ceiling(rth[$].#*hppp);
    pickup pencircle scaled rth[$];
    rule.nib[$] := savepen;
    $ := $+1;
  endfor
  %
  % spreads
  %
  for $ = 0 upto 10:
    if known spread[$].#:
      spread[$] := 2ceiling(0.5spread[$].#*hppp);
    fi
  endfor
  %
  % current transform (slant is not taken into account)
  %
  currenttransform = identity
  yscaled aspect_ratio scaled granularity;
  %
  % proofing
  %
  standard_proofing;
  use_rule1;
enddef;

% The following environment enables people to draw a picture
% almost like drawing a character. The resulting picture is
% stored in $_picture and then it can be used in at any
% place later.

def beginpicture(suffix $)(expr w_sharp, h_sharp, d_sharp) = 
  begingroup
    save picturename;
    w := hround(w_sharp*hppp); h := vround(h_sharp*hppp);
    d := vround(d_sharp*hppp); clearxy; clearit; clearpen;
    string picturename; picturename = str $ &"_picture";
  enddef;

  def endpicture = 
    expandafter picture scantokens picturename;
    scantokens picturename = currentpicture;
  endgroup
enddef;

vardef use_rule@# = 
  rth := rth@#; rth# := rth@#.#;
  rule.nib := rule.nib@#;
  math_axis := vround(math_axis#*hppp-0.5rth)+0.5rth;
enddef;

def numeric_pickup_ primary q = 
  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];
  if known breadth_[q]: currentbreadth := breadth_[q]; fi
enddef;

%def compute_spread(expr normal_spread, big_spread) = 
% spread# := math_spread[normal_spread, big_spread];
% spread := 2ceiling((spread#)*hppp/2)
%enddef;

def v_center(expr h_sharp) = 
  .5h_sharp+math_axis#, .5h_sharp-math_axis#
enddef;

def ensure_centering_of(expr stem) = 
  if hround 0.5(w-hround stem)+0.5hround stem<> 0.5w:
    change_width; fi
enddef;

vardef v_adjust(suffix $, $$)(expr middle, height) = 
  top y$-middle = middle-bot y$$ = vround 0.5(height-rth)+0.5rth
enddef;

def arithmetic_bounds = 
  12u#+2appr#, math_axis#+6u#, 6u#-math_axis#
enddef;

def padded expr del_sharp = 
  charht := charht+del_sharp; chardp := chardp+del_sharp
enddef;

%vardef pos@#(expr b, d) = 
% if known b: if b <= currentbreadth: errmessage "bad pos"; fi fi
% save d_; pair d_; d_ = dir d;
% z@#r-z@#l+penoffset d_ of currentpen+penoffset -d_ of currentpen = b*d_;
% x@# = .5(x@#l+x@#r); y@# = .5(y@#l+y@#r) enddef;

vardef pos@#(expr b, d) = 
  if known b: if b <= currentbreadth: errmessage "bad pos"; fi fi
  (x@#r-x@#l, y@#r-y@#l) = (b-currentbreadth, 0) rotated d;
  x@# = .5(x@#l+x@#r); y@# = .5(y@#l+y@#r) enddef;

vardef stroke text t = 
  forsuffixes e = l, r: path_.e := t;endfor
  if cycle path_.l:
    errmessage "Beware: `stroke' doesn't work with cycles";
  fi
  path_.l -- reverse path_.r -- cycle
enddef;

% DIAGONALS

def diag_width(expr $, $$) = 
  $/abs sind angle $$
enddef;

%vardef diag_height(expr $, $$) = 
% $/abs cosd angle $$
%enddef;

% $ <---> $$$; $$ <---> $$$$. sign = +1 for \, -1 for /.

vardef adjust_slanted_bar(suffix $, $$, $$$, $$$$)(expr thickness, sign) = 
  save a, b;
  if abs(y$$-y$) = thickness:
    (a1, a2) = (z$$-z$);
    if a1 = 0: b = 0;% b should then be infinite.
    else: b = if sign<0: - fi (a1++a2)*((a1++a2)/2a1);
    fi
  else:
    a = angle(z$$-z$);
    b = (cosd(a)/sind(a) if sign<0: - else: + fi
      (((y$$-y$)/(thickness)/sind(a))+-+1))
    /(((y$$-y$)/(thickness))**2-1)*(y$$-y$);
  fi
  z$$$ = (x$-b, y$); z$$$$ = (x$$+b, y$$)
enddef;

% supplementary points for diagonal strokes
% as in cm's \#. (see MetaFontbook, p. 200--201)
% Well, ...

vardef diag_stroke.@#(suffix $, $$, s)(text y_list) = 
  z$.@#--for y_ = y_list:
    (good.x(((x$.s-x$$.s)/(y$.s-y$$.s))*(y_-y$$r)+x$$.s), y_)
    +z$.@#-z$.s
    --endfor z$$.@#
enddef;

% CIRCLES, ELLIPSES AND RELATED THINGS

primarydef w up_to_right z = 
  w{0, ypart(z-w)}
  ...(superness[xpart z, xpart w], 
    superness[ypart w, ypart z]){z-w}
  ...{xpart(z-w), 0}z
enddef;

let up_to_left = up_to_right;
let down_to_right = up_to_right;
let down_to_left = up_to_right;

primarydef w right_to_up z = 
  w{xpart(z-w), 0}
  ...(superness[xpart w, xpart z], 
    superness[ypart z, ypart w]){z-w}
  ...{0, ypart(z-w)}z
enddef;

let right_to_down = right_to_up;
let left_to_up = right_to_up;
let left_to_down = right_to_up;

def ellipse_set(suffix $, @, @@, $$) = 
  alpha_ := slope*(x@-x$); beta_ := y$$-y$-slope*(x$$-x$);
  gamma_ := alpha_/beta_;
  y@-y$ = .5(beta_-alpha_*gamma_);
  x@@-x$ = -2gamma_*(x@-x$)/(1+gamma_*gamma_);
  y@@-y$$ = slope*(x@@-x$$)
enddef;

def hellipse_set(suffix $, @, @@, $$) = 
  alpha_ := (y@-y$)/slope; beta_ := x$$-x$-(y$$-y$)/slope;
  gamma_ := alpha_/beta_;
  x@-x$ = .5(beta_-alpha_*gamma_);
  y@@-y$ = -2gamma_*(y@-y$)/(1+gamma_*gamma_);
  x@@-x$$ = (y@@-y$$)/slope
enddef;

vardef adjust_elliptic_arc(suffix $, $$, $$$) = 
  save a, b;
  if known (y$$$-y$): a = (1+-+((y$$$-y$)/(y$$-y$)));
    x$$-x$ = (x$$$-x$)/(1+a); b = (1+-+((x$$$-x$$)/(x$$-x$)));
  else: b = (1+-+((x$$$-x$$)/(x$$-x$)));
    y$$$-y$ = (y$$-y$)*b; a = (1+-+((y$$$-y$)/(y$$-y$)));
  fi
  y$$$' = y$$; x$$$' = (((1-b)/a)*(b/a))[x$$$, x$$];
enddef;

def flatcup(expr zi, zii, ziii) = 
  zi..controls (xpart zi, flatness[ypart zi, ypart zii])
  and (xpart zi, ypart zii)
  ..zii..controls (xpart ziii, ypart zii)
  and (xpart ziii, flatness[ypart ziii, ypart zii])..ziii
enddef;

% DOTS

boolean full_dot; full_dot := true;

def dot(suffix $, $$) = 
  autorounded;
  if full_dot: filldraw else: draw fi
  dot_path($, $$); full_dot := true;
enddef;

def dot_path(suffix $, $$) = 
  (x$, 0.5[y$, y$$]) down_to_right (0.5[x$, x$$], y$) right_to_up
  (x$$, 0.5[y$, y$$]) up_to_left (0.5[x$, x$$], y$$) left_to_down
  (x$, 0.5[y$, y$$])...cycle
enddef;

vardef adjust_dot@#(expr center, diameter, h_fit, v_fit) = 
  if v_fit: save y_min, y_max;
    bot y_min = vround(ypart center-0.5diameter)-eps;
    top y_max = vround(ypart center+0.5diameter)+eps;
    y@#'-ypart center = ypart center-y@#
    = max(y_max-ypart center, ypart center-y_min);
  else:
    bot y@# = vround(ypart center-0.5diameter)-eps;
    top y@#'-bot y@# = vround diameter+2eps; fi
  if h_fit: save x_min, x_max;
    lft x_min = hround(xpart center-0.5diameter)-eps;
    rt x_max = hround(xpart center+0.5diameter)+eps;
    x@#'-xpart center = xpart center-x@#
    = max(x_max-xpart center, xpart center-x_min);
  else: 
    lft x@# = vround(xpart center-0.5diameter)-eps;
    rt x@#'-lft x@# = hround(diameter)+2eps; fi
  labels(@#, @#');
enddef;

% VERY DESIGN DEPENDENT MACROS

% DAGGERS AND ASTERISKS

vardef dagger_stroke@#(expr height, curve, stem, u_) = 
  save alpha, a, b, c, R;
  alpha = angle u_-90; R = 0.5(curve-currentbreadth);
  a = stress*(height-curve+0.5currentbreadth)+R;
  b = 0.5(stem-currentbreadth);
  c = (a*R-b*sqrt(a**2+b**2-R**2))/(a**2+b**2);
  z@#c-z@# = (height-0.5currentbreadth)*u_;
  z@#c-z@#b = R*u_; z@#d-z@#b = -a*u_; z@#a = (c*(R/a))[z@#b, z@#d];
  penpos@#(2b, alpha); penpos@#d(2b, alpha);
  penpos@#a(2R*(1+-+c), alpha); penpos@#b(2R, alpha);
  penlabels(@#a, @#b, @#c, @#d, @#);
  z@#r{u_}...z@#a.r{z@#a.r-z@#d.r}...z@#b.r{u_}...
  (superness[z@#b, z@#b.r]+superness[z@#b, z@#c]-z@#b){z@#c-z@#b.r}
  ...z@#c{z@#b.l-z@#b.r}...
  (superness[z@#b, z@#b.l]+superness[z@#b, z@#c]-z@#b){z@#b.l-z@#c}
  ...z@#b.l{-u_}...z@#a.l{z@#d.l-z@#a.l}...{-u_}z@#l
enddef;

% ARROWS

numeric arrow_height, arrow_width, arrow_breadth, arrow_stress, 
arrow_tense[], arrow_time, double_arrow_height, double_arrow_width, 
double_arrow_tense, double_arrow_flatness;

boolean arrow_head_fitting;
arrow_head_fitting := false;

vardef arrow_head@#(expr p, side) = 
  save a, t; numeric a[];
  a1 = angle direction infinity of p; pos@#a(rth, a1-90);
  z@#a = point infinity of p
  if arrow_head_fitting: -0.5currentbreadth*dir a1 fi;
  t := xpart(p intersectiontimes (halfcircle rotated(a1+90)
      scaled (2arrow_stress*arrow_height-currentbreadth)
      shifted z@#a));
  a2 := angle direction t of p; arrow_time := t;
  z@# = point t of p; pos@#(rth, a2-90);
  z@#-z@#c = (1-arrow_stress)*arrow_height*dir a2;
  z@#c.r-z@#c = z@#c-z@#c.l = 0.5(arrow_width-currentbreadth)*dir(a2-90);
  z@#b.r-z@#c.r = z@#b.l-z@#c.l = max(arrow_breadth-currentbreadth, 0)*dir a2;
  z@#b = p intersectionpoint (z@#b.r..z@#b.l);
  t := xpart(p intersectiontimes (halfcircle rotated(a1+90)
      scaled (2arrow_tense2[1, arrow_stress]*arrow_height-currentbreadth)
      shifted z@#a));
  a3 = angle direction t of p; z@#' = point t of p; pos@#'(rth, a3-90);
  z@#a' = if arrow_tense1<1:
    p intersectionpoint (halfcircle rotated(a1+90)
      scaled(arrow_tense1[length(z@#b-z@#a), 0]*2) shifted z@#a);
  else: z@#a; fi
  filldraw
  if side = right: z@#a.l{-dir a1}...{-dir a2}z@#l
  else: z@#a...{z@#b.l-z@#a'}z@#b.l--z@#c.l{z@#'l-z@#c.l}...z@#l
  fi --
  if side = left: z@#r{dir a2}...z@#a.r{dir a1}
  else: z@#r...{z@#c.r-z@#'r}z@#c.r--z@#b.r{z@#a'-z@#b.r}...z@#a
  fi -- cycle;
  labels(@#a'); penlabels(@#', @#a, @#b, @#c);
  arrow_head_fitting := false;
enddef;

vardef double_arrow_head@#(expr head, vect) = 
  save a, b, u_, v_; pair u_, v_;
  u_ = unitvector vect; v_ = u_ rotated 90;
  z@# = z@#' = head;
  z@#-z@#m = double_arrow_height*u_;
  pos@#'(rth, angle u_-90);
  pos@#m(rth, angle u_-90);
  z@#-z@#b.r = z@#m-z@#m.b = 0.5rth*double_arrow_flatness*v_;
  a = angle(-double_arrow_height, 0.5double_arrow_width);
  b = (cosd(a)/sind(a)+
    ((0.5double_arrow_width/rth/sind(a))+-+1))
  /((0.5double_arrow_width/rth)**2-1)
  *0.5double_arrow_width;
  z@#c.l = double_arrow_tense[z@#m.b, z@#b.r-b*u_];
  z@#m-z@#a.l = 0.5double_arrow_width*v_;
  b := rth/abs sind(angle(z@#a.l-z@#c.l)-angle(-u_));
  z@#a.r-z@#a.l = z@#c.r-z@#c.l = b*u_;
  z@#ab = 0.5[z@#a.r, z@#c.r];
  penpos@#b(rth, angle(z@#b.r-z@#ab)-90);
   %
  save p, t; path p[]; numeric t[];
  z@#a = 0.5[z@#a.r, z@#a.l];
  p1 = z@#a{z@#ab-z@#a.r}...{z@#b.r-z@#ab}z@#b;
  p3 = z@#a.r{z@#ab-z@#a.r}...{z@#b.r-z@#ab}z@#b.r;
  p5 = if (z@#b.l-z@#) dotprod v_<0:
    z@#'l+(u_ dotprod (z@#b.l-z@#))*u_-- fi
  z@#b.l{z@#ab-z@#b.r}...{z@#a.r-z@#ab}z@#a.l;
  p2 = reverse p1 reflectedabout (z@#, z@#m);
  p4 = reverse p3 reflectedabout (z@#, z@#m);
  p6 = reverse p5 reflectedabout (z@#, z@#m);
  t5 = xpart(p5 intersectiontimes (z@#+eps*v_ .. z@#m+eps*v_));
  t6 = xpart(p6 intersectiontimes (z@#-eps*v_ .. z@#m-eps*v_));
  fill p3--z@#+eps*v_--subpath (t5, length p5) of p5--cycle;
  fill z@#-eps*v_--p4--subpath (0, t6) of p6--cycle;
  forsuffixes $ = l, , r:
    z@#r$ = p1 intersectionpoint
    ((z@#'$..z@#m$) shifted (-0.5spread1*v_));
    z@#l$ = p2 intersectionpoint
    ((z@#'$..z@#m$) shifted (0.5spread1*v_));
  endfor
  penlabels(@#, @#', @#a, @#b, @#c, @#r, @#l, @#m); labels(@#ab, @#m.b);
enddef;

% ARM, BEAK and SERIFS (personal taste)

% vardef arm@#(expr beak, beak_jut, breadth, darkness, orientation, x_limit) = 
%  save a; a = 90;
%  if orientation = up: y@#a = min(y@#l, y@#r); y@#d = max(y@#l, y@#r);
%   y@#b-y@#d = vround beak; a := -a;
%  else: y@#a = max(y@#l, y@#r); y@#d = min(y@#l, y@#r);
%   y@#b-y@#d = -vround beak; fi
%  if x_limit>x@#: rt x@#b = hround x_limit; x@#b-x@#a = hround beak_jut;
%  else: lft x@#b = hround x_limit; x@#b-x@#a = -hround beak_jut; a := -a; fi
%  z@#c-z@#b = max(0, breadth-currentbreadth)
%  *unitvector(z@#a-z@#b)rotated a;
%  z@#d-z@#c = whatever*(z@#a-z@#b);
%  filldraw z@#c{z@#d-z@#c}...
%  if y@#l = y@#.d: darkness[z@#d, 0.5[z@#c, z@#l]]{z@#l-z@#c}
%   ...z@#l{z@#l-z@#d}--z@#r
%  else: darkness[z@#d, 0.5[z@#c, z@#r]]{z@#r-z@#c}
%   ...z@#r{z@#r-z@#d}--z@#l fi
%  --z@#a--z@#b--cycle;
%  labels(@#a, @#b, @#c, @#d);
% enddef;

vardef arm@#(expr beak, beak_jut, hair, darkness, direction, limit) = 
  y@#d = y@#r; y@#a = y@#b = y@#r if ypart direction > 0: + else: - fi vround beak;
  y@#c = y@#l;
  rt x@#b = hround limit; lft x@#a = hround(limit-hair);
  x@#b-x@#c = hround beak_jut; z@#d-z@#a = whatever*(z@#c-z@#b);
  filldraw z@#r{z@#d-z@#r}...darkness[z@#d, 0.5[z@#r, z@#a]]...
  z@#a{z@#a-z@#d}--z@#b--z@#c--z@#l--cycle;
  labels(@#a, @#b, @#c, @#d);
enddef;

vardef serif(suffix $, $$)
  (expr bracket, left_jut, left_slab, dished_left, left_dish, 
    right_jut, right_slab, dished_right, right_dish) = 
  save a, b; b = cosd angle(z$$-z$);
  a = max(0.5left_jut, 0.5right_jut, bracket);
  if y$<y$$: top y$b = bot y$+vround left_slab;
    top y$g = bot y$+vround right_slab;
    y$a-y$b = y$h-y$g = bracket;
    top y$c-bot y$d = left_slab+left_dish;
    top y$f-bot y$e = right_slab+right_dish;
  else: bot y$b = top y$-vround left_slab;
    bot y$g = top y$-vround right_slab;
    y$a-y$b = y$h-y$g = -bracket;
    bot y$c-top y$d = -left_slab-left_dish;
    bot y$f-top y$e = -right_slab-right_dish;
  fi
  if dished_left: y$c = y$b; else: y$d = y$; fi
  if dished_right: y$f = y$g; else: y$e = y$; fi
  if x$l<x$r: z$a = whatever[z$l, z$$l];
    z$h = whatever[z$r, z$$r];
    x$c = x$d = x$l-hround(left_jut-b*abs(y$b-y$));
    x$e = x$f = x$r+hround(right_jut+b*abs(y$g-y$));
    x$l-x$b = min(left_jut, a);
    x$g-x$r = min(right_jut, a);
  else: z$a = whatever[z$r, z$$r];
    z$h = whatever[z$l, z$$l];
    x$c = x$d = x$r-hround(left_jut-b*abs(y$b-y$));
    x$e = x$f = x$l+hround(right_jut+b*abs(y$g-y$));
    x$r-x$b = min(left_jut, a);
    x$g-x$l = min(right_jut, a);
  fi
  filldraw z$a{z$-z$$}...z$b{left}...z$c--z$d...z${right}
  ...z$e--z$f...z$g{left}...{z$$-z$}z$h--cycle;
  labels($a, $b, $c, $d, $e, $f, $g, $h);
enddef;

% SIM: drawn once, used many times

def make_sim_picture = 
  if unknown sim_picture:
    beginpicture(sim, 12u#+2appr#, v_center(spread1#+rth#));
    pickup tiny.nib;
    save a, b;
    a = angle(1, 1.25(h+d)/u);
    b = angle(1, -(h+d)/4.5u);
    pos1(hair, a+90); pos9(hair, a+90); pos5(stem, b+90);
    bot y7l = -d-eps; top y3r = h+eps;
    y1l = good.y 0.225[y7l, y3r]; y3r-y9r = y1l-y7l;
    top y3r-bot y3l = top y7r-bot y7l = vround 0.5[hair, stem];
    lft x1r = Appr-eps; rt x9l = w-Appr+eps;
    z5 = 0.5[z1, z9];
    forsuffixes $ = r, l: y2$ = y3$ = y4$; y6$ = y7$ = y8$;
      z2$-z1$ = whatever*dir a; z8$-z9$ = whatever*dir a;
      z4$-z5$ = whatever*dir b; z6$-z5$ = whatever*dir b;
      x3$ = 0.6525[x2$, x4$]; x7$ = 0.6525[x8$, x6$];
    endfor
    filldraw stroke z1e..controls 0.66[z1e, z2e] and 0.66[z3e, z2e]
    ..z3e..controls 0.4[z3e, z4e] and 1[z5e, z4e]% 1 for inflexion point
    ..z5e..controls 1[z5e, z6e] and 0.4[z7e, z6e]
    ..z7e..controls 0.66[z7e, z8e] and 0.66[z9e, z8e]..z9e;
   %penlabels(1, 2, 3, 4, 5, 6, 7, 8, 9);
    endpicture;
  fi
enddef;

% TRIANGLES

% makes an equilateral triangle optionally fully centered.

numeric triangle_foot;

vardef set_triangle@#(expr orientation, a, rth, centered, fit_bounds) = 
  if orientation = left:
    rt x1@#r = rt x3@#r = if centered:
      hround(0.5w+0.5a/sqrt3);
    else: hround triangle_foot; fi
    x1@#r-x2@#r = hround(0.5a*sqrt(3)-currentbreadth)+eps;
    y2@#r = good.y 0.5[-d, h];
    y3@#r-y2@#r = y2@#r-y1@#r = vround(0.5(a-currentbreadth))+eps;
  elseif orientation = right:
    lft x1@#r = lft x3@#r = if centered:
      hround(0.5w-0.5a/sqrt3);
    else: hround triangle_foot; fi
    x2@#r-x1@#r = hround(0.5a*sqrt(3)-currentbreadth)+eps;
    y2@#r = good.y 0.5[-d, h];
    y2@#r-y3@#r = y1@#r-y2@#r = vround(0.5(a-currentbreadth))+eps;
  elseif orientation = down:
    top y1@#r = top y3@#r = if centered:
      vround(math_axis+0.5a/sqrt3);
    else: vround triangle_foot; fi
    y1@#r-y2@#r = hround(0.5a*sqrt(3)-currentbreadth)+eps;
    x2@#r = good.x 0.5w;
    x1@#r-x2@#r = x2@#r-x3@#r
    = hround 0.5min(a-currentbreadth, w-2appr-currentbreadth+2ho)+eps;
  else:
    bot y1@#r = bot y3@#r = if centered:
      vround(math_axis-0.5a/sqrt3);
    else: vround triangle_foot; fi
    y2@#r-y1@#r = hround(0.5a*sqrt(3)-currentbreadth)+eps;
    x2@#r = good.x 0.5w;
    x3@#r-x2@#r = x2@#r-x1@#r
    = hround 0.5min(a-currentbreadth, w-2appr-currentbreadth+2ho)+eps;
  fi
  z1@#l-z1@#r = (rth-currentbreadth)/sind(60)
  *(unitvector(z3@#r-z1@#r)+unitvector(z2@#r-z1@#r));
  z2@#l-z2@#r = (rth-currentbreadth)/sind(60)
  *(unitvector(z3@#r-z2@#r)+unitvector(z1@#r-z2@#r));
  z3@#l-z3@#r = (rth-currentbreadth)/sind(60)
  *(unitvector(z1@#r-z3@#r)+unitvector(z2@#r-z3@#r)); 
  penlabels(1@#, 2@#, 3@#);
enddef;

% It's buggy
vardef draw_star@#(expr center, n_edges, radius, tense, angle_init, void) = 
  save a, b, theta; theta = 360/n_edges;
  x@# = good.x xpart center; y@# = good.y ypart center;
  % external points
  a = radius-0.5currentbreadth;
  b = (1-tense)*a*cosd theta/cosd(theta/2);
  for $ = 1 upto n_edges:
    z@#[2$-1]l = z@#+round(a*dir(($-1)*theta+angle_init));
    z@#[2$]l = z@#+round(b*dir(($-0.5)*theta+angle_init));
    labels(@#[2$-1]l, @#[2$]l);
  endfor
  if void:
  % internal points
    a := (rth-currentbreadth)/
    abs sind(angle(z@#[1]l-z@#[2]l)-angle(z@#[1]l-z@#));
    b := (rth-currentbreadth)/
    abs sind(angle(z@#[2]l-z@#[1]l)-angle(z@#[2]l-z@#));
    for $ = 1 upto n_edges:
      z@#[2$-1]l-z@#[2$-1]r = a*dir(($-1)*theta+angle_init);
      z@#[2$]l-z@#[2$]r = b*dir(($-0.5)*theta+angle_init);
      labels(@#[2$-1]r, @#[2$]r);
    endfor
    filldraw stroke for $ = 1 upto 2n_edges: z@#[$]e--endfor z@#[1]e;
  else:
    filldraw for $ = 1 upto 2n_edges: z@#[$]l--endfor cycle;
  fi
enddef;

% ADMINISTRATION

% PROOFING

def horizontal_rules_list = 
  -body_depth, -desc_depth, x_height, cap_height, asc_height, body_height
enddef;

def makebox(text rule) = 
  for y = -d.o_, 0, h.o_:
    rule((-xoffset, y), (w-xoffset, y)); endfor
  for y = horizontal_rules_list:
    rule((appr-xoffset, y), (w-appr-xoffset, y));
  endfor
  for x = -xoffset, appr-xoffset, w-appr-xoffset, w-xoffset:
    rule((x, -d.o_), (x, h.o_)); endfor
  for x = appr+u-xoffset step u until w-appr-1.5-xoffset:
    rule((x, -d.o_), (x, h.o_)); endfor
  if charic<>0:
    rule((w-xoffset+charic*hppp, h.o_), 
      (w-xoffset+charic*hppp, .5[h, -d].o_)); fi
enddef;

def accents_proofing = 
  for $ = 0 upto 19:
    makelabel("", (0.5w-xoffset, 0.5x_height)
      +(4u*cosd($*360/20), 0.5x_height*sind($*360/20)));
  endfor
enddef;

def diacritics_proofing = 
  if proofing>0: extra_endchar := extra_endchar&"accents_proofing;"; fi
enddef;

def standard_proofing = 
  if proofing>0: extra_endchar := "additions_to_proof;"; fi
enddef;

def additions_to_proof = 
  makelabel.lft("baseline", (-xoffset, 0));
  if h>math_axis: makelabel.lft("math axis", (-xoffset, math_axis)); fi
enddef;

% `iff' CONSTRUCTION

let semi_ = ;; let colon_ = :; let endchar_ = endchar;
def iff expr b = if b:let next_ = use_it else:let next_ = lose_it fi; next_ enddef;
def use_it = let : = restore_colon; enddef;
def restore_colon = let : = colon_; enddef;
def lose_it = let endchar = fi;
let ; = fix_ semi_ if false enddef;
def fix_ = let ; = semi_; let endchar = endchar_;
enddef;
def always_iff = let : = endgroup; killboolean enddef;
def killboolean text t = use_it enddef;

% Not the fastest solution
def beginchar(expr c, w_sharp, h_sharp, d_sharp) = 
    iff known c:
    begingroup
      charcode := byte c;
      charwd := w_sharp;
      charht := h_sharp;
      chardp := d_sharp;
      w := hround(charwd*hppp);
      h := vround(charht*hppp);
      d := vround(chardp*hppp);
      charic := 0; clearxy; clearit;
      clearpen;
      scantokens extra_beginchar;
    enddef;

    endinput;
