% fgerm.mf : fge roman charcters
% J.J. Green 2005-2006

mode_setup;
font_setup;

proofing := 2;

% The Russell class -- the class of all classes which
% are not members of themselves.

cmchar "Overturned A";
beginchar("A", 13u#, x_height#, desc_depth#);
  adjust_fit(cap_serif_fit#, cap_serif_fit#);
  
  numeric left_stem, right_stem, outer_jut, alpha;  
  right_stem = cap_stem-stem_corr;
  left_stem  = min(cap_hair, right_stem);
  outer_jut  = 0.8cap_jut;
  
  w-x1l = x4r = l+letter_fit+outer_jut+0.5u;
  y1 = y4 = h;
  x2-x1 = x4-x3;
  x3r = x2r+apex_corr;
  y2 = y3 = -d-apex_o-apex_oo;

  alpha = diag_ratio(2, left_stem, y2-y1, x4r-x1l-apex_corr);
  penpos1(alpha*left_stem, 180);
  penpos2(alpha*left_stem, 180);
  penpos3(alpha*right_stem, 180);
  penpos4(alpha*right_stem, 180);

  z0=whatever[z1r, z2r]=whatever[z3l, z4l];

  fill z0--diag_end(0, 4l, 1, 1, 4r, 3r)--diag_end(4r, 3r, 1, 1, 2l, 1l)
    --diag_end(2l, 1l, 1, 1, 1r, 0)--cycle;
  
  penpos5(whatever, angle(z2-z1)); z5=whatever[z1, z2];
  penpos6(whatever, angle(z3-z4)); z6=whatever[z3, z4];
  y6 = y5;
  y5 = 5/12(h-y0);
  y5r-y5l = y6r-y6l = cap_band;
  
  penstroke z5e--z6e; % bar line

  numeric inner_jut;

  % for the reversed serifs it is easier to introduce
  % new control points which are "the right way around"
  % since prime_points_inside() and dish_serif()
  % have the left & right sides of the points hard-coded
  
  penpos11(alpha*left_stem, 0);
  penpos12(alpha*left_stem, 0);
  z11 = z1;
  z12 = z2;

  penpos13(alpha*right_stem, 0);
  penpos14(alpha*right_stem, 0);
  z13 = z3;
  z14 = z4;
    
  pickup tiny.nib;
  prime_points_inside(11, 12);
  prime_points_inside(14, 13);
  
  inner_jut = cap_jut;
  
  dish_serif(11', 12, a, 0.6, inner_jut, b, 1/2, outer_jut)(dark);
  dish_serif(14', 13, c, 1/3, outer_jut, d, 1/2, inner_jut);
  
  penlabels(0, 1, 2, 3, 4, 5, 6);
  
endchar;

% rotated eszett

beginchar(oct "031", 4.5u#+max(4.5u#, .5stem#+flare#+curve#), x_height#, desc_depth#);
  adjust_fit(0, serif_fit#);

  pickup tiny.nib;

  pos1(stem', 0);
  pos2(stem', 0);
  
  rt x1r = rt x2r = hround(w-2.5u+.5stem');
  top y1 = h;
  y2 = y4 = 0.5[0, y3];
  
  penpos3(vair-fine, 270);
  fine.bot y3r = -d-oo;
  
  filldraw stroke z1e--z2e;  % stem

  numeric stem_edge, curve';
  stem_edge = lft x1l;
  curve' = hround .5[stem', curve];
  pickup fine.nib;
  pos4(curve', 180);
  pos5(vair, 90);
  pos2'(stem', 0);
  z2' = z2;
  x3  = 0.5[x2, x4];
  lft x4r = hround(u);
  bot y5l = 0;
  rt x5 = hround(stem_edge-u);
  filldraw stroke pulled_super_arc.e(2', 3)(.5superpull)
  & pulled_super_arc.e(3, 4)(.5superpull)
  & pulled_super_arc.e(4, 5)(.5superpull);  % upper bowl

  pos5'(vair, 270);
  z5' = z5;
  pos6(curve', 180);
  pos7(vair, 90);
  lft x6r = hround(0.5u)+3eps;
  y6 = .6x_height;
  top y7r = x_height+oo;
  pos8(hair, 0);
  rt x8r = hround(stem_edge-.5u-1);
  x7 = 0.4[rt x8r, x6];
  filldraw stroke pulled_super_arc.e(5', 6)(.5superpull)
  & pulled_super_arc.e(6, 7)(.5superpull);  % lower bowl
  
  pos9(5/7[vair, flare], 0);
  y9-(x9-lft x9r) = vround 0.93x_height;

  bulb(7, 8, 9);  % bulb

  dish_serif(1, 2, b, 0, epsilon, c, 1/3, jut);  % serif
  
  penlabels(0, 1, 2, 3, 4, 5, 6, 7, 8);
  
endchar;

% rotated 2, 3, B, C, taken from romanu.mf
%
% here we use that
% u#          := 20/36pt#;
% cap_height# := 246/36pt#;
% fig_height# := 232/36pt#
% and so cap_height/u = 11.6, fig_height/u = 12.3
 
cmchar "downward 2";
beginchar("2", 14u#, x_height#, 0);
  adjust_fit(0, 0);

  numeric arm_thickness, hair_vair;

  hair_vair = 0.25[vair, hair];
  arm_thickness = Vround(if hefty:slab+2stem_corr else:.4[stem, cap_stem] fi);

  pickup crisp.nib;
  
  pos7(arm_thickness, 0);
  pos8(hair, 90);
  rt x7r  = hround(w-0.9u);
  bot y7  = 0;
  top y8r = h+o/2;
  x8 = good.x(x7l-beak/2) - eps;
  
  varm(7, 8, a, 0.3beak_darkness, beak_jut);  % arm and beak

  pickup fine.nib;

  pos2(slab, 180);
  pos3(.4[curve, cap_curve], 90);
  
  lft x2r = 0.9u;
  y2 = h/2;
  top y3r = h+o/2;
  x3 = x0;
  
  numeric bulb_diam;
  bulb_diam=hround(flare+2/3(cap_stem-stem));

  pos0(bulb_diam, -90);
  pos1(cap_hair, -90);

  bot y0r = -o/2;
  x1 + 0.5 bulb_diam = 1/3(w-1.8u) + 0.9u;
  %(x2l, y) = whatever[z1l, z2r];
  %y2l := y;
  dlbulb(2, 1, 0);  % bulb and arc
  
  pos4(0.25[hair_vair, cap_stem], 90);
  pos5(hair_vair, 90);
  pos6(hair_vair, 90);

  x5 + arm_thickness = w - 0.9u;
  x4 = 0.3[x5, x3];
  rt x6 = w - 0.9u - slab;  
  bot y6 = crisp.bot y7;

  z4l = whatever[z6l, (0.50w, y3l)];
  z5l = whatever[z6l, z4l];

  % erase excess at left
  erase fill z4l--z6l--bot z6l--(x4l, bot y6l)--cycle;  

  % stroke
  filldraw stroke z2e{up}..tension atleast .9 and atleast 1
  ..z3e{right}..{z5e-z4e}z4e--z5e--z6e;  

  penlabels(0, 1, 2, 3, 4, 5, 6, 7, 8);
endchar;

cmchar "upward 2";
beginchar("4", 14u#, x_height#, 0);
  adjust_fit(0, 0);

  numeric arm_thickness, hair_vair;

  hair_vair = 0.25[vair, hair];
  arm_thickness = Vround(if hefty:slab+2stem_corr else:.4[stem, cap_stem] fi);

  pickup crisp.nib;
  
  pos7(arm_thickness, 180);
  pos8(hair, -90);
  lft x7r = hround(0.9u);
  top y7  = h;
  bot y8r = -o/2;
  x8 = good.x(x7l+beak/2) + eps;
  
  varm(7, 8, a, .3beak_darkness, -beak_jut);  % arm and beak

  pickup fine.nib;

  pos2(slab, 0);
  pos3(.4[curve, cap_curve], -90);
  
  rt x2r = w-0.9u;
  y2 = h/2;
  bot y3r = -o/2;
  x3 = x0;
  
  numeric bulb_diam;
  bulb_diam=hround(flare+2/3(cap_stem-stem));

  pos0(bulb_diam, 90);
  pos1(cap_hair, 90);

  top y0r = h+o/2;
  x1 - 0.5 bulb_diam = 2/3(w-1.8u) + 0.9u;
  %(x2l, y) = whatever[z1l, z2r];
  %y2l := y;
  dlbulb(2, 1, 0);  % bulb and arc
  
  pos4(0.25[hair_vair, cap_stem], -90);
  pos5(hair_vair, -90);
  pos6(hair_vair, -90);

  x5 = arm_thickness + 0.9u;
  x4 = 0.3[x5, x3];
  lft x6 = 0.9u + slab;  
  top y6 = crisp.top y7;

  z4l = whatever[z6l, (0.50w, y3l)];
  z5l = whatever[z6l, z4l];

  erase fill z4l--z6l--top z6l--(x4l, top y6l)--cycle;  

  % stroke
  filldraw stroke z2e{down}..tension atleast .9 and atleast 1
  ..z3e{left}..{z5e-z4e}z4e--z5e--z6e;  

  penlabels(0, 1, 2, 3, 4, 5, 6, 7, 8);
endchar;

cmchar "downward 3";
beginchar("3", 14u#, x_height#, 0);
  adjust_fit(0, 0);

  numeric top_thickness, mid_thickness, bot_thickness;
  
  top_thickness=max(fine.breadth, vround(slab-2vair_corr));
  mid_thickness=max(fine.breadth, vround 2/3vair);
  bot_thickness=max(fine.breadth, vround(slab-vair_corr));
  
  pickup fine.nib;

  pos2(top_thickness, 180);
  lft x2r = 0.9u;

  pos3(max(fine.breadth, .6[curve, cap_curve]-stem_corr), 90);
  top y3r=hround(h-0.75u+o);

  pos4(vair, 0);
  pos5(vair, 0);
  pos6(mid_thickness, 180);
  y2 = y6 = y8 = 0.5[0.75u, y7];

  pos7(cap_curve, 90);
  top y7r = hround(h+o);
  bot y5 = min(vround 3u, bot y6)-eps;
  
  pos8(bot_thickness, 0);
  rt x8r = w-0.9u;

  x3 = 0.55[lft x4l, rt x2l];
  x7 = 0.5[lft x6l, rt x8l];
  lft x5l = hround(0.9u+.46(w-1.8u)-0.5vair);
  
  x5r = x6l;
  
  y4 = 1/3[y5, y3l];
  z4 = z5 + whatever*(-0.1fig_height, 15u);

  filldraw stroke pulled_super_arc.e(2, 3)(.5superpull)
    & z3e{right}...z4e---z5e;  % upper bowl
  filldraw z5r--z6l--z6r--z5l---cycle;  % middle tip
  filldraw stroke pulled_super_arc.e(6, 7)(.5superpull)
    & pulled_super_arc.e(7, 8)(.5superpull);  % lower bowl

  numeric bulb_diam[];
  
  bulb_diam1 = flare + 0.5(cap_stem-stem);
  bulb_diam2 = flare + cap_stem-stem;

  pos0(bulb_diam1, -90);
  pos1(hair, -90);
  lft y0r = hround 0.25u;
  x0 = x3;
  
  dlbulb(2, 1, 0);  % upper bulb

  pos10(bulb_diam2, 270);
  pos9(cap_hair, -90);
  bot y10r = hround(-0.25u);

  x10 = 0.9u + 0.7(w-1.8u) + 0.5bulb_diam2;

  drbulb(8, 9, 10);  % lower bulb

  penlabels(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
endchar;

cmchar "upward B";
beginchar("D", 13u#, x_height#, 0);

  numeric left_stem, right_curve, middle_weight;
  left_stem = cap_stem - hround 2stem_corr;
  middle_weight = 0.6vair + 0.5;
  
  pickup tiny.nib;

  pos1(left_stem, -90);
  pos2(left_stem, -90);
  bot y1r = bot y2r = 0;
  lft x1 = u;
  rt x2 = w-u;
  filldraw stroke z1e--z2e; % stem
  
  penpos3(cap_band, 180);
  penpos4(cap_band, 180);
  penpos6(middle_weight, 0);
  penpos7(middle_weight, 0);
  penpos8(middle_weight, 180);
  penpos9(middle_weight, 180);
  penpos5(right_curve-stem_corr, 90);
  penpos10(right_curve, 90);
  penpos11(cap_band, 0);
  penpos12(cap_band, 0);
  
  z3r = lft z1;
  x4  = x3;
  x5  = 0.5[x4, x6];
  x6  = x7;
  x8l-x7l = vair;
  z12r = rt z2;
  x11 = x12;
  x10 = 0.5[x11, x9];
  x8 = x9;
  0.5[x7l, x8l] = u+0.48(w-2u);
  y4 = y6;
  y9 = y11 = y4+0.5u;
  y7 = y8 = y1;
  y9l :=  y4+0.25u;
  y5r  = vround(h+o-0.5u);
  y10r = vround(h+o);

  right_curve = cap_curve-stem_corr;
  y4 = 0.45[y1, h+o];

  y6l  := y6l-0.5u;
  y11l := y11l-0.5u;

  fill stroke z3e..super_arc.e(4, 5) & super_arc.e(5, 6)..z7e;  % upper lobe
  fill stroke z8e..super_arc.e(9, 10) & super_arc.e(10, 11)..z12e;  % lower lobe

  hserif(1, 2, a, 1/3, -cap_jut);
  hserif(1, 2, b, 1/3, 1/2cap_jut);
  hserif(2, 1, c, 1/3, -cap_jut);
  hserif(2, 1, d, 1/3, 1/2cap_jut);
  
  math_fit(0, 0.5ic#);
  penlabels(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);

endchar;

cmchar "downward B";
beginchar("B", 13u#, x_height#, 0);

  numeric left_stem, right_curve, middle_weight;
  left_stem = cap_stem - hround 2stem_corr;
  middle_weight = 0.6vair + 0.5;
  
  pickup tiny.nib;

  pos1(left_stem, -90);
  pos2(left_stem, -90);
  top y1l = top y2l = h;
  rt x1 = w-u;
  lft x2 = u;
  filldraw stroke z1e--z2e; % stem
  
  penpos3(cap_band, 0);
  penpos4(cap_band, 0);
  penpos6(middle_weight, 180);
  penpos7(middle_weight, 180);
  penpos8(middle_weight, 0);
  penpos9(middle_weight, 0);
  penpos5(right_curve-stem_corr, -90);
  penpos10(right_curve, -90);
  penpos11(cap_band, 180);
  penpos12(cap_band, 180);
  
  z3r = rt z1;
  x4  = x3;
  x5  = 0.5[x4, x6];
  x6  = x7;
  x7l-x8l = vair;
  z12r = lft z2;
  x11 = x12;
  x10 = 0.5[x11, x9];
  x8 = x9;
  0.5[x7l, x8l] = u+0.52(w-2u);
  y4 = y6;
  y9 = y11 = y4-0.5u;
  y7 = y8 = y1;
  y9l := y4+0.25u;
  y5r  = vround(0.5u-o);
  y10r = vround(-o);

  right_curve = cap_curve-stem_corr;
  y4 = 0.45[y1, -o];

  y6l  := y6l+0.5u;
  y11l := y11l+0.5u;

  fill stroke z3e..super_arc.e(4, 5) & super_arc.e(5, 6)..z7e;  % upper lobe
  fill stroke z8e..super_arc.e(9, 10) & super_arc.e(10, 11)..z12e;  % lower lobe

  hserif(1, 2, a, 1/3, cap_jut);
  hserif(1, 2, b, 1/3, -1/2cap_jut);
  hserif(2, 1, c, 1/3, cap_jut);
  hserif(2, 1, d, 1/3, -1/2cap_jut);
  
  math_fit(0, 0.5ic#);
  penlabels(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);

endchar;

% unlike the others there is no way to squeeze the
% rotated C to an x-height character, nor cap-height.
% So although on the baseline, this rather awkwardly
% ascends half way between them

cmchar "upward C";
beginchar("C", 13u#, cap_height#, 0);
 adjust_fit(0, 0);
 
 pickup fine.nib;

 pos1(cap_hair, 90);
 pos2(cap_band, 180);
 pos3(cap_curve, -90);
 pos4(cap_band, 0);
 pos5(hair, 90);
 
 top y1r = top y5r = 0.5[x_height, h];
 bot y3r = -o;
 y2 = y4 = 0.55[y3, y1];
 
 lft x2r = u;
 rt  x4r = hround(w-u);
 x3 = 0.5[x2, x4];
 
 rt  x1 = u + 0.4(w-2u);
 lft x5 = w - u - 0.95(x1-u);
 (x2l, y2l') = whatever[z2r, z1l]; y2l := min(y2l', y2l+.5u);
 (x4l, y4l') = whatever[z4r, z5l]; y4l := min(y4l', y4l+.5u);
 filldraw stroke z1e{10(x2-x1), y2-y1}
 ...pulled_arc.e(2, 3) & pulled_arc.e(3, 4)...{left}z5e; % arc
 
 pos6(0.3[fine.breadth, cap_hair], 90);
 y6r = y1r;
 lft x6 = u;
 y1r-y1'=2cap_curve-fine;
 x1'=x1;

 path upper_arc;

 upper_arc=z1{10(x2-x1), y2-y1}..z2{down};

 numeric t;

 t = xpart(upper_arc intersectiontimes (z6l--z1'));

 filldraw z1r--z6r--z6l--subpath(t, 0) of upper_arc--cycle; % barb

 math_fit(-.3cap_height#*slant-.5u#, .5ic#);
 penlabels(1, 1', 2, 3, 4, 5, 6);
endchar;

% fletched arrows, which are 4u longer than the cm
% right and up arrows. These are not identical -- the
% head on the upward arrow is slighty wider than the
% rightward

numeric fwdt, fjut, fang;

fwdt := 2/3 rule_thickness;
fjut := 1.3;
fang := 60;

vardef fletch(suffix $, $$, @) =
  fletchLR($, $$, @, fang, 90, fwdt, fjut);
  fletchLR($, $$, @', -fang, -90, fwdt, fjut);
enddef;

vardef fletchLR(suffix $, $$, @)(expr a, r, wdt, len) =
  numeric b, c;
  b := angle(z$$-z$);  
  z@1 = z$  + len * ((z$$-z$) rotated a);
  z@2 = z@1 + whatever*((z$ - z@1) rotated r);
  z@2 = z$$ + whatever*((z$$ - z$) rotated a);
  z@3 = z@4 = z$;
  c := angle(z@1-z@2);
  penpos@1(wdt, c);
  penpos@2(wdt, c+180);
  penpos@3(wdt, b-r);
  penpos@4(wdt, b+180);
  penstroke z@4e--z@1e...z@2e{z$-z@1}...{z$-z$$}z@3e;
  penlabels(@1, @2, @3);
enddef;

cmchar "Upward arrow with fletching";
beginchar(oct "042", 8u#, asc_height#+2u#, asc_depth#+2u#);
  adjust_fit(0, 0);

  pickup crisp.nib;
  
  pos1(rule_thickness, 0);
  pos2(rule_thickness, 0);
  pos3(rule_thickness, 90);
  pos4(rule_thickness, 90);

  numeric headh, headw;
  
  headw := (w-u)/2+eps;
  headh := 0.36*w/(9u)*asc_height+eps;
  
  lft x1l = hround(0.5w - 0.5rule_thickness);

  x0 = x1 = x2;
  top y0 = h;
  x0-x3 = x4-x0 = headw;
  y3 = y4 = y0 - headh;
  
  pos5(rule_thickness, angle(z4-z0));
  z5l=z0;
  
  pos6(rule_thickness, angle(z3-z0));
  z6l=z0;
  z9 = 0.2[0.5[z3, z4], z0];

  numeric rake;

  rake = y5l - y3r;
  
  y1 - 0.5 rule_thickness - rake = -d;

  numeric t; path p;
  
  p=z4l{z9-z4}..z6r;
  t=xpart(p intersectiontimes((x2r, -d)--(x2r, h))); y2=ypart point t of p;

  filldraw z0..{z4-z9}z4r--subpath (0, t) of\\(z4l{z9-z4}..z6r)
  ---z1r---z1l---subpath (t, 0) of\\(z3l{z9-z3}..z5r)
  --z3r{z9-z3}..z0 & cycle;  % arrowhead and stem

  penlabels(0, 2, 3, 4, 5, 6, 9);

  % fletching
  
  x10 = x11 = x12 = x13 = x1; 
  y11-y10 = y12-y11 = y13-y12 = 3/5rake;  % fletch separation
  y11 = y1;

  fletch(11, 10, a);
  fletch(12, 11, b);
  fletch(13, 12, c);
  
  labels(10, 11, 12, 13);
  
endchar;

cmchar "Rightward arrow with fletching";
compute_spread(0.45x_height#, 0.55x_height#);
beginchar(oct "041", 22u#, v_center(spread#+rule_thickness#));
  adjust_fit(0, 0);

  pickup crisp.nib;
  
  pos1(rule_thickness, 90);
  pos2(rule_thickness, 90);
  pos3(rule_thickness, 0);
  pos4(rule_thickness, 0);

  y0 = y1 = y2 = math_axis;
  rt x0 = hround(w-u);

  numeric headw, headh;

  headw = 0.26 asc_height+eps;
  headh = 4u + eps;
  
  y3-y0 = y0-y4 = headw;
  x3 = x4 = x0 - headh;
  
  pos5(rule_thickness, angle(z4-z0));
  pos6(rule_thickness, angle(z3-z0));
  
  z5l = z0;
  z6l = z0;
  z9  = 0.2[0.5[z3, z4], z0];

  numeric rake;

  rake = x5l - x3r;
  
  x1 = hround(2u + 3/5rake);
  
  numeric t; path p; p=z4l{z9-z4}..z6r;

  t=xpart(p intersectiontimes((0, y2l)--(w, y2l))); x2=xpart point t of p;
  
  filldraw z0..{z4-z9}z4r--subpath (0, t) of\\(z4l{z9-z4}..z6r)
  ---z1l---z1r---subpath (t, 0) of\\(z3l{z9-z3}..z5r)
  --z3r{z9-z3}..z0 & cycle;  % arrowhead and stem

  penlabels(0, 1, 2, 3, 4, 5, 6, 9);

  % fletching
  
  y10 = y11 = y12 = y13 = math_axis; 

  x11-x10 = x12-x11 = x13-x12 = 3/5rake;
  x11 = hround x1;  
  
  fletch(11, 10, a);
  fletch(12, 11, b);
  fletch(13, 12, c);
  
  labels(10, 11, 12, 13);
  
endchar;

% these struckout numerals are lifted directly from
% romand.mf, with the strikeout added at the end

cmchar "Reverse struckout 0";
beginchar("0", 9u#, fig_height#, 0);
  adjust_fit(0, 0);
  
  penpos1(vair, 90);
  penpos3(vair, -90);
  penpos2(curve, 180);
  penpos4(curve, 0);

  interim superness := sqrt(more_super*hein_super);
  
  x2r = hround max(.7u, 1.45u-.5curve);
  x4r = w-x2r;
  x1 = x3 = 0.5w;
  y1r = h+o;
  y3r = -o;
  y2=y4 = 0.5h-vair_corr;
  y2l := y4l := 0.52h;
  
  penstroke pulled_arc.e(1, 2)
  & pulled_arc.e(2, 3)
  & pulled_arc.e(3, 4)
  & pulled_arc.e(4, 1) & cycle;  % bowl
  
  penlabels(1, 2, 3, 4);

  % the strikeout

  pickup rule.nib;

  bot y5 = 0;
  top y6 = y1r + y3r;
  x5 = x4r;
  x6 = x2r;

  draw z5--z6;
  labels(5, 6);
  
endchar;

cmchar "Reverse struckout 1";
beginchar("1", 9u#, fig_height#, 0);
  adjust_fit(0, 0);
  
  numeric light_stem;
  light_stem=hround .4[stem', cap_stem'];
  
  pickup tiny.nib;
  pos1(light_stem, 0);
  pos2(light_stem, 0);
  
  lft x1l=lft x2l=hround(.5(w+.5u)-.5cap_stem');
  top y1=h+o;
  bot y2=0;
  
  filldraw stroke z1e--z2e;  % stem
  
  if not serifs: save slab; slab=bar; fi

  dish_serif(2, 1, a, 1/3, min(2.25u, lft x2l-1.5u), 
    b, 1/3, min(2.25u, w-1.25u-rt x2r)); % serif
  
  pickup crisp.nib;

  pos3(slab, -90);
  pos4(bar, -90);
  
  top y3l=h+o;
  top y4l=if monospace: .8 else: .9 fi\\ h+o;

  lft x4=max(1.25u, tiny.lft x1l-2.35u);
  tiny.rt x1r=lft x3+.25[tiny, hair];
  
  erase fill z3l{x4l-x3l, 3(y4l-y3l)}...z4l{left}
  --(x4l, h+o+1)--(x3l, h+o+1)--cycle; % erase excess at top

  filldraw stroke z3e{x4e-x3e, 3(y4e-y3e)}..z4e{left};  % point

  penlabels(1, 2, 3, 4);

  % the strikeout -- possible raise z6 a little

  pickup rule.nib;

  y4r - top y5 = bot y6 - y2;  
  top y5 = x_height;
  x5 = w-x6 = x4;

  draw z5--z6;
  
  labels(5, 6);
  
endchar;

% this is used with \mathaccent, but unlike the computer modern
% math accents it starts on the baseline, rather than at x_height.
% Knuth uses some dark magic in the cm sources to place this
% correctly with respect to the character to be accented, I couldn't
% reproduce it. So, this is like the cm accents, but with x_height 
% subtracted from the heights
% 
% This rather nice version (much better than my effort) was taken
% from ibyacc4.mf, part of the ibycus font for classical greek by
% Pierre A. MacKay, from work by Silvio Levy's realization of a
% classic Didot cut of Greek type from around 1800.

def smooth(suffix $, @)(expr dot_size, depth, shear) =
  pickup fine.nib;

  pos$(dot_size, 90);
  pos@1(vair, 90);
  pos@2(vair, 0);
  pos@3(vair, -90);

  z@1r  = z$r;
  y@1l := y$;
  rt x@2r = hround(x$ + 0.5 depth + 0.5 shear);
  x@3 - 0.5 vair = hround(x$ - 0.5 dot_size + shear);
  y@2 = 0.5[y@1, y@3];
  bot y@3r = vround(top y@1r - depth);

  path pp;
  pp = (z@2{down}...z@3);
  
  % position a vertical path through the right side of the bulb
  x@1' = x@1 + 0.5 dot_size;
  
  % At the intersection of that path with SL's tail, get the direction
  pair d@@;
  d@@ = (direction (xpart(
	  (z@2{down}...z@3)
	  intersectiontimes
	  ((x@1', 0){up}--(x@1', y@1)))) 
      of (z@2{down}...z@3));
  
  % Tilt a pen at a right angle to that direction
  pos@3'(vair, angle(d@@) + 90);

  % Place it at the intersection.  This will be the new end of the tail.
  z@3' = directionpoint d@@ of(z@2{down}...z@3); 
  y_ := ypart((z@1{right}...z@2{down}...z@3)
      intersectiontimes (z$l{right}..{left}z$r));
  if y_ < 0:
    y_ := 1;
  fi
  filldraw z$r{left}..subpath (0, y_) of (z$l{right}..{left}z$r)--cycle; % dot
  filldraw stroke z@1e{right}...z@2e{down}...{d@@}z@3'e;

  penlabels(@1, @2, @3);
enddef;

def rough(suffix $, @)(expr dot_size, depth, shear) =
  pickup fine.nib;
  
  pos$(dot_size, 90);
  pos@1(vair, 90);
  pos@2(vair, 180);
  pos@3(vair, -90);

  z@1r = z$r;
  y@1l := y$;
  lft x@2r = hround(x$ - 0.5 depth + 0.5 shear);
  x@3 + 0.5 vair = x$ + 0.5 dot_size + shear;
  y@2 = 0.5 [y@1, y@3];
  bot y@3r = vround(top y@1r - depth);

  % position a vertical path through the left side of the bulb
  x@1' = x@1 - 0.5 dot_size;

  % At the intersection of that path with SL's tail, get the direction
  pair d@@;
  d@@ = ( direction (xpart( (z@2{down}...z@3)
	  intersectiontimes
	  ((x@1', 0){up}--(x@1', y@1)))) 
      of (z@2{down}...z@3));
  
  % Tilt a pen at a right angle to that direction
  pos@3'(vair, angle(d@@) - 90);
  
  % Place it at the intersection.  This will be the new end of the tail.
  z@3' = directionpoint d@@ of(z@2{down}...z@3); 
  y_ := ypart((z@1{left}...z@2{down}...z@3)
      intersectiontimes (z$l{left}..{right}z$r));
  if y_ < 0:
    y_ := 1;
  fi
  filldraw z$r{right}..subpath (0,y_) of (z$l{left}..{right}z$r)--cycle; % dot
  filldraw stroke z@1e{left}...z@2e{down}...{d@@}z@3'e;
  
  penlabels(@1, @2, @3);
enddef;

cmchar "Spiritus Lenis accent (tailed)";
beginchar(oct "025", 9u#, min(asc_height#-x_height#, x_height#), 0); 

  adjust_fit(0, 0);
  
  numeric dot_diam#;
  dot_diam# = 3/4dot_size#;
  define_whole_blacker_pixels(dot_diam);

  x1 = 0.5w - o;
  y1 = h;

  smooth(1, a, dot_size, 3/4h, 0);

endchar;

% this is my effort -- closer to the form used by Pohl, 
% a blunted crecent.

cmchar "Spiritus Lenis accent (crescent)";
beginchar(oct "026", 9u#, min(asc_height#-x_height#, x_height#), 0); 

  numeric rake;
  
  rake = 10;
  
  penpos1(hair, 270+rake);
  penpos2(0.3[hair, stem], 180);
  penpos3(hair, 90-rake);
  
  x1 = x3 = 0.5w - o;
  y1 = h;
  y3l = max(h/3, o+hair);
  y2+y2 = y1+y3;
  x2 - x1 = 0.65*(y1-y3);

  penstroke z1e{dir(rake)}..z2e..{dir(180-rake)}z3e;
  
  penlabels(1, 2, 3);  
  
endchar;

cmchar "Spiritus Asper accent (tailed)";
beginchar(oct "023", 9u#, min(asc_height#-x_height#, x_height#), 0); 

  adjust_fit(0, 0);
  
  numeric dot_diam#;
  dot_diam# = 3/4dot_size#;
  define_whole_blacker_pixels(dot_diam);

  x1 = 0.5w - o;
  y1 = h;

  rough(1, a, dot_size, 3/4h, 0);

endchar;

cmchar "Spiritus Asper accent (crescent)";
beginchar(oct "024", 9u#, min(asc_height#-x_height#, x_height#), 0); 

  numeric rake;
  
  rake = 10;
  
  penpos1(hair, 90-rake);
  penpos2(0.3[hair, stem], 180);
  penpos3(hair, 270+rake);
  
  x1 = x3 = 0.5w - o;
  y1 = h;
  y3r = max(h/3, o+hair);
  y2+y2 = y1+y3;
  x1 - x2 = 0.65*(y1-y3);

  penstroke z1e{dir(180-rake)}..z2e..{dir(rake)}z3e;
  
  penlabels(1, 2, 3);  
  
endchar;

% This is the archaic long s with mid bar, used by
% Frege as the successor functon. The upright stroke
% is that of Computer Modern's f, but the bar runs
% along the math-axis rather than the x-height.

cmchar "Long s with midline bar";
beginchar("s", 5.5u#, asc_height#, 0);
  adjust_fit(0, 0);

  pickup tiny.nib;
  pos1(stem', 0);
  lft x1l = hround(2.5u-0.5stem');

  pickup fine.nib;
  numeric bulb_diam;
  bulb_diam = hround 0.8[stem, flare];
  pos2(bulb_diam, 0);
  y2 + 0.5bulb_diam = 0.9[x_height, h+oo];
  lft x2l = hround(w-0.75u+0.5);

  f_stroke(1, 2, a, b, c, jut, 1.25jut);

  pickup crisp.nib;
  pos3(bar, 90);
  pos4(bar, 90);
  y3 = y4 = math_axis;
  lft x3 = hround(0.5u - 1); 
  rt  x4 = hround(w - 1/3u);

  filldraw stroke z3e--z4e;

  penlabels(1, 2, 3, 4);
  
endchar;
  
cmchar "Roman U with flourish";
beginchar("U", 15u#, cap_height#, desc_depth#);
  adjust_fit(cap_serif_fit#, cap_serif_fit#);

  numeric colsep;
  
  % distance between columns
  
  colsep := 0.20h;

  pickup fine.nib;
  
  % 4-1-2-3-5 is the main part of the U
    
  pos1(cap_stem, 180);
  pos2(0.25[cap_hair, cap_stem], 270);
  pos3(cap_hair, 0);
  pos4(cap_stem, 180);
  pos5(cap_hair, 0);

  x1r = w-x3r;
  x3l - x1l = colsep;
  
  x4 = x1;
  x3 = x5;

  x2  = 0.5(x1l+x3l);
  y1  = y3 = 0.5(x3-x1)-d;
  y2r = -d-o;

  % 6 & 7 control the bulb on the right arm of the U
  % note that the top of the bulb is aligned with the
  % height, not h+o -- that is on purpose
  
  pos6(cap_hair, 270);
  pos7(cap_stem, 90);
  
  y4l = 0.72h;
  y5l = 0.82h;

  x6  = x5 + 0.6colsep;
  y6l = h;  

  filldraw stroke z4e..z1e{down}..z2e{right}..z3e{up}..z5e;
  vbulb(5, 6, 7);

  % 9-10-11-12 is the flourish 
  
  pos9(cap_hair, 270);
  
  bot y9r  = bot y10r = 0;
  x9l  = w-x10r = 0.5u;
  
  pos11(cap_hair, 50);
  pos12(0.25[cap_hair, cap_stem], 270);
  
  x11l = x12 = x4 - 0.9colsep;
  y11  = y4;
  y12l = h+o;
  
  z11l-z10l = whatever*(z11r-z10r);
  z9l-z10l  = whatever*(z9r-z10r);
  
  z10  = 0.5[z10l, z10r];
  
  % the curved stroke from the left arm of the U 
  
  filldraw stroke z4e{up}..{left}z12e..{z10-z11}z11e;

  % the flourish itself

  filldraw stroke z9e--z10e;
  filldraw stroke z10e--z11e;
  
  penlabels(1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12);

endchar;

% overturned c with spur; this is a modified version of
% the code in romanl.mf
%
% not sure I'm entirely happy with the spur

cmchar "Overturned c with spur";
beginchar("c", 8u#, asc_height#, 0);
  adjust_fit(0, 0);
  
  pickup fine.nib;
  
  pos2(vair', 270);
  pos4(vair', 90);
  
  x2 = x4 = 0.5(w-u); 
  bot y2r = -oo;
  top y4r = vround(x_height + 1.5oo);
  
  pos3(curve, 0);

  rt x3r = w - hround max(0.6u, 1.35u - 0.5curve);
  y3 = 0.5x_height;

  pos1(hair, 180);
  pos0(flare, 180);

  y1 = x_height -
    min(bar_height + 0.5flare + 2vair' + 2, 
        0.9[bar_height, x_height] - 0.5flare);

  lft x1r = 0.7u; 

  bulb(2, 1, 0);

  pos5(hair, 180);
  lft x5r = 0.5u;
  y5 = x_height - max(good.y(0.5bar_height-0.9), x_height-y4l-vair');
  (x, y4l) = whatever[z4r, z5l];
  x4l := min(x, x4l+.5u);
  
  filldraw stroke pulled_super_arc.e(2, 3)(0.7superpull)
    & pulled_super_arc.e(3, 4)(0.5superpull)
    ..tension .9 and 1..{x5-x4, 5(y5-y4)}z5e;
  
  path pth;
  numeric tp, theta;

  theta = 25;
  
  pos6(stem, theta-90);
  pos7(hair, 90+theta);
  
  top y6l = asc_height;
  
  pth = z4{left}..tension .9 and 1..{x5-x4, 5(y5-y4)}z5;
  
  z7 = directionpoint dir(180+theta) of pth;
  x6 = x7;
    
  filldraw stroke z7e{dir(theta)}..{dir(180+theta)}z6e;
  
  penlabels(0, 1, 2, 3, 4, 5, 6, 7);

endchar;

cmchar "Overturned e with spur";
beginchar("e", 7.25u#+max(0.75u#, 0.5curve#), asc_height#, 0);
  adjust_fit(0, 0);

  numeric left_curve, right_curve, rbar_height;

  rbar_height = x_height - bar_height;
  
  left_curve + 6stem_corr = right_curve = curve;

  if right_curve<tiny.breadth: right_curve:=tiny.breadth; fi
  if left_curve<tiny.breadth: left_curve:=tiny.breadth; fi

  pickup tiny.nib;

  pos1(left_curve, 180);
  pos2(vair, 270);
  pos3(right_curve, 0);

  y1 = good.y rbar_height;
  bot y2r = -oo;
  y0l = top y1;
  lft x1r = hround max(0.5u, 1.25u-0.5left_curve);
  rt  x3r = hround min(w-0.5u, w-u+0.5right_curve);
  x2 = 0.5w-0.25u;
  
  {{
  interim superness := more_super;
  filldraw stroke super_arc.e(1, 2);
  }};

  y3 = 0.5 [y2, y4];
  top y4r = x_height + vround 1.5oo;
  x4 = x2 + 0.25u;

  pos4(vair', 90);
  pos5(hair, 180);

  y5 = min(good.y(0.5[rbar_height, x_height]+0.9), y4l-vair);

  x5r = x1r;
  (x, y4l) = whathever[z4r, z5];
  x4l := min(x, x4l+0.5u);

  filldraw stroke pulled_arc.e(2, 3) & pulled_arc.e(3, 4)
  ... {x5-x4, 5(y5-y4)}z5e;

  path testpath;

  testpath = super_arc.r(2, 3) & super_arc.r(3, 4); 

  y1'r = y0r = y0l - 0.6[thin_join, vair];
  y1'l = y0l;
  x1'l = x1'r = x1;

  forsuffixes $ = l, r:
    x0$ = xpart(((w, y0$)--(x1, y0$)) intersectionpoint testpath);
  endfor;

  fill stroke z0e--z1'e;
  
  path pth;
  numeric tp, theta;

  theta = 25;
  
  pos6(stem, theta-90);
  pos7(hair, 90+theta);
  
  top y6l = asc_height;
  
  pth =  super_arc.r(3, 4) ... {x5-x4, 5(y5-y4)}z5;
  
  z7 = directionpoint dir(180+theta) of pth;
  x6 = x7;
    
  filldraw stroke z7e{dir(theta)}..{dir(180+theta)}z6e;

  penlabels(0, 1, 2, 3, 4, 5, 6, 7);
  
endchar;

% Reverse solidus -- in contrast the the cm backslash 
% this is stressed, an oblique slab of the width of 
% capital stems. The dimensions also are those of
% capitals, whearas the cm backslash has the dimensions 
% of delimiters.

cmchar "Reverse solidus";
beginchar(oct "113", 9u#, cap_height#, 0);
  adjust_fit(0, 0);

  pickup fine.nib;
  
  pos1(cap_stem, 0);
  pos2(cap_stem, 0);
  
  lft x1l = u;
  rt  x2r = w - u;
  top y1 = cap_height;
  bot y2 = 0;

  filldraw stroke z1e--z2e;

  penlabels(1, 2);
  
endchar;

% the left-angle, a funny looking thing, made from a single
% stroke of an eliptic pen. The upstroke is bowed inward, 
% barely perceptibly

cmchar "Left-angle";
beginchar(oct "150", 11u#, cap_height#, 0);
  adjust_fit(0, 0);

  numeric theta, bow, elbow;
  
  elbow := x_height + 0.5*(cap_height-x_height);

  x1 = x3 = w - 0.5u - 0.4cap_stem;
  y1 = 0; cap_height - y3 = 0.4cap_stem;
  y2 = elbow;
  x2 = 0.5u + 0.4cap_stem;

  theta := angle(z2-z1)-90;
  bow   := 5;
  
  pickup pencircle xscaled cap_hair yscaled cap_stem rotated theta;
  draw z1{dir(theta+90-bow)}...{dir(theta+90+bow)}z2--z3;

  penlabels(1, 2, 3);
  
endchar;

cmchar "Variant Infinity";
beginchar("infty", 18u#, x_height#, 0); 
  adjust_fit(0, 0);
  
  numeric theta, psi;  
  theta = 70;
  psi = 40;
  
  penrad = hair;
  
  y1 = y3 = y4 = y6 = 7/16x_height;
  x1 = w - x6 = 0.5u + penrad;
  2x3 = 2x4 = x1 + x6;
  2x2 = x1 + x3;
  2x5 = x4 + x6;
  y2 = y5 = penrad - oo;
  
  pickup pencircle scaled 2penrad;
  
  draw z1{dir(-theta)}...z2...{dir(theta)}z3;
  draw z4{dir(-theta)}...z5...{dir(theta)}z6;
  
  penlabels(1, 2, 3, 4, 5, 6);
  
  % this is the overbar

  pickup fine.nib;
  
  pos7(hair, 90+psi);
  pos8(2penrad, 90);
  pos9(hair, 90-psi);
  
  x7 = w - x9 = 0.32[x1, x2];
  y7 = y9 = 11/16x_height;
  2x8 = x7 + x9;
  top y8r = o + h; 
  
  filldraw stroke z7e{dir psi}...z8e...{dir -psi}z9e;
  
  penlabels(7, 8, 9);

endchar;

% This is series of small cups, caps and bars. Although
% most of these are binary operators, Pohle sets these
% much tighter than the other operators in the text, but
% not quite as tight as ordinary terms.
% We simulate this behaviour by declaring them \mathord
% in the style file (rather than \mathbin), but add a liile
% extra spacing around them with cupcap_fit

def cupcap_fit = adjust_fit(24/36pt#, 24/36pt#) enddef;

cmchar "upwards opened bracket";
beginchar(oct "114", 14u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  bot y1 = bot y2 = 0;

  x3 = x1;
  x4 = x2;

  y3 = y4 = 1/3x_height; 
  
  draw z3--z1--z2--z4;

  labels(1, 2, 3);
  
endchar;

cmchar "Small bar acute";
beginchar(oct "115", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  bot y1 = bot y2 = 0;
  
  draw z1--z2;

  labels(1, 2);
  
  pickup crisp.nib;

  x4 + 0.5stem = hround(2/3w);
  x5 = 2/3[x4, w-x4];
  y4 + 0.5stem = x_height + oo;
  y5 = 1/2x_height;

  numeric theta;
  theta = angle(z5-z4) + 90;
  pos4(stem, theta);
  pos5(hair, theta);

  filldraw circ_stroke z4e--z5e;

  penlabels(4, 5);
  
endchar;

cmchar "Small cup";
beginchar(oct "116", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  y1 = y2 = 0.5x_height;
  x3 = good.x 0.5w;
  bot y3 = -oo;
  
  draw z1..z3..z2;

  labels(1, 2, 3);

endchar;

cmchar "Small bar over cap";
beginchar(oct "117", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  y1 = y2 = 1/3x_height;
  x3 = good.x 0.5w;
  y3 = 2/3x_height;
  
  draw z1..z3..z2;

  labels(1, 2, 3);

  x4 = x1;
  x5 = x2;

  top y4 = top y5 = x_height;

  draw z4--z5;

  labels(4, 5);

endchar;

cmchar "Small cup over bar";
beginchar(oct "120", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  top y1 = top y2 = x_height + oo;
  x3 = good.x 0.5w;
  y3 = 2/3x_height;
  
  draw z1..z3..z2;

  labels(1, 2, 3);

  x4 = x1;
  x5 = x2;

  y4 = y5 = 1/3x_height;

  draw z4--z5;

  labels(4, 5);

endchar;

cmchar "Small cap over bar";
beginchar(oct "121", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  y1 = y2 = 2/3x_height;
  x3 = good.x 0.5w;
  top y3 = x_height + oo;
  
  draw z1..z3..z2;

  labels(1, 2, 3);

  x4 = x1;
  x5 = x2;

  y4 = y5 = 1/3x_height;

  draw z4--z5;

  labels(4, 5);

endchar;

cmchar "Small cup with acute";
beginchar(oct "122", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  y1 = y2 = 1/3x_height;
  x3 = good.x 0.5w;
  bot y3 = -oo;
  
  draw z1..z3..z2;

  labels(1, 2, 3);
  
  pickup crisp.nib;

  x4 + 0.5stem = hround(2/3w);
  x5 = 2/3[x4, w-x4];
  y4 + 0.5stem = x_height + oo;
  y5 = 1/2x_height;

  numeric theta;
  theta = angle(z5-z4) + 90;
  pos4(stem, theta);
  pos5(hair, theta);

  filldraw circ_stroke z4e--z5e;

  penlabels(4, 5);

endchar;

cmchar "Small raised cap";
beginchar(oct "123", 10u#, x_height#, 0); 
  cupcap_fit;

  pickup rule.nib;

  lft x1 = hround(u - eps);
  x2 = w - x1;
  y1 = y2 = 0.5x_height;
  x3 = good.x 0.5w;
  top y3 = x_height + oo;
  
  draw z1..z3..z2;

  labels(1, 2, 3);

endchar;

end
