% mathematical symbols by Anthony Phan.
% file: mathbase.mf (base file)
% last modification: April 29, 2002.

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);

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 autorounded= interim autorounding:=2 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 DEPENDANT 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 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;