% Feta (not the Font-En-Tja) music font --  implement scripts
% This file is part of LilyPond, the GNU music typesetter.
%
% Copyright (C) 1997--2022 Han-Wen Nienhuys <hanwen@xs4all.nl>
%        Jan Nieuwenhuizen <janneke@gnu.org>
%
%
% The LilyPond font is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version, or under the SIL Open Font License.
%
% LilyPond is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.


fet_begingroup ("scripts");

turn_stemwidth# = 0.1 staff_space# + 0.6 stafflinethickness#;
define_whole_blacker_pixels (turn_stemwidth);

def draw_fermata =
  save alpha, radius, crook_thinness, crook_fatness, dot_size;
  save pat;
  path pat;

  % [Wanske] and some Baerenreiter editions
  % suggest about 80 degrees instead of a half-circle
  alpha := 10;

  radius# = 1.25 staff_space#;
  crook_thinness# = 1.5 linethickness#;
  crook_fatness# = 0.25 staff_space# + 1.5 linethickness#;

  radius# + crook_fatness# / 2 = h#;
  radius# + crook_thinness# / 2 = w#;

  set_char_box (w#, w#, crook_thinness# / 2, h#);

  define_pixels (radius, crook_thinness, crook_fatness);

  dot_size# = 8/6 crook_fatness#;
  define_whole_blacker_pixels (dot_size);

  penpos1 (crook_thinness, 0);
  penpos2 (crook_fatness, -90);
  z1 = (-radius, 0);
  z2 = (0, radius);

  pat := z2l{left}
         .. z1l{dir (-alpha - 90)}
         .. {dir (90 - alpha)}z1r
         .. {right}z2r;
  pat := pat
         -- reverse pat xscaled -1 shifted (-feta_eps, 0)
         -- cycle;
  fill pat;

  pickup pencircle scaled dot_size;
  x4 = 0;
  bot y4 = vround (-crook_thinness / 2);
  drawdot z4;
enddef;


fet_beginchar ("fermata up", "ufermata");
  draw_fermata;
  penlabels (1, 2, 4);
fet_endchar;


fet_beginchar ("fermata down", "dfermata");
  draw_fermata;
  y_mirror_char;
fet_endchar;


def draw_henze_short_fermata =
  save alpha, radius, crook_thinness, crook_fatness, dot_size;
  save pat;
  path pat;

  % [Wanske] and some Baerenreiter editions
  % suggest about 80 degrees instead of a half-circle
  alpha := 10;

  radius# = 1.25 staff_space#;
  crook_thinness# = 1.5 linethickness#;
  crook_fatness# = 0.25 staff_space# + 1.5 linethickness#;

  dot_size# = 8/6 crook_fatness#;

  radius# + crook_fatness# / 2 = h#;
  radius# + crook_thinness# / 2 = w#;

  % The width of the character to the right is dot_size# / 2
  % but the fermata should be “centered” with the dot above the
  % note so the box is made wider here.
  set_char_box (w#, w#, crook_thinness# / 2, h#);

  define_pixels (radius, crook_thinness, crook_fatness);

  define_whole_blacker_pixels (dot_size);

  penpos1 (crook_thinness, 0);
  penpos2 (crook_fatness, -90);
  z1 = (-radius, 0);
  z2 = (0, radius);
  x5 = x6 = x2 + crook_thinness / 2;
  y5 = y2l - crook_thinness / 2;
  y6 = y2r + crook_thinness / 2;

  pat := z2l{left}
         .. z1l{dir (-alpha - 90)}
         .. {dir (90 - alpha)}z1r
         .. {right}z2r
         .. z6{up}
         .. {up}z5
         .. cycle;
  fill pat;

  pickup pencircle scaled dot_size;
  x4 = 0;
  bot y4 = vround (-crook_thinness / 2);
  drawdot z4;
enddef;


fet_beginchar ("Henze short fermata up", "uhenzeshortfermata");
  draw_henze_short_fermata;
  penlabels (1, 2, 4);
fet_endchar;


fet_beginchar ("Henze short fermata down", "dhenzeshortfermata");
  draw_henze_short_fermata;
  y_mirror_char;
fet_endchar;


def draw_henze_long_fermata =
  save alpha, radius, crook_thinness, crook_fatness, dot_size;
  save pat;
  path pat;

  % [Wanske] and some Baerenreiter editions
  % suggest about 80 degrees instead of a half-circle
  alpha := 10;

  radius# = 1.25 staff_space#;
  crook_thinness# = 1.5 linethickness#;
  crook_fatness# = 0.25 staff_space# + 1.5 linethickness#;

  radius# + crook_fatness# / 2 = h#;
  radius# + crook_thinness# / 2 = w#;

  set_char_box (w#, w#, crook_thinness# / 2, h#);

  define_pixels (radius, crook_thinness, crook_fatness);

  dot_size# = 8/6 crook_fatness#;
  define_whole_blacker_pixels (dot_size);

  penpos1 (crook_thinness, 0);
  penpos2 (crook_fatness, -90);
  z1 = (-radius, 0);
  z2 = (0, radius);

  pat := z2l{left}
         .. z1l{dir (-alpha - 90)}
         .. {dir (90 - alpha)}z1r
         .. {right}z2r;
  pat := pat
         -- reverse pat xscaled -1 shifted (-feta_eps, 0)
         -- cycle;
  fill pat;

  pickup pencircle scaled dot_size;
  x4 = -x5 = 0.8 dot_size;
  bot y4 = vround (-crook_thinness / 2);
  y4 = y5;
  drawdot z4;
  drawdot z5;
enddef;


fet_beginchar ("Henze long fermata up", "uhenzelongfermata");
  draw_henze_long_fermata;
  penlabels (1, 2, 4);
fet_endchar;


fet_beginchar ("Henze long fermata down", "dhenzelongfermata");
  draw_henze_long_fermata;
  y_mirror_char;
fet_endchar;


def draw_short_fermata =
  save fat_factor, thinness, dot_size;
  save left_dist, right_dist, se, ne;
  pair left_dist, right_dist, se, ne;

  set_char_box (staff_space#, staff_space#, 0, 2.2 staff_space#);

  dot_size# = 0.266 staff_space# + 2.666 linethickness#;
  define_whole_blacker_pixels (dot_size);

  fat_factor = .11;
  thinness = 1.5 linethickness;

  pickup pencircle scaled thinness;

  rt x2 = w;
  lft x5 = -b;
  bot y5 = 0;
  top y3 = h;
  y1 = y2 = y5;

  x3 = 0;
  z1 - z4 = whatever * (charwd, -charht);
  z4 = fat_factor [z3, z5];

  ne = unitvector (z3 - z5);
  se = unitvector (z2 - z3);

  left_dist = (ne rotated 90) * 0.5 thinness;
  right_dist = (se rotated 90) * 0.5 thinness;

  fill bot z5{right}
       .. (z5 - left_dist){ne}
       -- (((z5 - left_dist) -- (z3 - left_dist)) intersectionpoint
           ((z1 - right_dist) -- (z4 - right_dist)))
       -- (z1 - right_dist){se}
       .. bot z1{right}
       -- bot z2{right}
       .. (z2 + right_dist){-se}
       -- (z3 + right_dist){-se}
       .. top z3
       .. (z3 + left_dist){-ne}
       -- (z5 + left_dist){-ne}
       .. cycle;

  pickup pencircle scaled dot_size;

  x1 - 2 x6 = x2;
  x6 := vround (x6);
  bot y6 = -d;

  drawdot z6;
enddef;

fet_beginchar ("short fermata up", "ushortfermata");
  draw_short_fermata;
  labels (1, 2, 3, 4, 5, 6);
fet_endchar;


fet_beginchar ("short fermata down", "dshortfermata");
  draw_short_fermata;
  xy_mirror_char;
fet_endchar;


def draw_very_short_fermata =
  save fat_factor, thinness, dot_size;
  save inner_factor, x_gap, inner_fat_factor;
  save left_dist, right_dist, se, ne;
  pair left_dist, right_dist, se, ne;

  set_char_box (1.25 staff_space#, 1.25 staff_space#, 0, 1.1 * 2.2 staff_space#);

  % the same as in draw_very_long_fermata
  dot_size# = 0.48 staff_space#;
  define_whole_blacker_pixels (dot_size);

  fat_factor = .11;
  thinness = 1.5 linethickness;

  pickup pencircle scaled thinness;

  rt x2 = w;
  lft x5 = -b;
  bot y5 = 0;
  top y3 = h;
  y1 = y2 = y5;

  x3 = 0;
  z1 - z4 = whatever * (charwd, -charht);
  z4 = fat_factor [z3, z5];

  x_gap = 0.2 staff_space; % TODO: is this correct?
  inner_fat_factor = 0.6 fat_factor;

  x11 - x8 = inner_factor * (x5 - x2);
  rt x8 = lft x1 - 1.2 x_gap;
  lft x11 = rt x5 + x_gap;
  bot y11 = 0;
  y7 = y8 = y11;

  z9 - z8 = whatever * (z3 - z2);
  z9 - z11 = whatever * (z3 - z5);
  z7 - z10 = whatever * (charwd, -charht);
  z10 = inner_fat_factor [z9, z11];

  ne = unitvector (z3 - z5);
  se = unitvector (z2 - z3);

  left_dist = (ne rotated 90) * 0.5 thinness;
  right_dist = (se rotated 90) * 0.5 thinness;

  fill bot z5{right}
       .. (z5 - left_dist){ne}
       -- (((z5 - left_dist) -- (z3 - left_dist)) intersectionpoint
           ((z1 - right_dist) -- (z4 - right_dist)))
       -- (z1 - right_dist){se}
       .. bot z1{right}
       -- bot z2{right}
       .. (z2 + right_dist){-se}
       -- (z3 + right_dist){-se}
       .. top z3
       .. (z3 + left_dist){-ne}
       -- (z5 + left_dist){-ne}
       .. cycle;

  fill bot z11{right}
       .. (z11 - left_dist){ne}
       -- (((z11 - left_dist) -- (z9 - left_dist)) intersectionpoint
           ((z7 - right_dist) -- (z10 - right_dist)))
       -- (z7 - right_dist){se}
       .. bot z7{right}
       -- bot z8{right}
       .. (z8 + right_dist){-se}
       -- (z9 + right_dist){-se}
       .. top z9
       .. (z9 + left_dist){-ne}
       -- (z11 + left_dist){-ne}
       .. cycle;

  pickup pencircle scaled dot_size;

  %x7 - 2 x6 = x8;
  x6 = 0.5 [x7, x11];
  x6 := vround (x6);
  bot y6 = -d;

  drawdot z6;
enddef;

fet_beginchar ("very short fermata up", "uveryshortfermata");
  draw_very_short_fermata;
  labels (1, 2, 3, 4, 5, 6);
fet_endchar;


fet_beginchar ("very short fermata down", "dveryshortfermata");
  draw_very_short_fermata;
  xy_mirror_char;
fet_endchar;


def draw_long_fermata =
  save stemthick, beamheight, dot_size, wd;
  save pat;
  path pat;

  wd# = 2.5 staff_space#;
  stemthick = hround (1.5 linethickness);
  beamheight = 0.3 staff_space + linethickness;
  dot_size# = 0.266 staff_space# + 2.666 * linethickness#;
  define_pixels (wd);
  define_whole_blacker_pixels (dot_size);

  set_char_box (wd# / 2, wd# / 2, 0, 3/2 staff_space#);

  pickup pencircle scaled blot_diameter;

  top y1 = h;
  lft x1 = -b;

  pat := top z1{left}
         .. {down}lft z1;

  pickup pencircle scaled stemthick;

  x2 = -b + stemthick;
  y2 = h - beamheight;
  lft x3 = -b;
  bot y3 = -d;

  pat := pat
         -- lft z3
         .. bot z3
         .. rt z3
         -- z2;
  pat := pat
         -- reverse pat xscaled -1 shifted (-feta_eps, 0)
         -- cycle;

  fill pat;

  pickup pencircle scaled dot_size;

  x4 = 0;
  bot y4 = -d;

  drawdot z4;
enddef;


fet_beginchar ("long fermata up", "ulongfermata");
  draw_long_fermata;
  labels (1, 2, 3, 4);
fet_endchar;


fet_beginchar ("long fermata down", "dlongfermata");
  draw_long_fermata;
  y_mirror_char;
fet_endchar;


def draw_very_long_fermata =
  save ibeamheight, obeamheight;
  save ihwd, ohwd, iht, oht;        % inner/outer half_width/height
  save stemthick, dot_size;
  save opat, ipat;
  path opat, ipat;

  ihwd# = 1.0 staff_space#;
  ohwd# = 1.5 staff_space#;
  iht# = 0.9 staff_space#;
  oht# = 1.6 staff_space#;
  define_pixels (ihwd, ohwd, iht, oht)

  stemthick = hround (1.5 linethickness);
  ibeamheight# = 0.3 staff_space#;
  obeamheight# = 0.5 staff_space#;
  define_pixels (ibeamheight, obeamheight);

  dot_size# = (iht# - ibeamheight#) * 8/10;
  define_whole_blacker_pixels (dot_size);

  set_char_box (ohwd#, ohwd#, 0, oht#);

  pickup pencircle scaled blot_diameter;

  top y1 = oht;
  lft x1 = -ohwd;
  top y11 = iht;
  lft x11 = -ihwd;

  opat := top z1{left}
          .. {down}lft z1;
  ipat := top z11{left}
          .. {down}lft z11;

  pickup pencircle scaled stemthick;

  x2 = -ohwd + stemthick;
  y2 = oht - obeamheight;
  lft x3 = -ohwd;
  bot y3 = 0;
  x12 = -ihwd + stemthick;
  y12 = iht - ibeamheight;
  lft x13 = -ihwd;
  bot y13 = 0;

  opat := opat
          -- lft z3
          .. bot z3
          .. rt z3
          -- z2;
  opat := opat
          -- reverse opat xscaled -1 shifted (-feta_eps, 0)
          -- cycle;
  ipat := ipat
          -- lft z13
          .. bot z13
          .. rt z13
          -- z12;
  ipat := ipat
          -- reverse ipat xscaled -1 shifted (-feta_eps, 0)
          -- cycle;

  fill opat;
  fill ipat;

  pickup pencircle scaled dot_size;

  x4 = 0;
  bot y4 = -d;

  drawdot z4;
enddef;


fet_beginchar ("very long fermata up", "uverylongfermata");
  draw_very_long_fermata;
  labels (1, 2, 3, 11, 12, 13, 4);
fet_endchar;


fet_beginchar ("very long fermata down", "dverylongfermata");
  draw_very_long_fermata;
  y_mirror_char;
fet_endchar;


%
% Thumbs are used in cello music.
% TODO : thumbs should look like the finger-font and should be placed in
% the same way in the score.
%

fet_beginchar ("thumb", "thumb");
  save thin, height, width, thick, depth;
  height# = 5/4 width#;
  height# = staff_space#;
  depth# = 1.6 (height# / 2);

  set_char_box (width# / 2, width# / 2, depth#, height# / 2);

  define_pixels (height, width);

  thin = .6 linethickness + 0.06 staff_space;
  2 thick + 0.5 (height - 2 thin) = width;

  penpos1 (thick, 0);
  penpos2 (thin, 90);
  penpos3 (thick, 180);
  penpos4 (thin, 270);
  z1r = (w, 0);
  z2r = (0, h);
  z3r = (-w, 0);
  z4r = (0, -h);

  penlabels (1, 2, 3, 4);

  penstroke z1e{up}
            .. z2e{left}
            .. z3e{down}
            .. z4e{right}
            .. cycle;

  save brush_thick;
  y5 = -d + brush_thick / 2;
  brush_thick = 0.9 thick;
  x5 = 0;

  labels (5);

  draw_brush (z4r, 1.4 thin, z5, brush_thick, 0);
fet_endchar;


def draw_accent (expr bottom_left, top_right, thickness, diminish) =
  save thinning_start;
  thinning_start = 0.4;
  pickup pencircle scaled thickness;

  lft x1 = xpart bottom_left;
  top y1 = ypart top_right;
  lft x6 = xpart bottom_left;
  bot y6 = ypart bottom_left;

  rt z4 = (xpart top_right, (ypart top_right + ypart bottom_left) / 2);
  x5 = x3 = thinning_start [xpart top_right, xpart bottom_left]
            - linethickness + 0.1 staff_space;
  z3 = whatever [z1, z4];
  z5 = whatever [z6, z4];

  penpos1 (thickness, angle (z3 - z1) + 90);
  penpos3 (thickness, angle (z3 - z1) + 90);
  penpos4 (thickness, angle (z3 - z1) + 90);
  penpos4' (thickness, angle (z6 - z5) + 90);
  penpos5 (thickness, angle (z6 - z5) + 90);
  penpos6 (thickness, angle (z6 - z5) + 90);

  x4 - x7 = diminish * thickness;
  y7 = y4;
  z4' = z4;

  fill z1l
       -- z3l
       -- z7
       -- z5l
       -- z6l
       .. lft z6{down}
       .. bot z6{right}
       .. z6r
       -- z4'r
       .. rt z4{up}
       .. z4r
       -- z1r
       .. top z1{left}
       .. lft z1{down}
       .. cycle;
enddef;


fet_beginchar ("wedge accent", "sforzato");
  set_char_box (0.75 staff_space#, 0.75 staff_space#,
                0.42 staff_space#, 0.42 staff_space#);

  draw_accent ((-w, -d), (w, h),
               0.05 staff_space + linethickness, 0.7);
  penlabels (1, 3, 4, 4', 5, 6);
  labels (7);
fet_endchar;


fet_beginchar ("espr", "espr");
  set_char_box (1.9 staff_space#, 1.9 staff_space#,
                .5 staff_space#, .5 staff_space#);

  draw_accent ((w - 1.78 staff_space, -d), (w, h),
               0.05 staff_space + linethickness, 0.6);
  addto currentpicture also currentpicture xscaled -1;
fet_endchar;


fet_beginchar ("staccato dot", "staccato");
  save radius;
  radius# = 0.20 * staff_space#;
  define_whole_pixels (radius);

  pickup pencircle scaled 2 radius;
  drawdot (0, 0);

  set_char_box (radius#, radius#, radius#, radius#);
fet_endchar;


def draw_staccatissimo (expr show_labels) =
  save radius, height;
  height# = .8 staff_space#;
  radius# = linethickness# + .1 staff_space#;
  define_whole_blacker_pixels (radius);
  define_pixels (height);

  draw_brush ((0, 0), linethickness, (0, height), 2 radius, show_labels);

  set_char_box (radius#, radius#,
                blot_diameter# / 2, height# + radius#);
enddef;


fet_beginchar ("staccatissimo/martellato up", "ustaccatissimo");
  draw_staccatissimo (1);
fet_endchar;


fet_beginchar ("staccatissimo/martellato down", "dstaccatissimo");
  draw_staccatissimo (0);
  y_mirror_char;
fet_endchar;


fet_beginchar ("portato/single tenuto", "tenuto");
  save thick;
  thick# = 1.6 linethickness#;
  define_whole_blacker_pixels (thick);

  set_char_box (.6 staff_space#, .6 staff_space#,
                thick# / 2, thick# / 2);

  draw_rounded_block ((-b, -thick / 2), (w, thick / 2), thick);
fet_endchar;


def draw_portato =
  save thick, dot_size;
  thick# = 1.4 linethickness#;
  dot_size# = 2.4 linethickness# + 0.08 staff_space#;
  define_whole_blacker_pixels (thick, dot_size);

  set_char_box (.6 staff_space#, .6 staff_space#,
                thick# / 2, .5 staff_space# + .5 dot_size#);

  draw_rounded_block ((-b, -thick / 2), (w, thick / 2), thick);

  pickup pencircle scaled dot_size;
  drawdot (0, h);
enddef;


fet_beginchar ("portato/tenuto with staccato", "uportato");
  draw_portato;
fet_endchar;


fet_beginchar ("portato/tenuto with staccato", "dportato");
  draw_portato;
  y_mirror_char
fet_endchar;


def draw_marcato =
  save fat_factor, thinness;
  save left_dist, right_dist, ne, se;
  pair left_dist, right_dist, ne, se;

  set_char_box (staff_space# / 2, staff_space# / 2,
                0, 1.1 staff_space#);

  fat_factor = .3;
  thinness = linethickness;

  pickup pencircle scaled thinness;

  rt x2 = w;
  lft x5 = -b;
  bot y5 = 0;
  top y3 = h;
  y1 = y2 = y5;

  x3 =0;
  z1 - z4 = whatever * (charwd, -charht);
  z4 = fat_factor [z3, z5];

  ne = unitvector (z3 - z5);
  se = unitvector (z2 - z3);

  left_dist = (ne rotated 90) * 0.5 thinness;
  right_dist = (se rotated 90) * 0.5 thinness;

  fill bot z5{right}
       .. (z5 - left_dist){ne}
       -- (((z5 - left_dist) -- (z3 - left_dist)) intersectionpoint
           ((z1 - right_dist) -- (z4 - right_dist)))
       -- (z1 - right_dist){se}
       .. bot z1{right}
       -- bot z2{right}
       .. (z2 + right_dist){-se}
       -- (z3 + right_dist){-se}
       .. top z3
       .. (z3 + left_dist){-ne}
       -- (z5 + left_dist){-ne}
       .. cycle;
enddef;


fet_beginchar ("marcato up", "umarcato");
  draw_marcato;
  labels (1, 2, 3, 4, 5);
fet_endchar;


%
% The down marcato char (not very much used).
% Contrary to what some MF/TeX `gurus' believe
% it is *point*-symmetric with the "up" version
%

fet_beginchar ("marcato down", "dmarcato");
  draw_marcato;
  xy_mirror_char;
fet_endchar;


%
% used in french horn music todo
%
% TODO: too light at 20pt
%

fet_beginchar ("open (unstopped)", "open");
  save thin, height, width, thick;

  height# = 5/4 width#;
  height# = staff_space#;
  thin = .6 linethickness + 0.06 staff_space;

  set_char_box (width# / 2, width# / 2, height# / 2, height# / 2);

  define_pixels (width, height);

  2 thick + 0.6 (height - 2 thin) = width;

  penpos1 (thick, 0);
  penpos2 (thin, 90);
  penpos3 (thick, 180);
  penpos4 (thin, 270);
  z1r = (w, 0);
  z2r = (0, h);
  z3r = (-w, 0);
  z4r = (0, -h);

  penlabels (1, 2, 3, 4);

  penstroke z1e{up}
            .. z2e{left}
            .. z3e{down}
            .. z4e{right}
            .. cycle;
fet_endchar;


fet_beginchar ("halfopen (unstopped)", "halfopen");
  save thin, height, width, thick, factor, slash;

  factor = 5/4;
  height# = 5/4 width#;
  height# = staff_space#;
  thin = 0.6 linethickness + 0.06 staff_space;
  slash# = 1.05 linethickness#;

  set_char_box (width# / 2, width# / 2, height# / 2, height# / 2);

  define_pixels (width, height, slash);

  2 thick + 0.6 (height - 2 thin) = width;

  penpos1 (thick, 0);
  penpos2 (thin, 90);
  penpos3 (thick, 180);
  penpos4 (thin, 270);
  z1r = (w, 0);
  z2r = (0, h);
  z3r = (-w, 0);
  z4r = (0, -h);

  penlabels (1, 2, 3, 4);

  penstroke z1e{up}
            .. z2e{left}
            .. z3e{down}
            .. z4e{right}
            .. cycle;

  draw_brush ((-w * factor, -h * factor), slash,
              (w * factor, h * factor), slash,
              1);
fet_endchar;


fet_beginchar ("halfopen vertical", "halfopenvertical");
  save thin, height, width, thick, factor, slash;

  factor := 3/2;
  height# = 5/4 width#;
  height# = staff_space#;
  thin = 0.6 linethickness + 0.06 staff_space;
  slash# = 1.05 linethickness#;

  set_char_box (width# / 2, width# / 2,
                height# / 2, height# / 2);

  define_pixels (width, height, slash);

  2 thick + 0.6 (height - 2 thin) = width;

  penpos1 (thick, 0);
  penpos2 (thin, 90);
  penpos3 (thick, 180);
  penpos4 (thin, 270);
  z1r = (w, 0);
  z2r = (0, h);
  z3r = (-w, 0);
  z4r = (0, -h);

  penlabels (1, 2, 3, 4);

  penstroke z1e{up}
            .. z2e{left}
            .. z3e{down}
            .. z4e{right}
            .. cycle;

  draw_brush ((0, -h * factor), slash,
              (0, h * factor), slash,
              1);
fet_endchar;


fet_beginchar ("plus (stopped)", "stopped");
  save hthick, vthick, size, outer_hsize, outer_vsize;

  hthick# = vthick# = 2 linethickness#;
  size# = 1.1 staff_space#;
  define_whole_blacker_pixels (vthick);
  define_whole_vertical_blacker_pixels (hthick);

  set_char_box (size# / 2, size# / 2, size# / 2, size# / 2);

  outer_hsize = hround ((b + w - vthick) / 2);
  outer_vsize = vround ((h + d - hthick) / 2);
  w := b := (2 outer_hsize + vthick) / 2;
  h := d := (2 outer_vsize + hthick) / 2;

  draw_rounded_block ((-b, -d + outer_vsize),
                      (w, -d + outer_vsize + hthick), hthick);
  draw_rounded_block ((-b + outer_hsize, -d),
                      (-b + outer_hsize + vthick, h), vthick);
fet_endchar;


fet_beginchar ("upbow", "upbow");
  save ht, wd, thick;

  thick = 1.4 linethickness;
  wd# = 1.3 staff_space#;
  ht# = 1.6 wd#;

  set_char_box (wd# / 2, wd# / 2, 0, ht#);

  draw_accent ((-h, -w), (0, w), thick, 0.9);
  currentpicture := currentpicture rotated -90;
fet_endchar;


fet_beginchar ("downbow", "downbow");
  save stemthick, beamheight, wd;
  save pat;
  path pat;

  wd# = 1.5 staff_space#;
  define_pixels (wd);

  stemthick = hround (1.2 linethickness);

  set_char_box (wd# / 2, wd# / 2, 0, 4/3 staff_space#);

  beamheight = 4/10 h;

  pickup pencircle scaled blot_diameter;

  top y1 = h;
  lft x1 = -b;

  pat := top z1{left}
         .. {down}lft z1;

  pickup pencircle scaled stemthick;

  x2 = -b + stemthick;
  y2 = h - beamheight;
  lft x3 = -b;
  bot y3 = -d;

  pat := pat
         -- lft z3
         .. bot z3
         .. rt z3
         -- z2;
  pat := pat
         -- reverse pat xscaled -1 shifted (-feta_eps, 0)
         -- cycle;

  fill pat;

  labels (1, 2, 3);
fet_endchar;

%
% Inspired by a computer-set version of Auf dem Strom by Baerenreiter.
%

def draw_turn (expr height_factor, thicker_center) =
  save thin, thick, ball_diam, darkness;
  save wd, ht, thick_nibangle, ball_nib_thick;
  save turndir;
  pair turndir;

  wd# = 35/16 staff_space#;
  ht# = 18/17 staff_space#;
  darkness = 0.3 linethickness + 0.09 staff_space;

  set_char_box (wd# / 2, wd# / 2,
                ht# / 2 * height_factor, ht# / 2 * height_factor);

  thick_nibangle = 60;
  thick = 3 darkness;
  thin = darkness;
  ball_nib_thick = 2.7 darkness;
  ball_diam = ball_nib_thick + (h / height_factor - ball_nib_thick) / 10;

  x3l = w;
  y3 = 0;
  y4l = h / height_factor;
  x4 = x2;
  x2l = w / 2;
  y2l = -d / height_factor;
  z1 = (0,0);
  x5r = x4;
  y5r = y4l - ball_diam / 2;
  z6r = z5r;

  penpos1 (thicker_center * thick, thick_nibangle);
  penpos2 (thick, thick_nibangle);
  penpos3 (thin, 180);
  penpos4 (ball_nib_thick, -90);
  penpos5 (1.6 ball_diam / 2, 10);
  penpos6 (ball_diam / 2, 150);

  save pata, patb, swoosh;
  path pata, patb, swoosh;
  numeric ta, tb;
  pata := z1l{curl 0}
          .. z2l{right}
          .. z3l{up}
          .. {left}z4l
          .. z5l
          .. z6l;
  patb := z4r
          .. z3r{down}
          .. z2r{left};
  (ta, tb) = pata intersectiontimes patb;
  swoosh := subpath (0, ta) of pata
            -- subpath (tb, 2) of patb;

  fill swoosh
       .. swoosh scaled -1 shifted (-feta_eps, -feta_eps)
       .. cycle;
enddef;


fet_beginchar ("reverse turn", "reverseturn");
  draw_turn (1, 1.1);
  currentpicture := currentpicture yscaled -1;
fet_endchar;


fet_beginchar ("turn", "turn");
  draw_turn (1, 1.1);
  penlabels (1, 2, 3, 4, 5, 6, 7);
fet_endchar;


fet_beginchar ("slashed turn", "slashturn");
  draw_turn (4 / 3, 0.96);

  clearxy;

  pickup pencircle scaled turn_stemwidth;

  top y1 = h;
  bot y2 = -d;
  x1 = x2;
  x2 = 0;

  draw_gridline (z2, z1, turn_stemwidth);
fet_endchar;


def draw_haydnturn (expr height_factor) =
  save thin, thick, darkness;
  save wd, ht, thick_nibangle;

  wd# = 2 staff_space#;
  ht# = 3 / 5 staff_space#;
  set_char_box (wd# / 2, wd# / 2,
                ht# / 2 * height_factor, ht# / 2 * height_factor);

  darkness = 0.3 linethickness + 0.09 staff_space;

  thick_nibangle = 60;
  thick = 3 darkness;
  thin = darkness;

  x3l = w;
  y3 = h / height_factor - thin / 2;
  x2l = w / 3;
  y2l = -d / height_factor;
  z1 = (0,0);

  penpos1 (1.1 thick, thick_nibangle);
  penpos2 (thick, thick_nibangle);
  penpos3 (thin, 150);

  path swoosh;
  swoosh := z1l{curl 0}
            .. z2l
            .. z3l{dir (60)}
            .. z3r{dir (240)}
            .. z2r{left};
  fill swoosh
       .. swoosh scaled -1 shifted (-feta_eps, -feta_eps)
       .. cycle;

  pickup pencircle scaled turn_stemwidth;

  top y4 = h;
  bot y5 = -d;
  x4 = x5;
  x5 = 0;

  draw_gridline (z5, z4, turn_stemwidth);
enddef;

fet_beginchar ("Haydn ornament", "haydnturn");
  draw_haydnturn (2);
  penlabels (1, 2, 3);
  labels (4, 5);
fet_endchar;


%
% Inspired by a (by now) PD edition of Durand & C'ie edition of
% Saint-Saens' Celloconcerto no. 1
%
% FIXME take out hardcoded vars.
% FIXME the two loops on the `t' should be smoother (and the left one bigger).
% FIXME generic macros for serifs: top of the t and bottom of r
%

fet_beginchar ("trill (`tr')", "trill");
  save start_nib_angle, ascender_extra, ex, hair_thick, fatness;
  save slant, t_fatness, r_fatness, kerning, t_overshoot;
  save uitschieter, bulb_size, krul_ang;
  save u, v;

  ascender_extra# = 1/2 ex#;
  ascender# = ascender_extra# + ex#;
  ex# = 1.4 staff_space#;
  kerning# = 0.6 ex#;
  start_nib_angle = 20;
  bulb_size = 0.8;
  define_pixels (ex, ascender_extra, ascender, kerning);

  t_overshoot = 0.03 ex;
  fatness = 12/40 ex;
  t_fatness = 0.78 fatness;
  t_width =  1.9 t_fatness;
  r_fatness = 0.78 fatness;
  uitschieter = 0.48 ex;
  hair_thick = linethickness;
  r_flare = .5 hair_thick + 0.25 r_fatness;
  r_width =  2 r_fatness + 0.25 kerning;
  slant = .2;

  local_copy (transform)(currenttransform);
  currenttransform := currenttransform slanted slant
                                       shifted (-staff_space, 0);

  set_char_box (.85 staff_space#, .85 staff_space#, 0, ascender#);

  y1 = ascender;

  % try to position in such a way that the center is the visual
  % center

  x1l = 0.2 staff_space;
  x1r - x1l = t_fatness;
  penpos1 (start_nib_wid, start_nib_angle);

  z2 = (x1, 7/18 ex);
  penpos2 (start_nib_wid, start_nib_angle);

  z3l = (x2l + 0.5 t_width, - t_overshoot);

  z4l = (x2l + t_width, 0.23 ex);
  penpos4 (whatever, 180);        % 200
  x4l - x4r = hair_thick;

  x3r = 0.5 [x4r, x2r];
  % 1.7 [x3l, x3r] = x4r;
  y3r - y3l = 0.6 t_fatness;

  save krul_p;
  path krul_p;

  krul_ang = 32;

  pickup pencircle scaled hair_thick;

  z5 = (x2l + t_fatness / 2, 2/3 ex);
  lft x6 = x2l - uitschieter;
  y6 = y5;                  % - 1/20 ex;
  z7 = z5 + whatever * dir krul_ang;
  up_angle = krul_ang;      % = angle (z7-z5)
  x7 = 5/10 kerning + x5;

  krul_p := z4{up}
            ..tension 0.98.. z5
            .. z6
            .. z5{z7 - z5}
            -- z7;

  z4' = point 0.85 of krul_p;
  penpos4' (hair_thick, angle (direction 0.85 of krul_p) + 90);

  % the body of the `t' and the bottom loop
  fill z1r{dir (angle (z1l - z1r) + 30)}
       .. z1l{-dir (angle (z1r - z1l) - 45)}
       -- z2l{down}
       ..tension (1 + .5 slant).. z3l{right}
       .. z4l{up}
       .. z4'l{direction 0.85 of krul_p}
       -- z4'r{-direction 0.85 of krul_p}
       .. z4r{down}
       .. z3r{left}
       ..tension (1.5 + .7 slant).. z2r{up}
       -- cycle;

  z5' = point 1.1 of krul_p;
  penpos5' (hair_thick, angle (direction 1.1 of krul_p) + 90);
  z5'' = point 1.5 of krul_p;
  penpos5'' (hair_thick, angle (direction 1.5 of krul_p) + 90);
  z5''' = point 1.8 of krul_p;
  penpos5''' (hair_thick, angle (direction 1.8 of krul_p) + 90);
  z6 = point 2 of krul_p;
  penpos6 (hair_thick, angle (direction 2 of krul_p) + 90);
  z6' = point 2.3 of krul_p;
  penpos6' (hair_thick, angle (direction 2.3 of krul_p) + 90);
  z6'' = point 2.6 of krul_p;
  penpos6'' (hair_thick, angle (direction 2.6 of krul_p) + 90);
  z6''' = point 2.9 of krul_p;
  penpos6''' (hair_thick, angle (direction 2.9 of krul_p) + 90);
  penpos7 (hair_thick, up_angle + 90);
  z7' = point 3.2 of krul_p;
  penpos7' (hair_thick, angle (direction 3.2 of krul_p) + 90);

  % the left loop
  penstroke z5'e{direction 1.1 of krul_p}
            .. z5''e{direction 1.5 of krul_p}
            .. z5'''e{direction 1.8 of krul_p}
            .. z6e{direction 2 of krul_p}
            .. z6'e{direction 2.3 of krul_p}
            .. z6''e{direction 2.6 of krul_p}
            .. {direction 2.9 of krul_p}z6'''e;

  y9 = 3/4 ex;
  x9 = x1 + kerning;
  penpos9 (r_fatness, 0);

  x10 = x9;
  y10 = -0.3 linethickness;
  penpos10 (r_fatness, 0);

  penpos11 (hair_thick, -4);
  z11r = z9r;

  z13l = (x9l + r_width, y11 - linethickness);
  penpos13 (r_flare, 180);

  z15 = z13r - (bulb_size * r_fatness, 0);
  z14 = 0.5 [z13l, z15] - (0, bulb_size * r_fatness);

  save before, after;
  path before, after;
  before := z13l{up}
            .. {down}z11l;
  after := z9r{up}
           .. z7r{z7' - z7}
           -- z7'r;
  (u, v) = before intersectiontimes after;

  save before_bulb, after_bulb;
  path before_bulb, after_bulb;
  before_bulb := z9r{up}
                 ..tension 0.94.. z13r{down};
  after_bulb := z13l{up}
                ..tension 1.06.. z15{down};
  (u_bulb, v_bulb) = before_bulb intersectiontimes after_bulb;

  % the connection between `t' and `r', the body of the `r',
  % and the bulb
  fill z7'l
       -- z7l{z7 - z7'}
       .. z9l{down}
       -- simple_serif (z10l, z10r, -30)
       -- z9r{up}
       .. subpath (0, u_bulb) of before_bulb
       .. subpath (v_bulb, infinity) of after_bulb
       .. z14
       .. z13l{up}
       .. subpath (0, u) of before
       .. subpath (v, infinity) of after
       -- cycle;

  penlabels (range 1 thru 15);
  penlabels (4', 5', 5'', 5''', 6', 6'', 6''', 7');
fet_endchar;


def draw_heel =
  save radius, thickness;
  save pat;
  path pat;

  radius# := .5 staff_space#;

  set_char_box (radius#, radius#, radius#, 2/3 staff_space#);

  thickness := hround (1.5 linethickness);

  pickup pencircle scaled thickness;

  rt x1 = b;
  top y1 = h;

  x2 =x1;
  y2 = 0;

  x3 = 0;
  bot y3 = -d;

  pat := top z3{right}
         .. lft z2{up}
         -- lft z1
         .. top z1
         .. rt z1
         -- rt z2{down}
         .. bot z3{left};
  pat := pat
         -- reverse pat xscaled -1 shifted (-feta_eps, 0)
         -- cycle;
  fill pat;
enddef;


fet_beginchar ("left heel", "upedalheel");
  draw_heel;
  labels (1, 2, 3);
fet_endchar;


fet_beginchar ("right heel", "dpedalheel");
  draw_heel;
  y_mirror_char;
fet_endchar;


def draw_toe =
  save ht, wd, thickness;

  thickness := 1.5 linethickness;
  ht# := 1.5 staff_space#;
  wd# := 1/3 ht#;
  define_pixels (ht, wd);

  set_char_box (wd#, wd#, 0, ht#);
  draw_accent ((-h, -w), (0, w), thickness, 0.9);
  currentpicture := currentpicture rotated -90;
enddef;


fet_beginchar ("left toe", "upedaltoe");
  draw_toe;
fet_endchar;


fet_beginchar ("right toe", "dpedaltoe");
  draw_toe;
  y_mirror_char;
fet_endchar;


fet_beginchar ("flageolet", "flageolet");
  save height, width, thickness, superness;

  height# = 3/15 staffsize#;
  width# = height#;
  thickness# = 1.25 * blot_diameter#;
  define_pixels (height, width);
  define_whole_blacker_pixels (thickness);

  set_char_box (width# / 2, width# / 2, height# / 2, height# / 2);

  penpos1 (thickness, 90);
  penpos2 (thickness, 180);
  penpos3 (thickness, 270);
  penpos4 (thickness, 0);

  x1 = 0;
  y1r = h;
  x4r = w;
  x2r = -x4r;
  y2 = 0;
  y4 = y2;
  x3 = x1;
  y3r = -y1r;

  penlabels (1, 2, 3, 4);

  % mf doesn't handle pixel dropouts in outline objects, so we use
  % `draw' if not called by mpost
  if known miterlimit:
    penstroke z1e
              .. z2e
              .. z3e
              .. z4e
              .. cycle;
  else:
    pickup pencircle scaled thickness;
    draw z1
         .. z2
         .. z3
         .. z4
         .. cycle;
  fi;
fet_endchar;


%
% TODO:  ARGRGHGH code dup.
%

fet_beginchar ("segno", "segno");
  save thin, thick, ball_diam, darkness, pointheight;
  save wd, ht, thick_nibangle, ball_nib_thick;
  save turndir;
  pair turndir;

  ht# = 3 staff_space#;
  wd# = 2 staff_space#;
  darkness = .08 staff_space + 0.4 linethickness;

  set_char_box (wd# / 2, wd# / 2, ht# / 2, ht# / 2);

  thick_nibangle = 30;
  thick = 3 darkness;
  thin = darkness;
  ball_nib_thick = 2.7 darkness;
  ball_diam = ball_nib_thick + (w - ball_nib_thick) / 10;
  pointheight = 2 linethickness;

  y3l = h;
  2 x3 = x2 + x4;
  x4 = 0;
  y4 = y2;
  y2l = .6 h;
  x2l = -b;
  z1 = (0, 0);
  y5r = y4;
  x5r = x4l - ball_diam / 2;
  z6r = z5r;

  penpos1 (thick, 2 thick_nibangle);
  penpos2 (thick, thick_nibangle);
  penpos3 (thin, -90);
  penpos4 (ball_nib_thick, 180 - thick_nibangle);
  penpos5 (1.6 ball_diam / 2, 100);
  penpos6 (ball_diam / 2, 240);

  save pata, ta, patb, tb, swoosh;
  path pata, patb, swoosh;
  numeric ta, tb;

  pata := z1l{dir (2 thick_nibangle + 90)}
          ..tension 0.95.. z2l{up}
          .. z3l{right}
          .. {down}z4l
          .. z5l
          .. z6l;
  patb := z4r
          .. z3r{left}
          .. z2r{down};

  (ta, tb) = pata intersectiontimes patb;

  swoosh := subpath (0, ta) of pata
            -- subpath (tb, 2) of patb;
  fill swoosh
       .. swoosh scaled -1 shifted (-feta_eps, -feta_eps)
       .. cycle;

  penpos7 (2 thin, 0);
  z7l = (-b, -d);
  penpos8 (2 thin, 0);
  z8r = (w, h);

  penstroke z7e
            -- z8e;

  pickup pencircle scaled 2 thin;
  drawdot (-x2r, pointheight);
  drawdot (x2r, -pointheight);

  penlabels (range 1 thru 8);
fet_endchar;


fet_beginchar ("varied segno", "varsegno");
  save ht, wd, loopdist, loopangle;
  save thin, med, thick;
  save bulbradius, center;
  pair center;

  ht# = 8 staff_space#;
  wd# = 2.5 staff_space#;

  set_char_box (wd# / 2, wd# / 2, ht# / 2, ht# / 2);
  % set_char_box (0, 0, ht# / 2, ht# / 2);

  loopdist = 4/3 staff_space;
  loopangle = 35;

  thick = 1/2 staff_space;
  med = 1/4 staff_space;
  thin = 1/10 staff_space;

  x1 = staff_space;
  y1 = 13/4 staff_space;
  penpos1 (med, 210);

  z2l = (0, 4 staff_space);
  penpos2 (med, 270 - loopangle);

  x3 = -x1;
  y3 = y1 + 1/4 staff_space;
  penpos3 (med, 270 + loopangle);

  center = (0, 2 staff_space);
  z4 = (3/4 staff_space, 2 staff_space)
         rotatedabout (center, 180 - loopangle);
  z5 = 2[z4, center];
  x9 = x4;
  y9 = y4 - 2 loopdist;
  x10 = x5;
  y10 = y5 - 2 loopdist;

  penpos4 (thick, 90 - loopangle);
  penpos5 (thick, 90 - loopangle);
  penpos9 (thick, 90 - loopangle);
  penpos10 (thick, 90 - loopangle);

  z6 = (4/3 staff_space, 4/3 staff_space)
         rotatedabout (2/3 center, -loopangle);
  x11 = x6;
  y11 = y6 - 2 loopdist;

  penpos6 (thin, -loopangle);
  penpos11 (thin, -loopangle);

  z7 = 1/3 center;
  penpos7 (thick, 270 - loopangle);

  z8 = (4/3 staff_space, 0) rotated (180 - loopangle);
  penpos8 (thin, -loopangle);

  z12 = -center;
  penpos12 (thick, 270 - loopangle);

  z1' = 4/3[z1l, z1r];
  bulbradius = length (z1l - z1');
  pickup pencircle scaled 2 bulbradius;

  save se_dir, nw_dir;
  pair se_dir, nw_dir;
  se_dir := dir -loopangle;
  nw_dir := dir (180 - loopangle);

  draw_bulb (-1, z1r, z1l, bulbradius, .8);

  penstroke z1e
            .. z2e
            .. z3e
            ... {se_dir}z4e
            -- z5e{se_dir}
            ... z6e
            ... z7e{nw_dir}
            ... z8e
            ... {se_dir}z9e
            -- z10e{se_dir}
            ... z11e
            ... {nw_dir}z12e;
  addto currentpicture also currentpicture scaled -1;

  penlabels (1, 1', 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);
fet_endchar;


fet_beginchar ("coda", "coda");
  save stickout, thin, thick, codawidth, codaheight;

  stickout# = 0.35 staff_space#;
  codawidth# = 2/3 staff_space#;
  codaheight# = staff_space#;
  define_pixels (codawidth, codaheight);

  set_char_box (codawidth# + stickout#, codawidth# + stickout#,
                codaheight# + stickout#, codaheight# + stickout#);

  thin = 1.2 linethickness;
  0.1 (codaheight - 2 thin) = (codawidth - 2 thick);

  penpos1 (thick, 0);
  penpos2 (thin, -90);
  penpos3 (thick, -180);
  penpos4 (thin, -270);

  x1l = -codawidth;
  y2l = codaheight;
  y1 = 0;
  x2 = 0;
  z3 = -z1;
  z4 = -z2;

  penlabels (1, 2, 3, 4);

  fill z1l{up}
       .. z2l{right}
       .. z3l{down}
       .. z4l{left}
       .. cycle;
  unfill z1r{up}
         .. z2r{right}
         .. z3r{down}
         .. z4r{left}
         .. cycle;

  draw_gridline ((0, -h), (0, h), thin);
  draw_gridline ((-w, 0), (w, 0), thin);
fet_endchar;


fet_beginchar ("varied coda", "varcoda");
  save thin, thick, codawidth, codaheight;
  thin# = 1.2 linethickness#;
  thick# = 1.0 linethickness# + 0.25 staff_space#;
  codawidth# = 2/3 staff_space#;
  codaheight# = staff_space#;
  define_pixels (thin, thick, codawidth, codaheight);

  set_char_box (codawidth# + thick#, codawidth# + thick#,
                codaheight# + thick#, codaheight# + thick#);

  x1 = -codawidth + thick - .5 blot_diameter;
  y1 = y2 - thin;
  x2 = codawidth - thick + .5 blot_diameter;
  y2 = codaheight;
  draw_square_block (z1, z2);

  x3 = -codawidth;
  y3 = -codaheight;
  x4 = x3 + thick;
  y4 = y2;
  draw_block (z3, z4);

  labels (1, 2, 3, 4);

  addto currentpicture also currentpicture scaled -1;

  draw_gridline ((0, -h), (0, h), thin);
  draw_gridline ((-w, 0), (w, 0), thin);
fet_endchar;


def draw_comma =
  save alpha, thick, thin, tip_thin, base_offset;
  save pata, patb;
  path pata, patb;
  save r, d;
  numeric r[], d[];
  save ta, tb;

  alpha := 65;
  thick# := 1/3 staff_space# + 2 linethickness#;
  thin# := 1/3 thick#;
  base_offset# := 0.3 thick#;
  define_whole_blacker_pixels (thick);
  define_pixels (thin, base_offset);
  tip_thin = 0.6 thin;

  r1# := 1.0 thick#;
  r2# := 0.9 thick#;
  r3# := 0.8 thick#;
  define_pixels (r1, r2, r3);

  d1# := 0.5 (r1# - r2#);
  d2# := 0.5 (r2# - r3#);
  define_pixels (d1, d2);

  set_char_box (0,
                0.5 (r1# + r2#),
                thick# - base_offset#,
                0.5 (r1# + r3#) - d1# + base_offset#);

  pata := quartercircle scaled r1
          .. quartercircle rotated 90 scaled r2
                           shifted (0, d1)
          .. quartercircle rotated 180 scaled r3
                           shifted (-d2, d1)
          -- (0.4, -0.5) scaled r3 shifted (-d2, d1);
  pata := pata shifted (w - 0.5 r1, h - 0.5 r1);

  penpos1 (thin, 0);
  pickup pencircle scaled thin;
  rt x1 = w;
  y1 = 0.2 thick + base_offset;

  penpos2 (tip_thin, -alpha);
  pickup pencircle scaled tip_thin;
  bot y2 = -d;
  lft x2 = 0;

  patb := z1l{down}
          ..z2l{dir (270 - alpha)}
          .. lft z2{down}
          .. bot z2{right}
          .. z2r{dir (90 - alpha)}
          .. z1r{up};

  (ta, tb) = pata intersectiontimes patb;

  fill subpath (0, ta) of pata
       .. subpath (tb, length patb) of patb
       -- cycle;
enddef;


fet_beginchar ("right comma", "rcomma");
  draw_comma;
  penlabels (1, 2);
fet_endchar;


fet_beginchar ("left comma", "lcomma");
  draw_comma;
  xy_mirror_char;
fet_endchar;


def draw_varcomma (expr show_labels) =
  save thick, thin, ht, wd, alpha;

  alpha := 35;
  thin# = 1.2 linethickness#;
  thick# = 3 linethickness#;
  ht# = .6 staff_space#;
  wd# = .25 staff_space#;
  define_pixels (thin, thick, ht, alpha);

  set_char_box (wd#, wd#, ht#, ht#);

  z1 = (-b, -d);
  z2 = (w, h);

  draw_brush (z1, thin, z2, thick, show_labels);
enddef;


fet_beginchar ("right varied comma", "rvarcomma");
  draw_varcomma (1);
  labels (1, 2);
fet_endchar;


fet_beginchar ("left varied comma", "lvarcomma");
  draw_varcomma (0);
  xy_mirror_char;
fet_endchar;


def draw_altcomma =
  save alpha, thick, thin, ht;

  alpha := 35;
  thin# = 1.2 linethickness#;
  thick# = 3 linethickness#;
  ht# = .6 staff_space#;
  define_pixels (thin, thick, ht);

  set_char_box (0, .5 staff_space#, ht#, ht#);

  penpos1 (thick, alpha);
  penpos2 (thick, alpha + 90);
  penpos3 (thin, 180 - alpha);
  penpos4 (thin, 90 - alpha);

  x3r = 0;
  x1l = x3l;
  y2r = -y4l = h;
  z1 = z2;
  z3 = z4;

  fill z1l{dir (alpha + 90)}
       .. z2r{dir alpha}
       .. z1r{dir (alpha - 90)}
       .. z3l{dir (270 - alpha)}
       .. z4l{dir (180 - alpha)}
       .. z3r{dir (90-alpha)}
       .. cycle;
enddef;


fet_beginchar ("right alternate comma", "raltcomma");
  draw_altcomma;
  penlabels (1, 2, 3, 4);
fet_endchar;


fet_beginchar ("left alternate comma", "laltcomma");
  draw_altcomma;
  xy_mirror_char;
fet_endchar;


thick# := 1/24 designsize;
define_blacker_pixels (thick);

rthin := 0.075 * staff_space + 0.5 linethickness;
rthick := 2 thick + rthin;


def draw_arpeggio =
  save alpha;
  save ne, nw, se, sw;
  save x, y;
  pair ne, nw, se, sw;

  alpha := -40;

  nw = dir (alpha + 180);
  ne = dir (alpha + 90);
  se = dir alpha;
  sw = dir (alpha - 90);

  penpos1 (rthin, alpha + 90);
  penpos2 (5/4 rthick, alpha);
  penpos3 (3/4 rthick, alpha);
  penpos4 (5/4 rthick, alpha);
  penpos5 (rthin, alpha + 90);

  z1 = (width / 2, height) - overshoot * se;
  z2 = 2 [z4, (width / 2, height / 2)];
  z3 = 1/2 [z2, z4];
  x4 = 2/8 staff_space;
  y4 = rthin;

  z5 = 2 [z1, (width / 2, height / 2)];
  z6 = z2l + 1/2 rthin * sw;
  z7 = z4l + 1/2 rthin * sw + 1/2 rthin * se;
  z8 = 2 [z6, (width / 2, height / 2)];
  z9 = 2 [z7, (width / 2, height / 2)];

  fill z1l{se}
       -- z6
       .. z3l
       .. z7{se}
       -- z5l
       .. z5r{nw}
       -- z8
       .. z3r
       .. z9{nw}
       -- z1r
       .. cycle;
enddef;


fet_beginchar ("arpeggio", "arpeggio");
  begingroup;
    save height, overshoot, width;
    height# := staff_space#;
    width# := 0.8 * height#;
    overshoot# := 0.25 * staff_space#;
    define_pixels (height, overshoot, width);
    set_char_box (0, width#, 0, height#);
    draw_arpeggio;
    penlabels (range 1 thru 9);

    draw_staff_if_debugging (-2, 2);
  endgroup;
fet_endchar;


%
% Extendable Trill symbol.
% Not yet used
% Rename me to Trill, rename Trill to Tr?
%

fet_beginchar ("trill element", "trill_element");
  begingroup;
    save height, overshoot, width;
    height# = staff_space#;
    width# = 0.8 height#;
    overshoot# = 0.25 staff_space#;
    define_pixels (height, overshoot, width);

    set_char_box (0, height#, 0, width#);
    draw_arpeggio;

    currentpicture := currentpicture shifted -(width / 2, height / 2);
    currentpicture := currentpicture rotated 90;
    currentpicture := currentpicture shifted (height / 2, width / 2);
  endgroup;
fet_endchar;


%
% Arpeggio arrow by Chris Jackson <chris@fluffhouse.org.uk>
%

def draw_arpeggio_arrow =
  save thinness, height, width, overshoot;
  save nw, ne, se, sw;
  save alpha;
  save before_left, before_right, after_left, after_right;
  save u_left, v_left, u_right, v_right;
  pair nw, ne, se, sw;
  path before_left, before_right, after_left, after_right;

  height# = staff_space#;
  width# = 0.8 height#;
  overshoot# = 0.25 staff_space#;
  define_pixels (height, overshoot, width);

  set_char_box (0, width#, 0, height#);

  alpha := -40;
  nw = dir (alpha + 180);
  ne = dir (alpha + 90);
  se = dir alpha;
  sw = dir (alpha - 90);

  penpos1 (rthin, alpha + 90);
  penpos2 (5/4 rthick, alpha);
  penpos3 (5/4 rthick, 0);

  z1 = (width / 2, height) - overshoot * se; % numbering is consistent
                                             % with the arpeggio symbol
  z2 = 2 [z4, (width / 2, height / 2)];
  z3 = (0.5 width, 0.5 height);
  z4 = (0.25 staff_space, rthin);
  z6 = z2l + 1/2 rthin * sw;
  z9 = (width / 2, height) + overshoot * se;

  pickup pencircle scaled vround (0.5 rthin);

  bot z10 = (0.5 w, 0);
  lft z11 = (0.5 w - hround (0.8 w), 0.8 h);
  rt z12 = (0.5 w + hround (0.8 w), 0.8 h);

  before_left := z1l
                 -- z6{z6 - z1l}
                 .. {down}z3l;
  after_left := (z3 + (0, -0.25 rthin / cosd (angle (nw))))
                -- (z11 + 0.25 rthin * ne);
  (u_left, v_left) = before_left intersectiontimes after_left;

  before_right := (z12 + 0.25 rthin * nw)
                  -- (z3 + (0, -0.25 rthin / cosd (angle (nw))));
  after_right := z3r{up}
                 .. z9{z1r - z9}
                 -- z1r;
  (u_right, v_right) = before_right intersectiontimes after_right;

  fill subpath (0, u_left) of before_left
       .. subpath (v_left, infinity) of after_left
       .. top z11
       .. lft z11
       .. {dir -50}(z11 + 0.25 rthin * sw)
       .. (z10 + 0.25 rthin * sw){dir -70}
       .. bot z10
       .. {dir 70}(z10 + 0.25 rthin * se)
       .. (z12 + 0.25 rthin * se){dir 50}
       .. rt z12
       .. top z12
       .. subpath (0, u_right) of before_right
       .. subpath (v_right, infinity) of after_right
       .. cycle;

  % mf doesn't handle pixel dropouts in outline objects, so we use
  % `draw' if not called by mpost
  if not known miterlimit:
    pickup pencircle scaled 0.7 rthin;
    draw z1
         -- (z9 + 0.5 rthin * dir (alpha - 90));
  fi;
enddef;


fet_beginchar ("arpeggio arrow down", "arpeggio.arrow.M1");
  draw_arpeggio_arrow;
  penlabels (range 1 thru 12);
fet_endchar;


fet_beginchar ("arpeggio arrow up", "arpeggio.arrow.1");
  draw_arpeggio_arrow;
  currentpicture := currentpicture scaled -1
                                   shifted (w - feta_eps, h - feta_eps);
fet_endchar;


% Hmm
input feta-trills;


%
% Railroad tracks.  We define two variants of these -- both as slightly
% tapered, comma-shaped curves and as two straight parallel slashes.
%

fet_beginchar ("curved caesura", "caesura.curved");
  save slant, space_between, clearance;
  save alpha, pat;
  save botthick, topthick;
  save krom;
  path pat;

  botthick = 1.5 linethickness;
  topthick = 2.5 linethickness;

  pickup pencircle scaled botthick;

  slant = 3.5;
  space_between# = 0.6 staff_space#;
  clearance# = 0.2 staff_space#;
  height# = 1.2 staff_space#;

  set_char_box (0, 2.0 staff_space#, staff_space# - clearance#, height#);
  define_pixels (clearance, height);
  define_whole_pixels (space_between);

  bot y1 = -d;
  top y2 = h;

  lft x1 = 0;
  x2 = (y2 - y1) / slant;

  krom = 10;

  alpha = angle (z2 - z1);
  penpos1 (botthick, alpha - krom);
  penpos3 (botthick, alpha - krom + 90);

  penpos2 (topthick, alpha + krom);
  penpos4 (topthick, alpha + krom + 90);

  z3 = z1;
  z4 = z2;

  penlabels (1, 2, 3, 4);

  pat := z3r{(z1r - z1l)}
         .. z4r{z2r-z2l}
         .. z2r{z4l-z4r}
         .. z4l{z2l-z2r}
         .. z3l{z1l-z1r}
         .. z1l{z3r-z3l}
         .. cycle;
  fill pat;
  fill pat shifted (space_between, 0);
fet_endchar;


fet_beginchar ("straight caesura", "caesura.straight");
  save slant, space_between, clearance;
  save thick, ne, pat;
  path pat;
  pair ne;

  slant = 2.0;
  thick = 2.88 linethickness;

  space_between# = 0.56 staff_space#;
  clearance# = 0.2 staff_space#;

  set_char_box (0, 2.0 staff_space#,
                staff_space# - clearance#, 1.2 staff_space#);
  define_whole_pixels (space_between);

  x1 = 0;
  x2 = x1 + thick;
  y1 = y2 = -d;

  x3 = x4 + thick;
  x4 = x1 + (h + d) / slant;
  y3 = y4 = h;

  ne = unitvector (z4 - z1);

  z1a = z1 + blot_diameter * ne;
  z1b = z1 + blot_diameter * right;
  z2a = z2 + blot_diameter * ne;
  z2b = z2 + blot_diameter * left;

  z3a = z3 - blot_diameter * ne;
  z3b = z3 + blot_diameter * left;
  z4a = z4 - blot_diameter * ne;
  z4b = z4 + blot_diameter * right;

  pat = z1a{-ne}
        .. {right}z1b
        -- z2b{right}
        .. {ne}z2a
        -- z3a{ne}
        .. {left}z3b
        -- z4b{left}
        .. {-ne}z4a
        -- cycle;

  fill pat;
  fill pat shifted (space_between, 0);

  labels (range 1 thru 4);
  labels (1a, 1b, 2a, 2b, 3a, 3b, 4a, 4b);
fet_endchar;


% A tick character to use instead of a comma or caesura as a breath mark.
% Very common in vocal notation.

fet_beginchar ("tick mark", "tickmark");
  save end_rad, bot_rad, pat, x_centre, x_extent;
  path pat;

  end_rad = linethickness / 2;
  bot_rad = linethickness;

  x_centre# = 0.6 staff_space#;
  x_extent# = 1.7 staff_space#;

  define_pixels (x_centre, x_extent);

  pickup pencircle scaled end_rad;

  lft x1 = -x_centre;
  y1 = 0.8 staff_space;

  x2 = 0;
  y2l = 0;

  top rt z3 = (x_extent - x_centre, x_extent);

  x4 = lft x1;
  y4 = staff_space;

  penpos2 (0.4 staff_space, 90);
  penpos3 (end_rad, angle (z4 - z3) + 90);
  penpos1 (end_rad, angle (z2 - z1) + 90);

  pat = z1r
        .. top z1
        .. z1l{z2 - z1}
        .. {z2 - (z1 + (0.3 staff_space,0))}z2l + (-bot_rad, bot_rad)
        .. z2l
        .. z2l + (bot_rad, bot_rad){z3 - (0.6 staff_space, 0) - z2}
        .. {z3 - z4}z3r
        .. rt z3
        .. {z4 - z3}z3l
        .. {z2 - (z3 - (0.6 staff_space, 0))}rt z2r
        .. {z1 - z2}lft z2r{z1 - z2}
        .. cycle;
  fill pat;

  set_char_box (x_centre#, x_extent# - x_centre#, 0, x_extent#);

  penlabels (1, 2, 3);
  labels (4);
fet_endchar;


fet_beginchar ("snap pizzicato (Bartok pizzicato)", "snappizzicato");
  save height, width, thickness, superness;

  height# = 4/15 staffsize#;
  width# = height#;
  thickness# = 1.3 linethickness#;
  define_pixels (height, width);
  define_whole_blacker_pixels (thickness);

  set_char_box (width# / 2, width# / 2, height# / 2, height# * 3 / 4);

  penpos1 (thickness, 90);
  penpos2 (thickness, 180);
  penpos3 (thickness, 270);
  penpos4 (thickness, 0);

  x1 = 0;
  y1r = height / 2;
  x3 = x1;
  y3r = -y1r;
  x4r = width / 2;
  y4 = 0;
  x2r = -x4r;
  y2 = y4;

  penlabels (1, 2, 3, 4);

  % mf doesn't handle pixel dropouts in outline objects, so we use
  % `draw' if not called by mpost
  if known miterlimit:
    penstroke z1e
              .. z2e
              .. z3e
              .. z4e
              .. cycle;
  else:
    pickup pencircle scaled thickness;
    draw z1
         .. z2
         .. z3
         .. z4
         .. cycle;
  fi;

  z5 = (0, 0);
  z6 = (x5, 1.5 y1r);

  draw_gridline (z5, z6, thickness);

  labels (5, 6);
fet_endchar;

fet_endgroup ("scripts");