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 % 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, mi_width;
1226 mi_weight := 2;
1227 mi_width := 1.2;
1228
1229 fet_beginchar ("Whole mihead", "s0mi");
1230         draw_mi_head (mi_width * solfa_whole_width, mi_weight, false);
1231         fill path_out;
1232         unfill path_in;
1233 fet_endchar;
1234
1235
1236 fet_beginchar ("Half mihead", "s1mi");
1237         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1238         fill path_out;
1239         unfill path_in;
1240 fet_endchar;
1241
1242
1243 fet_beginchar ("Quarter mihead", "s2mi");
1244         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1245         fill path_out;
1246 fet_endchar;
1247
1248
1249 fet_beginchar ("Whole mirror mihead", "s0miMirror");
1250         draw_mi_head (mi_width * solfa_whole_width, mi_weight, true);
1251         fill path_out;
1252         unfill path_in;
1253 fet_endchar;
1254
1255
1256 fet_beginchar ("Half  mirror mihead", "s1miMirror");
1257         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1258         fill path_out;
1259         unfill path_in;
1260 fet_endchar;
1261
1262
1263 fet_beginchar ("Quarter mirror mihead", "s2miMirror");
1264         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1265         fill path_out;
1266 fet_endchar;
1267
1268
1269 fet_beginchar ("Whole thin mihead", "s0miThin");
1270         draw_mi_head (mi_width * solfa_whole_width, 1, false);
1271         fill path_out;
1272         unfill path_in;
1273 fet_endchar;
1274
1275
1276 fet_beginchar ("Half thin mihead", "s1miThin");
1277         draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1278         fill path_out;
1279         unfill path_in;
1280 fet_endchar;
1281
1282
1283 fet_beginchar ("Quarter thin mihead", "s2miThin");
1284         draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1285         fill path_out;
1286 fet_endchar;
1287
1288
1289 %%%% fa head
1290 %
1291 % Right triangle, hypotenuse from nw to se corner.  Stem attaches on
1292 % vertical side in direction of horizontal side.
1293 %
1294 def draw_fa_head (expr width_factor, thickness_factor) =
1295         set_char_box (0, width_factor * solfa_base_notewidth#,
1296                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1297
1298         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1299         path p_down_in, p_down_out, p_up_in, p_up_out;
1300         save path_a, path_b, path_c;
1301         path path_a, path_b, path_c;
1302         pair nw_dist, nw;
1303
1304         save offset;
1305         offset := 2 * thickness_factor - 1;
1306
1307         save pen_radius;
1308         pen_radius := min (solfa_pen_radius,
1309                            .33 * (h + d) / (1 + offset));
1310
1311         pickup pencircle scaled (2 * pen_radius);
1312
1313         lft x1 = 0;
1314         top y1 = h;
1315
1316         rt x2 = w;
1317         y2 = y1;
1318         bot y3 = -d;
1319         x3 = x2;
1320
1321         y4 = y3;
1322         x4 = x1;
1323
1324         labels (1, 2, 3, 4);
1325
1326         nw = unitvector (z1 - z3);
1327         nw_dist = (nw rotated 90) * pen_radius;
1328
1329         path_a := (z1 - (0,1) * offset * pen_radius)
1330                   -- (z2 - (0,1) * offset * pen_radius);
1331         path_b := (z2 - (1,0) * pen_radius)
1332                   -- (z3 - (1,0) * pen_radius);
1333         path_c := (z3 - nw_dist)
1334                   -- (z1 - nw_dist);
1335
1336         p_up_in := (path_a intersectionpoint path_b)
1337                    -- (path_b intersectionpoint path_c)
1338                    -- (path_c intersectionpoint path_a)
1339                    -- cycle;
1340
1341         p_up_out := lft z1{down}
1342                     .. (z1 + nw_dist){-nw}
1343                     -- (z3 + nw_dist){-nw}
1344                     .. bot z3{right}
1345                     .. rt z3{up}
1346                     -- rt z2{up}
1347                     .. top z2{left}
1348                     -- top z1{left}
1349                     .. cycle;
1350
1351         p_down_in := p_up_in rotated 180 shifted (w, 0);
1352         p_down_out := p_up_out rotated 180 shifted (w, 0);
1353
1354         charwy := 0.0;
1355         charwx := charwd;
1356 enddef;
1357
1358 save fa_weight;
1359 fa_weight := 1.75;
1360
1361 fet_beginchar ("Whole fa up head", "u0fa");
1362         draw_fa_head (solfa_whole_width, fa_weight);
1363         fill p_up_out;
1364         unfill p_up_in;
1365 fet_endchar;
1366
1367
1368 fet_beginchar ("Whole fa down head", "d0fa");
1369         draw_fa_head (solfa_whole_width, fa_weight);
1370         fill p_down_out;
1371         unfill p_down_in;
1372 fet_endchar;
1373
1374
1375 fet_beginchar ("half fa up head", "u1fa");
1376         draw_fa_head (solfa_half_width, fa_weight);
1377         fill p_up_out;
1378         unfill p_up_in;
1379 fet_endchar;
1380
1381
1382 fet_beginchar ("Half fa down head", "d1fa");
1383         draw_fa_head (solfa_half_width, fa_weight);
1384         fill p_down_out;
1385         unfill p_down_in;
1386 fet_endchar;
1387
1388
1389 fet_beginchar ("Quarter fa up head", "u2fa");
1390         draw_fa_head (solfa_quarter_width, fa_weight);
1391         fill p_up_out;
1392 fet_endchar;
1393
1394
1395 fet_beginchar ("Quarter fa down head", "d2fa");
1396         draw_fa_head (solfa_quarter_width, fa_weight);
1397         fill p_down_out;
1398 fet_endchar;
1399
1400
1401 fet_beginchar ("Whole thin fa up head", "u0faThin");
1402         draw_fa_head (solfa_whole_width, 1);
1403         fill p_up_out;
1404         unfill p_up_in;
1405 fet_endchar;
1406
1407
1408 fet_beginchar ("Whole thin fa down head", "d0faThin");
1409         draw_fa_head (solfa_whole_width, 1);
1410         fill p_down_out;
1411         unfill p_down_in;
1412 fet_endchar;
1413
1414
1415 fet_beginchar ("half thin fa up head", "u1faThin");
1416         draw_fa_head (solfa_half_width, 1);
1417         fill p_up_out;
1418         unfill p_up_in;
1419 fet_endchar;
1420
1421
1422 fet_beginchar ("Half thin fa down head", "d1faThin");
1423         draw_fa_head (solfa_half_width, 1);
1424         fill p_down_out;
1425         unfill p_down_in;
1426 fet_endchar;
1427
1428
1429 fet_beginchar ("Quarter thin fa up head", "u2faThin");
1430         draw_fa_head (solfa_quarter_width, 1);
1431         fill p_up_out;
1432 fet_endchar;
1433
1434
1435 fet_beginchar ("Quarter thin fa down head", "d2faThin");
1436         draw_fa_head (solfa_quarter_width, 1);
1437         fill p_down_out;
1438 fet_endchar;
1439
1440
1441
1442 %%%% sol head
1443 %
1444 % Note: sol head is the same shape as a standard music head, and doesn't
1445 %       vary from style to style.  However, width is constant with duration,
1446 %       so we can't just use the standard note font.
1447 %
1448 def draw_sol_head (expr filled) =
1449         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
1450         if not filled:
1451           undraw_inside_ellipse (3.25, 33, 0.81, 2.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_width, funk_mi_weight;
1970 funk_mi_width := 1.2;
1971 funk_mi_weight := 1.9;
1972
1973 fet_beginchar ("Whole up Funk mihead", "u0miFunk");
1974         draw_mi_head (funk_mi_width * funk_notehead_width,
1975                       funk_mi_weight, false);
1976         fill path_out;
1977         unfill path_in;
1978 fet_endchar;
1979
1980
1981 fet_beginchar ("Whole down Funk mihead", "d0miFunk");
1982         draw_mi_head (funk_mi_width * funk_notehead_width,
1983                       funk_mi_weight, true);
1984         fill path_out;
1985         unfill path_in;
1986 fet_endchar;
1987
1988
1989 fet_beginchar ("Half up Funk mihead", "u1miFunk");
1990         draw_mi_head (funk_mi_width * funk_notehead_width,
1991                       funk_mi_weight, false);
1992         fill path_out;
1993         unfill path_in;
1994 fet_endchar;
1995
1996
1997 fet_beginchar ("Half down Funk mihead", "d1miFunk");
1998         draw_mi_head (funk_mi_width * funk_notehead_width,
1999                       funk_mi_weight, true);
2000         fill path_out;
2001         unfill path_in;
2002 fet_endchar;
2003
2004
2005 fet_beginchar ("Quarter Funk mihead", "s2miFunk");
2006         draw_mi_head (funk_mi_width * funk_notehead_width,
2007                       funk_mi_weight, false);
2008         fill path_out;
2009 fet_endchar;
2010
2011
2012 %%%%%%  Funk fa
2013 %       Triangle shape
2014 %       Does it rotate for whole notes?
2015 %       Same as other shape note systems
2016 %       Need special notes because of special width
2017 %
2018 save funk_fa_weight;
2019 funk_fa_weight := 1.9;
2020
2021 fet_beginchar ("Whole up Funk fahead", "u0faFunk");
2022         draw_fa_head (funk_notehead_width, funk_fa_weight);
2023         fill p_up_out;
2024         unfill p_up_in;
2025 fet_endchar;
2026
2027
2028 fet_beginchar ("Whole down Funk fahead", "d0faFunk");
2029         draw_fa_head (funk_notehead_width, funk_fa_weight);
2030         fill p_down_out;
2031         unfill p_down_in;
2032 fet_endchar;
2033
2034
2035 fet_beginchar ("Half up Funk fahead", "u1faFunk");
2036         draw_fa_head (funk_notehead_width, funk_fa_weight);
2037         fill p_up_out;
2038         unfill p_up_in;
2039 fet_endchar;
2040
2041
2042 fet_beginchar ("Half down Funk fahead", "d1faFunk");
2043         draw_fa_head (funk_notehead_width, funk_fa_weight);
2044         fill p_down_out;
2045         unfill p_down_in;
2046 fet_endchar;
2047
2048
2049 fet_beginchar ("Quarter up Funk fahead", "u2faFunk");
2050         draw_fa_head (funk_notehead_width, funk_fa_weight);
2051         fill p_up_out;
2052 fet_endchar;
2053
2054
2055 fet_beginchar ("Quarter down Funk fahead", "d2faFunk");
2056         draw_fa_head (funk_notehead_width, funk_fa_weight);
2057         fill p_down_out;
2058 fet_endchar;
2059
2060
2061 %%%%%%  Funk sol head is the same as the others
2062 %       Need special character because of skinnier head
2063 %
2064 def draw_Funk_sol_head (expr filled) =
2065 begingroup
2066         save noteheight;
2067         noteheight# := solfa_noteheight#;
2068         draw_outside_ellipse (1.2, 34, 0.71, 0.);
2069         if not filled:
2070           undraw_inside_ellipse (1.9, 33, 0.74, 5.5 stafflinethickness#);
2071         fi
2072         draw_staff_if_debugging (-2, 2);
2073 endgroup
2074 enddef;
2075
2076
2077 fet_beginchar ("Whole Funk solhead", "s0solFunk");
2078         draw_Funk_sol_head ( false);
2079 fet_endchar;
2080
2081
2082 fet_beginchar ("Half Funk solhead", "s1solFunk");
2083         draw_Funk_sol_head ( false);
2084 fet_endchar;
2085
2086
2087 fet_beginchar ("Quarter Funk solhead", "s2solFunk");
2088         draw_Funk_sol_head ( true);
2089 fet_endchar;
2090
2091
2092 %%%%%%  Funk la head
2093 %       Rectangle head
2094 %       Same as for other shape notes
2095 %       Smaller width requires special characters
2096 %
2097 save funk_la_weight;
2098 funk_la_weight := 1.9;
2099
2100 fet_beginchar ("Whole Funk lahead", "s0laFunk");
2101         draw_la_head (funk_notehead_width, funk_notehead_width);
2102         fill p_out;
2103         unfill p_in;
2104 fet_endchar;
2105
2106
2107 fet_beginchar ("Half Funk lahead", "s1laFunk");
2108         draw_la_head (funk_notehead_width, funk_notehead_width);
2109         fill p_out;
2110         unfill p_in;
2111 fet_endchar;
2112
2113
2114 fet_beginchar ("Quarter Funk lahead", "s2laFunk");
2115         draw_la_head (funk_notehead_width, funk_notehead_width);
2116         fill p_out;
2117 fet_endchar;
2118
2119
2120 %%%%%%  Funk ti head
2121 %       `Sideways snow cone'.
2122 %       Rotates for all notes.
2123 %
2124 def draw_Funk_ti_head (expr width_factor, thickness_factor) =
2125         set_char_box (0, width_factor * solfa_base_notewidth#,
2126                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2127         save cone_width;
2128         cone_width = 0.8;
2129
2130         save offset;
2131         offset := 2 * thickness_factor - 1;
2132
2133         save pen_radius;
2134         pen_radius := min (solfa_pen_radius,
2135                            .33 * (h + d) / (1 + offset));
2136
2137         pickup pencircle scaled (2 * pen_radius);
2138
2139         lft x1 = 0;
2140         y1 = .5 [y2, y4];
2141
2142         x2 = cone_width [x1, x3];
2143         top y2 = h;
2144
2145         rt x3 = w;
2146         y3 = y1;
2147
2148         x4 = x2;
2149         bot y4 = -d;
2150
2151         save nw_dist, sw_dist, ne, se;
2152         pair nw_dist, sw_dist, ne, se;
2153
2154         ne = unitvector (z2 - z1);
2155         se = unitvector (z4 - z1);
2156
2157         nw_dist = (ne rotated 90) * pen_radius ;
2158         sw_dist = (se rotated -90) * pen_radius;
2159
2160         save path_a, path_b;
2161         path path_a, path_b;
2162         path_a := z1 - nw_dist
2163                   -- z2 - offset * nw_dist;
2164         path_b := z1 - sw_dist
2165                   -- z4 - offset * sw_dist;
2166
2167         save path_right, path_right_in;
2168         path path_right, path_right_in;
2169         path_right := (z2 + ne * pen_radius)
2170                       .. (rt z3){down}
2171                       .. (z4 + se * pen_radius);
2172
2173         path_right_in := (z2 - ne * pen_radius)
2174                          .. lft z3{down}
2175                          .. (z4 - se * pen_radius);
2176
2177         z5 = path_a intersectionpoint path_b;
2178         z6 = path_a intersectionpoint path_right_in;
2179         z7 = path_b intersectionpoint path_right_in;
2180
2181         save p_up_in, p_down_in, p_up_out, p_down_out;
2182         path p_up_in, p_down_in, p_up_out, p_down_out;
2183
2184         p_down_in := z5
2185                      -- z6
2186                      .. lft z3
2187                      .. z7
2188                      -- cycle;
2189
2190         p_down_out := lft z1
2191                       .. (z1 + nw_dist)
2192                       -- (z2 + nw_dist)
2193                       .. top z2
2194                       .. (z2 + ne * pen_radius){direction 0 of path_right}
2195                       & path_right
2196                       & {direction infinity of path_right}(z4 + se * pen_radius)
2197                       .. bot z4
2198                       .. (z4 + sw_dist)
2199                       -- (z1 + sw_dist)
2200                       .. cycle;
2201
2202         p_up_in := p_down_in rotated 180 shifted (w, 0);
2203         p_up_out := p_down_out rotated 180 shifted (w, 0);
2204 enddef;
2205
2206
2207 save funk_ti_weight;
2208 funk_ti_weight := 1.6;
2209
2210 fet_beginchar ("Whole up Funk tihead", "u0tiFunk");
2211         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2212         fill p_up_out;
2213         unfill p_up_in;
2214 fet_endchar;
2215
2216
2217 fet_beginchar ("Whole down Funk tihead", "d0tiFunk");
2218         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2219         fill p_down_out;
2220         unfill p_down_in;
2221 fet_endchar;
2222
2223
2224 fet_beginchar ("Half up Funk tihead", "u1tiFunk");
2225         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2226         fill p_up_out;
2227         unfill p_up_in;
2228 fet_endchar;
2229
2230
2231 fet_beginchar ("Half down Funk tihead", "d1tiFunk");
2232         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2233         fill p_down_out;
2234         unfill p_down_in;
2235 fet_endchar;
2236
2237
2238 fet_beginchar ("Quarter up Funk tihead", "u2tiFunk");
2239         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2240         fill p_up_out;
2241 fet_endchar;
2242
2243
2244 fet_beginchar ("Quarter down Funk tihead", "d2tiFunk");
2245         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2246         fill p_down_out;
2247 fet_endchar;
2248
2249
2250 %%%%%%   Walker shape note heads
2251 %
2252 % Walker heads are narrow like Funk heads, so use funk_notehead_width.
2253 %
2254
2255 %%%%%%   Walker do head
2256 %
2257 % Trapezoid, with largest side on stem side
2258 %
2259 def draw_Walker_do_head (expr width_factor, dir, thickness_factor) =
2260         set_char_box (0, width_factor * solfa_base_notewidth#,
2261                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2262
2263         pickup pencircle scaled solfa_pen_thick;
2264
2265         save offset;
2266         offset := 2 * thickness_factor - 1;
2267
2268         % adjust width so stem can be centered
2269         if .5w <> good.x .5w: change_width; fi
2270
2271         save scaling;
2272
2273         scaling# = charwd / w;
2274
2275         save inset;
2276         inset := 0.25;
2277
2278         x1 = inset [x4, x3];
2279         top y1 = h;
2280
2281         x2 = inset [x3, x4];
2282         y2 = y1;
2283
2284         bot y3 = -d;
2285         rt x3 = w;
2286
2287         y4 = y3;
2288         lft x4 = 0;
2289
2290         labels (range 1 thru 4);
2291
2292         save left_dir, left_perp, right_dir, right_perp;
2293         pair left_dir, left_perp, right_dir, right_perp;
2294
2295         left_dir = unitvector(z1 - z4);
2296         left_perp = (left_dir rotated 90) * solfa_pen_radius;
2297         right_dir = unitvector(z3 - z2);
2298         right_perp = (right_dir rotated 90) * solfa_pen_radius;
2299
2300         save path_a, path_b, path_c, path_d;
2301         path path_a, path_b, path_c, path_d;
2302
2303         path_a := (z4 - left_perp)
2304                   -- (z1 - left_perp);
2305         path_b := (z1 - (0, offset*solfa_pen_radius))
2306                   -- (z2 - (0, offset*solfa_pen_radius));
2307         path_c := (z2 - right_perp)
2308                   -- (z3 - right_perp);
2309         path_d := (z3 + (0, offset*solfa_pen_radius))
2310                   -- (z4 + (0, offset*solfa_pen_radius));
2311
2312         save p_in, p_out;
2313         path p_in, p_out;
2314
2315         p_in := (path_a intersectionpoint path_b)
2316                 -- (path_b intersectionpoint path_c)
2317                 -- (path_c intersectionpoint path_d)
2318                 -- (path_d intersectionpoint path_a)
2319                 -- cycle;
2320
2321         p_out := top z1{right}
2322                  -- top z2{right}
2323                  .. z2 + right_perp {right_dir}
2324                  -- z3 + right_perp {right_dir}
2325                  .. bot z3{left}
2326                  -- bot z4{left}
2327                  .. z4 + left_perp {left_dir}
2328                  .. z1 + left_perp {left_dir}
2329                  .. cycle;
2330
2331         charwx := scaling# * (w/2 + solfa_pen_radius);
2332         charwy := scaling# * y2 ;
2333
2334         if dir = 1:
2335                 p_in := p_in rotated 180 shifted (w,0);
2336                 p_out := p_out rotated 180 shifted (w,0);
2337         fi;
2338 enddef;
2339
2340
2341 save walker_do_weight;
2342 walker_do_weight := 1.5;
2343
2344 fet_beginchar ("Whole Walker dohead", "s0doWalker");
2345         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2346         fill p_out;
2347         unfill p_in;
2348 fet_endchar;
2349
2350
2351 fet_beginchar ("Half up Walker dohead", "u1doWalker");
2352         draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2353         fill p_out;
2354         unfill p_in;
2355 fet_endchar;
2356
2357
2358 fet_beginchar ("Half down Walker dohead", "d1doWalker");
2359         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2360         fill p_out;
2361         unfill p_in;
2362 fet_endchar;
2363
2364
2365 fet_beginchar ("Quarter up Walker dohead", "u2doWalker");
2366         draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2367         fill p_out;
2368 fet_endchar;
2369
2370
2371 fet_beginchar ("Quarter down Walker dohead", "d2doWalker");
2372         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2373         fill p_out;
2374 fet_endchar;
2375
2376
2377 %%%%%%   Walker re head
2378 %          Parabolic on one side, shallow parabola on other
2379 %          Has up and down shapes for *all* notes
2380 %
2381 def draw_Walker_re_head (expr width_factor, thickness_factor) =
2382         set_char_box (0, width_factor * solfa_base_notewidth#,
2383                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2384
2385         save offset;
2386         offset := 2 * thickness_factor - 1;
2387
2388         save pen_radius;
2389         pen_radius := min (solfa_pen_radius,
2390                            .3 * (h + d) / (1 + offset));
2391
2392         pickup pencircle scaled (2 * pen_radius);
2393
2394         save dish_factor;
2395         dish_factor := 0.20;
2396
2397         rt x1 = w;
2398         bot y1 = -d;
2399
2400         lft x2 = 0;
2401         y2 = 0.5 [y1, y3];
2402
2403         top y3 = h;
2404         x3 = x1;
2405
2406         x4 = dish_factor [x1, x2];
2407         y4 = y2;
2408
2409         x5 = x1;
2410         y5 = y1 + offset * pen_radius;
2411
2412         y6 = y2;
2413         x6 = x2 + pen_radius;
2414
2415         x7 = x3;
2416         y7 = y3 - offset * pen_radius;
2417
2418         y8 = y4;
2419         x8 = x4 - pen_radius;
2420
2421         save path_a, path_d;
2422         path path_a, path_d;
2423
2424         save p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2425         pair p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2426
2427         path_a := z3 .. z4{down} .. z1;
2428
2429         p_a_start_dir := unitvector(direction 0 of path_a);
2430         p_a_end_dir := unitvector(direction infinity of path_a);
2431         p_a_start_perp := (p_a_start_dir rotated 90) * pen_radius;
2432         p_a_end_perp := (p_a_end_dir rotated 90) * pen_radius;
2433
2434         path_d := (z3 - p_a_start_perp){p_a_start_dir}
2435                   .. z4 {down}
2436                   ..(z1 - p_a_end_perp){p_a_end_dir};
2437
2438         save path_b, path_c;
2439         path path_b, path_c;
2440
2441         path_b := z5 {left} .. z6{up};
2442         path_c := z7 {left} .. z6{down};
2443
2444         z9 = path_d intersectionpoint path_b;
2445         z10 = path_d intersectionpoint path_c;
2446
2447         labels (range 1 thru 4);
2448
2449         save p_up_in, p_up_out, p_down_in, p_down_out;
2450         path p_up_in, p_up_out, p_down_in, p_down_out;
2451
2452         p_down_in := z6{up}
2453                      ... {right} z10 {p_a_start_dir}
2454                      .. z8{down}
2455                      .. {p_a_end_dir} z9 {left}
2456                      ... cycle;
2457
2458         p_down_out := lft z2{up}
2459                       .. top z3{right}
2460                       .. rt z3
2461                       .. (z3 + p_a_start_perp){p_a_start_dir}
2462                       .. rt z4{down}
2463                       .. (z1 + p_a_end_perp) {p_a_end_dir}
2464                       .. rt z1
2465                       .. bot z1 {left}
2466                       .. cycle;
2467
2468         p_up_in := p_down_in rotated 180 shifted (w,0);
2469         p_up_out := p_down_out rotated 180 shifted (w,0);
2470 enddef;
2471
2472
2473 save walker_re_weight;
2474 walker_re_weight := 1.2;
2475
2476 fet_beginchar ("Whole Walker rehead", "s0reWalker");
2477         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2478         fill p_down_out;
2479         unfill p_down_in;
2480 fet_endchar;
2481
2482
2483 fet_beginchar ("Half up Walker rehead", "u1reWalker");
2484         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2485         fill p_up_out;
2486         unfill p_up_in;
2487 fet_endchar;
2488
2489
2490 fet_beginchar ("Half down Walker rehead", "d1reWalker");
2491         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2492         fill p_down_out;
2493         unfill p_down_in;
2494 fet_endchar;
2495
2496
2497 fet_beginchar ("Quarter up Walker rehead", "u2reWalker");
2498         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2499         fill p_up_out;
2500 fet_endchar;
2501
2502
2503 fet_beginchar ("Quarter down Walker rehead", "d2reWalker");
2504         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2505         fill p_down_out;
2506 fet_endchar;
2507
2508
2509 %%%%%%  Walker mi head
2510 %       Diamond shape
2511 %       Symmetric for all hollow notes
2512 %
2513 save walker_mi_width, walker_mi_weight;
2514 walker_mi_width := 1.2;
2515 walker_mi_weight := 1.5;
2516
2517 fet_beginchar ("Whole Walker mihead", "s0miWalker");
2518         draw_mi_head (walker_mi_width * funk_notehead_width,
2519                       walker_mi_weight, true);
2520         fill path_out;
2521         unfill path_in;
2522 fet_endchar;
2523
2524
2525 fet_beginchar ("Half Walker mihead", "s1miWalker");
2526         draw_mi_head (walker_mi_width * funk_notehead_width,
2527                       walker_mi_weight, true);
2528         fill path_out;
2529         unfill path_in;
2530 fet_endchar;
2531
2532
2533 fet_beginchar ("Quarter Walker mihead", "s2miWalker");
2534         draw_mi_head (walker_mi_width * funk_notehead_width,
2535                       walker_mi_weight, true);
2536         fill path_out;
2537 fet_endchar;
2538
2539
2540 %%%%%%  Walker fa
2541 %       Triangle shape
2542 %       Does not rotate for whole notes
2543 %       Whole rotation is different from Funk, so special notes
2544
2545 %%%%%%  Funk sol head is the same as the others
2546 %       Need special character because of skinnier head
2547 %
2548 save walker_fa_weight;
2549 walker_fa_weight := 1.5;
2550
2551 fet_beginchar ("Whole Walker fahead", "s0faWalker");
2552         draw_fa_head (funk_notehead_width, walker_fa_weight);
2553         fill p_down_out;
2554         unfill p_down_in;
2555 fet_endchar;
2556
2557
2558 fet_beginchar ("Half up Walker fahead", "u1faWalker");
2559         draw_fa_head (funk_notehead_width, walker_fa_weight);
2560         fill p_up_out;
2561         unfill p_up_in;
2562 fet_endchar;
2563
2564
2565 fet_beginchar ("Half down Walker fahead", "d1faWalker");
2566         draw_fa_head (funk_notehead_width, walker_fa_weight);
2567         fill p_down_out;
2568         unfill p_down_in;
2569 fet_endchar;
2570
2571
2572 fet_beginchar ("Quarter up Walker fahead", "u2faWalker");
2573         draw_fa_head (funk_notehead_width, walker_fa_weight);
2574         fill p_up_out;
2575 fet_endchar;
2576
2577
2578 fet_beginchar ("Quarter down Walker fahead", "d2faWalker");
2579         draw_fa_head (funk_notehead_width, walker_fa_weight);
2580         fill p_down_out;
2581 fet_endchar;
2582
2583
2584 %%%%%%  Walker sol
2585 %       Same as Funk, no special notes
2586 %
2587
2588 %%%%%%  Walker la head
2589 %       Rectcangle head
2590 %       Lighter weight requires separate notes
2591 %
2592 save walker_la_weight;
2593 walker_la_weight := 1.5;
2594
2595 fet_beginchar ("Whole Walker lahead", "s0laWalker");
2596         draw_la_head (funk_notehead_width, walker_la_weight);
2597         fill p_out;
2598         unfill p_in;
2599 fet_endchar;
2600
2601
2602 fet_beginchar ("Half Funk lahead", "s1laWalker");
2603         draw_la_head (funk_notehead_width, walker_la_weight);
2604         fill p_out;
2605         unfill p_in;
2606 fet_endchar;
2607
2608
2609 fet_beginchar ("Quarter Funk lahead", "s2laWalker");
2610         draw_la_head (funk_notehead_width, walker_la_weight);
2611         fill p_out;
2612 fet_endchar;
2613
2614
2615 %%%%%%  Walker ti head
2616 %       Triangular arrowhead
2617 %       Rotates for all but whole notes
2618 %
2619 def draw_Walker_ti_head (expr width_factor, thickness_factor) =
2620         set_char_box (0, width_factor * solfa_base_notewidth#,
2621                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2622
2623         save offset;
2624         offset := 2 * thickness_factor - 1;
2625
2626         save pen_radius;
2627         pen_radius := min (solfa_pen_radius,
2628                            .3 * (h + d) / (1 + offset));
2629
2630         pickup pencircle scaled (2 * pen_radius);
2631
2632         lft x1 = 0;
2633         y1 = .5 [y2, y3];
2634
2635         rt x2 = w;
2636         top y2 = h;
2637
2638         x3 = x2;
2639         bot y3 = -d;
2640
2641
2642         labels (range 1 thru 4);
2643
2644         save nw_dist, sw_dist, ne, se;
2645         pair nw_dist, sw_dist, ne, se;
2646
2647         ne = unitvector (z2 - z1);
2648         se = unitvector (z3 - z1);
2649
2650         nw_dist = (ne rotated 90) * pen_radius ;
2651         sw_dist = (se rotated -90) * pen_radius;
2652
2653
2654         save path_a, path_b, path_c;
2655         path path_a, path_b, path_c;
2656         path_a := z2 - nw_dist * offset
2657                   -- z1 - nw_dist * offset;
2658         path_b := z3 - sw_dist * offset
2659                   -- z1 - sw_dist * offset;
2660         path_c := z2 + left * pen_radius
2661                   -- z3 + left * pen_radius;
2662
2663         z4 = path_a intersectionpoint path_b;
2664         z5 = path_a intersectionpoint path_c;
2665         z6 = path_b intersectionpoint path_c;
2666
2667         save p_up_in, p_down_in, p_up_out, p_down_out;
2668         path p_up_in, p_down_in, p_up_out, p_down_out;
2669
2670         p_down_in := z4
2671                      -- z5
2672                      -- z6
2673                      -- cycle;
2674
2675         p_down_out := lft z1{up}
2676                       .. (z1 + nw_dist){ne}
2677                       -- (z2 + nw_dist){ne}
2678                       .. top z2{right}
2679                       .. rt z2 {down}
2680                       -- rt z3 {down}
2681                       .. bot z3 {left}
2682                       .. (z3 + sw_dist){- se}
2683                       .. (z1 + sw_dist){- se}
2684                       .. cycle;
2685
2686         p_up_in := p_down_in rotated 180 shifted (w, 0);
2687         p_up_out := p_down_out rotated 180 shifted (w, 0);
2688 enddef;
2689
2690
2691 save walker_ti_weight;
2692 walker_ti_weight := 1.4;
2693
2694 fet_beginchar ("Whole Walker tihead", "s0tiWalker");
2695         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2696         fill p_down_out;
2697         unfill p_down_in;
2698 fet_endchar;
2699
2700
2701 fet_beginchar ("Half up Walker tihead", "u1tiWalker");
2702         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2703         fill p_up_out;
2704         unfill p_up_in;
2705 fet_endchar;
2706
2707
2708 fet_beginchar ("Half down Walker tihead", "d1tiWalker");
2709         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2710         fill p_down_out;
2711         unfill p_down_in;
2712 fet_endchar;
2713
2714
2715 fet_beginchar ("Quarter up Walker tihead", "u2tiWalker");
2716         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2717         fill p_up_out;
2718 fet_endchar;
2719
2720
2721 fet_beginchar ("Quarter down Walker tihead", "d2tiWalker");
2722         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2723         fill p_down_out;
2724 fet_endchar;
2725
2726 fet_endgroup ("noteheads");
2727
2728
2729 %
2730 % we derive black_notehead_width# from the quarter head,
2731 % so we have to define black_notehead_width (pixel qty)
2732 % after the black_notehead_width# itself.
2733 %
2734 % Let's keep it outside the group as well.
2735 %
2736
2737 define_pixels (black_notehead_width);