+def custos_mensural (expr verbose_name, internal_name,
+ direction, staffline_adjustment) =
+ fet_beginchar (verbose_name, internal_name);
+ save alpha, dalpha, ht, wd, stem_ht;
+
+ ht# = noteheight#;
+ wd# / ht# = 1.2;
+ alpha = 35;
+ dalpha = direction * alpha;
+
+ if staffline_adjustment = between_staff_lines:
+ stem_ht# = 2.00 staff_space#;
+ elseif staffline_adjustment = on_staff_line:
+ stem_ht# = 2.50 staff_space#;
+ else: % staffline_adjustment = anywhere
+ stem_ht# = 2.25 staff_space#;
+ fi;
+
+ define_pixels (ht, wd, stem_ht);
+
+ save ellipse, T;
+ path ellipse;
+ transform T;
+
+ T := identity xscaled linethickness
+ yscaled 0.4 ht
+ rotated -dalpha;
+ pickup pencircle transformed T;
+ ellipse := fullcircle transformed T;
+
+ if direction > 0:
+ bot y1 = bot y3 = bot y5 = -direction * 0.33 ht;
+ top y2 = top y4 = +direction * 0.33 ht;
+ else:
+ top y1 = top y3 = top y5 = -direction * 0.33 ht;
+ bot y2 = bot y4 = +direction * 0.33 ht;
+ fi;
+
+ lft x1 = 0.0 wd;
+ lft x2 = 0.2 wd;
+ lft x3 = 0.4 wd;
+ lft x4 = 0.6 wd;
+ lft x5 = 0.8 wd;
+
+ y6 - y5 = direction * stem_ht;
+ y6 - y5 = (x6 - x5) * tand (90 - dalpha);
+
+ if direction > 0:
+ fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
+ -- get_subpoint (ellipse, z2 - z1, z2)
+ -- get_subpoint (ellipse, z3 - z2, z2)
+ -- get_subpath (ellipse, z3 - z2, z4 - z3, z3)
+ -- get_subpoint (ellipse, z4 - z3, z4)
+ -- get_subpoint (ellipse, z5 - z4, z4)
+ -- get_subpath (ellipse, z5 - z4, z6 - z5, z5)
+ -- get_subpath (ellipse, z6 - z5, z5 - z6, z6)
+ -- get_subpoint (ellipse, z5 - z6, z5)
+ -- get_subpoint (ellipse, z4 - z5, z5)
+ -- get_subpath (ellipse, z4 - z5, z3 - z4, z4)
+ -- get_subpoint (ellipse, z3 - z4, z3)
+ -- get_subpoint (ellipse, z2 - z3, z3)
+ -- get_subpath (ellipse, z2 - z3, z1 - z2, z2)
+ -- cycle;
+ else:
+ fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
+ -- get_subpath (ellipse, z2 -z1, z3 - z2, z2)
+ -- get_subpoint (ellipse, z3 - z2, z3)
+ -- get_subpoint (ellipse, z4 - z3, z3)
+ -- get_subpath (ellipse, z4 -z3, z5 - z4, z4)
+ -- get_subpoint (ellipse, z5 - z4, z5)
+ -- get_subpoint (ellipse, z6 - z5, z5)
+ -- get_subpath (ellipse, z6 - z5, z5 - z6, z6)
+ -- get_subpath (ellipse, z5 - z6, z4 - z5, z5)
+ -- get_subpoint (ellipse, z4 - z5, z4)
+ -- get_subpoint (ellipse, z3 - z4, z4)
+ -- get_subpath (ellipse, z3 - z4, z2 - z3, z3)
+ -- get_subpoint (ellipse, z2 - z3, z2)
+ -- get_subpoint (ellipse, z1 - z2, z2)
+ -- cycle;
+ fi;
+
+ % The stem is intentionally outside of the char box.
+ if direction > 0:
+ set_char_box (0, wd#,
+ +direction * 0.33 ht#, stem_ht#);
+ else:
+ set_char_box (0, wd#,
+ stem_ht#, -direction * 0.33 ht#);
+ fi;
+
+ labels (1, 2, 3, 4, 5, 6);
+ fet_endchar;
+enddef;
+
+
+% custos mensural, stem up, between staff lines
+custos_mensural ("Custos Mensural", "mensural.u0",
+ dir_up, between_staff_lines);
+
+
+% custos mensural, stem up, on staff line
+custos_mensural ("Custos Mensural", "mensural.u1",
+ dir_up, on_staff_line);
+
+
+% custos mensural, stem up, anywhere
+custos_mensural ("Custos Mensural", "mensural.u2",
+ dir_up, anywhere);
+
+
+% custos mensural, stem down, between staff lines
+custos_mensural ("Reverse Custos Mensural", "mensural.d0",
+ dir_down, between_staff_lines);
+
+
+% custos mensural, stem down, on staff line
+custos_mensural ("Reverse Custos Mensural", "mensural.d1",
+ dir_down, on_staff_line);
+
+
+% custos mensural, stem down, anywhere
+custos_mensural ("Reverse Custos Mensural", "mensural.d2",
+ dir_down, anywhere);
+
+
+fet_endgroup ("custodes");