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