path: root/fonts/mathabx/source/mathastr.mf

% mathematical symbols by Anthony Phan.
% file: mathastr.mf (mathematical astronomical symbols)
% last modification: May 16, 2005.
% Only known charcodes will be generated.

% stem_corr had been added (darkness).
% also vair_corr and slab.

%astro := 1;

% from cmbase.mf

% super_arc.r(suffix $, $$) and super_arc.l(suffix $, $$)
% have the same effect as a right_to_down

vardef pulled_super_arc.r(suffix $, $$)(expr superpull) = 
  pair center, corner;
  if y$ = y$r: center = (x$$r, y$r); corner = (x$r, y$$r);
  else: center = (x$r, y$$r); corner = (x$$r, y$r); fi
  z$r{corner-z$r}...superness[center, corner]{z$$r-z$r}
  ...{z$$r-corner}z$$r
enddef;

vardef pulled_super_arc.l(suffix $, $$)(expr superpull) = 
  pair center, corner, outer_point;
  if y$ = y$r: center = (x$$l, y$l); corner = (x$l, y$$l);
    outer_point = superness[(x$$r, y$r), (x$r, y$$r)];
  else: center = (x$l, y$$l); corner = (x$$l, y$l);
    outer_point = superness[(x$r, y$$r), (x$$r, y$r)]; fi
  z$l{corner-z$l}
  ...superpull[superness[center, corner], outer_point]{z$$l-z$l}
  ...{z$$l-corner}z$$l
enddef;

vardef pulled_arc@#(suffix $, $$) = 
  pulled_super_arc@#($, $$)(superpull)
enddef;

% let's go

use_rule4;

boolean serifs;
if astro > 0.75: serifs := true; else: serifs := false; fi

astro.hair := hround astro[rth, hair];
astro.vair := vround astro[rth, vair];
astro.stem := hround astro[rth, stem];
astro.light_stem := astro[rth, 0.9[vair, 0.85stem]];
astro.curve := hround astro[rth, curve];
astro.vair' := vround astro[rth, vair'];
astro.cap_hair := vround astro[rth, cap_hair];
astro.cap_stem := hround astro[rth, cap_stem];
astro.cap_curve := hround astro[rth, cap_curve];
astro.rth := astro[rth, rth];
astro.beak := astro[0, 0.38cap_height-astro.cap_hair];
astro.slab := vround astro[rth, slab];

superpull   := astro*1/6;
arrow_breadth := astro[0, vair];
arrow_stress  := astro[1, 0.7];
arrow_tense1  := astro[1, 0.75];
arrow_tense2  := astro[1, 0.875];

% absolutely okay
beginchar(astro_sun, 13u#+2appr#, cap_height#, 0);
  "Sun";
  italcorr 0; % italcorr 0.6cap_height#*slant-.5u#;
  autorounded;
  pickup null.nib;
% circle
  penpos1(astro.vair', 90);
  penpos2(hround astro[rth, cap_curve-stem_corr], 180);
  penpos3(vround astro[rth, vair+1.5vair_corr], -90);
  penpos4(hround astro[rth, cap_curve-stem_corr], 0);
  y1r = h+o; y3r = -o; y2 = y4 = 0.5h;
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52h];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
% dot
  adjust_dot5((x1, y2), astro[2.7rth, 1.3dtsz], true, true);
  dot(5, 5');
  penlabels(1, 2, 3, 4);
endchar;

% okay
beginchar(astro_left_moon, 10u#+2appr#, cap_height#, 0);
  "Left moon (Moon)";
  italcorr 0; % italcorr cap_height#*slant-.5u#;
  save tmp_path, a, t; path tmp_path[];
%
% Two solutions may be considered for
% this construction. The first (and the
% one which is done here) is to put the
% two centers of circles at a predeterminated
% distance $a$ from each others (namely $a = 4u$)
% and do the construction hoping that edges
% will fit the right bound.
% The second one consists in calculating that
% distance $a$ to make sure that edges will lie
% on the right bound (the calculations are shown
% commentated). The problem with this method
% is that there is no control of the clear part's
% width of the drawing. Moreover, when the inner
% radius become too small there is no more solution
% to that problem (see below). 
%
%% The actual width of the drawing must be 10u.
%% The problem is to calculate the distance
%% between the two centers to make it work.
%% Alas when the two radius are too far from
%% each over, this problem has no solution.
%%
%% 6.5u = radius of great circle.
%% 3.5u = 10u-6.5u = (inner width)-radius.
%% 6.5u-rth = radius of small circle.
%%
% b = (3.5u)**2+(rth**2)-2*6.5u*rth;
% if b> = 0: a = hround(3.5u+sqrt b);
% else: a = hround(3.5u); fi
  a = hround(4u-rth+astro.rth);
  penpos2(vround astro.rth, 90);
  penpos3(hround astro.rth, 180);
  penpos4(vround astro.rth, -90);
  penpos1(hround astro.rth, 0);
  x3r = appr; x1r-x3r = 13u; y2r = h+o; y4r = -o;
  y1 = y3 = 0.5[y2, y4]; x2 = x4 = 0.5[x1, x3];
  tmp_path1 = z1r up_to_left z2r left_to_down z3r
  down_to_right z4r right_to_up z1r..cycle;
  tmp_path2 = z1l up_to_left z2l left_to_down z3l
  down_to_right z4l right_to_up z1l..cycle;
  tmp_path3 = tmp_path1 shifted (a, 0);
  tmp_path4 = tmp_path2 shifted (a, 0);
%
% The presence of epsilons makes almost certain
% that paths won't have double points causing
% trouble with filling commands.
%
  (t1-eps, t4-eps) = (subpath (0, 4) of tmp_path1)
  intersectiontimes (subpath (0, 4) of tmp_path4);
  (t2-4+eps, t3-4+eps) = (subpath (4, 8) of tmp_path1)
  intersectiontimes (subpath (4, 8) of tmp_path4);
  (t5-eps, t8-eps) = (subpath (0, 4) of tmp_path2)
  intersectiontimes (subpath (0, 4) of tmp_path3);
  (t6-4+eps, t7-4+eps) = (subpath (4, 8) of tmp_path2)
  intersectiontimes (subpath (4, 8) of tmp_path3);
  fill subpath (t1, t2) of tmp_path1
  ..reverse subpath(t4, t3) of tmp_path4..cycle;
  unfill subpath (t5, t6) of tmp_path2
  ..reverse subpath(t8, t7) of tmp_path3..cycle;
  penlabels(1, 2, 3, 4);
endchar;

beginchar(astro_right_moon, 10u#+2appr#, cap_height#, 0);
  "Right moon";
  italcorr 0; % italcorr cap_height#*slant-.5u#;
  save tmp_path, a, t; path tmp_path[];
  a = -hround(4u-rth+astro.rth);
  penpos2(vround astro.rth, 90);
  penpos3(hround astro.rth, 0);
  penpos4(vround astro.rth, -90);
  penpos1(hround astro.rth, 180);
  x3 = w-appr-0.5rth; x1r-x3r = -13u; y2r = h+o; y4r = -o;
  y1 = y3 = 0.5[y2, y4]; x2 = x4 = 0.5[x1, x3];
  tmp_path1 = z1r up_to_left z2r left_to_down z3r
  down_to_right z4r right_to_up z1r..cycle;
  tmp_path2 = z1l up_to_left z2l left_to_down z3l
  down_to_right z4l right_to_up z1l..cycle;
  tmp_path3 = tmp_path1 shifted (a, 0);
  tmp_path4 = tmp_path2 shifted (a, 0);
  (t1-eps, t4-eps) = (subpath (0, 4) of tmp_path1)
  intersectiontimes (subpath (0, 4) of tmp_path4);
  (t2-4+eps, t3-4+eps) = (subpath (4, 8) of tmp_path1)
  intersectiontimes (subpath (4, 8) of tmp_path4);
  (t5-eps, t8-eps) = (subpath (0, 4) of tmp_path2)
  intersectiontimes (subpath (0, 4) of tmp_path3);
  (t6-4+eps, t7-4+eps) = (subpath (4, 8) of tmp_path2)
  intersectiontimes (subpath (4, 8) of tmp_path3);
  fill subpath (t1, t2) of tmp_path1
  ..reverse subpath(t4, t3) of tmp_path4..cycle;
  unfill subpath (t5, t6) of tmp_path2
  ..reverse subpath(t8, t7) of tmp_path3..cycle;
  penlabels(1, 2, 3, 4);
endchar;

beginchar(astro_full_moon, 13u#+2appr#, cap_height#, 0);
  "Full moon";
  italcorr 0; % italcorr 0.6cap_height#*slant-.5u#;
  autorounded;
% circle
  penpos1(vround astro.rth, 90);
  penpos2(hround astro.rth, 180);
  penpos3(vround astro.rth, -90);
  penpos4(hround astro.rth, 0);
  y1r = h+o; y3r = -o; y2 = y4 = 0.5h;
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, y2];
  penstroke z1e left_to_down z2e down_to_right
  z3e right_to_up z4e up_to_left z1e;
  penlabels(1, 2, 3, 4);
endchar;

beginchar(astro_new_moon, 13u#+2appr#, cap_height#, 0);
  "New moon";
  italcorr 0; % italcorr cap_height#*slant-.5u#;
  autorounded;
  x4 = w-appr; x2 = appr; y1 = h+o; y3 = -o;
  y2 = y4 = 0.5h; x1 = x3 = 0.5[x2, x4];
  fill z1 left_to_down z2 down_to_right z3
  right_to_up z4 up_to_left z1..cycle;
  labels(1, 2, 3, 4);
endchar;

% okay
beginchar(astro_mercury, 9u#+2appr#, cap_height#, 0);
  "Mercury";
  italcorr 0; % italcorr cap_height#*slant-.5u#;
  save a; a = astro.light_stem;
  ensure_centering_of(a);
% circle
  penpos1(astro.vair, 90);
  penpos2(astro.curve, 180);
  penpos3(astro.vair, -90);
  penpos4(astro.curve, 0);
  y1r = cap_height+oo;
  y3r = vround astro[0.30cap_height, cap_height-x_height]-oo;
  y2 = y4 = 0.5[y1, y3];
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52[y3, y1]];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
% queue
  tmp_path := pulled_arc.r(1, 2) & pulled_arc.r(2, 3)
  & pulled_arc.r(3, 4) & pulled_arc.r(4, 1) & cycle;
  pickup crisp.nib;
  bot y5 = -o; bot y6l = bot y7l = vround(0.5[-d, y3r]-0.5a);% a little higher
  pos5(hround a, 0); pos6(vround a, 90); pos7(vround a, 90);
  x5 = x3; x5l-x6 = x7-x5r = hround 0.5(x1-x2l);
  save t;
  forsuffixes $ = , r, l:
    t$ = xpart(tmp_path intersectiontimes (z5$..(x5$, y2)));
  endfor
  filldraw subpath (t.r, t.l) of tmp_path--z5l--z5r--cycle;
  filldraw stroke z6e..z7e;
% horns
  tmp_path := reverse tmp_path;
  save p; path p.r, p.l;
  a := astro[rth, stem];
  pos8(a, 90); pos9(hround 0.5[a, astro.vair], 180);
  pos10(astro.vair, -90); pos11(hround 0.5[a, astro.vair], 0);
  lft x9r = appr; x8 = x10 = x1; rt x11r = w-appr;
  y9 = y11 = 0.5[y8, y10] = y1;
  top y8 = vround max(1.22cap_height, y1r+a);
  p.r = z8r left_to_down z9r down_to_right
  z10r right_to_up z11r up_to_left z8r;
  p.l = z8l right_to_down z11l down_to_left
  z10l left_to_up z9l up_to_right z8l;
  t1 = xpart(p.r intersectiontimes (z8..(x9r, y8)));
  (t2, t3-4) = p.r intersectiontimes subpath (4, 8) of tmp_path;
  (t5, t4-4) = p.l intersectiontimes subpath (4, 8) of tmp_path;
  t6-6 = xpart(subpath (6, 8) of p.l intersectiontimes
    ((point t1 of p.r)..(x1, y2)));
  t7 = xpart(p.r intersectiontimes (z8..(x11r, y8)));
  (t8, t9) = p.r intersectiontimes subpath (0, 4) of tmp_path;
  (t11, t10) = p.l intersectiontimes subpath (0, 4) of tmp_path;
  t12 = xpart(subpath (0, 2) of p.l intersectiontimes
    ((point t7 of p.r)..(x1, y2)));
  interim turningcheck := 0;% I hate turning numbers
  filldraw subpath (t1, t2) of p.r
  --subpath (t3, t4) of tmp_path
  --subpath (t5, t6) of p.l -- cycle;
  filldraw subpath (t12, t11) of p.l
  --subpath (t10, t9) of tmp_path
  --subpath (t8, t7) of p.r -- cycle;
  penlabels(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11);
endchar;

% okay
beginchar(astro_venus, 9u#+2appr#, cap_height#, 0);
  "Venus";
  italcorr 0; % italcorr cap_height#*slant-.5u#;
  save a, t; a = astro.light_stem;
  ensure_centering_of(a);
% circle
  penpos1(astro.vair, 90);
  penpos2(astro.curve, 180);
  penpos3(astro.vair', -90);
  penpos4(astro.curve, 0);
  y1r = cap_height+oo;
  y3r = vround astro[0.30cap_height, cap_height-x_height]-oo;
  y2 = y4 = 0.5[y1, y3];
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52[y3, y1]];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1)& cycle;
% queue
  tmp_path := pulled_arc.r(1, 2) & pulled_arc.r(2, 3)
  & pulled_arc.r(3, 4) & pulled_arc.r(4, 1) & cycle;
  pickup crisp.nib;
  bot y5 = -o; bot y6l = bot y7l = vround(0.5[-d, y3r]-0.5a);% a little higher
  pos5(hround a, 0); pos6(vround a, 90); pos7(vround a, 90);
  x5 = x3; x5l-x6 = x7-x5r = hround 0.5(x1-x2l);
  forsuffixes $ = , r, l:
    t$ = xpart(tmp_path intersectiontimes (z5$..(x5$, y2)));
  endfor
  filldraw subpath (t.r, t.l) of tmp_path--z5l--z5r--cycle;
  filldraw stroke z6e..z7e;
  penlabels(1, 2, 3, 4, 5, 6, 7);
endchar;

% absolutely okay
beginchar(astro_earth, 13u#+2appr#, cap_height#, 0);
  "Earth";
  italcorr 0; % italcorr 0.6cap_height#*slant-.5u#;
  save a; a = astro.light_stem;
  ensure_centering_of(a);
  pickup null.nib;
  autorounded;
% circle
  penpos1(astro.vair', 90);
  penpos2(hround astro[rth, cap_curve-2stem_corr], 180);
  penpos3(vround astro[rth, vair+1.5vair_corr], -90);
  penpos4(hround astro[rth, cap_curve-2stem_corr], 0);
  y1r = h+o; y3r = -o; y2 = y4 = 0.5h;
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52h];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
% cross
  tmp_path := z1 left_to_down z2 down_to_right
  z3 right_to_up z4 up_to_right z1;
  penpos5(hround a, 0); penpos6(vround a, 90);
  x5 = x6 = 0.5w;
  y5 = y6 = vround(y2-0.5vround a)+0.5vround a;
  forsuffixes $ = , r, l:
    z7$ = tmp_path intersectionpoint (z5$..(x5$, y1r));
    z8$ = tmp_path intersectionpoint (z5$..(x5$, y3r));
    z9$ = tmp_path intersectionpoint (z6$..(x2r, y6$));
    z10$ = tmp_path intersectionpoint (z6$..(x4r, y6$));
  endfor
  fill z7r..z7..z7l--z8l..z8..z8r--cycle;
  fill z9r..z9..z9l--z10l..z10..z10r--cycle;
  penlabels(1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
endchar;

% almost okay (see arrows dimensions)
beginchar(astro_mars, 9u#+2appr#, body_height#, 0);
  "Mars";
  italcorr 0; % italcorr body_height#*slant-.5u#;
  save a; a = astro.light_stem;
  % ensure_centering_of(a);% just for homogeneity
  % circle
  penpos1(astro.vair, 90);
  penpos2(astro.curve, 180);
  penpos3(astro.vair', -90);
  penpos4(astro.curve, 0);
  y1r = vround astro[0.70cap_height, x_height]+oo;
  y3r = -oo;
  y2 = y4 = 0.5[y1, y3];
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52[y3, y1]];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
  % arrow
  tmp_path := pulled_arc.r(1, 2) & pulled_arc.r(2, 3)
  & pulled_arc.r(3, 4) & pulled_arc.r(4, 1) & cycle;
  z6 = (x1, y2); top y7 = body_height+o; rt x7 = w-appr;
  arrow_height := vround astro[0.2cap_height, 0.3cap_height];
  arrow_width := max(4.9rth, rth+3u);
  save rth; rth = a;
  arrow_head5(z6..z7, both);
  z6r-z6 = z5r-z5; z6-z6l = z5-z5l;
  save t;
  forsuffixes $ = r, l:
    t$ = xpart(tmp_path intersectiontimes (z6$..z5$));
  endfor
  filldraw if t.l>t.r: subpath (t.r, t.l) of tmp_path
  else: subpath (t.r, 8) of tmp_path & subpath (0, t.l) of tmp_path fi
  --z5l--z5r--cycle;
  penlabels(1, 2, 3, 4, 6, 7);
endchar;

% humm
beginchar(astro_jupiter, 10u#+2appr#, asc_height#, desc_depth#);
  "Jupiter";
  italcorr 0; % italcorr body_height#*slant-.5u#;
  pickup crisp.nib;
  %
  top y1r = h; bot y2l = -d;
  rt x1r = w-appr-.5u;
  lft x2l = appr+3u;
  adjust_slanted_bar(1r, 2l, 1l, 2r)(astro[rth, cap_stem]-crisp, -1);
  z1r-z1 = z1-z1l; z2r-z2 = z2-z2l;
  filldraw stroke z1e..z2e;
  %
  top y3r-bot y3l = top y4r-bot y4l = astro.cap_hair;
  z3r-z3l = whatever*(z1-z2);
  bot y3l = bot y4l = bot y5l = vround 0.0h;
  lft x5l = appr-0.5u;
  adjust_slanted_bar(1l, 5l, 0, 5)(0.5(astro.cap_hair-crisp), -1);
  z5r-z5 = z5-z5l;
  top y8 = h-0.5rth; lft x8 = appr;
  z0' = 0.72[z5, z1l]; z6 = 0.25[z5, z1l];
  pos6(astro.cap_hair, angle(z1l-z5)-90);
  pos8(astro.cap_curve, angle(z8-z0')-90);
  x4l = x5; z4r-z4l = whatever*(z6-z5); z3 = 0.5[z3l, z3r];
  filldraw stroke z5e---z6e{z0'-z6}...{z8-z0'}z8e;
  %
  if serifs:
    save beak_jut, bracket, cap_jut;
    cap_jut = hround astro[0, 1.8u];
    bracket = 0.5cap_jut;
    serif(1, 2, bracket, cap_jut, astro.slab, true, dish,
      cap_jut, astro.slab, true, dish);
    serif(2, 1, bracket, cap_jut, astro.slab, true, dish,
      cap_jut, astro.slab, true, dish);
    z3l = whatever[z1r, z2r];
    beak_jut = (astro.beak+astro.slab)*(x1-x2)/(y1-y2);
    arm3(astro.beak, beak_jut, astro.slab, beak_darkness, up, w-appr+0.75u);
  else: x3l = 0.8[x2, x1];
  fi
  filldraw stroke z3e..z4e;
  labels(0, 0'); penlabels(1, 2, 3, 4, 5, 6, 7, 8);
endchar;

% humm
beginchar(astro_saturn, 9.5u#+2appr#, body_height#, 0);
  "Saturn";
  italcorr 0; % italcorr body_height#*slant-.5u#;
 % curve
  pickup crisp.nib;
  pos1(astro.cap_hair, 180); pos2(astro.cap_hair, 90);
  pos3(hround 0.43[astro.cap_hair, astro.cap_stem], 0);
  pos5(hround 0.44[astro.cap_hair, astro.cap_stem], 0);
  pos6(astro.cap_hair, 90);
  pos7(hround 0.44[astro.cap_hair, astro.cap_stem], 180);
  pos10(astro.cap_stem, 0);
  lft x10l = appr+hround 1.5u;
  x10r = x1l;
  rt x3r = rt x7l = w-appr;
  x2 = (astro[0.5,0.57])[x1l, x3l];
  rt x5r+eps = hround astro[x2, x10r+0.5[astro.cap_hair, astro.cap_stem]];
  x6 = 0.5[x5, x7];
 %
 % Construction with tangent circles
 %
  save d, k, R; k = (x7-x5)/(x3-x1);
  k' = (1+k-2sqrt k)/((1-k)**2);
  bot y6l = -o;
  top y2r = vround 0.8h+o;
  R = k'*(y2-y6);
  y3 = y2-R; bot y1 = bot y10 = vround y3;
  y5 = y7 = y6+k*R;
  z4 = (1/(1+k))[(x2, y1), (x6, y5)]; d = R/(x2-x1);
  pos4(astro.cap_stem, angle((y1-y5)/d, (x6-x2)*d)-90);
 % stem
  save rth; rth = astro.cap_stem;
  arrow_height := vround astro[h-cap_height, 0.2cap_height]+o;
  arrow_width := rth+hround 2(2.25u)+0.5;
  arrow_head9(z10..(x10, h+o-pen_top), left);
  filldraw stroke z9e..z10e;
 %
  x7 := x7r+1;
  tmp_path := z6l right_to_up z7l;
  t := xpart(tmp_path intersectiontimes (z7..(x7, y6l)));
  autorounded;
  filldraw subpath (0, t) of tmp_path
  --z7--z7r down_to_left z6r--cycle;
  filldraw stroke z1e up_to_right z2e right_to_down
  z3e...z4e{((y5-y1)/d, (x2-x6)*d)}
  ...z5e down_to_right z6e;
  penlabels(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
endchar;

% almost okay (see arrows dimensions)
beginchar(astro_uranus, 9u#+2appr#, body_height#, 0);
  "Uranus";
  italcorr 0; % italcorr body_height#*slant-.5u#;
  save a;
  a = astro.light_stem;
  ensure_centering_of(a);% just for homogeneity
% circle
  penpos1(astro.vair, 90);
  penpos2(hround astro[rth, curve-stem_corr], 180);
  penpos3(astro.vair', -90);
  penpos4(hround astro[rth, curve-stem_corr], 0);
  y1r = vround astro[0.70cap_height, x_height]+oo;
  y3r = -oo;
  y2 = y4 = 0.5[y1, y3];
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52[y3, y1]];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
% dot
  adjust_dot5((x1, y2), astro[1.6rth, dtsz], true, true);
  dot(5, 5');
% arrow
  tmp_path := pulled_arc.r(1, 2) & pulled_arc.r(2, 3)
  & pulled_arc.r(3, 4) & pulled_arc.r(4, 1) & cycle;
  arrow_height := vround astro[0.2cap_height, 0.3cap_height]+eps;
  arrow_width := max(4.9rth, rth+3u);
  save rth; rth = hround a;
  arrow_head6(z1..(x1, body_height+o-pen_top), both);
  save t;
  forsuffixes $ = , r, l:
    t$ = xpart(tmp_path intersectiontimes (z6$..(x6$, y2)));
  endfor
  pickup crisp.nib;
  filldraw subpath (t.r, 8) of tmp_path
  & subpath (0, t.l) of tmp_path --z6l--z6r--cycle;
  penlabels(1, 2, 3, 4, 6, 7);
endchar;

% almost okay (see arrows dimensions)
beginchar(astro_neptune, 10.5u#+2Appr#, cap_height#, 0);
  "Neptune";
  italcorr 0; % italcorr cap_height#*slant-.5u#;
  save a;
  a = hround astro[rth, cap_stem-2stem_corr];
  ensure_centering_of(a);
% stems
  x1-0.5a = hround astro[Appr, appr];
  x3 = x7 = 0.5w;
  x1 = x2; x4-x3 = x3-x1;
  pickup crisp.nib;
% arrows
  save rth; rth = a;
  arrow_height := vround astro[0.125cap_height, 0.25cap_height]+eps;
  arrow_width := min(3a, x3-x1-0.5u, 2.5u+a);
  arrow_head0((x1, 0)..(x1, h+o-pen_top), both);
  arrow_head5((x4, 0)..(x4, h+o-pen_top), both);
  arrow_head6((x3, 0)..(x3, h+o-pen_top), both);
% cup and queue
  pos1(a, 180); pos2(a, 180); pos3(astro.vair, -90); pos4(a, 0); pos7(a, 0);
  pos8(vround astro.light_stem, 90); pos9(vround astro.light_stem, 90);
  bot y3r = vround 0.2cap_height;
  y1 = y0; y2 = y4 = 0.5[y1, y3]; bot y7 = -o;
  top y8r = top y9r = vround 0.2cap_height-1;
  x7l-x8 = x9-x7r = hround 0.5(x3-x1-a);
  filldraw stroke z1e..z2e down_to_right z3e right_to_up z4e..z5e;
  filldraw stroke z6e..z7e; filldraw stroke z8e..z9e;
  penlabels(1, 2, 3, 4, 7, 8, 9);
endchar;

% The serifs are not cm compatible
beginchar(astro_pluto, 7.75u#+Appr#+appr#, cap_height#, 0);
  "Pluto";
  italcorr 0; % italcorr 0.75cap_height#*slant-.5u#;
  pickup crisp.nib;
  %
  % stem
  %
  pos1(astro.cap_stem, 0);
  pos2(astro.cap_stem, 0);
  top y1 = h; bot y2 = 0; lft x1l = lft x2l = Appr;
  filldraw stroke z1e..z2e;
  %
  % curve
  %
  penpos3(astro.cap_hair, 90);
  penpos4(astro.cap_hair, 90);
  penpos5(astro.cap_curve, 0);
  penpos6(astro.vair, -90);
  penpos7(astro.vair, -90);
  y3r = y4r = h; y5 = 0.5[y4, y6];
  y6r = y7r = vround astro[0.275h, 0.5h-astro.vair];
  x3 = x7 = x1; x5r = w-appr; x4 = x6 = 0.4[x3, x5];
  penstroke z3e..pulled_arc.e(4, 5) & pulled_arc.e(5, 6)..z7e;
  %
  % arm or beak, and serifs
  %
  pos9(astro.slab, 90); pos10(astro.slab, 90); y9l = y10l = y2; x9 = x2r;
  if serifs: x10 = 0.5w;
    save beak_jut, bracket, cap_jut;
    beak_jut = hround astro[0, 0.75u];
    cap_jut = hround astro[0, 1.8u];
    bracket = 0.5cap_jut;
    arm10(astro.beak, beak_jut, astro.slab, beak_darkness, up, w-appr);
    serif(1, 2, bracket, cap_jut, astro.slab, true,
      0, 0.5cap_jut, astro.slab, true, 0);
    serif(2, 1, bracket, cap_jut, astro.slab, true,
      0, 0.5cap_jut, astro.slab, true, 0);
  else: rt x10 = w-appr; fi
  filldraw stroke z9e..z10e;
  penlabels(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11);
endchar;

% okay
beginchar(astro_varearth, 9u#+2appr#, cap_height#, 0);
  "Variant Earth";
  italcorr 0; % italcorr x_height#*slant-.5u#;
  save a;
  a = astro.light_stem;
  ensure_centering_of(a);
  % circle
  penpos1(astro.vair, 90);
  penpos2(astro.curve, 180);
  penpos3(astro.vair', -90);
  penpos4(astro.curve, 0);
  y1r = vround astro[0.70cap_height, x_height]+oo;
  y3r = -oo;
  y2 = y4 = 0.5[y1, y3];
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52[y3, y1]];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
 % head
  tmp_path := pulled_arc.r(1, 2) & pulled_arc.r(2, 3)
  & pulled_arc.r(3, 4) & pulled_arc.r(4, 1) & cycle;
  pickup crisp.nib;
  top y5 = h+o; top y6r = top y7r = vround(0.5[h, y1r]+0.5o+0.5a);
  pos5(hround a, 0); pos6(vround a, 90); pos7(vround a, 90);
  x5 = x1; x5l-x6 = x7-x5r = hround 0.5(x1-x2l);
  save t;
  forsuffixes $ = , r, l:
    t$ = xpart(tmp_path intersectiontimes (z5$..(x5$, y2)));
  endfor
  filldraw subpath (t.r, 8) of tmp_path
  & subpath (0, t.l) of tmp_path --z5l--z5r--cycle;
  filldraw stroke z6e..z7e;
  penlabels(1, 2, 3, 4, 5, 6, 7);
endchar;

beginchar(astro_aries, 13u#+2appr#, cap_height#, 0);
  "Aries";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  save a, b;
  a = 10; b = hround astro[1.2rth,astro.cap_stem];
  ensure_centering_of(b);
  x1 = x2 = x3 = 0.5w; y3 = 0.5h;
  if serifs:
    save bracket, cap_jut;
    pickup crisp.nib;
    cap_jut = hround astro[0, 1.8u];
    bracket = 0.5cap_jut;
    bot y2=0;
    pos2(b, 0); pos3(b, 0);
    serif(2, 3, bracket, cap_jut, astro.slab, true, dish,
      cap_jut, astro.slab, true, dish);
    filldraw stroke z2e..z3e;
  else:
    pickup tiny.nib;
    bot y1 = -d-o; y2-y1 = o;
    pos1(max(0.75b, tiny+eps), 0);
    pos2(b, 0); pos3(b, 0);
    filldraw stroke z1e--z2e--z3e;
    penlabels(1);
  fi
  pickup tiny.nib;
  pos3a(astro.light_stem, 0); pos4a(vround astro.light_stem, 90);
  pos5a(astro.curve, 180); pos6a(astro.cap_hair, 270-a); 
  pos3b(astro.light_stem, 180); pos4b(vround astro.light_stem, 90);
  pos5b(astro.curve, 0); pos6b(astro.cap_hair, -90+a);
  y3 = y3a = y3b;
  top y4a.r = top y4b.r = h+o;
  y5a = y5b = 0.6[y6a, y4a];
  bot y6a.r = bot y6b.r = vround 0.5h;
  lft x3a.l = 0.5(w-b); rt x3b.l = 0.5(w+b);
  x4a = 0.6[x3a, x5a]; x4b = 0.6[x3b, x5b];
  lft x5a.r = appr; rt x5b.r = w-appr;
  x6a.r = good.x 0.5[x5a.r, x3a.l];
  x3a.l-x6a.r = x6b.r-x3b.l;
  filldraw stroke z3a.e up_to_left z4a.e
  & pulled_arc.e(4a, 5a)...z6a.e{dir -a};
  filldraw stroke z3b.e up_to_right z4b.e
  & pulled_arc.e(4b, 5b)...z6b.e{dir(180+a)};
  penlabels(1, 2, 3, 3a, 4a, 5a, 6a, 3b, 4b, 5b, 6b);
endchar;

% okay
beginchar(astro_taurus, 9u#+2appr#, cap_height#, 0);
  "Taurus";
  italcorr 0; % italcorr x_height#*slant-.5u#;
% circle
  penpos1(astro.vair, 90);
  penpos2(astro.curve, 180);
  penpos3(astro.vair', -90);
  penpos4(astro.curve, 0);
  y1r = vround astro[0.70cap_height, x_height]+oo;
  y3r = -oo;
  y2 = y4 = 0.5[y1, y3];
  x2r = appr; x4r = w-appr; x1 = x3 = 0.5[x2, x4];
  y2l := y4l := astro[y2, 0.52[y3, y1]];
  penstroke pulled_arc.e(1, 2) & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4) & pulled_arc.e(4, 1) & cycle;
% head
  pickup crisp.nib;
  pos5(astro.hair, 180);
  pos6(vround astro.light_stem, -90);
  pos7(astro.hair, 0);
  top y5 = top y7 = h+o; bot y6r = y1l;
  lft x5r = appr; rt x7r = w-appr; x6 = x1;
  filldraw stroke z5e down_to_right z6e right_to_up z7e;
  penlabels(1, 2, 3, 4, 5, 6, 7);
endchar;

beginchar(astro_gemini, 11u#+2appr#, cap_height#, 0);
  "Gemini";
  italcorr 0; % italcorr asc_height#*slant-.5u#;
  pickup crisp.nib;
  save c, bracket;
  bracket = 0.5hround astro[0, 1.8u];
  c = hround 0.25(w-2appr-2astro.stem);
  % stems
  pos1(astro.stem, 0); pos2(astro.stem, 0);
  pos3(astro.stem, 0); pos4(astro.stem, 0);
  top y1 = top y3 = h; bot y2 = bot y4 = 0;
  lft x1l = lft x2l = appr+c; rt x3r = rt x4r = w-appr-c;
  filldraw stroke z1e..z2e;
  filldraw stroke z3e..z4e;
  % serifs
  if serifs:
    serif(1, 2, bracket, c, astro.slab, true, dish, 0.0c, astro.slab, true, 0);
    serif(2, 1, bracket, c, astro.slab, true, dish, 0.0c, astro.slab, true, 0);
    serif(3, 4, bracket, 0.0c, astro.slab, true, 0, c, astro.slab, true, dish);
    serif(4, 3, bracket, 0.0c, astro.slab, true, 0, c, astro.slab, true, dish);
    filldraw z1e--z1f--z3c--z3d--cycle;
    filldraw z2e--z2f--z4c--z4d--cycle;
  else:
    pos5(astro.slab, 90); pos6(astro.slab, 90);
    pos7(astro.slab, 90); pos8(astro.slab, 90);
    lft x5r = lft x7l = appr; rt x6r = rt x8l = w-appr;
    y5r = y6r = y1; y7l = y8l = y2;
    filldraw stroke z5e..z6e;
    filldraw stroke z7e..z8e;
    penlabels(5, 6, 7, 8);
  fi
  penlabels(1, 2, 3, 4);
endchar;

beginchar(astro_cancer, 13u#+2appr#, cap_height#, 0);
  "Cancer";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  labels(1, 2, 3, 4);
endchar;

beginchar(astro_leo, 13u#+2appr#, cap_height#, 0);
  "Leo";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  pickup crisp.nib;
  pos1(astro.cap_hair,0);
  pos2(astro.vair,90);
  pos3(astro.cap_hair,180);
  pos4(astro.vair,-90);
  pos5(astro.cap_hair,180);
  pos6(astro.cap_curve,180);
  pos7(astro.vair,90);
  pos8(astro.cap_curve,0);
  pos9(astro.cap_hair,0);
  pos10(astro.vair,90);
  pos11(astro.cap_hair,180);
  bot y4r=bot y10.l=-o; top y7r=h+o;top y2r=vround 0.3h+o;
  y1=y3=y5=y9=0.5[y2, y4]; y6=y8=0.6[y1,y7]; y11=good.y y9;
  lft x3r=appr; rt x11l=w-appr;
  lft x6r=w-rt x8r=appr+hround(2.5u-0.5astro.cap_curve);
  rt x1r-lft x3r=rt x11l-lft x9l=hround 5u;
  x5=x1; x2=x4=0.5[x1,x3]; x10=0.5[x9,x11];
  x7=0.5[x6, x8];
  filldraw stroke z1e up_to_left z2e left_to_down z3e down_to_right z4e
  right_to_up z1e;
  filldraw stroke z5e{up}...pulled_arc.e(6,7)&pulled_arc.e(7,8)...z9e
  down_to_right z10e right_to_up z11e;
  penlabels(1,2,3,4,5,6,7,8,9,10,11);
endchar;

beginchar(astro_virgo, 13u#+2appr#, cap_height#, 0);
  "Virgo";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  labels(1, 2, 3, 4);
endchar;

beginchar(astro_libra, 13u#+2appr#, cap_height#, 0);
  "Libra";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  pickup crisp.nib;
  save a, b;
  % horizontal stems
  top y1r-bot y1l = astro.slab;
  y1=0.5[y1r, y1l]; x1 = x1l= x1r;
  forsuffixes $ = 2, 3, 4, 5, 6:
    y$r-y$l = y1r-y1l; y$ = 0.5[y$r, y$l]; x$ = x$l = x$r;
  endfor
  bot y1l = 0; y1 = y2;
  y3-y1= vround astro[0.375x_height, 0.2x_height]; y3 = y4 = y5 = y6;
  rt x4= hround(0.5w-astro[1.5u, 1u]); x5 = w-x4; lft x1= appr; rt x2=w-appr;
  % ellipses $(x-x_0)^2/a^2+(y-y_0)^2/b^2=1$
  pos8(astro.curve, 180); pos9(astro.vair, 90); pos10(astro.curve, 0);
  top y9r=h+o; lft x8r=w-rt x10r=appr+hround(2u-0.5astro.curve);
  x0 = x9 = 0.5w; y7l = y7r = y11l = y11r = y4r; x7l = x4r; x11l = x5r;
  % inner ellipse
  a = x10l-x0;
  b*(1+-+((x11l-x0)/a)) = (-b+y9l-y7l);
  y0 = y8 = y10 = y9l-b;
  z7'l=unitvector((y7l-y0)/b/b, -(x7l-x0)/a/a);
  z11'l=unitvector((y11l-y0)/b/b, -(x11l-x0)/a/a);
  % outer ellipse
  a := x10r-x0;
  b := y9r-y0;
  x0-x7r = x11r-x0 = a*(1+-+((y11r-y0)/b));
  z7'r=unitvector((y7r-y0)/b/b, -(x7r-x0)/a/a);
  z11'r=unitvector((y11r-y0)/b/b, -(x11r-x0)/a/a);  
  % draw things
  if serifs: x3=x7r; x6=x11r;
    arm3(astro.beak, -astro[0, 0.75u], -astro.slab,
      beak_darkness, up, appr-0.75u);
    arm6(astro.beak, astro[0, 0.75u], astro.slab,
      beak_darkness, up, w-appr+0.75u);
  else: x3=x1; x6=x2;
  fi
  filldraw stroke z1e..z2e;
  filldraw stroke z3e..z4e;
  filldraw stroke z5e..z6e;
  filldraw stroke z7e{z7'e}...pulled_arc.e(8, 9)
  & pulled_arc.e(9, 10)...z11e{z11'e};
  penlabels(0, 1, 2, 3, 4,5,6,7,8,9,10,11);
endchar;

%iff false:
beginchar(astro_scorpio,15u#+2appr#,cap_height#,0.5desc_depth#);
  "Scorpio";
% italcorr .5[bar_height#,x_height#]*slant-serif_fit#+.5stem#-2u#;
% adjust_fit(serif_fit#+stem_shift#,serif_fit#-stem_shift#);
% numeric shaved_stem; shaved_stem=hround(mfudged.stem-2stem_corr);
  pickup crisp.nib;
  pos1(astro.cap_stem,0); pos2(astro.cap_stem,0);
  pos3(astro.cap_stem,0); pos4(astro.cap_stem,0);
  pos5(astro.cap_stem,0); pos6(astro.cap_stem,0);
  pos6'(astro.cap_stem,180); pos7(astro.vair,-90);
  lft x1l=appr+hround(1.5u-.5astro.cap_stem);
  x5-x3=x3-x1=hround 5u; x1=x2; x3=x4; x5=x6;
  bot y2=0; y2=y4; y6=0.25x_height; y1=y3=y5=0.7h;
  for $ = 3, 5:
    pos[$]a(astro.cap_hair, 180); top y[$]b.r-bot y[$]b.l=astro.vair;
    rt x[$]a.l=x[$-2]r; y[$]a=astro[0.7h,0.55h]; top y[$]b.r=h+o;
    x[$]b.r=astro[0.5[x[$]a, x[$]], 0.5[rt x[$]a.l, rt x[$]r]];
    z[$]b.l= whatever[z[$]a.l, z[$]b.r];
    x[$]b = x[$]b.r; y[$]b=0.5[y[$]b.l, y[$]b.r];
    filldraw stroke z[$]a.e{up}...z[$]b.e{right}
    & pulled_arc.e([$]b, [$])..z[$+1]e;
  endfor
  lft x1a=appr-hround u; top y1a.r=h+o; pos1a(astro.vair,90);
  filldraw stroke pulled_arc.e(1a, 1)..z2e;
  z6=z6'; bot y7r=-d; x7=0.5[x6,w];
  save rth; rth = astro.hair;
  arrow_height := vround astro[0.125cap_height, 0.25cap_height]+eps;
  arrow_width := 3.5u;
  arrow_head8(z7{right}...(w,0.25x_height){up}, both);
  filldraw stroke pulled_arc.e(6',7)...{z8a-z8}z8e;
  if serifs:
    save beak_jut, bracket, cap_jut;
    cap_jut = hround astro[0, 1.8u];
    bracket = 0.5cap_jut;
    serif(2, 1, bracket, cap_jut, astro.slab, true, dish,
      cap_jut-0.5u, astro.slab, true, dish);
    serif(4, 3, bracket, cap_jut-0.5u, astro.slab, true, dish,
      cap_jut-0.5u, astro.slab, true, dish);
  fi
  penlabels(1,1a,2,3,3a,3b,4,5,5a,5b,6,7); 
endchar;

beginchar(astro_sagittarius, 13u#+2appr#, cap_height#, 0);
  "Sagittarius";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  save a, rth; a= angle(w-2appr,h+2o); rth=astro.light_stem;
  pickup crisp.nib; lft x1l=appr; bot y1r=-o;
  pos1(astro.light_stem, a-90);
  arrow_height := vround astro[0.2cap_height, 0.3cap_height]+eps;
  arrow_width := max(4.9rth, rth+3u);
  arrow_head2((appr,-o)..(w-appr, h+o), both);
  pos3(astro.light_stem,a); pos4(astro.light_stem,a);
  z3-z2c.l=whatever*(z2-z1); z0=1/3[z1,z2]; z3-z0=whatever*dir(a+90);
  z3-z0=z0-z4;
%  autorounded;
  filldraw stroke z1e..z2e;
  filldraw stroke z3e..z4e;
  penlabels(1, 2, 3, 4);
endchar;

beginchar(astro_capricorn, 13u#+2appr#, cap_height#, 0);
  "Capricorn";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  labels(1, 2, 3, 4);
endchar;

beginchar(astro_aquarius, 13u#+2appr#, cap_height#, 0);
  "Aquarius";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  labels(1, 2, 3, 4);
endchar;

beginchar(astro_pisces, 13u#+2appr#, cap_height#, 0);
  "Pisces";
  italcorr 0; % italcorr 0.7x_height#*slant-.5u#;
  pickup crisp.nib;
  pos1(astro.vair, 90); pos2(astro.curve,0); pos3(astro.vair, -90);
  pos4(astro.vair, 90); pos5(astro.curve,180); pos6(astro.vair, -90);
  pos7(vround astro.light_stem,90); pos8(vround astro.light_stem,90);
  top y1r=top y4r=h+o; bot y3r=bot y6r=-o;
  top y7r=top y8r=vround(0.5h+0.5astro.light_stem); y2=y5=y7;
  lft x3=lft x1=appr; rt x4=rt x6=w-appr;
  lft x2l=w-rt x5l=appr+hround(4u-.5astro.curve);
  lft x7=w-rt x8=appr+hround u;
  filldraw stroke pulled_arc.e(1,2)&pulled_arc.e(2,3);
  filldraw stroke pulled_arc.e(4,5)&pulled_arc.e(5,6);
  filldraw stroke z7e..z8e;
  penlabels(1, 2, 3, 4,5,6,7,8);
endchar;

% The next symbol is intended to figure ``cemetery''
% in the theory of Markov processes.
% Usualy, this concept is represented by a partial derivative
% symbol or a Greek lowercase delta. It seems that
% no specific symbol has been designed before.

use_rule1;
beginchar(cemetery, 10u#+2appr#, cap_height#, 0);
  "Cemetery symbol";
  pickup rule.nib;
  ensure_centering_of(rth);
  x1 = x2 = 0.5w;
  lft x5 = appr; rt x8 = w-appr; bot y5 = bot y8 = 0;
  y1 = h; x3 = w-x4 = appr+hround 1.5u;
  y2 = good.y 0.2[y5, y1]; y3 = y4 = good.y 2/3[top y2, y1];
  z6 = 0.5[z5, z2]; z7 = 0.5[z8, z2];
  tmp_path := z5{right}...z6{0.5(x2-x6), y2-y6}...z2{right}
  ...z7{0.5(x7-x2), y7-y2}...z8{right};
  draw tmp_path;
  penpos1(rth, 0); penpos2(rth, 0);
  penpos3(rth, 90); penpos4(rth, 90);
  penstroke z1e..z2e; penstroke z3e..z4e;
  save a, b, c, number_of_slashes; a = max(h, w);
  pickup crisp.nib;
  x5' = good.x appr; x8' = good.x w-appr; y5 = y5'; y8 = y8';
  pos5(rth, 90); pos5'(rth, 90); pos8(rth, 90); pos8'(rth, 90);
  filldraw stroke z5e..z5'e; filldraw stroke z8e..z8'e;
  pickup fine.nib;
  number_of_slashes = 6; c = hround((x8-x5)/(number_of_slashes+1));
  number_of_slashes := round((x8-x5)/max(c, 1))-1;
  for i = 1 upto number_of_slashes:
    bot y[i+8]l = 0; x[i+8]l = x5+i*c;
    z[i+8]r = tmp_path intersectionpoint (z[i+8]l..z[i+8]l+(a, a));
    draw z[i+8]l..z[i+8]r; penlabels([i+8]);
  endfor;
  penlabels(1, 2, 3, 4, 5, 8, 5', 8'); labels(6, 7);
endchar;