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