mf/feta-noteheads.mf

   1 % Feta (not the Font-En-Tja) music font -- implement noteheads
   2 % This file is part of LilyPond, the GNU music typesetter.
   3 %
   4 % Copyright (C) 1997--2012 Jan Nieuwenhuizen <janneke@gnu.org>
   5 % & Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 % & Juergen Reuter <reuter@ipd.uka.de>
   7 %
   8 % The LilyPond font is free software: you can redistribute it and/or modify
   9 % it under the terms of the GNU General Public License as published by
  10 % the Free Software Foundation, either version 3 of the License, or
  11 % (at your option) any later version, or under the SIL Open Font License.
  12 %
  13 % LilyPond is distributed in the hope that it will be useful,
  14 % but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 % GNU General Public License for more details.
  17 %
  18 % You should have received a copy of the GNU General Public License
  19 % along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 test_outlines := 0;
  22
  23
  24 save remember_pic;
  25 picture remember_pic;
  26
  27
  28 % Most beautiful noteheads are pronounced, not circular,
  29 % and not even symmetric.
  30 % These examples are inspired by [Wanske]; see literature list.
  31
  32
  33
  34 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  35 % NOTE HEAD VARIABLES
  36 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  37
  38 save half_notehead_width, whole_notehead_width;
  39 save solfa_noteheight;
  40
  41 numeric whole_notehead_width;
  42 numeric half_notehead_width;
  43
  44 fet_begingroup ("noteheads");
  45
  46
  47 %
  48 % solfa heads should not overlap on chords.
  49 %
  50 solfa_noteheight# := staff_space# - stafflinethickness#;
  51
  52 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) =
  53 begingroup
  54         save pat;
  55         path pat;
  56
  57         pat := superellipse ((ellipticity, 0), (0, 1.0),
  58                              (-ellipticity, 0), (0, -1.0),
  59                              superness);
  60         pat := pat rotated tilt;
  61
  62         save top_point, right_point;
  63         pair top_point, right_point;
  64
  65         top_point := directionpoint left of pat;
  66         right_point := directionpoint up of pat;
  67
  68         save height, scaling;
  69
  70         height# = staff_space# + stafflinethickness# - clearance;
  71         scaling# = height# / (2 ypart (top_point));
  72         define_pixels (scaling);
  73         pat := pat scaled scaling shifted (w / 2, .5 (h - d));
  74
  75         if test_outlines = 1:
  76                 draw pat;
  77         else:
  78                 unfill pat;
  79         fi
  80 endgroup;
  81 enddef;
  82
  83
  84 def draw_longa (expr up) =
  85         save stemthick, fudge;
  86
  87         stemthick# = 2 stafflinethickness#;
  88         define_whole_blacker_pixels (stemthick);
  89
  90         % Longas of smaller design sizes should have their lines farther
  91         % apart (the overlap with notehead ellipsoid should be smaller).
  92         fudge = hround (blot_diameter
  93                         * min (max (-0.15,
  94                                     (0.9
  95                                      - (20 / (design_size + 4)))),
  96                                0.3));
  97
  98         draw_outside_ellipse (1.80, 0, 0.707, 0);
  99         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
 100
 101         pickup pencircle scaled stemthick;
 102
 103         % Longas of smaller design sizes should have their lines longer.
 104         line_length := min (max (0.7, (64/60 - (design_size / 60))), 0.85);
 105
 106         % Line lengths between 0.72 and 0.77 are not nice
 107         % because they are neither separate nor connected
 108         % when there is an interval of fourth.
 109         if line_length < 0.75:
 110                 quanted_line_length := min (0.72, line_length);
 111         else:
 112                 quanted_line_length := max (0.77, line_length);
 113         fi;
 114
 115         set_char_box (stemthick#,
 116                       width# + stemthick#,
 117                       staff_space# * quanted_line_length,
 118                       staff_space# * quanted_line_length);
 119
 120         final_line_length := quanted_line_length * staff_space;
 121
 122         if up:
 123                 bot y1 = -final_line_length;
 124                 top y2 = final_line_length;
 125                 rt x1 - fudge = 0;
 126                 x1 = x2;
 127
 128                 fudge + lft x3 = width;
 129                 x4 = x3;
 130                 top y4 = h + 3.0 staff_space;
 131                 y3 = y1;
 132         else:
 133                 bot y1 = -d - 3.0 staff_space;
 134                 top y2 = final_line_length;
 135                 rt x1 - fudge = 0;
 136                 x1 = x2;
 137
 138                 fudge + lft x3 = width;
 139                 x4 = x3;
 140                 y4 = y2;
 141                 bot y3 = -final_line_length;
 142         fi;
 143
 144         draw_gridline (z1, z2, stemthick);
 145         draw_gridline (z3, z4, stemthick);
 146
 147         labels (1, 2, 3, 4);
 148 enddef;
 149
 150
 151 fet_beginchar ("Longa notehead", "uM2");
 152         draw_longa (true);
 153
 154         draw_staff (-2, 2, 0);
 155 fet_endchar;
 156
 157
 158 fet_beginchar ("Longa notehead", "dM2");
 159         draw_longa (false);
 160
 161         draw_staff (-2, 2, 0);
 162 fet_endchar;
 163
 164
 165 if test > 0:
 166         fet_beginchar ("Longa notehead", "uM2");
 167                 draw_longa (true);
 168
 169                 draw_staff (-2, 2, 0.5);
 170         fet_endchar;
 171
 172
 173         fet_beginchar ("Longa notehead", "dM2");
 174                 draw_longa (false);
 175
 176                 draw_staff (-2, 2, 0.5);
 177         fet_endchar;
 178 fi;
 179
 180
 181 def draw_brevis (expr linecount, line_thickness_multiplier) =
 182         save stemthick, fudge, gap;
 183
 184         stemthick# = line_thickness_multiplier * 2 * stafflinethickness#;
 185         define_whole_blacker_pixels (stemthick);
 186
 187         % double-lined breves of smaller design sizes should have
 188         % bigger gap between the lines.
 189         gap# := (0.95 - 0.008 * design_size) * stemthick#;
 190
 191         % Breves of smaller design sizes should have their lines farther
 192         % apart (the overlap with notehead ellipsoid should be smaller).
 193         fudge = hround (blot_diameter
 194                         * min (max (-0.15,
 195                                     (0.8
 196                                      - (20 / (design_size + 4))
 197                                      + .1 linecount)),
 198                                0.3));
 199
 200         draw_outside_ellipse (1.80, 0, 0.707, 0);
 201         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
 202
 203         define_pixels (gap);
 204         pickup pencircle scaled stemthick;
 205
 206         % Breves of smaller design sizes should have their lines longer.
 207         line_length := min (max (0.7, (64/60 - (design_size / 60))), 0.85);
 208
 209         % Line lengths between 0.72 and 0.77 are not nice
 210         % because they are neither separate nor connected
 211         % when there is an interval of fourth.
 212         if line_length < 0.75:
 213                 quanted_line_length := min (0.72, line_length);
 214         else:
 215                 quanted_line_length := max (0.77, line_length);
 216         fi;
 217
 218         set_char_box (stemthick# * linecount + gap# * (linecount - 1),
 219                       width# + stemthick# * linecount + gap# * (linecount - 1),
 220                       staff_space# * quanted_line_length,
 221                       staff_space# * quanted_line_length);
 222
 223         bot y1 = -quanted_line_length * staff_space;
 224         top y2 = quanted_line_length * staff_space;
 225         rt x1 - fudge = 0;
 226         x1 = x2;
 227
 228         fudge + lft x3 = width;
 229         x4 = x3;
 230         y4 = y2;
 231         y3 = y1;
 232
 233         for i := 0 step 1 until linecount - 1:
 234                 line_distance := i * (gap + stemthick);
 235                 draw_gridline (z1 - (line_distance, 0),
 236                                z2 - (line_distance, 0),
 237                                stemthick);
 238                 draw_gridline (z3 + (line_distance, 0),
 239                                z4 + (line_distance, 0),
 240                                stemthick);
 241         endfor;
 242 enddef;
 243
 244
 245 fet_beginchar ("Brevis notehead", "sM1");
 246         draw_brevis (1, 1);
 247
 248         draw_staff (-2, 2, 0);
 249 fet_endchar;
 250
 251
 252 if test > 0:
 253         fet_beginchar ("Brevis notehead", "sM1");
 254                 draw_brevis(1, 1);
 255
 256                 draw_staff (-2, 2, 0.5);
 257         fet_endchar;
 258 fi;
 259
 260
 261 fet_beginchar ("Double-lined brevis notehead", "sM1double");
 262         draw_brevis (2, 0.8);
 263
 264         draw_staff (-2, 2, 0);
 265 fet_endchar;
 266
 267
 268 if test > 0:
 269         fet_beginchar ("Double-lined brevis notehead", "sM1double");
 270                 draw_brevis (2, 0.8);
 271
 272                 draw_staff (-2, 2, 0.5);
 273         fet_endchar;
 274 fi;
 275
 276
 277 fet_beginchar ("Whole notehead", "s0");
 278         draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0);
 279         undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
 280                                0.68, 2 stafflinethickness#);
 281
 282         whole_notehead_width# := charwd;
 283
 284         draw_staff (-2, 2, 0);
 285 fet_endchar;
 286
 287
 288 if test > 0:
 289         fet_beginchar ("Whole notehead", "s0");
 290                 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0,
 291                                       0.707, 0);
 292                 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
 293                                        0.68, 2 stafflinethickness#);
 294
 295                 draw_staff (-2, 2, 0.5);
 296         fet_endchar;
 297 fi;
 298
 299
 300 fet_beginchar ("Half notehead", "s1");
 301         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
 302         undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
 303
 304         half_notehead_width# := charwd;
 305
 306         draw_staff (-2, 2, 0);
 307 fet_endchar;
 308
 309
 310 if test > 0:
 311         fet_beginchar ("Half notehead", "s1");
 312                 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34,
 313                                       0.66, 0.17);
 314                 undraw_inside_ellipse (3.25, 33, 0.81,
 315                                        2.5 stafflinethickness#);
 316
 317                 draw_staff (-2, 2, 0.5);
 318         fet_endchar;
 319 fi;
 320
 321
 322 fet_beginchar ("Quarter notehead", "s2");
 323         draw_quarter_path;
 324         draw_staff (-2, 2, 0);
 325 fet_endchar;
 326
 327
 328 if test > 0:
 329         fet_beginchar ("Quarter notehead", "s2");
 330                 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31,
 331                                       0.707, 0);
 332
 333                 draw_staff (-2, 2, 0.5);
 334         fet_endchar;
 335 fi;
 336
 337
 338 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 339
 340
 341 fet_beginchar ("Whole diamondhead", "s0diamond");
 342         draw_outside_ellipse (1.80, 0, 0.495, 0);
 343         undraw_inside_ellipse (1.30, 125, 0.6,
 344                                .4 staff_space# + stafflinethickness#);
 345
 346         draw_staff (-2, 2, 0);
 347 fet_endchar;
 348
 349
 350 if test > 0:
 351         fet_beginchar ("Whole diamondhead", "s0diamond");
 352                 draw_outside_ellipse (1.80, 0, 0.495, 0);
 353                 undraw_inside_ellipse (1.30, 125, 0.6,
 354                                        .4 staff_space# + stafflinethickness#);
 355
 356                 draw_staff (-2, 2, 0.5);
 357         fet_endchar;
 358 fi;
 359
 360
 361 fet_beginchar ("Half diamondhead", "s1diamond");
 362         draw_outside_ellipse (1.50, 34, 0.49, 0.17);
 363         undraw_inside_ellipse (3.5, 33, 0.80,
 364                                .3 staff_space# + 1.5 stafflinethickness#);
 365
 366         draw_staff (-2, 2, 0);
 367 fet_endchar;
 368
 369
 370 if test > 0:
 371         fet_beginchar ("Half diamondhead", "s1diamond");
 372                 draw_outside_ellipse (1.50, 34, 0.49, 0.17);
 373                 undraw_inside_ellipse (3.5, 33, 0.80,
 374                                        .3 staff_space#
 375                                        + 1.5 stafflinethickness#);
 376
 377                 draw_staff (-2, 2, 0.5);
 378         fet_endchar;
 379 fi;
 380
 381
 382 fet_beginchar ("Quarter diamondhead", "s2diamond");
 383         draw_outside_ellipse (1.80, 35, 0.495, -0.25);
 384
 385         draw_staff (-2, 2, 0);
 386 fet_endchar;
 387
 388
 389 if test > 0:
 390         fet_beginchar ("Quarter diamondhead", "s2diamond");
 391                 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
 392
 393                 draw_staff (-2, 2, 0.5);
 394         fet_endchar;
 395 fi;
 396
 397
 398 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 399
 400
 401 vardef penposx@# (expr d) =
 402 begingroup;
 403         save pat;
 404         path pat;
 405
 406         pat = top z@#
 407               .. lft z@#
 408               .. bot z@#
 409               .. rt z@#
 410               .. cycle;
 411         z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180));
 412         z@#r = pat intersectionpoint (z@# -- infinity * dir (d));
 413 endgroup
 414 enddef;
 415
 416
 417 %
 418 % UGH: xs not declared as argument.
 419 %
 420 def define_triangle_shape (expr stemdir) =
 421         save triangle_a, triangle_b, triangle_c;
 422         save triangle_out_a, triangle_out_b, triangle_out_c;
 423         save triangle_in, triangle_out;
 424         save width, depth, height;
 425         save origin, left_up_dir;
 426         save exact_left_point, exact_right_point, exact_down_point;
 427
 428         path triangle_a, triangle_b, triangle_c;
 429         path triangle_out_a, triangle_out_b, triangle_out_c;
 430         path triangle_in, triangle_out;
 431         pair origin, left_up_dir;
 432         pair exact_down_point, exact_left_point, exact_right_point;
 433
 434         save pen_thick;
 435         pen_thick# = stafflinethickness# + .1 staff_space#;
 436         define_pixels (llap);
 437         define_blacker_pixels (pen_thick);
 438
 439         left_up_dir = llap# * dir (90 + tilt);
 440
 441         xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0;
 442         ypart origin = 0;
 443
 444         exact_left_point := origin + (left_up_dir xscaled xs);
 445         exact_down_point := origin + (left_up_dir rotated 120 xscaled xs);
 446         exact_right_point := origin + (left_up_dir rotated 240 xscaled xs);
 447
 448         height# = ypart (exact_left_point + origin) + pen_thick# / 2;
 449         depth# = -ypart (exact_down_point + origin) + pen_thick# / 2;
 450         width# = xpart (exact_right_point - exact_left_point)
 451                  + pen_thick# * xs;
 452
 453         set_char_box (0, width#, depth#, height#);
 454
 455         % Formerly, the shape has simply been drawn with an elliptical pen
 456         % (`scaled pen_thick xscaled xs'), but the envelope of such a curve
 457         % is of 6th degree.  For the sake of mf2pt1, we approximate it.
 458
 459         pickup pencircle scaled pen_thick xscaled xs;
 460
 461         z0 = (hround_pixels (xpart origin), 0);
 462
 463         z1 = z1' = z0 + llap * dir (90 + tilt) xscaled xs;
 464         z2 = z2' = z0 + llap * dir (90 + tilt + 120) xscaled xs;
 465         z3 = z3' = z0 + llap * dir (90 + tilt + 240) xscaled xs;
 466
 467         z12 = caveness [.5[z1, z2], z3];
 468         z23 = caveness [.5[z2, z3], z1];
 469         z31 = caveness [.5[z3, z1], z2];
 470
 471         triangle_a = z1 .. z12 .. z2;
 472         triangle_b = z2 .. z23 .. z3;
 473         triangle_c = z3 .. z31 .. z1;
 474
 475         penposx1 (angle (direction 0 of triangle_a) - 90);
 476         penposx2 (angle (direction 0 of triangle_b) - 90);
 477         penposx3 (angle (direction 0 of triangle_c) - 90);
 478
 479         penposx1' (angle (direction infinity of triangle_c) + 90);
 480         penposx2' (angle (direction infinity of triangle_a) + 90);
 481         penposx3' (angle (direction infinity of triangle_b) + 90);
 482
 483         penposx12 (angle (z12 - z0));
 484         penposx23 (angle (z23 - z0));
 485         penposx31 (angle (z31 - z0));
 486
 487         z10 = (z0 -- z1) intersectionpoint (z1l .. z12l .. z2'r);
 488         z20 = (z0 -- z2) intersectionpoint (z2l .. z23l .. z3'r);
 489         z30 = (z0 -- z3) intersectionpoint (z3l .. z31l .. z1'r);
 490
 491         triangle_in = z10
 492                       .. z12l
 493                       .. z20
 494                       & z20
 495                       .. z23l
 496                       .. z30
 497                       & z30
 498                       .. z31l
 499                       .. z10
 500                       & cycle;
 501
 502         triangle_out_a = z1r .. z12r .. z2'l;
 503         triangle_out_b = z2r .. z23r .. z3'l;
 504         triangle_out_c = z3r .. z31r .. z1'l;
 505
 506         triangle_out = top z1
 507                        .. lft z1
 508                        .. z1r{direction 0 of triangle_out_a}
 509                        & triangle_out_a
 510                        & {direction infinity of triangle_out_a}z2'l
 511                        .. lft z2
 512                        .. bot z2
 513                        .. z2r{direction 0 of triangle_out_b}
 514                        & triangle_out_b
 515                        & {direction infinity of triangle_out_b}z3'l
 516                        .. rt z3
 517                        .. top z3
 518                        .. z3r{direction 0 of triangle_out_c}
 519                        & triangle_out_c
 520                        & {direction infinity of triangle_out_c}z1'l
 521                        .. cycle;
 522
 523         labels (0, 10, 20, 30);
 524         penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31);
 525
 526         % attachment Y
 527         if stemdir = 1:
 528                 charwy := ypart exact_right_point;
 529                 charwx := xpart exact_right_point + .5 pen_thick# * xs;
 530         else:
 531                 charwy := -ypart exact_down_point;
 532                 charwx := width# - (xpart exact_down_point - .5 pen_thick# * xs);
 533         fi
 534 enddef;
 535
 536
 537 def draw_whole_triangle_head =
 538         save hei, xs;
 539         save llap;
 540         save tilt;
 541
 542         tilt = 40;
 543         llap# = 3/4 noteheight#;
 544
 545         xs = 1.5;
 546         caveness := 0.1;
 547         define_triangle_shape (1);
 548         fill triangle_out;
 549         unfill triangle_in;
 550 enddef;
 551
 552
 553 fet_beginchar ("Whole trianglehead", "s0triangle");
 554         draw_whole_triangle_head;
 555
 556         draw_staff (-2, 2, 0);
 557 fet_endchar;
 558
 559
 560 if test > 0:
 561         fet_beginchar ("Whole trianglehead", "s0triangle");
 562                 draw_whole_triangle_head;
 563
 564                 draw_staff (-2, 2, 0.5);
 565         fet_endchar;
 566 fi;
 567
 568
 569 def draw_small_triangle_head (expr dir) =
 570         save hei, xs;
 571         save llap;
 572         save tilt;
 573
 574         tilt = 40;
 575         llap# = 2/3 noteheight#;
 576         xs = 1.2;
 577         caveness := 0.1;
 578         define_triangle_shape (dir);
 579
 580         pickup feta_fillpen;
 581
 582         filldraw triangle_out;
 583         unfilldraw triangle_in;
 584 enddef;
 585
 586
 587 fet_beginchar ("Half trianglehead (downstem)", "d1triangle");
 588         draw_small_triangle_head (-1);
 589
 590         draw_staff (-2, 2, 0);
 591 fet_endchar;
 592
 593
 594 fet_beginchar ("Half trianglehead (upstem)", "u1triangle");
 595         draw_small_triangle_head (1);
 596
 597         draw_staff (-2, 2, 0.5);
 598 fet_endchar;
 599
 600
 601 def draw_closed_triangle_head (expr dir) =
 602         save hei, xs;
 603         save llap;
 604         save tilt;
 605
 606         tilt = 40;
 607         llap# = 2/3 noteheight#;
 608         xs = 1.0;
 609         caveness := 0.1;
 610         define_triangle_shape (dir);
 611         fill triangle_out;
 612 enddef;
 613
 614
 615 fet_beginchar ("Quarter trianglehead (upstem)", "u2triangle");
 616         draw_closed_triangle_head (1);
 617
 618         draw_staff (-2, 2, 0);
 619 fet_endchar;
 620
 621
 622 fet_beginchar ("Quarter trianglehead (downstem)", "d2triangle");
 623         draw_closed_triangle_head (-1);
 624
 625         draw_staff (-2, 2, 0.5);
 626 fet_endchar;
 627
 628
 629 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 630 %
 631 % Slash heads are for indicating improvisation.  They are
 632 % twice as high as normal heads.
 633 %
 634 def draw_slash (expr hwid_hash) =
 635         save exact_height;
 636         save ne, nw_dist;
 637         pair ne, nw_dist;
 638         exact_height = staff_space# + stafflinethickness# / 2;
 639
 640         set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
 641                       exact_height, exact_height);
 642
 643         charwx := charwd;
 644         charwy := charht;
 645
 646         clearxy;
 647
 648         d := d - feta_shift;
 649
 650         pickup pencircle scaled blot_diameter;
 651
 652         bot y1 = -d;
 653         top y2 = h;
 654         lft x1 = 0;
 655         lft x2 = 2 h / slash_slope;
 656
 657         rt x3 = w;
 658         y3 = y2;
 659         y4 = y1;
 660         x3 - x2 = x4 - x1;
 661
 662         ne = unitvector (z3 - z4);
 663         nw_dist = (ne rotated 90) * 0.5 blot_diameter;
 664
 665         fill bot z1{left}
 666              .. (z1 + nw_dist){ne}
 667              -- (z2 + nw_dist){ne}
 668              .. top z2{right}
 669              -- top z3{right}
 670              .. (z3 - nw_dist){-ne}
 671              -- (z4 - nw_dist){-ne}
 672              .. bot z4{left}
 673              -- cycle;
 674
 675         if hwid_hash > 2 slash_thick#:
 676                 save th;
 677
 678                 th = slash_thick - blot_diameter;
 679                 y6 = y7;
 680                 y5 = y8;
 681                 y3 - y7 = th;
 682                 y5 - y1 = th;
 683                 z6 - z5 = whatever * ne;
 684                 z8 - z7 = whatever * ne;
 685
 686                 z5 = z1 + whatever * ne + th * (ne rotated -90);
 687                 z8 = z4 + whatever * ne + th * (ne rotated 90);
 688
 689                 unfill z5
 690                        -- z6
 691                        -- z7
 692                        -- z8
 693                        -- cycle;
 694         fi
 695         labels (range 1 thru 10);
 696 enddef;
 697
 698
 699 fet_beginchar ("Whole slashhead", "s0slash");
 700         draw_slash (4 slash_thick# + 0.5 staff_space#);
 701
 702         draw_staff (-2, 2, 0);
 703 fet_endchar;
 704
 705
 706 fet_beginchar ("Half slashhead", "s1slash");
 707         draw_slash (3.0 slash_thick# + 0.15 staff_space#);
 708
 709         draw_staff (-2, 2, 0);
 710 fet_endchar;
 711
 712
 713 fet_beginchar ("Quarter slashhead", "s2slash");
 714         draw_slash (1.5 slash_thick#);
 715
 716         draw_staff (-2, 2, 0);
 717 fet_endchar;
 718
 719
 720 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 721 %
 722 % `thick' is the distance between the NE/SW parallel lines in the cross
 723 % (distance between centres of lines) in multiples of stafflinethickness
 724 %
 725 def draw_cross (expr thick) =
 726         save ne, nw;
 727         save ne_dist, nw_dist, rt_dist, up_dist;
 728         save crz_in, crz_out;
 729         save thickness;
 730         pair ne, nw;
 731         pair ne_dist, nw_dist, rt_dist, up_dist;
 732         path crz_in, crz_out;
 733
 734         pen_thick# := 1.2 stafflinethickness#;
 735         thickness# := thick * stafflinethickness#;
 736         define_pixels (thickness);
 737         define_blacker_pixels (pen_thick);
 738
 739         pickup pencircle scaled pen_thick;
 740
 741         h := h - feta_shift;
 742
 743         top y3 = h;
 744         ne = unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
 745         rt x4 = w / 2;
 746         y5 = 0;
 747         z4 - z5 = whatever * ne;
 748         x6 = 0;
 749         z6 - z3 = whatever * ne;
 750         z3 - z4 = whatever * (ne yscaled -1);
 751
 752         z4 - z3 = whatever * (ne) + (ne rotated -90) * thickness;
 753
 754
 755         x1 = charwd / 2 - .5 pen_thick#;
 756         z1 = whatever * ne
 757              + thick / 2 * stafflinethickness# * (ne rotated -90);
 758
 759         % labels (1, 2, 3, 4, 5, 6);
 760
 761         nw = unitvector (z3 - z4);
 762
 763         up_dist = up * 0.5 pen_thick / cosd (angle (ne));
 764         rt_dist = right * 0.5 pen_thick / sind (angle (ne));
 765         nw_dist = (ne rotated 90) * 0.5 pen_thick;
 766         ne_dist = (nw rotated -90) * 0.5 pen_thick;
 767
 768         x4' := x4;
 769         x5' := x5;
 770         y6' := y6;
 771
 772         x4 := hround (x4' + .5 pen_thick) - .5 pen_thick;
 773         x5 := hfloor (x5' + xpart rt_dist) - xpart rt_dist;
 774         y6 := vfloor (y6' + ypart up_dist) - ypart up_dist;
 775
 776         crz_out = (z6 + up_dist)
 777                   -- (z3 + nw_dist){ne}
 778                   .. (top z3)
 779                   .. (z3 + ne_dist){-nw}
 780                   -- (z4 + ne_dist){-nw}
 781                   .. (rt z4)
 782                   .. (z4 - nw_dist){-ne}
 783                   -- (z5 + rt_dist);
 784         crz_out := crz_out shifted (0, feta_shift)
 785                    -- reverse crz_out yscaled -1 shifted (0, -feta_eps);
 786         fill crz_out
 787              -- reverse crz_out xscaled -1 shifted (-feta_eps, 0)
 788              -- cycle;
 789
 790         if (thick > 1):
 791                 x4 := hround (x4' - xpart rt_dist) + xpart rt_dist;
 792                 x5 := hceiling (x5' - .5 pen_thick) + .5 pen_thick;
 793                 y6 := vfloor (y6' - .5 pen_thick) + .5 pen_thick;
 794
 795                 crz_in = (bot z6){right}
 796                          .. (z6 - nw_dist){ne}
 797                          -- (z3 - up_dist)
 798                          -- (z4 - rt_dist)
 799                          -- (z5 + nw_dist){-ne}
 800                          .. {down}(lft z5);
 801                 crz_in := crz_in shifted (0, feta_shift)
 802                           -- reverse crz_in yscaled -1 shifted (0, -feta_eps);
 803                 unfill crz_in
 804                        -- reverse crz_in xscaled -1 shifted (-feta_eps, 0)
 805                        -- cycle;
 806         fi
 807
 808         % ugh
 809         currentpicture := currentpicture shifted (hround (w / 2), 0);
 810
 811         charwx := charwd;
 812         charwy := y1 + feta_shift;
 813
 814         z12 = (charwx * hppp, y1 * vppp);
 815
 816         labels (12);
 817 enddef;
 818
 819
 820 fet_beginchar ("Whole Crossed notehead", "s0cross");
 821         save wid, hei;
 822
 823         wid# := black_notehead_width# + 4 stafflinethickness#;
 824         hei# := noteheight# + stafflinethickness#;
 825
 826         set_char_box (0, wid#, hei# / 2, hei# / 2);
 827
 828         draw_cross (3.75);
 829
 830         remember_pic := currentpicture;
 831
 832         draw_staff (-2, 2, 0);
 833 fet_endchar;
 834
 835
 836 if test > 0:
 837         fet_beginchar ("Whole Crossed notehead", "s0cross");
 838                 save wid, hei;
 839
 840                 wid# := black_notehead_width# + 4 stafflinethickness#;
 841                 hei# := noteheight# + stafflinethickness#;
 842
 843                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 844
 845                 currentpicture := remember_pic;
 846
 847                 draw_staff (-2, 2, 0.5);
 848         fet_endchar;
 849 fi;
 850
 851
 852 fet_beginchar ("Half Crossed notehead", "s1cross");
 853         save wid, hei;
 854
 855         wid# := black_notehead_width# + 2 stafflinethickness#;
 856         hei# := noteheight# + stafflinethickness# / 2;
 857
 858         set_char_box (0, wid#, hei# / 2, hei# / 2);
 859
 860         draw_cross (3.0);
 861
 862         remember_pic := currentpicture;
 863
 864         draw_staff (-2, 2, 0);
 865 fet_endchar;
 866
 867
 868 if test > 0:
 869         fet_beginchar ("Half Crossed notehead", "s1cross");
 870                 save wid, hei;
 871
 872                 wid# := black_notehead_width# + 2 stafflinethickness#;
 873                 hei# := noteheight# + stafflinethickness# / 2;
 874
 875                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 876
 877                 currentpicture := remember_pic;
 878
 879                 draw_staff (-2, 2, 0.5);
 880         fet_endchar;
 881 fi;
 882
 883
 884 fet_beginchar ("Crossed notehead", "s2cross");
 885         wid# := black_notehead_width#;
 886         hei# := noteheight#;
 887         set_char_box (0, wid#, hei# / 2, hei# / 2);
 888
 889         draw_cross (1.0);
 890
 891         remember_pic := currentpicture;
 892
 893         draw_staff (-2, 2, 0);
 894 fet_endchar;
 895
 896
 897 if test > 0:
 898         fet_beginchar ("Crossed notehead", "s2cross");
 899                 wid# := black_notehead_width#;
 900                 hei# := noteheight#;
 901                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 902
 903                 currentpicture := remember_pic;
 904
 905                 draw_staff (-2, 2, 0.5);
 906         fet_endchar;
 907 fi;
 908
 909
 910 fet_beginchar ("X-Circled notehead", "s2xcircle");
 911         save wid, hei;
 912         save cthick, cxd, cyd, dy;
 913
 914         wid# := black_notehead_width# * sqrt (sqrt2);
 915         hei# := noteheight# * sqrt (sqrt2);
 916
 917         set_char_box (0, wid#, hei# / 2, hei# / 2);
 918
 919         d := d - feta_space_shift;
 920
 921         cthick# := (1.2 + 1/4) * stafflinethickness#;
 922         define_blacker_pixels (cthick);
 923
 924         cxd := w - cthick;
 925         cyd := h + d - cthick / 2;
 926
 927         dy = .5 (h - d);
 928
 929         pickup pencircle scaled cthick;
 930
 931         fill fullcircle xscaled (cxd + cthick)
 932                         yscaled (cyd + cthick)
 933                         shifted (w / 2, dy);
 934         unfill fullcircle xscaled (cxd - cthick)
 935                           yscaled (cyd - cthick)
 936                           shifted (w / 2, dy);
 937
 938         xpos := .5 cxd / sqrt2;
 939         ypos := .5 cyd / sqrt2;
 940
 941         pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
 942         draw (-xpos + w / 2, -ypos + dy)
 943              -- (xpos + w / 2, ypos + dy);
 944
 945         pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
 946         draw (-xpos + w / 2, ypos + dy)
 947              -- (xpos + w / 2, -ypos + dy);
 948
 949         charwx := charwd;
 950         charwy := 0;
 951
 952         z12 = (charwx * hppp, charwy * vppp);
 953         labels (12);
 954
 955         remember_pic := currentpicture;
 956
 957         draw_staff (-2, 2, 0);
 958 fet_endchar;
 959
 960
 961 if test > 0:
 962         fet_beginchar ("X-Circled notehead", "s2xcircle");
 963                 save wid, hei;
 964                 save cthick, cxr, cyr;
 965
 966                 wid# := black_notehead_width# * sqrt (sqrt2);
 967                 hei# := noteheight# * sqrt (sqrt2);
 968
 969                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 970
 971                 currentpicture := remember_pic;
 972
 973                 draw_staff (-2, 2, 0.5);
 974         fet_endchar;
 975 fi;
 976
 977
 978 %%%%%%%%
 979 %
 980 % SOLFA SHAPED NOTES
 981 %
 982 %
 983 % Note: For whole and half notes, the `fill' curve (p_out) is offset from
 984 %       the points that specify the outer geometry, because we need to add
 985 %       the rounding.  In contrast, the inner curve is not offset, because
 986 %       there is no rounding.
 987 %
 988 %       This means that to get a line of thick_factor * pen_thickness,
 989 %       we need to offset the inner curve by
 990 %
 991 %         (thick_factor - 0.5) * pen_thickness
 992 %
 993 %       or by
 994 %
 995 %         (2 * thick_factor - 1) * half_pen_thickness
 996 %
 997 save solfa_pen_thick;
 998 solfa_pen_thick# = 1.3 stafflinethickness#;
 999 define_blacker_pixels (solfa_pen_thick);
1000
1001 save solfa_pen_radius;
1002 solfa_pen_radius = 0.5 solfa_pen_thick;
1003
1004 save solfa_base_notewidth;
1005 solfa_base_notewidth# := black_notehead_width#;
1006
1007 solfa_whole_width := 1.0;
1008 solfa_half_width := 1.0;
1009 solfa_quarter_width := 1.0;
1010
1011
1012 %%% Do head
1013 %
1014 % Triangle with base parallel to staff lines.
1015 %
1016
1017 def draw_do_head (expr width_factor, dir, thickness_factor) =
1018         save p_in, p_out;
1019         save left_dist, right_dist, bottom_dist;
1020         path p_in, p_out;
1021         pair left_dist, right_dist, bottom_dist;
1022
1023         set_char_box (0, width_factor * solfa_base_notewidth#,
1024                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1025
1026         bottom_thick_factor := 2 * thickness_factor - 1;
1027         % no different thickness for left side if we want uniform thickness
1028         if thickness_factor = 1:
1029                 left_thick_factor := 1;
1030         else:
1031                 left_thick_factor := 0.7 * bottom_thick_factor;
1032         fi
1033
1034         save pen_radius;
1035         pen_radius := min (solfa_pen_radius,
1036                            (h + d) / (3 * (1 + bottom_thick_factor)));
1037
1038         pickup pencircle scaled (2 * pen_radius);
1039
1040         bot y1 = -d;
1041         y1 = y2;
1042         lft x1 = 0;
1043         rt x2 = w;
1044         top y3 = h;
1045         x3 = .5 [x1, x2];
1046
1047         left_dist = (unitvector (z3 - z1) rotated 90) * pen_radius;
1048         right_dist = (unitvector (z2 - z3) rotated 90) * pen_radius;
1049         bottom_dist = (0,1) * pen_radius;
1050
1051         save pa, pb, pc;
1052         path pa, pb, pc;
1053         save point_a, point_b, point_c;
1054         pair point_a, point_b, point_c;
1055
1056         pa := (z1 - left_thick_factor * left_dist)
1057               -- (z3 - left_thick_factor * left_dist);
1058         pb := (z1 + bottom_thick_factor * bottom_dist)
1059               -- (z2 + bottom_thick_factor * bottom_dist);
1060         pc := (z2 - right_dist)
1061               -- (z3 - right_dist);
1062
1063         point_a := pa intersectionpoint pb;
1064         point_b := pb intersectionpoint pc;
1065         point_c := pc intersectionpoint pa;
1066
1067         p_in := point_a
1068                 -- point_b
1069                 -- point_c
1070                 -- cycle;
1071
1072         p_out := bot z1
1073                  -- bot z2{right}
1074                  .. rt z2{up}
1075                  .. (z2 + right_dist){z3 - z2}
1076                  -- (z3 + right_dist){z3 - z2}
1077                  .. top z3{left}
1078                  .. (z3 + left_dist){z1 - z3}
1079                  -- (z1 + left_dist){z1 - z3}
1080                  .. lft z1{down}
1081                  .. {right}cycle;
1082
1083         labels (1, 2, 3);
1084
1085         charwx := charwd;
1086         charwy := -chardp + 0.5 stafflinethickness#;
1087         if dir = -1:
1088                 charwy := -charwy;
1089         fi;
1090 enddef;
1091
1092 save do_weight;
1093 do_weight := 2;
1094
1095
1096 fet_beginchar ("Whole dohead", "s0do");
1097         draw_do_head (solfa_whole_width, 1, do_weight);
1098         fill p_out;
1099         unfill p_in;
1100 fet_endchar;
1101
1102
1103 fet_beginchar ("Half dohead", "d1do");
1104         draw_do_head (solfa_half_width, -1, do_weight);
1105         fill p_out;
1106         unfill p_in;
1107 fet_endchar;
1108
1109
1110 fet_beginchar ("Half dohead", "u1do");
1111         draw_do_head (solfa_half_width, 1, do_weight);
1112         fill p_out;
1113         unfill p_in;
1114 fet_endchar;
1115
1116
1117 fet_beginchar ("Quarter dohead", "d2do");
1118         draw_do_head (solfa_quarter_width, -1, do_weight);
1119         fill p_out;
1120 fet_endchar;
1121
1122
1123 fet_beginchar ("Quarter dohead", "u2do");
1124         draw_do_head (solfa_quarter_width, 1, do_weight);
1125         fill p_out;
1126 fet_endchar;
1127
1128
1129 fet_beginchar ("Whole thin dohead", "s0doThin");
1130         draw_do_head (solfa_whole_width, 1, 1);
1131         fill p_out;
1132         unfill p_in;
1133 fet_endchar;
1134
1135
1136 fet_beginchar ("Half thin dohead", "d1doThin");
1137         draw_do_head (solfa_half_width, -1, 1);
1138         fill p_out;
1139         unfill p_in;
1140 fet_endchar;
1141
1142
1143 fet_beginchar ("Half thin dohead", "u1doThin");
1144         draw_do_head (solfa_half_width, 1, 1);
1145         fill p_out;
1146         unfill p_in;
1147 fet_endchar;
1148
1149
1150 fet_beginchar ("Quarter thin dohead", "d2doThin");
1151         draw_do_head (solfa_quarter_width, -1, 1);
1152         fill p_out;
1153 fet_endchar;
1154
1155
1156 fet_beginchar ("Quarter thin dohead", "u2doThin");
1157         draw_do_head (solfa_quarter_width, 1, 1);
1158         fill p_out;
1159 fet_endchar;
1160
1161
1162 %
1163 % re - flat top, curved bottom:
1164 %
1165 %   (0,h/2) {dir -90}
1166 %   .. (w/2,-h/2)
1167 %   .. {dir 90} (w,h/2)
1168 %   -- cycle;
1169 %
1170 % (broader along the base and with more vertical sides for half and
1171 % whole notes)
1172 %
1173 % Note: According to some shape-note singers, there should be no size
1174 %       differences for half and whole notes, contrary to the comment above.
1175 %       Consequently, we have made them all the same width.
1176 %
1177 % stem attachment: h/2
1178 %
1179 def draw_re_head (expr width_factor, dir, thickness_factor) =
1180         save p_in, p_out;
1181         path p_in, p_out;
1182
1183         set_char_box (0, width_factor * solfa_base_notewidth#,
1184                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1185
1186         save offset;
1187         offset = (2 * thickness_factor - 1);
1188
1189         save curve_start;
1190         curve_start = 0.7;
1191
1192         save pen_radius;
1193
1194         pen_radius := min (solfa_pen_radius,
1195                            (h + d) * (1-curve_start) / (1+ offset));
1196
1197         pickup pencircle scaled (2 * pen_radius);
1198
1199         lft x1 = 0;
1200         top y1 = h;
1201         x2 = x1;
1202         y2 = curve_start [y3, y1];
1203         bot y3 = -d;
1204         x3 = .5 [x2, x4];
1205         rt x4 = w;
1206         y4 = y2;
1207         y5 = y1;
1208         x5 = x4;
1209
1210         labels (range 1 thru 5);
1211
1212         p_in := (z1 + pen_radius * (1, -1 * offset))
1213                 -- rt z2{down}
1214                 .. ((top z3) + (0, offset * pen_radius))
1215                 .. lft z4{up}
1216                 -- (z5 + pen_radius * (-1, -1 * offset))
1217                 -- cycle;
1218
1219         p_out := lft z1
1220                  -- lft z2{down}
1221                  .. bot z3
1222                  .. rt z4{up}
1223                  -- rt z5{up}
1224                  .. top z5{left}
1225                  -- top z1{left}
1226                  .. {down}cycle;
1227
1228         charwx := charwd;
1229         charwy := curve_start [-chardp, charht];
1230
1231         if dir = -1:
1232                 charwy := -charwy;
1233         fi;
1234 enddef;
1235
1236
1237 save re_weight;
1238 re_weight := 2;
1239
1240 fet_beginchar ("Whole rehead", "s0re");
1241         draw_re_head (solfa_whole_width, 1, re_weight);
1242         fill p_out;
1243         unfill p_in;
1244 fet_endchar;
1245
1246
1247 fet_beginchar ("Half up rehead", "u1re");
1248         draw_re_head (solfa_half_width, 1, re_weight);
1249         fill p_out;
1250         unfill p_in;
1251 fet_endchar;
1252
1253
1254 fet_beginchar ("Half down rehead", "d1re");
1255         draw_re_head (solfa_half_width, -1, re_weight);
1256         fill p_out;
1257         unfill p_in;
1258 fet_endchar;
1259
1260
1261 fet_beginchar ("Quarter up rehead", "u2re");
1262         draw_re_head (solfa_quarter_width, 1, re_weight);
1263         fill p_out;
1264 fet_endchar;
1265
1266
1267 fet_beginchar ("Quarter down rehead", "d2re");
1268         draw_re_head (solfa_quarter_width, -1, re_weight);
1269         fill p_out;
1270 fet_endchar;
1271
1272
1273 fet_beginchar ("Whole thin rehead", "s0reThin");
1274         draw_re_head (solfa_whole_width, 1, 1);
1275         fill p_out;
1276         unfill p_in;
1277 fet_endchar;
1278
1279
1280 fet_beginchar ("Half up thin rehead", "u1reThin");
1281         draw_re_head (solfa_half_width, 1, 1);
1282         fill p_out;
1283         unfill p_in;
1284 fet_endchar;
1285
1286
1287 fet_beginchar ("Half down thin rehead", "d1reThin");
1288         draw_re_head (solfa_half_width, -1, 1);
1289         fill p_out;
1290         unfill p_in;
1291 fet_endchar;
1292
1293
1294 fet_beginchar ("Quarter thin rehead", "u2reThin");
1295         draw_re_head (solfa_quarter_width, 1, 1);
1296         fill p_out;
1297 fet_endchar;
1298
1299
1300 fet_beginchar ("Quarter thin rehead", "d2reThin");
1301         draw_re_head (solfa_quarter_width, -1, 1);
1302         fill p_out;
1303 fet_endchar;
1304
1305
1306 %%%% mi head -- diamond shape
1307 %
1308 % two versions, depending on whether the `strong' lines are on the nw & se
1309 % or the ne & sw
1310 %
1311 def draw_mi_head (expr width_factor, thickness_factor, mirror) =
1312         save path_out, path_in;
1313         save ne_dist, se_dist, ne, se;
1314         save path_a, path_b, path_c, path_d;
1315         path path_out, path_in;
1316         pair ne_dist, se_dist, ne, se;
1317         path path_a, path_b, path_c, path_d;
1318         save inner_path;
1319         path inner_path;
1320
1321         set_char_box (0, width_factor * solfa_base_notewidth#,
1322                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1323
1324         save offset;
1325         offset := 2 * thickness_factor - 1;
1326
1327         save note_diagonal;
1328
1329         note_diagonal := w / 2 ++ (h + d) / 2;
1330
1331         save pen_radius;
1332
1333         pen_radius := min (solfa_pen_radius,
1334                            .3 * note_diagonal / (1 + offset));
1335
1336         pickup pencircle scaled (2 * pen_radius);
1337
1338         lft x1 = 0;
1339         y1 = 0;
1340         bot y2 = -d;
1341         x2 = .5 [x1, x3];
1342         rt x3 = w;
1343         x4 = x2;
1344         y3 = y1;
1345         top y4 = h;
1346
1347         % inner sides are parallel to outer sides
1348         z6 - z5 = whatever * (z2 - z1);
1349         z8 - z7 = whatever * (z4 - z3);
1350         z8 - z5 = whatever * (z4 - z1);
1351         z7 - z6 = whatever * (z3 - z2);
1352
1353         ne = unitvector (z4 - z1);
1354         se = unitvector (z2 - z1);
1355
1356         ne_dist = (ne rotated 90) * pen_radius;
1357         se_dist = (se rotated 90) * pen_radius;
1358
1359         path_a := (z1 + se_dist)
1360                   -- (z2 + se_dist);
1361         path_b := (z2 + (ne_dist * offset))
1362                   -- (z3 + (ne_dist * offset));
1363         path_c := (z3 - se_dist)
1364                   -- (z4 - se_dist);
1365         path_d := (z4 - (ne_dist * offset))
1366                   -- (z1 - (ne_dist * offset));
1367
1368         z5 = path_a intersectionpoint path_d;
1369         z7 = path_b intersectionpoint path_c;
1370
1371         labels (range 1 thru 8);
1372
1373         inner_path := z5
1374                       -- z6
1375                       -- z7
1376                       -- z8
1377                       -- cycle;
1378
1379         if mirror:
1380                 path_in := inner_path;
1381         else:
1382                 path_in := inner_path reflectedabout (z2, z4);
1383         fi
1384
1385         path_out := lft z1 {down}
1386                     .. (z1 - se_dist){se}
1387                     -- (z2 - se_dist){se}
1388                     .. bot z2 {right}
1389                     .. (z2 - ne_dist){ne}
1390                     -- (z3 - ne_dist){ne}
1391                     .. rt z3 {up}
1392                     .. (z3 + se_dist){-se}
1393                     -- (z4 + se_dist){-se}
1394                     .. top z4 {left}
1395                     .. (z4 + ne_dist){-ne}
1396                     -- (z1 + ne_dist){-ne}
1397                     .. cycle;
1398 enddef;
1399
1400
1401 save mi_weight, mi_width;
1402 mi_weight := 2;
1403 mi_width := 1.2;
1404
1405 fet_beginchar ("Whole mihead", "s0mi");
1406         draw_mi_head (mi_width * solfa_whole_width, mi_weight, false);
1407         fill path_out;
1408         unfill path_in;
1409 fet_endchar;
1410
1411
1412 fet_beginchar ("Half mihead", "s1mi");
1413         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1414         fill path_out;
1415         unfill path_in;
1416 fet_endchar;
1417
1418
1419 fet_beginchar ("Quarter mihead", "s2mi");
1420         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1421         fill path_out;
1422 fet_endchar;
1423
1424
1425 fet_beginchar ("Whole mirror mihead", "s0miMirror");
1426         draw_mi_head (mi_width * solfa_whole_width, mi_weight, true);
1427         fill path_out;
1428         unfill path_in;
1429 fet_endchar;
1430
1431
1432 fet_beginchar ("Half  mirror mihead", "s1miMirror");
1433         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1434         fill path_out;
1435         unfill path_in;
1436 fet_endchar;
1437
1438
1439 fet_beginchar ("Quarter mirror mihead", "s2miMirror");
1440         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1441         fill path_out;
1442 fet_endchar;
1443
1444
1445 fet_beginchar ("Whole thin mihead", "s0miThin");
1446         draw_mi_head (mi_width * solfa_whole_width, 1, false);
1447         fill path_out;
1448         unfill path_in;
1449 fet_endchar;
1450
1451
1452 fet_beginchar ("Half thin mihead", "s1miThin");
1453         draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1454         fill path_out;
1455         unfill path_in;
1456 fet_endchar;
1457
1458
1459 fet_beginchar ("Quarter thin mihead", "s2miThin");
1460         draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1461         fill path_out;
1462 fet_endchar;
1463
1464
1465 %%%% fa head
1466 %
1467 % Right triangle, hypotenuse from nw to se corner.  Stem attaches on
1468 % vertical side in direction of horizontal side.
1469 %
1470 def draw_fa_head (expr width_factor, thickness_factor) =
1471         set_char_box (0, width_factor * solfa_base_notewidth#,
1472                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1473
1474         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1475         path p_down_in, p_down_out, p_up_in, p_up_out;
1476         save path_a, path_b, path_c;
1477         path path_a, path_b, path_c;
1478         pair nw_dist, nw;
1479
1480         save offset;
1481         offset := 2 * thickness_factor - 1;
1482
1483         save pen_radius;
1484         pen_radius := min (solfa_pen_radius,
1485                            .33 * (h + d) / (1 + offset));
1486
1487         pickup pencircle scaled (2 * pen_radius);
1488
1489         lft x1 = 0;
1490         top y1 = h;
1491
1492         rt x2 = w;
1493         y2 = y1;
1494         bot y3 = -d;
1495         x3 = x2;
1496
1497         y4 = y3;
1498         x4 = x1;
1499
1500         labels (1, 2, 3, 4);
1501
1502         nw = unitvector (z1 - z3);
1503         nw_dist = (nw rotated 90) * pen_radius;
1504
1505         path_a := (z1 - (0,1) * offset * pen_radius)
1506                   -- (z2 - (0,1) * offset * pen_radius);
1507         path_b := (z2 - (1,0) * pen_radius)
1508                   -- (z3 - (1,0) * pen_radius);
1509         path_c := (z3 - nw_dist)
1510                   -- (z1 - nw_dist);
1511
1512         p_up_in := (path_a intersectionpoint path_b)
1513                    -- (path_b intersectionpoint path_c)
1514                    -- (path_c intersectionpoint path_a)
1515                    -- cycle;
1516
1517         p_up_out := lft z1{down}
1518                     .. (z1 + nw_dist){-nw}
1519                     -- (z3 + nw_dist){-nw}
1520                     .. bot z3{right}
1521                     .. rt z3{up}
1522                     -- rt z2{up}
1523                     .. top z2{left}
1524                     -- top z1{left}
1525                     .. cycle;
1526
1527         p_down_in := p_up_in rotated 180 shifted (w, 0);
1528         p_down_out := p_up_out rotated 180 shifted (w, 0);
1529
1530         charwy := 0.0;
1531         charwx := charwd;
1532 enddef;
1533
1534 save fa_weight;
1535 fa_weight := 1.75;
1536
1537 fet_beginchar ("Whole fa up head", "u0fa");
1538         draw_fa_head (solfa_whole_width, fa_weight);
1539         fill p_up_out;
1540         unfill p_up_in;
1541 fet_endchar;
1542
1543
1544 fet_beginchar ("Whole fa down head", "d0fa");
1545         draw_fa_head (solfa_whole_width, fa_weight);
1546         fill p_down_out;
1547         unfill p_down_in;
1548 fet_endchar;
1549
1550
1551 fet_beginchar ("half fa up head", "u1fa");
1552         draw_fa_head (solfa_half_width, fa_weight);
1553         fill p_up_out;
1554         unfill p_up_in;
1555 fet_endchar;
1556
1557
1558 fet_beginchar ("Half fa down head", "d1fa");
1559         draw_fa_head (solfa_half_width, fa_weight);
1560         fill p_down_out;
1561         unfill p_down_in;
1562 fet_endchar;
1563
1564
1565 fet_beginchar ("Quarter fa up head", "u2fa");
1566         draw_fa_head (solfa_quarter_width, fa_weight);
1567         fill p_up_out;
1568 fet_endchar;
1569
1570
1571 fet_beginchar ("Quarter fa down head", "d2fa");
1572         draw_fa_head (solfa_quarter_width, fa_weight);
1573         fill p_down_out;
1574 fet_endchar;
1575
1576
1577 fet_beginchar ("Whole thin fa up head", "u0faThin");
1578         draw_fa_head (solfa_whole_width, 1);
1579         fill p_up_out;
1580         unfill p_up_in;
1581 fet_endchar;
1582
1583
1584 fet_beginchar ("Whole thin fa down head", "d0faThin");
1585         draw_fa_head (solfa_whole_width, 1);
1586         fill p_down_out;
1587         unfill p_down_in;
1588 fet_endchar;
1589
1590
1591 fet_beginchar ("half thin fa up head", "u1faThin");
1592         draw_fa_head (solfa_half_width, 1);
1593         fill p_up_out;
1594         unfill p_up_in;
1595 fet_endchar;
1596
1597
1598 fet_beginchar ("Half thin fa down head", "d1faThin");
1599         draw_fa_head (solfa_half_width, 1);
1600         fill p_down_out;
1601         unfill p_down_in;
1602 fet_endchar;
1603
1604
1605 fet_beginchar ("Quarter thin fa up head", "u2faThin");
1606         draw_fa_head (solfa_quarter_width, 1);
1607         fill p_up_out;
1608 fet_endchar;
1609
1610
1611 fet_beginchar ("Quarter thin fa down head", "d2faThin");
1612         draw_fa_head (solfa_quarter_width, 1);
1613         fill p_down_out;
1614 fet_endchar;
1615
1616
1617
1618 %%%% sol head
1619 %
1620 % Note: sol head is the same shape as a standard music head, and doesn't
1621 %       vary from style to style.  However, width is constant with duration,
1622 %       so we can't just use the standard note font.
1623 %
1624 def draw_sol_head (expr filled) =
1625         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
1626         if not filled:
1627           undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
1628         fi
1629         draw_staff (-2, 2, 0);
1630 enddef;
1631
1632 fet_beginchar ("Whole solhead", "s0sol");
1633         draw_sol_head ( false);
1634 fet_endchar;
1635
1636
1637 fet_beginchar ("Half solhead", "s1sol");
1638         draw_sol_head ( false);
1639 fet_endchar;
1640
1641
1642 fet_beginchar ("Quarter solhead", "s2sol");
1643         draw_sol_head ( true);
1644 fet_endchar;
1645
1646
1647 %%%% la head
1648 %
1649 %   Rectangle head
1650 %
1651 def draw_la_head (expr width_factor, thickness_factor) =
1652         set_char_box (0, width_factor * solfa_base_notewidth#,
1653                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1654         save p_in, p_out;
1655         path p_in, p_out;
1656
1657         save offset;
1658         offset := 2 * thickness_factor - 1;
1659
1660         save pen_radius;
1661         pen_radius := min (solfa_pen_radius,
1662                            .35 * (h + d) / (1 + offset));
1663
1664         pickup pencircle scaled (2 * pen_radius);
1665
1666         lft x1 = 0;
1667         top y1 = h;
1668
1669         rt x2 = w;
1670         y2 = y1;
1671         bot y3 = -d;
1672         x3 = x2;
1673
1674         y4 = y3;
1675         x4 = x1;
1676
1677         labels (range 1 thru 4);
1678
1679         p_in := (z1 + pen_radius * (1, -offset))
1680                 -- (z2 + pen_radius * (-1, -offset))
1681                 -- (z3 + pen_radius * (-1, offset))
1682                 -- (z4 + pen_radius * (1, offset))
1683                 -- cycle;
1684
1685         p_out := top z1
1686                  -- top z2{right}
1687                  .. rt z2{down}
1688                  -- rt z3{down}
1689                  .. bot z3{left}
1690                  -- bot z4{left}
1691                  .. lft z4{up}
1692                  -- lft z1{up}
1693                  .. cycle;
1694 enddef;
1695
1696
1697 save la_weight;
1698 la_weight := 2;
1699
1700 fet_beginchar ("Whole lahead", "s0la");
1701         draw_la_head (solfa_whole_width, la_weight);
1702         fill p_out;
1703         unfill p_in;
1704 fet_endchar;
1705
1706
1707 fet_beginchar ("Half lahead", "s1la");
1708         draw_la_head (solfa_half_width, la_weight);
1709         fill p_out;
1710         unfill p_in;
1711 fet_endchar;
1712
1713
1714 fet_beginchar ("Quarter lahead", "s2la");
1715         draw_la_head (solfa_quarter_width, la_weight);
1716         fill p_out;
1717 fet_endchar;
1718
1719
1720 fet_beginchar ("Whole thin lahead", "s0laThin");
1721         draw_la_head (solfa_whole_width, 1);
1722         fill p_out;
1723         unfill p_in;
1724 fet_endchar;
1725
1726
1727 fet_beginchar ("Half thin lahead", "s1laThin");
1728         draw_la_head (solfa_half_width, 1);
1729         fill p_out;
1730         unfill p_in;
1731 fet_endchar;
1732
1733
1734 fet_beginchar ("Quarter lahead", "s2laThin");
1735         draw_la_head (solfa_quarter_width, 1);
1736         fill p_out;
1737 fet_endchar;
1738
1739
1740 %%%% ti head
1741 %
1742 %   `Snow-cone', V with rounded top.
1743 %
1744 def draw_ti_head (expr width_factor, dir, thickness_factor) =
1745         set_char_box (0, width_factor * solfa_base_notewidth#,
1746                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1747         save p_in, p_out, p_top, p_top_in;
1748         path p_in, p_out, p_top, p_top_in;
1749         save cone_height;
1750         cone_height = 0.64;
1751
1752         save offset;
1753         offset := 2 * thickness_factor - 1;
1754
1755         save pen_radius;
1756         pen_radius := min (solfa_pen_radius,
1757                            .4 * (h + d) / (1 + offset));
1758
1759         pickup pencircle scaled (2 * pen_radius);
1760
1761         x1 = .5 [x2, x4];
1762         bot y1 = -d;
1763         lft x2 = 0;
1764         y2 = cone_height [y1, y3];
1765         rt x4 = w;
1766         y4 = y2;
1767         x3 = x1;
1768         top y3 = h;
1769         x5 = x1;
1770         y5 = y1 + offset * pen_radius;
1771
1772         labels (range 1 thru 4);
1773
1774         save nw_dist, sw_dist, nw, sw;
1775         pair nw_dist, sw_dist, nw, sw;
1776
1777         nw = unitvector (z2 - z1);
1778         sw = unitvector (z1 - z4);
1779
1780         nw_dist = (nw rotated 90) * pen_radius;
1781         sw_dist = (sw rotated 90) * pen_radius;
1782
1783         p_top := (z2 + nw * pen_radius)
1784                  .. (top z3){right}
1785                  .. (z4 - sw * pen_radius);
1786
1787         p_top_in := (z2 - nw * offset * pen_radius)
1788                     .. (z3 - (0,1) * pen_radius) {right}
1789                     .. (z4 + sw * offset * pen_radius);
1790
1791         save path_a, path_b;
1792         path path_a, path_b;
1793         path_a := z2
1794                   -- z5;
1795         path_b := z5
1796                   -- z4;
1797
1798         z6 = path_a intersectionpoint p_top_in;
1799         z7 = path_b intersectionpoint p_top_in;
1800
1801         p_in := z5
1802                 -- z6
1803                 .. bot z3
1804                 .. z7
1805                 -- cycle;
1806
1807         p_out := bot z1
1808                  .. (z1 + nw_dist)
1809                  -- (z2 + nw_dist)
1810                  .. lft z2
1811                  .. (z2 + nw * pen_radius){direction 0 of p_top}
1812                  & p_top
1813                  & {direction infinity of p_top}(z4 - sw * pen_radius)
1814                  .. rt z4
1815                  .. (z4 + sw_dist)
1816                  -- (z1 + sw_dist)
1817                  .. cycle;
1818
1819         charwx := charwd;
1820         charwy := cone_height [-chardp, charht];
1821         if dir = -1:
1822                 charwy := -charwy;
1823         fi;
1824 enddef;
1825
1826
1827 save ti_weight;
1828 ti_weight := 2;
1829
1830 fet_beginchar ("Whole up tihead", "s0ti");
1831         draw_ti_head (solfa_whole_width, 1, ti_weight);
1832         fill p_out;
1833         unfill p_in;
1834 fet_endchar;
1835
1836
1837 fet_beginchar ("Half up tihead", "u1ti");
1838         draw_ti_head (solfa_half_width, 1, ti_weight);
1839         fill p_out;
1840         unfill p_in;
1841 fet_endchar;
1842
1843
1844 fet_beginchar ("Half down tihead", "d1ti");
1845         draw_ti_head (solfa_half_width, -1, ti_weight);
1846         fill p_out;
1847         unfill p_in;
1848 fet_endchar;
1849
1850
1851 fet_beginchar ("Quarter up tihead", "u2ti");
1852         draw_ti_head (solfa_quarter_width, 1, ti_weight);
1853         fill p_out;
1854 fet_endchar;
1855
1856
1857 fet_beginchar ("Quarter down tihead", "d2ti");
1858         draw_ti_head (solfa_quarter_width, -1, ti_weight);
1859         fill p_out;
1860 fet_endchar;
1861
1862
1863 fet_beginchar ("Whole thin up tihead", "s0tiThin");
1864         draw_ti_head (solfa_whole_width, 1, 1);
1865         fill p_out;
1866         unfill p_in;
1867 fet_endchar;
1868
1869
1870 fet_beginchar ("Half thin up tihead", "u1tiThin");
1871         draw_ti_head (solfa_half_width, 1, 1);
1872         fill p_out;
1873         unfill p_in;
1874 fet_endchar;
1875
1876
1877 fet_beginchar ("Half thin down tihead", "d1tiThin");
1878         draw_ti_head (solfa_half_width, -1, 1);
1879         fill p_out;
1880         unfill p_in;
1881 fet_endchar;
1882
1883
1884 fet_beginchar ("Quarter thin up tihead", "u2tiThin");
1885         draw_ti_head (solfa_quarter_width, 1, 1);
1886         fill p_out;
1887 fet_endchar;
1888
1889
1890 fet_beginchar ("Quarter thin down tihead", "d2tiThin");
1891         draw_ti_head (solfa_quarter_width, -1, 1);
1892         fill p_out;
1893 fet_endchar;
1894
1895
1896 %%%%%%   Funk shape note heads
1897 %
1898 %  Funk heads are narrower than Aiken and Sacred Harp, so we need a new
1899 %  width.
1900 %
1901 funk_notehead_width := 0.75;
1902
1903
1904 %%%%%%   Funk do head
1905 %          Parabolic on one side, vertical line on other
1906 %          Has up and down shapes for *all* notes
1907 %
1908 def draw_Funk_do_head (expr width_factor, thickness_factor) =
1909         set_char_box (0, width_factor * solfa_base_notewidth#,
1910                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1911
1912         save offset;
1913         offset := 2 * thickness_factor - 1;
1914
1915         save pen_radius;
1916         pen_radius := min (solfa_pen_radius,
1917                            .3 * (h + d) / (1 + offset));
1918
1919         pickup pencircle scaled (2 * pen_radius);
1920
1921         rt x1 = w;
1922         bot y1 = -d;
1923
1924         lft x2 = 0;
1925         y2 = 0.5 [y1, y3];
1926
1927         x3 = x1;
1928         top y3 = h;
1929
1930         x4 = x1 - pen_radius;
1931         y4 = y1 + offset * pen_radius;
1932
1933         y5 = y2;
1934         x5 = x2 + pen_radius;
1935
1936         x6 = x4;
1937         y6 = y3 - offset * pen_radius;
1938
1939         save p_up_in, p_up_out, p_down_in, p_down_out;
1940         path p_up_in, p_up_out, p_down_in, p_down_out;
1941
1942         p_down_in := z4{left}
1943                      ... z5{up}
1944                      ... z6{right}
1945                      -- cycle;
1946
1947         p_down_out := bot z1{left}
1948                       .. lft z2{up}
1949                       .. top z3{right}
1950                       .. rt z3{down}
1951                       -- rt z1{down}
1952                       .. cycle;
1953
1954         p_up_in := p_down_in rotated 180 shifted (w,0);
1955         p_up_out := p_down_out rotated 180 shifted (w,0);
1956
1957 enddef;
1958
1959
1960 save funk_do_weight;
1961 funk_do_weight := 1.7;
1962
1963 fet_beginchar ("Whole up Funk dohead", "u0doFunk");
1964         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1965         fill p_up_out;
1966         unfill p_up_in;
1967 fet_endchar;
1968
1969
1970 fet_beginchar ("Whole down Funk dohead", "d0doFunk");
1971         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1972         fill p_down_out;
1973         unfill p_down_in;
1974 fet_endchar;
1975
1976
1977 fet_beginchar ("Half up Funk dohead", "u1doFunk");
1978         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1979         fill p_up_out;
1980         unfill p_up_in;
1981 fet_endchar;
1982
1983
1984 fet_beginchar ("Half down Funk dohead", "d1doFunk");
1985         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1986         fill p_down_out;
1987         unfill p_down_in;
1988 fet_endchar;
1989
1990
1991 fet_beginchar ("Quarter up Funk dohead", "u2doFunk");
1992         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1993         fill p_up_out;
1994 fet_endchar;
1995
1996
1997 fet_beginchar ("Quarter down Funk dohead", "d2doFunk");
1998         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1999         fill p_down_out;
2000 fet_endchar;
2001
2002
2003 %%%%%%  Funk re head
2004 %       Arrowhead shape.
2005 %       Has up and down shapes for *all* notes
2006 %
2007 def draw_Funk_re_head (expr width_factor, thickness_factor) =
2008         set_char_box (0, width_factor * solfa_base_notewidth#,
2009                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2010
2011         save offset;
2012         offset := 2 * thickness_factor - 1;
2013
2014         save pen_radius;
2015         pen_radius := min (solfa_pen_radius,
2016                            .3 * (h + d) / (1 + offset));
2017
2018         pickup pencircle scaled (2 * pen_radius);
2019
2020         save curve_in;
2021         curve_in := 0.9;
2022
2023         lft x1 = 0;
2024         y1 := 0.5 [y2, y4];
2025
2026         rt x2 = w;
2027         top y2 = h;
2028
2029         x3 := curve_in [x1, x2];
2030         y3 := y1;
2031
2032         x4 = x2;
2033         bot y4 = -d;
2034
2035         z6 = lft z3;
2036
2037         save ne, se, ne_perp, se_perp;
2038         pair ne, se, ne_perp, se_perp;
2039
2040         ne := unitvector (z2 - z1);
2041         se := unitvector (z4 - z1);
2042         ne_perp := ne rotated 90;
2043         se_perp := se rotated 90;
2044
2045         save path_a, path_b, path_c, path_d;
2046         path path_a, path_b, path_c, path_d;
2047         save arrow_a_perp, arrow_b_perp;
2048         pair arrow_a_perp, arrow_b_perp;
2049
2050
2051         path_d := z2 .. z3{down} .. z4;
2052         arrow_a_perp = unitvector (direction 0 of path_d rotated 90)
2053                        * pen_radius;
2054         arrow_b_perp = unitvector (direction 2 of path_d rotated 90)
2055                        * pen_radius;
2056
2057         path_b := (z1 + se_perp * pen_radius)
2058                   -- z4 + se_perp * offset * pen_radius;
2059         path_a := (z1 - ne_perp * pen_radius)
2060                   -- z2 - ne_perp * offset * pen_radius;
2061         path_c := z2 - arrow_a_perp
2062                   .. z6{down}
2063                   .. z4 - arrow_b_perp;
2064
2065         z5 = path_a intersectionpoint path_b;
2066         z7 = path_a intersectionpoint path_c;
2067         z8 = path_b intersectionpoint path_c;
2068
2069         save p_up_in, p_down_in, p_up_out, p_down_out;
2070         path p_up_in, p_down_in, p_up_out, p_down_out;
2071
2072         p_down_in := z5
2073                      -- z7
2074                      .. z6{down}
2075                      .. z8
2076                      -- cycle;
2077
2078         p_down_out := lft z1{up}
2079                       .. (z1 + ne_perp * pen_radius){ne}
2080                       -- (z2 + ne_perp * pen_radius){ne}
2081                       .. top z2 {right}
2082                       .. rt z2{down}
2083                       .. (z2 + arrow_a_perp)
2084                       .. rt z3{down}
2085                       .. (z4 + arrow_b_perp)
2086                       .. rt z4{down}
2087                       .. bot z4 {left}
2088                       .. z4 - se_perp * pen_radius
2089                       -- z1 - se_perp * pen_radius
2090                       .. cycle;
2091
2092         p_up_in := p_down_in rotated 180 shifted (w, 0);
2093         p_up_out := p_down_out rotated 180 shifted (w, 0);
2094
2095 enddef;
2096
2097
2098 save funk_re_weight;
2099 funk_re_weight = 1.7;
2100
2101 fet_beginchar ("Whole up Funk rehead", "u0reFunk");
2102         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2103         fill p_up_out;
2104         unfill p_up_in;
2105 fet_endchar;
2106
2107
2108 fet_beginchar ("Whole down Funk rehead", "d0reFunk");
2109         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2110         fill p_down_out;
2111         unfill p_down_in;
2112 fet_endchar;
2113
2114
2115 fet_beginchar ("Half up Funk rehead", "u1reFunk");
2116         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2117         fill p_up_out;
2118         unfill p_up_in;
2119 fet_endchar;
2120
2121
2122 fet_beginchar ("Half down Funk rehead", "d1reFunk");
2123         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2124         fill p_down_out;
2125         unfill p_down_in;
2126 fet_endchar;
2127
2128
2129 fet_beginchar ("Quarter up Funk rehead", "u2reFunk");
2130         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2131         fill p_up_out;
2132 fet_endchar;
2133
2134
2135 fet_beginchar ("Quarter down Funk rehead", "d2reFunk");
2136         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2137         fill p_down_out;
2138 fet_endchar;
2139
2140
2141 %%%%%%  Funk mi head
2142 %       Diamond shape
2143 %       Has up and down shapes for all hollow notes
2144 %
2145 save funk_mi_width, funk_mi_weight;
2146 funk_mi_width := 1.2;
2147 funk_mi_weight := 1.9;
2148
2149 fet_beginchar ("Whole up Funk mihead", "u0miFunk");
2150         draw_mi_head (funk_mi_width * funk_notehead_width,
2151                       funk_mi_weight, false);
2152         fill path_out;
2153         unfill path_in;
2154 fet_endchar;
2155
2156
2157 fet_beginchar ("Whole down Funk mihead", "d0miFunk");
2158         draw_mi_head (funk_mi_width * funk_notehead_width,
2159                       funk_mi_weight, true);
2160         fill path_out;
2161         unfill path_in;
2162 fet_endchar;
2163
2164
2165 fet_beginchar ("Half up Funk mihead", "u1miFunk");
2166         draw_mi_head (funk_mi_width * funk_notehead_width,
2167                       funk_mi_weight, false);
2168         fill path_out;
2169         unfill path_in;
2170 fet_endchar;
2171
2172
2173 fet_beginchar ("Half down Funk mihead", "d1miFunk");
2174         draw_mi_head (funk_mi_width * funk_notehead_width,
2175                       funk_mi_weight, true);
2176         fill path_out;
2177         unfill path_in;
2178 fet_endchar;
2179
2180
2181 fet_beginchar ("Quarter Funk mihead", "s2miFunk");
2182         draw_mi_head (funk_mi_width * funk_notehead_width,
2183                       funk_mi_weight, false);
2184         fill path_out;
2185 fet_endchar;
2186
2187
2188 %%%%%%  Funk fa
2189 %       Triangle shape
2190 %       Does it rotate for whole notes?
2191 %       Same as other shape note systems
2192 %       Need special notes because of special width
2193 %
2194 save funk_fa_weight;
2195 funk_fa_weight := 1.9;
2196
2197 fet_beginchar ("Whole up Funk fahead", "u0faFunk");
2198         draw_fa_head (funk_notehead_width, funk_fa_weight);
2199         fill p_up_out;
2200         unfill p_up_in;
2201 fet_endchar;
2202
2203
2204 fet_beginchar ("Whole down Funk fahead", "d0faFunk");
2205         draw_fa_head (funk_notehead_width, funk_fa_weight);
2206         fill p_down_out;
2207         unfill p_down_in;
2208 fet_endchar;
2209
2210
2211 fet_beginchar ("Half up Funk fahead", "u1faFunk");
2212         draw_fa_head (funk_notehead_width, funk_fa_weight);
2213         fill p_up_out;
2214         unfill p_up_in;
2215 fet_endchar;
2216
2217
2218 fet_beginchar ("Half down Funk fahead", "d1faFunk");
2219         draw_fa_head (funk_notehead_width, funk_fa_weight);
2220         fill p_down_out;
2221         unfill p_down_in;
2222 fet_endchar;
2223
2224
2225 fet_beginchar ("Quarter up Funk fahead", "u2faFunk");
2226         draw_fa_head (funk_notehead_width, funk_fa_weight);
2227         fill p_up_out;
2228 fet_endchar;
2229
2230
2231 fet_beginchar ("Quarter down Funk fahead", "d2faFunk");
2232         draw_fa_head (funk_notehead_width, funk_fa_weight);
2233         fill p_down_out;
2234 fet_endchar;
2235
2236
2237 %%%%%%  Funk sol head is the same as the others
2238 %       Need special character because of skinnier head
2239 %
2240 def draw_Funk_sol_head (expr filled) =
2241 begingroup
2242         save noteheight;
2243         noteheight# := solfa_noteheight#;
2244         draw_outside_ellipse (1.2, 34, 0.71, 0.);
2245         if not filled:
2246           undraw_inside_ellipse (1.9, 33, 0.74, 5.5 stafflinethickness#);
2247         fi
2248         draw_staff (-2, 2, 0);
2249 endgroup
2250 enddef;
2251
2252
2253 fet_beginchar ("Whole Funk solhead", "s0solFunk");
2254         draw_Funk_sol_head ( false);
2255 fet_endchar;
2256
2257
2258 fet_beginchar ("Half Funk solhead", "s1solFunk");
2259         draw_Funk_sol_head ( false);
2260 fet_endchar;
2261
2262
2263 fet_beginchar ("Quarter Funk solhead", "s2solFunk");
2264         draw_Funk_sol_head ( true);
2265 fet_endchar;
2266
2267
2268 %%%%%%  Funk la head
2269 %       Rectangle head
2270 %       Same as for other shape notes
2271 %       Smaller width requires special characters
2272 %
2273 save funk_la_weight;
2274 funk_la_weight := 1.9;
2275
2276 fet_beginchar ("Whole Funk lahead", "s0laFunk");
2277         draw_la_head (funk_notehead_width, funk_notehead_width);
2278         fill p_out;
2279         unfill p_in;
2280 fet_endchar;
2281
2282
2283 fet_beginchar ("Half Funk lahead", "s1laFunk");
2284         draw_la_head (funk_notehead_width, funk_notehead_width);
2285         fill p_out;
2286         unfill p_in;
2287 fet_endchar;
2288
2289
2290 fet_beginchar ("Quarter Funk lahead", "s2laFunk");
2291         draw_la_head (funk_notehead_width, funk_notehead_width);
2292         fill p_out;
2293 fet_endchar;
2294
2295
2296 %%%%%%  Funk ti head
2297 %       `Sideways snow cone'.
2298 %       Rotates for all notes.
2299 %
2300 def draw_Funk_ti_head (expr width_factor, thickness_factor) =
2301         set_char_box (0, width_factor * solfa_base_notewidth#,
2302                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2303         save cone_width;
2304         cone_width = 0.8;
2305
2306         save offset;
2307         offset := 2 * thickness_factor - 1;
2308
2309         save pen_radius;
2310         pen_radius := min (solfa_pen_radius,
2311                            .33 * (h + d) / (1 + offset));
2312
2313         pickup pencircle scaled (2 * pen_radius);
2314
2315         lft x1 = 0;
2316         y1 = .5 [y2, y4];
2317
2318         x2 = cone_width [x1, x3];
2319         top y2 = h;
2320
2321         rt x3 = w;
2322         y3 = y1;
2323
2324         x4 = x2;
2325         bot y4 = -d;
2326
2327         save nw_dist, sw_dist, ne, se;
2328         pair nw_dist, sw_dist, ne, se;
2329
2330         ne = unitvector (z2 - z1);
2331         se = unitvector (z4 - z1);
2332
2333         nw_dist = (ne rotated 90) * pen_radius ;
2334         sw_dist = (se rotated -90) * pen_radius;
2335
2336         save path_a, path_b;
2337         path path_a, path_b;
2338         path_a := z1 - nw_dist
2339                   -- z2 - offset * nw_dist;
2340         path_b := z1 - sw_dist
2341                   -- z4 - offset * sw_dist;
2342
2343         save path_right, path_right_in;
2344         path path_right, path_right_in;
2345         path_right := (z2 + ne * pen_radius)
2346                       .. (rt z3){down}
2347                       .. (z4 + se * pen_radius);
2348
2349         path_right_in := (z2 - ne * pen_radius)
2350                          .. lft z3{down}
2351                          .. (z4 - se * pen_radius);
2352
2353         z5 = path_a intersectionpoint path_b;
2354         z6 = path_a intersectionpoint path_right_in;
2355         z7 = path_b intersectionpoint path_right_in;
2356
2357         save p_up_in, p_down_in, p_up_out, p_down_out;
2358         path p_up_in, p_down_in, p_up_out, p_down_out;
2359
2360         p_down_in := z5
2361                      -- z6
2362                      .. lft z3
2363                      .. z7
2364                      -- cycle;
2365
2366         p_down_out := lft z1
2367                       .. (z1 + nw_dist)
2368                       -- (z2 + nw_dist)
2369                       .. top z2
2370                       .. (z2 + ne * pen_radius){direction 0 of path_right}
2371                       & path_right
2372                       & {direction infinity of path_right}(z4 + se * pen_radius)
2373                       .. bot z4
2374                       .. (z4 + sw_dist)
2375                       -- (z1 + sw_dist)
2376                       .. cycle;
2377
2378         p_up_in := p_down_in rotated 180 shifted (w, 0);
2379         p_up_out := p_down_out rotated 180 shifted (w, 0);
2380 enddef;
2381
2382
2383 save funk_ti_weight;
2384 funk_ti_weight := 1.6;
2385
2386 fet_beginchar ("Whole up Funk tihead", "u0tiFunk");
2387         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2388         fill p_up_out;
2389         unfill p_up_in;
2390 fet_endchar;
2391
2392
2393 fet_beginchar ("Whole down Funk tihead", "d0tiFunk");
2394         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2395         fill p_down_out;
2396         unfill p_down_in;
2397 fet_endchar;
2398
2399
2400 fet_beginchar ("Half up Funk tihead", "u1tiFunk");
2401         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2402         fill p_up_out;
2403         unfill p_up_in;
2404 fet_endchar;
2405
2406
2407 fet_beginchar ("Half down Funk tihead", "d1tiFunk");
2408         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2409         fill p_down_out;
2410         unfill p_down_in;
2411 fet_endchar;
2412
2413
2414 fet_beginchar ("Quarter up Funk tihead", "u2tiFunk");
2415         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2416         fill p_up_out;
2417 fet_endchar;
2418
2419
2420 fet_beginchar ("Quarter down Funk tihead", "d2tiFunk");
2421         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2422         fill p_down_out;
2423 fet_endchar;
2424
2425
2426 %%%%%%   Walker shape note heads
2427 %
2428 % Walker heads are narrow like Funk heads, so use funk_notehead_width.
2429 %
2430
2431 %%%%%%   Walker do head
2432 %
2433 % Trapezoid, with largest side on stem side
2434 %
2435 def draw_Walker_do_head (expr width_factor, dir, thickness_factor) =
2436         set_char_box (0, width_factor * solfa_base_notewidth#,
2437                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2438
2439         pickup pencircle scaled solfa_pen_thick;
2440
2441         save offset;
2442         offset := 2 * thickness_factor - 1;
2443
2444         % adjust width so stem can be centered
2445         if .5w <> good.x .5w: change_width; fi
2446
2447         save scaling;
2448
2449         scaling# = charwd / w;
2450
2451         save inset;
2452         inset := 0.25;
2453
2454         x1 = inset [x4, x3];
2455         top y1 = h;
2456
2457         x2 = inset [x3, x4];
2458         y2 = y1;
2459
2460         bot y3 = -d;
2461         rt x3 = w;
2462
2463         y4 = y3;
2464         lft x4 = 0;
2465
2466         labels (range 1 thru 4);
2467
2468         save left_dir, left_perp, right_dir, right_perp;
2469         pair left_dir, left_perp, right_dir, right_perp;
2470
2471         left_dir = unitvector(z1 - z4);
2472         left_perp = (left_dir rotated 90) * solfa_pen_radius;
2473         right_dir = unitvector(z3 - z2);
2474         right_perp = (right_dir rotated 90) * solfa_pen_radius;
2475
2476         save path_a, path_b, path_c, path_d;
2477         path path_a, path_b, path_c, path_d;
2478
2479         path_a := (z4 - left_perp)
2480                   -- (z1 - left_perp);
2481         path_b := (z1 - (0, offset*solfa_pen_radius))
2482                   -- (z2 - (0, offset*solfa_pen_radius));
2483         path_c := (z2 - right_perp)
2484                   -- (z3 - right_perp);
2485         path_d := (z3 + (0, offset*solfa_pen_radius))
2486                   -- (z4 + (0, offset*solfa_pen_radius));
2487
2488         save p_in, p_out;
2489         path p_in, p_out;
2490
2491         p_in := (path_a intersectionpoint path_b)
2492                 -- (path_b intersectionpoint path_c)
2493                 -- (path_c intersectionpoint path_d)
2494                 -- (path_d intersectionpoint path_a)
2495                 -- cycle;
2496
2497         p_out := top z1{right}
2498                  -- top z2{right}
2499                  .. z2 + right_perp {right_dir}
2500                  -- z3 + right_perp {right_dir}
2501                  .. bot z3{left}
2502                  -- bot z4{left}
2503                  .. z4 + left_perp {left_dir}
2504                  .. z1 + left_perp {left_dir}
2505                  .. cycle;
2506
2507         charwx := scaling# * (w/2 + solfa_pen_radius);
2508         charwy := scaling# * y2 ;
2509
2510         if dir = 1:
2511                 p_in := p_in rotated 180 shifted (w,0);
2512                 p_out := p_out rotated 180 shifted (w,0);
2513         fi;
2514 enddef;
2515
2516
2517 save walker_do_weight;
2518 walker_do_weight := 1.5;
2519
2520 fet_beginchar ("Whole Walker dohead", "s0doWalker");
2521         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2522         fill p_out;
2523         unfill p_in;
2524 fet_endchar;
2525
2526
2527 fet_beginchar ("Half up Walker dohead", "u1doWalker");
2528         draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2529         fill p_out;
2530         unfill p_in;
2531 fet_endchar;
2532
2533
2534 fet_beginchar ("Half down Walker dohead", "d1doWalker");
2535         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2536         fill p_out;
2537         unfill p_in;
2538 fet_endchar;
2539
2540
2541 fet_beginchar ("Quarter up Walker dohead", "u2doWalker");
2542         draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2543         fill p_out;
2544 fet_endchar;
2545
2546
2547 fet_beginchar ("Quarter down Walker dohead", "d2doWalker");
2548         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2549         fill p_out;
2550 fet_endchar;
2551
2552
2553 %%%%%%   Walker re head
2554 %          Parabolic on one side, shallow parabola on other
2555 %          Has up and down shapes for *all* notes
2556 %
2557 def draw_Walker_re_head (expr width_factor, thickness_factor) =
2558         set_char_box (0, width_factor * solfa_base_notewidth#,
2559                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2560
2561         save offset;
2562         offset := 2 * thickness_factor - 1;
2563
2564         save pen_radius;
2565         pen_radius := min (solfa_pen_radius,
2566                            .3 * (h + d) / (1 + offset));
2567
2568         pickup pencircle scaled (2 * pen_radius);
2569
2570         save dish_factor;
2571         dish_factor := 0.20;
2572
2573         rt x1 = w;
2574         bot y1 = -d;
2575
2576         lft x2 = 0;
2577         y2 = 0.5 [y1, y3];
2578
2579         top y3 = h;
2580         x3 = x1;
2581
2582         x4 = dish_factor [x1, x2];
2583         y4 = y2;
2584
2585         x5 = x1;
2586         y5 = y1 + offset * pen_radius;
2587
2588         y6 = y2;
2589         x6 = x2 + pen_radius;
2590
2591         x7 = x3;
2592         y7 = y3 - offset * pen_radius;
2593
2594         y8 = y4;
2595         x8 = x4 - pen_radius;
2596
2597         save path_a, path_d;
2598         path path_a, path_d;
2599
2600         save p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2601         pair p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2602
2603         path_a := z3 .. z4{down} .. z1;
2604
2605         p_a_start_dir := unitvector(direction 0 of path_a);
2606         p_a_end_dir := unitvector(direction infinity of path_a);
2607         p_a_start_perp := (p_a_start_dir rotated 90) * pen_radius;
2608         p_a_end_perp := (p_a_end_dir rotated 90) * pen_radius;
2609
2610         path_d := (z3 - p_a_start_perp){p_a_start_dir}
2611                   .. z4 {down}
2612                   ..(z1 - p_a_end_perp){p_a_end_dir};
2613
2614         save path_b, path_c;
2615         path path_b, path_c;
2616
2617         path_b := z5 {left} .. z6{up};
2618         path_c := z7 {left} .. z6{down};
2619
2620         z9 = path_d intersectionpoint path_b;
2621         z10 = path_d intersectionpoint path_c;
2622
2623         labels (range 1 thru 4);
2624
2625         save p_up_in, p_up_out, p_down_in, p_down_out;
2626         path p_up_in, p_up_out, p_down_in, p_down_out;
2627
2628         p_down_in := z6{up}
2629                      ... {right} z10 {p_a_start_dir}
2630                      .. z8{down}
2631                      .. {p_a_end_dir} z9 {left}
2632                      ... cycle;
2633
2634         p_down_out := lft z2{up}
2635                       .. top z3{right}
2636                       .. rt z3
2637                       .. (z3 + p_a_start_perp){p_a_start_dir}
2638                       .. rt z4{down}
2639                       .. (z1 + p_a_end_perp) {p_a_end_dir}
2640                       .. rt z1
2641                       .. bot z1 {left}
2642                       .. cycle;
2643
2644         p_up_in := p_down_in rotated 180 shifted (w,0);
2645         p_up_out := p_down_out rotated 180 shifted (w,0);
2646 enddef;
2647
2648
2649 save walker_re_weight;
2650 walker_re_weight := 1.2;
2651
2652 fet_beginchar ("Whole Walker rehead", "s0reWalker");
2653         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2654         fill p_down_out;
2655         unfill p_down_in;
2656 fet_endchar;
2657
2658
2659 fet_beginchar ("Half up Walker rehead", "u1reWalker");
2660         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2661         fill p_up_out;
2662         unfill p_up_in;
2663 fet_endchar;
2664
2665
2666 fet_beginchar ("Half down Walker rehead", "d1reWalker");
2667         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2668         fill p_down_out;
2669         unfill p_down_in;
2670 fet_endchar;
2671
2672
2673 fet_beginchar ("Quarter up Walker rehead", "u2reWalker");
2674         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2675         fill p_up_out;
2676 fet_endchar;
2677
2678
2679 fet_beginchar ("Quarter down Walker rehead", "d2reWalker");
2680         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2681         fill p_down_out;
2682 fet_endchar;
2683
2684
2685 %%%%%%  Walker mi head
2686 %       Diamond shape
2687 %       Symmetric for all hollow notes
2688 %
2689 save walker_mi_width, walker_mi_weight;
2690 walker_mi_width := 1.2;
2691 walker_mi_weight := 1.5;
2692
2693 fet_beginchar ("Whole Walker mihead", "s0miWalker");
2694         draw_mi_head (walker_mi_width * funk_notehead_width,
2695                       walker_mi_weight, true);
2696         fill path_out;
2697         unfill path_in;
2698 fet_endchar;
2699
2700
2701 fet_beginchar ("Half Walker mihead", "s1miWalker");
2702         draw_mi_head (walker_mi_width * funk_notehead_width,
2703                       walker_mi_weight, true);
2704         fill path_out;
2705         unfill path_in;
2706 fet_endchar;
2707
2708
2709 fet_beginchar ("Quarter Walker mihead", "s2miWalker");
2710         draw_mi_head (walker_mi_width * funk_notehead_width,
2711                       walker_mi_weight, true);
2712         fill path_out;
2713 fet_endchar;
2714
2715
2716 %%%%%%  Walker fa
2717 %       Triangle shape
2718 %       Does not rotate for whole notes
2719 %       Whole rotation is different from Funk, so special notes
2720
2721 %%%%%%  Funk sol head is the same as the others
2722 %       Need special character because of skinnier head
2723 %
2724 save walker_fa_weight;
2725 walker_fa_weight := 1.5;
2726
2727 fet_beginchar ("Whole Walker fahead", "s0faWalker");
2728         draw_fa_head (funk_notehead_width, walker_fa_weight);
2729         fill p_down_out;
2730         unfill p_down_in;
2731 fet_endchar;
2732
2733
2734 fet_beginchar ("Half up Walker fahead", "u1faWalker");
2735         draw_fa_head (funk_notehead_width, walker_fa_weight);
2736         fill p_up_out;
2737         unfill p_up_in;
2738 fet_endchar;
2739
2740
2741 fet_beginchar ("Half down Walker fahead", "d1faWalker");
2742         draw_fa_head (funk_notehead_width, walker_fa_weight);
2743         fill p_down_out;
2744         unfill p_down_in;
2745 fet_endchar;
2746
2747
2748 fet_beginchar ("Quarter up Walker fahead", "u2faWalker");
2749         draw_fa_head (funk_notehead_width, walker_fa_weight);
2750         fill p_up_out;
2751 fet_endchar;
2752
2753
2754 fet_beginchar ("Quarter down Walker fahead", "d2faWalker");
2755         draw_fa_head (funk_notehead_width, walker_fa_weight);
2756         fill p_down_out;
2757 fet_endchar;
2758
2759
2760 %%%%%%  Walker sol
2761 %       Same as Funk, no special notes
2762 %
2763
2764 %%%%%%  Walker la head
2765 %       Rectcangle head
2766 %       Lighter weight requires separate notes
2767 %
2768 save walker_la_weight;
2769 walker_la_weight := 1.5;
2770
2771 fet_beginchar ("Whole Walker lahead", "s0laWalker");
2772         draw_la_head (funk_notehead_width, walker_la_weight);
2773         fill p_out;
2774         unfill p_in;
2775 fet_endchar;
2776
2777
2778 fet_beginchar ("Half Funk lahead", "s1laWalker");
2779         draw_la_head (funk_notehead_width, walker_la_weight);
2780         fill p_out;
2781         unfill p_in;
2782 fet_endchar;
2783
2784
2785 fet_beginchar ("Quarter Funk lahead", "s2laWalker");
2786         draw_la_head (funk_notehead_width, walker_la_weight);
2787         fill p_out;
2788 fet_endchar;
2789
2790
2791 %%%%%%  Walker ti head
2792 %       Triangular arrowhead
2793 %       Rotates for all but whole notes
2794 %
2795 def draw_Walker_ti_head (expr width_factor, thickness_factor) =
2796         set_char_box (0, width_factor * solfa_base_notewidth#,
2797                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2798
2799         save offset;
2800         offset := 2 * thickness_factor - 1;
2801
2802         save pen_radius;
2803         pen_radius := min (solfa_pen_radius,
2804                            .3 * (h + d) / (1 + offset));
2805
2806         pickup pencircle scaled (2 * pen_radius);
2807
2808         lft x1 = 0;
2809         y1 = .5 [y2, y3];
2810
2811         rt x2 = w;
2812         top y2 = h;
2813
2814         x3 = x2;
2815         bot y3 = -d;
2816
2817
2818         labels (range 1 thru 4);
2819
2820         save nw_dist, sw_dist, ne, se;
2821         pair nw_dist, sw_dist, ne, se;
2822
2823         ne = unitvector (z2 - z1);
2824         se = unitvector (z3 - z1);
2825
2826         nw_dist = (ne rotated 90) * pen_radius ;
2827         sw_dist = (se rotated -90) * pen_radius;
2828
2829
2830         save path_a, path_b, path_c;
2831         path path_a, path_b, path_c;
2832         path_a := z2 - nw_dist * offset
2833                   -- z1 - nw_dist * offset;
2834         path_b := z3 - sw_dist * offset
2835                   -- z1 - sw_dist * offset;
2836         path_c := z2 + left * pen_radius
2837                   -- z3 + left * pen_radius;
2838
2839         z4 = path_a intersectionpoint path_b;
2840         z5 = path_a intersectionpoint path_c;
2841         z6 = path_b intersectionpoint path_c;
2842
2843         save p_up_in, p_down_in, p_up_out, p_down_out;
2844         path p_up_in, p_down_in, p_up_out, p_down_out;
2845
2846         p_down_in := z4
2847                      -- z5
2848                      -- z6
2849                      -- cycle;
2850
2851         p_down_out := lft z1{up}
2852                       .. (z1 + nw_dist){ne}
2853                       -- (z2 + nw_dist){ne}
2854                       .. top z2{right}
2855                       .. rt z2 {down}
2856                       -- rt z3 {down}
2857                       .. bot z3 {left}
2858                       .. (z3 + sw_dist){- se}
2859                       .. (z1 + sw_dist){- se}
2860                       .. cycle;
2861
2862         p_up_in := p_down_in rotated 180 shifted (w, 0);
2863         p_up_out := p_down_out rotated 180 shifted (w, 0);
2864 enddef;
2865
2866
2867 save walker_ti_weight;
2868 walker_ti_weight := 1.4;
2869
2870 fet_beginchar ("Whole Walker tihead", "s0tiWalker");
2871         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2872         fill p_down_out;
2873         unfill p_down_in;
2874 fet_endchar;
2875
2876
2877 fet_beginchar ("Half up Walker tihead", "u1tiWalker");
2878         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2879         fill p_up_out;
2880         unfill p_up_in;
2881 fet_endchar;
2882
2883
2884 fet_beginchar ("Half down Walker tihead", "d1tiWalker");
2885         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2886         fill p_down_out;
2887         unfill p_down_in;
2888 fet_endchar;
2889
2890
2891 fet_beginchar ("Quarter up Walker tihead", "u2tiWalker");
2892         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2893         fill p_up_out;
2894 fet_endchar;
2895
2896
2897 fet_beginchar ("Quarter down Walker tihead", "d2tiWalker");
2898         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2899         fill p_down_out;
2900 fet_endchar;
2901
2902 fet_endgroup ("noteheads");
2903
2904
2905 %
2906 % we derive black_notehead_width# from the quarter head,
2907 % so we have to define black_notehead_width (pixel qty)
2908 % after the black_notehead_width# itself.
2909 %
2910 % Let's keep it outside the group as well.
2911 %
2912
2913 define_pixels (black_notehead_width);