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