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--2010 Jan Nieuwenhuizen <janneke@gnu.org>
   5 % & Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 % & Juergen Reuter <reuter@ipd.uka.de>
   7 %
   8 %
   9 % LilyPond is free software: you can redistribute it and/or modify
  10 % it under the terms of the GNU General Public License as published by
  11 % the Free Software Foundation, either version 3 of the License, or
  12 % (at your option) any later version.
  13 %
  14 % LilyPond is distributed in the hope that it will be useful,
  15 % but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 % GNU General Public License for more details.
  18 %
  19 % You should have received a copy of the GNU General Public License
  20 % along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 test_outlines := 0;
  23
  24
  25 save remember_pic;
  26 picture remember_pic;
  27
  28
  29 % Most beautiful noteheads are pronounced, not circular,
  30 % and not even symmetric.
  31 % These examples are inspired by [Wanske]; see literature list.
  32
  33
  34
  35 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  36 % NOTE HEAD VARIABLES
  37 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  38
  39 save black_notehead_width, noteheight;
  40 save half_notehead_width, whole_notehead_width, slash_thick;
  41 save slash_slope, overdone_heads, solfa_noteheight;
  42
  43 numeric noteheight;
  44 numeric slash_thick;
  45 numeric black_notehead_width;
  46 numeric whole_notehead_width;
  47 numeric half_notehead_width;
  48
  49
  50 fet_begingroup ("noteheads");
  51
  52
  53 % Slope of slash.  From scm/grob-description.scm.  How to auto-copy?
  54 slash_slope := 1.7;
  55
  56 % Thickness of slash lines.  Quarter notes get 1.5slt width.
  57 slash_thick# := 2/3 * 0.48 staff_space#;
  58
  59
  60 %
  61 % Hand-engraved music often has balls extending above and below
  62 % the lines.  If you like that, modify overdone heads (unit:
  63 % stafflinethickness).
  64 %
  65 overdone_heads = 0.0;
  66 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
  67
  68
  69 %
  70 % solfa heads should not overlap on chords.
  71 %
  72 solfa_noteheight# := staff_space# - stafflinethickness#;
  73
  74 define_pixels (slash_thick);
  75 define_whole_vertical_pixels (noteheight);
  76
  77
  78 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  79 %
  80 % SLANT moves both extrema on the long axis (by SLANT * ELLIPTICITY,
  81 % so SLANT = -1, puts the extreme on the long axis next to the short
  82 % axis one).
  83 %
  84
  85 def draw_outside_ellipse (expr ellipticity, tilt, superness, slant) =
  86         save attachment_y;
  87         save pat;
  88         path pat;
  89
  90         pat := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
  91                              (-ellipticity, 0), (slant * ellipticity, -1.0),
  92                              superness);
  93         pat := pat rotated tilt;
  94
  95         save top_point, right_point;
  96         pair top_point, right_point;
  97
  98         top_point := directionpoint left of pat;
  99         right_point := directionpoint up of pat;
 100
 101         save scaling, width;
 102
 103         scaling# = noteheight# / (2 ypart (top_point));
 104         width# := 2 xpart (right_point) * scaling#;
 105         define_pixels (scaling, width);
 106
 107         set_char_box (0, width#, noteheight# / 2, noteheight# / 2);
 108
 109         d := d - feta_space_shift;
 110
 111         % attachment Y
 112         charwy := ypart (right_point) * scaling#;
 113         charwx := width#;
 114
 115         pat := pat scaled scaling shifted (w / 2, .5 (h - d));
 116
 117         width := hround width;
 118
 119         if test_outlines = 1:
 120                 draw pat;
 121         else:
 122                 fill pat;
 123         fi;
 124 enddef;
 125
 126
 127 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) =
 128 begingroup
 129         save pat;
 130         path pat;
 131
 132         pat := superellipse ((ellipticity, 0), (0, 1.0),
 133                              (-ellipticity, 0), (0, -1.0),
 134                              superness);
 135         pat := pat rotated tilt;
 136
 137         save top_point, right_point;
 138         pair top_point, right_point;
 139
 140         top_point := directionpoint left of pat;
 141         right_point := directionpoint up of pat;
 142
 143         save height, scaling;
 144
 145         height# = staff_space# + stafflinethickness# - clearance;
 146         scaling# = height# / (2 ypart (top_point));
 147         define_pixels (scaling);
 148         pat := pat scaled scaling shifted (w / 2, .5 (h - d));
 149
 150         if test_outlines = 1:
 151                 draw pat;
 152         else:
 153                 unfill pat;
 154         fi
 155 endgroup;
 156 enddef;
 157
 158
 159 %
 160 % dimensions aren't entirely right.
 161 %
 162 def draw_longa (expr up) =
 163         save stemthick, fudge;
 164
 165         stemthick# = 2 stafflinethickness#;
 166         define_whole_blacker_pixels (stemthick);
 167
 168         fudge = hround (blot_diameter / 2);
 169
 170         draw_outside_ellipse (1.80, 0, 0.707, 0);
 171         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
 172
 173         pickup pencircle scaled stemthick;
 174
 175         if up:
 176                 bot y1 = -d;
 177                 top y2 = h;
 178                 rt x1 - fudge = 0;
 179                 x1 = x2;
 180
 181                 fudge + lft x3 = w;
 182                 x4 = x3;
 183                 top y4 = h + 3.0 staff_space;
 184                 y3 = y1;
 185         else:
 186                 bot y1 = -d - 3.0 staff_space;
 187                 top y2 = h;
 188                 rt x1 - fudge = 0;
 189                 x1 = x2;
 190
 191                 fudge + lft x3 = w;
 192                 x4 = x3;
 193                 y4 = y2;
 194                 bot y3 = -d;
 195         fi;
 196
 197         draw_gridline (z1, z2, stemthick);
 198         draw_gridline (z3, z4, stemthick);
 199
 200         labels (1, 2, 3, 4);
 201 enddef;
 202
 203
 204 fet_beginchar ("Longa notehead", "uM2");
 205         draw_longa (true);
 206
 207         draw_staff (-2, 2, 0);
 208 fet_endchar;
 209
 210 fet_beginchar ("Longa notehead", "dM2");
 211         draw_longa (false);
 212
 213         draw_staff (-2, 2, 0);
 214 fet_endchar;
 215
 216
 217 if test > 0:
 218         fet_beginchar ("Longa notehead", "uM2");
 219                 draw_longa (true);
 220
 221                 draw_staff (-2, 2, 0.5);
 222         fet_endchar;
 223
 224         fet_beginchar ("Longa notehead", "dM2");
 225                 draw_longa (false);
 226
 227                 draw_staff (-2, 2, 0.5);
 228         fet_endchar;
 229 fi;
 230
 231
 232 %
 233 % dimensions aren't entirely right.
 234 %
 235 def draw_brevis (expr linecount) =
 236         save stemthick, fudge;
 237
 238         stemthick# = 2 stafflinethickness#;
 239         define_whole_blacker_pixels (stemthick);
 240
 241         fudge = hround (blot_diameter / 2);
 242
 243         draw_outside_ellipse (1.80, 0, 0.707, 0);
 244         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
 245
 246         pickup pencircle scaled stemthick;
 247
 248         bot y1 = -d;
 249         top y2 = h;
 250         rt x1 - fudge = 0;
 251         x1 = x2;
 252
 253         fudge + lft x3 = w;
 254         x4 = x3;
 255         y4 = y2;
 256         y3 = y1;
 257
 258         for i := 0 step 1 until linecount - 1:
 259                 draw_gridline (z1 - (1.5 * i * stemthick, 0),
 260                                z2 - (1.5 * i * stemthick, 0), stemthick);
 261                 draw_gridline (z3 + (1.5 * i * stemthick, 0),
 262                                z4 + (1.5 * i * stemthick, 0), stemthick);
 263         endfor;
 264 enddef;
 265
 266
 267 fet_beginchar ("Brevis notehead", "sM1");
 268         draw_brevis (1);
 269
 270         draw_staff (-2, 2, 0);
 271 fet_endchar;
 272
 273
 274 if test > 0:
 275         fet_beginchar ("Brevis notehead", "sM1");
 276                 draw_brevis(1);
 277
 278                 draw_staff (-2, 2, 0.5);
 279         fet_endchar;
 280 fi;
 281
 282
 283 fet_beginchar ("Double-lined brevis notehead", "sM1double");
 284         draw_brevis (2);
 285
 286         draw_staff (-2, 2, 0);
 287 fet_endchar;
 288
 289
 290 if test > 0:
 291         fet_beginchar ("Double-lined brevis notehead", "sM1double");
 292                 draw_brevis (2);
 293
 294                 draw_staff (-2, 2, 0.5);
 295         fet_endchar;
 296 fi;
 297
 298
 299 fet_beginchar ("Whole notehead", "s0");
 300         draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0);
 301         undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
 302                                0.68, 2 stafflinethickness#);
 303
 304         whole_notehead_width# := charwd;
 305
 306         draw_staff (-2, 2, 0);
 307 fet_endchar;
 308
 309
 310 if test > 0:
 311         fet_beginchar ("Whole notehead", "s0");
 312                 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0,
 313                                       0.707, 0);
 314                 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
 315                                        0.68, 2 stafflinethickness#);
 316
 317                 draw_staff (-2, 2, 0.5);
 318         fet_endchar;
 319 fi;
 320
 321
 322 fet_beginchar ("Half notehead", "s1");
 323         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
 324         undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
 325
 326         half_notehead_width# := charwd;
 327
 328         draw_staff (-2, 2, 0);
 329 fet_endchar;
 330
 331
 332 if test > 0:
 333         fet_beginchar ("Half notehead", "s1");
 334                 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34,
 335                                       0.66, 0.17);
 336                 undraw_inside_ellipse (3.25, 33, 0.81,
 337                                        2.5 stafflinethickness#);
 338
 339                 draw_staff (-2, 2, 0.5);
 340         fet_endchar;
 341 fi;
 342
 343
 344 fet_beginchar ("Quart notehead", "s2");
 345         % used to have 32. With 31, they are slightly bolder.
 346         draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0);
 347         black_notehead_width# := charwd;
 348
 349         draw_staff (-2, 2, 0);
 350 fet_endchar;
 351
 352
 353 if test > 0:
 354         fet_beginchar ("Quart notehead", "s2");
 355                 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31,
 356                                       0.707, 0);
 357
 358                 draw_staff (-2, 2, 0.5);
 359         fet_endchar;
 360 fi;
 361
 362
 363 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 364
 365
 366 fet_beginchar ("Whole diamondhead", "s0diamond");
 367         draw_outside_ellipse (1.80, 0, 0.495, 0);
 368         undraw_inside_ellipse (1.30, 125, 0.6,
 369                                .4 staff_space# + stafflinethickness#);
 370
 371         draw_staff (-2, 2, 0);
 372 fet_endchar;
 373
 374
 375 if test > 0:
 376         fet_beginchar ("Whole diamondhead", "s0diamond");
 377                 draw_outside_ellipse (1.80, 0, 0.495, 0);
 378                 undraw_inside_ellipse (1.30, 125, 0.6,
 379                                        .4 staff_space# + stafflinethickness#);
 380
 381                 draw_staff (-2, 2, 0.5);
 382         fet_endchar;
 383 fi;
 384
 385
 386 fet_beginchar ("Half diamondhead", "s1diamond");
 387         draw_outside_ellipse (1.50, 34, 0.49, 0.17);
 388         undraw_inside_ellipse (3.5, 33, 0.80,
 389                                .3 staff_space# + 1.5 stafflinethickness#);
 390
 391         draw_staff (-2, 2, 0);
 392 fet_endchar;
 393
 394
 395 if test > 0:
 396         fet_beginchar ("Half diamondhead", "s1diamond");
 397                 draw_outside_ellipse (1.50, 34, 0.49, 0.17);
 398                 undraw_inside_ellipse (3.5, 33, 0.80,
 399                                        .3 staff_space#
 400                                        + 1.5 stafflinethickness#);
 401
 402                 draw_staff (-2, 2, 0.5);
 403         fet_endchar;
 404 fi;
 405
 406
 407 fet_beginchar ("Quart diamondhead", "s2diamond");
 408         draw_outside_ellipse (1.80, 35, 0.495, -0.25);
 409
 410         draw_staff (-2, 2, 0);
 411 fet_endchar;
 412
 413
 414 if test > 0:
 415         fet_beginchar ("Quart diamondhead", "s2diamond");
 416                 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
 417
 418                 draw_staff (-2, 2, 0.5);
 419         fet_endchar;
 420 fi;
 421
 422
 423 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 424
 425
 426 vardef penposx@# (expr d) =
 427 begingroup;
 428         save pat;
 429         path pat;
 430
 431         pat = top z@#
 432               .. lft z@#
 433               .. bot z@#
 434               .. rt z@#
 435               .. cycle;
 436         z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180));
 437         z@#r = pat intersectionpoint (z@# -- infinity * dir (d));
 438 endgroup
 439 enddef;
 440
 441
 442 %
 443 % UGH: xs not declared as argument.
 444 %
 445 def define_triangle_shape (expr stemdir) =
 446         save triangle_a, triangle_b, triangle_c;
 447         save triangle_out_a, triangle_out_b, triangle_out_c;
 448         save triangle_in, triangle_out;
 449         save width, depth, height;
 450         save origin, left_up_dir;
 451         save exact_left_point, exact_right_point, exact_down_point;
 452
 453         path triangle_a, triangle_b, triangle_c;
 454         path triangle_out_a, triangle_out_b, triangle_out_c;
 455         path triangle_in, triangle_out;
 456         pair origin, left_up_dir;
 457         pair exact_down_point, exact_left_point, exact_right_point;
 458
 459         save pen_thick;
 460         pen_thick# = stafflinethickness# + .1 staff_space#;
 461         define_pixels (llap);
 462         define_blacker_pixels (pen_thick);
 463
 464         left_up_dir = llap# * dir (90 + tilt);
 465
 466         xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0;
 467         ypart origin = 0;
 468
 469         exact_left_point := origin + (left_up_dir xscaled xs);
 470         exact_down_point := origin + (left_up_dir rotated 120 xscaled xs);
 471         exact_right_point := origin + (left_up_dir rotated 240 xscaled xs);
 472
 473         height# = ypart (exact_left_point + origin) + pen_thick# / 2;
 474         depth# = -ypart (exact_down_point + origin) + pen_thick# / 2;
 475         width# = xpart (exact_right_point - exact_left_point)
 476                  + pen_thick# * xs;
 477
 478         set_char_box (0, width#, depth#, height#);
 479
 480         % Formerly, the shape has simply been drawn with an elliptical pen
 481         % (`scaled pen_thick xscaled xs'), but the envelope of such a curve
 482         % is of 6th degree.  For the sake of mf2pt1, we approximate it.
 483
 484         pickup pencircle scaled pen_thick xscaled xs;
 485
 486         z0 = (hround_pixels (xpart origin), 0);
 487
 488         z1 = z1' = z0 + llap * dir (90 + tilt) xscaled xs;
 489         z2 = z2' = z0 + llap * dir (90 + tilt + 120) xscaled xs;
 490         z3 = z3' = z0 + llap * dir (90 + tilt + 240) xscaled xs;
 491
 492         z12 = caveness [.5[z1, z2], z3];
 493         z23 = caveness [.5[z2, z3], z1];
 494         z31 = caveness [.5[z3, z1], z2];
 495
 496         triangle_a = z1 .. z12 .. z2;
 497         triangle_b = z2 .. z23 .. z3;
 498         triangle_c = z3 .. z31 .. z1;
 499
 500         penposx1 (angle (direction 0 of triangle_a) - 90);
 501         penposx2 (angle (direction 0 of triangle_b) - 90);
 502         penposx3 (angle (direction 0 of triangle_c) - 90);
 503
 504         penposx1' (angle (direction infinity of triangle_c) + 90);
 505         penposx2' (angle (direction infinity of triangle_a) + 90);
 506         penposx3' (angle (direction infinity of triangle_b) + 90);
 507
 508         penposx12 (angle (z12 - z0));
 509         penposx23 (angle (z23 - z0));
 510         penposx31 (angle (z31 - z0));
 511
 512         z10 = (z0 -- z1) intersectionpoint (z1l .. z12l .. z2'r);
 513         z20 = (z0 -- z2) intersectionpoint (z2l .. z23l .. z3'r);
 514         z30 = (z0 -- z3) intersectionpoint (z3l .. z31l .. z1'r);
 515
 516         triangle_in = z10
 517                       .. z12l
 518                       .. z20
 519                       & z20
 520                       .. z23l
 521                       .. z30
 522                       & z30
 523                       .. z31l
 524                       .. z10
 525                       & cycle;
 526
 527         triangle_out_a = z1r .. z12r .. z2'l;
 528         triangle_out_b = z2r .. z23r .. z3'l;
 529         triangle_out_c = z3r .. z31r .. z1'l;
 530
 531         triangle_out = top z1
 532                        .. lft z1
 533                        .. z1r{direction 0 of triangle_out_a}
 534                        & triangle_out_a
 535                        & {direction infinity of triangle_out_a}z2'l
 536                        .. lft z2
 537                        .. bot z2
 538                        .. z2r{direction 0 of triangle_out_b}
 539                        & triangle_out_b
 540                        & {direction infinity of triangle_out_b}z3'l
 541                        .. rt z3
 542                        .. top z3
 543                        .. z3r{direction 0 of triangle_out_c}
 544                        & triangle_out_c
 545                        & {direction infinity of triangle_out_c}z1'l
 546                        .. cycle;
 547
 548         labels (0, 10, 20, 30);
 549         penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31);
 550
 551         % attachment Y
 552         if stemdir = 1:
 553                 charwy := ypart exact_right_point;
 554                 charwx := xpart exact_right_point + .5 pen_thick# * xs;
 555         else:
 556                 charwy := -ypart exact_down_point;
 557                 charwx := width# - (xpart exact_down_point - .5 pen_thick# * xs);
 558         fi
 559 enddef;
 560
 561
 562 def draw_whole_triangle_head =
 563         save hei, xs;
 564         save llap;
 565         save tilt;
 566
 567         tilt = 40;
 568         llap# = 3/4 noteheight#;
 569
 570         xs = 1.5;
 571         caveness := 0.1;
 572         define_triangle_shape (1);
 573         fill triangle_out;
 574         unfill triangle_in;
 575 enddef;
 576
 577
 578 fet_beginchar ("Whole trianglehead", "s0triangle");
 579         draw_whole_triangle_head;
 580
 581         draw_staff (-2, 2, 0);
 582 fet_endchar;
 583
 584
 585 if test > 0:
 586         fet_beginchar ("Whole trianglehead", "s0triangle");
 587                 draw_whole_triangle_head;
 588
 589                 draw_staff (-2, 2, 0.5);
 590         fet_endchar;
 591 fi;
 592
 593
 594 def draw_small_triangle_head (expr dir) =
 595         save hei, xs;
 596         save llap;
 597         save tilt;
 598
 599         tilt = 40;
 600         llap# = 2/3 noteheight#;
 601         xs = 1.2;
 602         caveness := 0.1;
 603         define_triangle_shape (dir);
 604
 605         pickup feta_fillpen;
 606
 607         filldraw triangle_out;
 608         unfilldraw triangle_in;
 609 enddef;
 610
 611
 612 fet_beginchar ("Half trianglehead (downstem)", "d1triangle");
 613         draw_small_triangle_head (-1);
 614
 615         draw_staff (-2, 2, 0);
 616 fet_endchar;
 617
 618
 619 fet_beginchar ("Half trianglehead (upstem)", "u1triangle");
 620         draw_small_triangle_head (1);
 621
 622         draw_staff (-2, 2, 0.5);
 623 fet_endchar;
 624
 625
 626 def draw_closed_triangle_head (expr dir) =
 627         save hei, xs;
 628         save llap;
 629         save tilt;
 630
 631         tilt = 40;
 632         llap# = 2/3 noteheight#;
 633         xs = 1.0;
 634         caveness := 0.1;
 635         define_triangle_shape (dir);
 636         fill triangle_out;
 637 enddef;
 638
 639
 640 fet_beginchar ("Quart trianglehead (upstem)", "u2triangle");
 641         draw_closed_triangle_head (1);
 642
 643         draw_staff (-2, 2, 0);
 644 fet_endchar;
 645
 646
 647 fet_beginchar ("Quart trianglehead (downstem)", "d2triangle");
 648         draw_closed_triangle_head (-1);
 649
 650         draw_staff (-2, 2, 0.5);
 651 fet_endchar;
 652
 653
 654 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 655 %
 656 % Slash heads are for indicating improvisation.  They are
 657 % twice as high as normal heads.
 658 %
 659 def draw_slash (expr hwid_hash) =
 660         save exact_height;
 661         save ne, nw_dist;
 662         pair ne, nw_dist;
 663         exact_height = staff_space# + stafflinethickness# / 2;
 664
 665         set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
 666                       exact_height, exact_height);
 667
 668         charwx := charwd;
 669         charwy := charht;
 670
 671         clearxy;
 672
 673         d := d - feta_shift;
 674
 675         pickup pencircle scaled blot_diameter;
 676
 677         bot y1 = -d;
 678         top y2 = h;
 679         lft x1 = 0;
 680         lft x2 = 2 h / slash_slope;
 681
 682         rt x3 = w;
 683         y3 = y2;
 684         y4 = y1;
 685         x3 - x2 = x4 - x1;
 686
 687         ne = unitvector (z3 - z4);
 688         nw_dist = (ne rotated 90) * 0.5 blot_diameter;
 689
 690         fill bot z1{left}
 691              .. (z1 + nw_dist){ne}
 692              -- (z2 + nw_dist){ne}
 693              .. top z2{right}
 694              -- top z3{right}
 695              .. (z3 - nw_dist){-ne}
 696              -- (z4 - nw_dist){-ne}
 697              .. bot z4{left}
 698              -- cycle;
 699
 700         if hwid_hash > 2 slash_thick#:
 701                 save th;
 702
 703                 th = slash_thick - blot_diameter;
 704                 y6 = y7;
 705                 y5 = y8;
 706                 y3 - y7 = th;
 707                 y5 - y1 = th;
 708                 z6 - z5 = whatever * ne;
 709                 z8 - z7 = whatever * ne;
 710
 711                 z5 = z1 + whatever * ne + th * (ne rotated -90);
 712                 z8 = z4 + whatever * ne + th * (ne rotated 90);
 713
 714                 unfill z5
 715                        -- z6
 716                        -- z7
 717                        -- z8
 718                        -- cycle;
 719         fi
 720         labels (range 1 thru 10);
 721 enddef;
 722
 723
 724 fet_beginchar ("Whole slashhead", "s0slash");
 725         draw_slash (4 slash_thick# + 0.5 staff_space#);
 726
 727         draw_staff (-2, 2, 0);
 728 fet_endchar;
 729
 730
 731 fet_beginchar ("Half slashhead", "s1slash");
 732         draw_slash (3.0 slash_thick# + 0.15 staff_space#);
 733
 734         draw_staff (-2, 2, 0);
 735 fet_endchar;
 736
 737
 738 fet_beginchar ("Quart slashhead", "s2slash");
 739         draw_slash (1.5 slash_thick#);
 740
 741         draw_staff (-2, 2, 0);
 742 fet_endchar;
 743
 744
 745 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 746 %
 747 % `thick' is the distance between the NE/SW parallel lines in the cross
 748 % (distance between centres of lines) in multiples of stafflinethickness
 749 %
 750 def draw_cross (expr thick) =
 751         save ne, nw;
 752         save ne_dist, nw_dist, rt_dist, up_dist;
 753         save crz_in, crz_out;
 754         save thickness;
 755         pair ne, nw;
 756         pair ne_dist, nw_dist, rt_dist, up_dist;
 757         path crz_in, crz_out;
 758
 759         pen_thick# := 1.2 stafflinethickness#;
 760         thickness# := thick * stafflinethickness#;
 761         define_pixels (thickness);
 762         define_blacker_pixels (pen_thick);
 763
 764         pickup pencircle scaled pen_thick;
 765
 766         h := h - feta_shift;
 767
 768         top y3 = h;
 769         ne = unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
 770         rt x4 = w / 2;
 771         y5 = 0;
 772         z4 - z5 = whatever * ne;
 773         x6 = 0;
 774         z6 - z3 = whatever * ne;
 775         z3 - z4 = whatever * (ne yscaled -1);
 776
 777         z4 - z3 = whatever * (ne) + (ne rotated -90) * thickness;
 778
 779
 780         x1 = charwd / 2 - .5 pen_thick#;
 781         z1 = whatever * ne
 782              + thick / 2 * stafflinethickness# * (ne rotated -90);
 783
 784         % labels (1, 2, 3, 4, 5, 6);
 785
 786         nw = unitvector (z3 - z4);
 787
 788         up_dist = up * 0.5 pen_thick / cosd (angle (ne));
 789         rt_dist = right * 0.5 pen_thick / sind (angle (ne));
 790         nw_dist = (ne rotated 90) * 0.5 pen_thick;
 791         ne_dist = (nw rotated -90) * 0.5 pen_thick;
 792
 793         x4' := x4;
 794         x5' := x5;
 795         y6' := y6;
 796
 797         x4 := hround (x4' + .5 pen_thick) - .5 pen_thick;
 798         x5 := hfloor (x5' + xpart rt_dist) - xpart rt_dist;
 799         y6 := vfloor (y6' + ypart up_dist) - ypart up_dist;
 800
 801         crz_out = (z6 + up_dist)
 802                   -- (z3 + nw_dist){ne}
 803                   .. (top z3)
 804                   .. (z3 + ne_dist){-nw}
 805                   -- (z4 + ne_dist){-nw}
 806                   .. (rt z4)
 807                   .. (z4 - nw_dist){-ne}
 808                   -- (z5 + rt_dist);
 809         crz_out := crz_out shifted (0, feta_shift)
 810                    -- reverse crz_out yscaled -1 shifted (0, -feta_eps);
 811         fill crz_out
 812              -- reverse crz_out xscaled -1 shifted (-feta_eps, 0)
 813              -- cycle;
 814
 815         if (thick > 1):
 816                 x4 := hround (x4' - xpart rt_dist) + xpart rt_dist;
 817                 x5 := hceiling (x5' - .5 pen_thick) + .5 pen_thick;
 818                 y6 := vfloor (y6' - .5 pen_thick) + .5 pen_thick;
 819
 820                 crz_in = (bot z6){right}
 821                          .. (z6 - nw_dist){ne}
 822                          -- (z3 - up_dist)
 823                          -- (z4 - rt_dist)
 824                          -- (z5 + nw_dist){-ne}
 825                          .. {down}(lft z5);
 826                 crz_in := crz_in shifted (0, feta_shift)
 827                           -- reverse crz_in yscaled -1 shifted (0, -feta_eps);
 828                 unfill crz_in
 829                        -- reverse crz_in xscaled -1 shifted (-feta_eps, 0)
 830                        -- cycle;
 831         fi
 832
 833         % ugh
 834         currentpicture := currentpicture shifted (hround (w / 2), 0);
 835
 836         charwx := charwd;
 837         charwy := y1 + feta_shift;
 838
 839         z12 = (charwx * hppp, y1 * vppp);
 840
 841         labels (12);
 842 enddef;
 843
 844
 845 fet_beginchar ("Whole Crossed notehead", "s0cross");
 846         save wid, hei;
 847
 848         wid# := black_notehead_width# + 4 stafflinethickness#;
 849         hei# := noteheight# + stafflinethickness#;
 850
 851         set_char_box (0, wid#, hei# / 2, hei# / 2);
 852
 853         draw_cross (3.75);
 854
 855         remember_pic := currentpicture;
 856
 857         draw_staff (-2, 2, 0);
 858 fet_endchar;
 859
 860
 861 if test > 0:
 862         fet_beginchar ("Whole Crossed notehead", "s0cross");
 863                 save wid, hei;
 864
 865                 wid# := black_notehead_width# + 4 stafflinethickness#;
 866                 hei# := noteheight# + stafflinethickness#;
 867
 868                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 869
 870                 currentpicture := remember_pic;
 871
 872                 draw_staff (-2, 2, 0.5);
 873         fet_endchar;
 874 fi;
 875
 876
 877 fet_beginchar ("Half Crossed notehead", "s1cross");
 878         save wid, hei;
 879
 880         wid# := black_notehead_width# + 2 stafflinethickness#;
 881         hei# := noteheight# + stafflinethickness# / 2;
 882
 883         set_char_box (0, wid#, hei# / 2, hei# / 2);
 884
 885         draw_cross (3.0);
 886
 887         remember_pic := currentpicture;
 888
 889         draw_staff (-2, 2, 0);
 890 fet_endchar;
 891
 892
 893 if test > 0:
 894         fet_beginchar ("Half Crossed notehead", "s1cross");
 895                 save wid, hei;
 896
 897                 wid# := black_notehead_width# + 2 stafflinethickness#;
 898                 hei# := noteheight# + stafflinethickness# / 2;
 899
 900                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 901
 902                 currentpicture := remember_pic;
 903
 904                 draw_staff (-2, 2, 0.5);
 905         fet_endchar;
 906 fi;
 907
 908
 909 fet_beginchar ("Crossed notehead", "s2cross");
 910         wid# := black_notehead_width#;
 911         hei# := noteheight#;
 912         set_char_box (0, wid#, hei# / 2, hei# / 2);
 913
 914         draw_cross (1.0);
 915
 916         remember_pic := currentpicture;
 917
 918         draw_staff (-2, 2, 0);
 919 fet_endchar;
 920
 921
 922 if test > 0:
 923         fet_beginchar ("Crossed notehead", "s2cross");
 924                 wid# := black_notehead_width#;
 925                 hei# := noteheight#;
 926                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 927
 928                 currentpicture := remember_pic;
 929
 930                 draw_staff (-2, 2, 0.5);
 931         fet_endchar;
 932 fi;
 933
 934
 935 fet_beginchar ("X-Circled notehead", "s2xcircle");
 936         save wid, hei;
 937         save cthick, cxd, cyd, dy;
 938
 939         wid# := black_notehead_width# * sqrt (sqrt2);
 940         hei# := noteheight# * sqrt (sqrt2);
 941
 942         set_char_box (0, wid#, hei# / 2, hei# / 2);
 943
 944         d := d - feta_space_shift;
 945
 946         cthick# := (1.2 + 1/4) * stafflinethickness#;
 947         define_blacker_pixels (cthick);
 948
 949         cxd := w - cthick;
 950         cyd := h + d - cthick / 2;
 951
 952         dy = .5 (h - d);
 953
 954         pickup pencircle scaled cthick;
 955
 956         fill fullcircle xscaled (cxd + cthick)
 957                         yscaled (cyd + cthick)
 958                         shifted (w / 2, dy);
 959         unfill fullcircle xscaled (cxd - cthick)
 960                           yscaled (cyd - cthick)
 961                           shifted (w / 2, dy);
 962
 963         xpos := .5 cxd / sqrt2;
 964         ypos := .5 cyd / sqrt2;
 965
 966         pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
 967         draw (-xpos + w / 2, -ypos + dy) -- (xpos + w / 2, ypos + dy);
 968
 969         pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
 970         draw (-xpos + w / 2, ypos + dy) -- (xpos + w / 2, -ypos + dy);
 971
 972         charwx := charwd;
 973         charwy := 0;
 974
 975         z12 = (charwx * hppp, charwy * vppp);
 976         labels (12);
 977
 978         remember_pic := currentpicture;
 979
 980         draw_staff (-2, 2, 0);
 981 fet_endchar;
 982
 983
 984 if test > 0:
 985         fet_beginchar ("X-Circled notehead", "s2xcircle");
 986                 save wid, hei;
 987                 save cthick, cxr, cyr;
 988
 989                 wid# := black_notehead_width# * sqrt (sqrt2);
 990                 hei# := noteheight# * sqrt (sqrt2);
 991
 992                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 993
 994                 currentpicture := remember_pic;
 995
 996                 draw_staff (-2, 2, 0.5);
 997         fet_endchar;
 998 fi;
 999
1000
1001 %%%%%%%%
1002 %
1003 % SOLFA SHAPED NOTES
1004 %
1005
1006 save solfa_pen_thick;
1007 solfa_pen_thick# = 1.3 stafflinethickness#;
1008 define_blacker_pixels (solfa_pen_thick);
1009
1010
1011 save solfa_base_notewidth;
1012 solfa_base_notewidth# := black_notehead_width#;
1013
1014 solfa_whole_width := 1.0;
1015 solfa_half_width := 1.0;
1016 solfa_quarter_width := 1.0;
1017
1018 def draw_do_head (expr width_factor, dir, thickness_factor) =
1019         save p_in, p_out;
1020         save left_dist, right_dist, bottom_dist;
1021         path p_in, p_out;
1022         pair left_dist, right_dist, bottom_dist;
1023
1024         set_char_box (0, width_factor * solfa_base_notewidth#,
1025                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1026
1027         pickup pencircle scaled solfa_pen_thick;
1028
1029
1030         bottom_thick_factor := thickness_factor;
1031         % no different thickness for left side if we want uniform thickness
1032         left_thick_factor := if thickness_factor = 1 :
1033                                 1;
1034                              else :
1035                                 0.7 * thickness_factor;
1036                              fi
1037         bot y1 = -d;
1038         y1 = y2;
1039         lft x1 = 0;
1040         rt x2 = w;
1041         top y3 = h;
1042         x3 =.5 [x1, x2];
1043
1044         left_dist = (unitvector (z3 - z1) rotated 90) * 0.5 solfa_pen_thick;
1045         right_dist = (unitvector (z2 - z3) rotated 90) * 0.5 solfa_pen_thick;
1046         bottom_dist = (0,1) * 0.5 solfa_pen_thick;
1047
1048         save pa, pb, pc;
1049         path pa, pb, pc;
1050         save point_a, point_b, point_c;
1051         pair point_a, point_b, point_c;
1052
1053         pa := (z1 - left_thick_factor * left_dist) --
1054               (z3 - left_thick_factor * left_dist);
1055         pb := (z1 + bottom_thick_factor * bottom_dist) --
1056               (z2 + bottom_thick_factor * bottom_dist);
1057         pc := (z2 - right_dist) -- (z3 - right_dist);
1058
1059
1060         point_a := pa intersectionpoint pb;
1061         point_b := pb intersectionpoint pc;
1062         point_c := pc intersectionpoint pa;
1063
1064         p_in := point_a -- point_b -- point_c -- cycle;
1065
1066         p_out := bot z1
1067                  -- bot z2{right}
1068                  .. rt z2{up}
1069                  .. (z2 + right_dist){z3 - z2}
1070                  -- (z3 + right_dist){z3 - z2}
1071                  .. top z3{left}
1072                  .. (z3 + left_dist){z1 - z3}
1073                  -- (z1 + left_dist){z1 - z3}
1074                  .. lft z1{down}
1075                  .. {right}cycle;
1076
1077         labels (1, 2, 3);
1078
1079         charwx := charwd;
1080         charwy := -chardp + 0.5 stafflinethickness#;
1081         if dir = -1:
1082                 charwy := -charwy;
1083         fi;
1084 enddef;
1085
1086
1087 fet_beginchar ("Whole dohead", "s0do");
1088         draw_do_head (solfa_whole_width, 1, 3.25);
1089         fill p_out;
1090         unfill p_in;
1091 fet_endchar;
1092
1093
1094 fet_beginchar ("Half dohead", "d1do");
1095         draw_do_head (solfa_half_width, -1, 3.25);
1096         fill p_out;
1097         unfill p_in;
1098 fet_endchar;
1099
1100
1101 fet_beginchar ("Half dohead", "u1do");
1102         draw_do_head (solfa_half_width, 1, 3.25);
1103         fill p_out;
1104         unfill p_in;
1105 fet_endchar;
1106
1107
1108 fet_beginchar ("Quart dohead", "d2do");
1109         draw_do_head (solfa_quarter_width, -1, 3.25);
1110         fill p_out;
1111 fet_endchar;
1112
1113
1114 fet_beginchar ("Quart dohead", "u2do");
1115         draw_do_head (solfa_quarter_width, 1, 3.25);
1116         fill p_out;
1117 fet_endchar;
1118
1119
1120
1121 fet_beginchar ("Whole thin dohead", "s0doThin");
1122         draw_do_head (solfa_whole_width, 1, 1);
1123         fill p_out;
1124         unfill p_in;
1125 fet_endchar;
1126
1127
1128 fet_beginchar ("Half thin dohead", "d1doThin");
1129         draw_do_head (solfa_half_width, -1, 1);
1130         fill p_out;
1131         unfill p_in;
1132 fet_endchar;
1133
1134
1135 fet_beginchar ("Half thin dohead", "u1doThin");
1136         draw_do_head (solfa_half_width, 1, 1);
1137         fill p_out;
1138         unfill p_in;
1139 fet_endchar;
1140
1141
1142 fet_beginchar ("Quart thin dohead", "d2doThin");
1143         draw_do_head (solfa_quarter_width, -1, 1);
1144         fill p_out;
1145 fet_endchar;
1146
1147
1148 fet_beginchar ("Quart thin dohead", "u2doThin");
1149         draw_do_head (solfa_quarter_width, 1, 1);
1150         fill p_out;
1151 fet_endchar;
1152
1153
1154
1155 %
1156 % re - flat top, curved bottom:
1157 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
1158 % (broader along the base and with more vertical sides for half and
1159 % whole notes)
1160 %
1161 % Note:  According to some shape-note singers, there should be no size
1162 %        differences for half and whole notes, contrary to the comment above
1163 %
1164 % stem attachment: h/2
1165 %
1166
1167 def draw_re_head (expr width_factor, dir, thickness_factor) =
1168         save p_in, p_out;
1169         path p_in, p_out;
1170
1171         set_char_box (0, width_factor * solfa_base_notewidth#,
1172                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1173
1174         pickup pencircle scaled solfa_pen_thick;
1175
1176
1177         save curve_start;
1178         curve_start = 0.7;
1179         lft x1 = 0;
1180         y1 = y5;
1181         x1 = x2;
1182         y2 = curve_start [y3, y1];
1183         bot y3 = -d;
1184         x3 = .5 [x2, x4];
1185         rt x4 = w;
1186         y4 = y2;
1187         top y5 = h;
1188         x5 = x4;
1189
1190         labels (range 1 thru 5);
1191
1192         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1 * thickness_factor))
1193                 -- rt z2{down}
1194                 .. ((top z3) + (0, thickness_factor * 0.5 solfa_pen_thick))
1195                 .. lft z4{up}
1196                 -- (z5 + 0.5 solfa_pen_thick * (-1, -1 * thickness_factor))
1197                 -- cycle;
1198
1199         p_out := lft z1
1200                  -- lft z2{down}
1201                  .. bot z3
1202                  .. rt z4{up}
1203                  -- rt z5{up}
1204                  .. top z5{left}
1205                  -- top z1{left}
1206                  .. {down}cycle;
1207
1208         charwx := charwd;
1209         charwy := curve_start [-chardp, charht];
1210
1211         if dir = -1:
1212                 charwy := -charwy;
1213         fi;
1214 enddef;
1215
1216
1217 fet_beginchar ("Whole rehead", "s0re");
1218         draw_re_head (solfa_whole_width, 1, 2.5);
1219         fill p_out;
1220         unfill p_in;
1221 fet_endchar;
1222
1223
1224 fet_beginchar ("Half up rehead", "u1re");
1225         draw_re_head (solfa_half_width, 1, 2.5);
1226         fill p_out;
1227         unfill p_in;
1228 fet_endchar;
1229
1230
1231 fet_beginchar ("Half down rehead", "d1re");
1232         draw_re_head (solfa_half_width, -1, 2.5);
1233         fill p_out;
1234         unfill p_in;
1235 fet_endchar;
1236
1237
1238 fet_beginchar ("Quart rehead", "u2re");
1239         draw_re_head (solfa_quarter_width, 1, 2.5);
1240         fill p_out;
1241 fet_endchar;
1242
1243
1244 fet_beginchar ("Quart rehead", "d2re");
1245         draw_re_head (solfa_quarter_width, -1, 2.5);
1246         fill p_out;
1247 fet_endchar;
1248
1249
1250 fet_beginchar ("Whole thin rehead", "s0reThin");
1251         draw_re_head (solfa_whole_width, 1, 1);
1252         fill p_out;
1253         unfill p_in;
1254 fet_endchar;
1255
1256
1257 fet_beginchar ("Half up thin rehead", "u1reThin");
1258         draw_re_head (solfa_half_width, 1, 1);
1259         fill p_out;
1260         unfill p_in;
1261 fet_endchar;
1262
1263
1264 fet_beginchar ("Half down thin rehead", "d1reThin");
1265         draw_re_head (solfa_half_width, -1, 1);
1266         fill p_out;
1267         unfill p_in;
1268 fet_endchar;
1269
1270
1271 fet_beginchar ("Quart thin rehead", "u2reThin");
1272         draw_re_head (solfa_quarter_width, 1, 1);
1273         fill p_out;
1274 fet_endchar;
1275
1276
1277 fet_beginchar ("Quart thin rehead", "d2reThin");
1278         draw_re_head (solfa_quarter_width, -1, 1);
1279         fill p_out;
1280 fet_endchar;
1281
1282
1283
1284
1285 %%%% mi head -- diamond shape
1286
1287 def draw_mi_head (expr width_factor, thickness_factor, mirror) =
1288         save path_out, path_in;
1289         save ne_dist, se_dist, ne, se;
1290         save path_a, path_b, path_c, path_d;
1291         path path_out, path_in;
1292         pair ne_dist, se_dist, ne, se;
1293         path path_a, path_b, path_c, path_d;
1294         save inner_path;
1295         path inner_path;
1296
1297         set_char_box (0, width_factor * solfa_base_notewidth#,
1298                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1299
1300         pickup pencircle scaled solfa_pen_thick;
1301
1302         lft x1 = 0;
1303         y1 = 0;
1304         bot y2 = -d;
1305         x2 = .5 [x1, x3];
1306         rt x3 = w;
1307         x4 = x2;
1308         y3 = y1;
1309         top y4 = h;
1310
1311         % inner sides are parallel to outer sides
1312         z6 - z5 = whatever * (z2 - z1);
1313         z8 - z7 = whatever * (z2 - z1);
1314         z8 - z5 = whatever * (z4 - z1);
1315         z6 - z7 = whatever * (z4 - z1);
1316
1317         ne = unitvector (z4 - z1);
1318         se = unitvector (z1 - z2);
1319
1320         ne_dist = (ne rotated 90) * 0.5 solfa_pen_thick;
1321         se_dist = (se rotated 90) * 0.5 solfa_pen_thick;
1322
1323         path_a := (z1 - se_dist) -- (z2 - se_dist);
1324         path_b := (z2 + (ne_dist * thickness_factor)) --
1325                   (z3 + (ne_dist * thickness_factor));
1326         path_c := (z3 + se_dist) -- (z4 + se_dist);
1327         path_d := (z4 - (ne_dist * thickness_factor)) --
1328                   (z1 - (ne_dist * thickness_factor));
1329
1330         z5 = path_a intersectionpoint path_d;
1331         z7 = path_b intersectionpoint path_c;
1332
1333         labels (range 1 thru 8);
1334
1335         inner_path := z5
1336                    -- z6
1337                    -- z7
1338                    -- z8
1339                    -- cycle;
1340
1341         path_in := if mirror:
1342                       inner_path;
1343                    else:
1344                       inner_path reflectedabout (z2, z4);
1345                    fi
1346
1347         path_out := lft z1
1348                     .. (z1 + se_dist){-se}
1349                     -- (z2 + se_dist){-se}
1350                     .. bot z2
1351                     .. (z2 - ne_dist){ne}
1352                     -- (z3 - ne_dist){ne}
1353                     .. rt z3
1354                     .. (z3 - se_dist){se}
1355                     -- (z4 - se_dist){se}
1356                     .. top z4
1357                     .. (z4 + ne_dist){-ne}
1358                     -- (z1 + ne_dist){-ne}
1359                     .. cycle;
1360 enddef;
1361
1362
1363 fet_beginchar ("Whole mihead", "s0mi");
1364         draw_mi_head (solfa_whole_width, 3, false);
1365         fill path_out;
1366         unfill path_in;
1367 fet_endchar;
1368
1369
1370 fet_beginchar ("Half mihead", "s1mi");
1371         draw_mi_head (solfa_quarter_width, 3, false);
1372         fill path_out;
1373         unfill path_in;
1374 fet_endchar;
1375
1376 fet_beginchar ("Quart mihead", "s2mi");
1377         draw_mi_head (solfa_quarter_width, 3, false);
1378         fill path_out;
1379 fet_endchar;
1380
1381
1382
1383 fet_beginchar ("Whole mirror mihead", "s0miMirror");
1384         draw_mi_head (solfa_whole_width, 3, true);
1385         fill path_out;
1386         unfill path_in;
1387 fet_endchar;
1388
1389 fet_beginchar ("Half  mirror mihead", "s1miMirror");
1390         draw_mi_head (solfa_quarter_width, 3, true);
1391         fill path_out;
1392         unfill path_in;
1393 fet_endchar;
1394
1395 fet_beginchar ("Quart mirror mihead", "s2miMirror");
1396         draw_mi_head (solfa_quarter_width, 3, true);
1397         fill path_out;
1398 fet_endchar;
1399
1400
1401
1402 fet_beginchar ("Whole thin mihead", "s0miThin");
1403         draw_mi_head (solfa_whole_width, 1, false);
1404         fill path_out;
1405         unfill path_in;
1406 fet_endchar;
1407
1408
1409 fet_beginchar ("Half thin mihead", "s1miThin");
1410         draw_mi_head (solfa_quarter_width, 1, false);
1411         fill path_out;
1412         unfill path_in;
1413 fet_endchar;
1414
1415
1416 fet_beginchar ("Quart thin mihead", "s2miThin");
1417         draw_mi_head (solfa_quarter_width, 1, false);
1418         fill path_out;
1419 fet_endchar;
1420
1421
1422
1423 %%%%  fa head
1424
1425 def draw_fa_head (expr width_factor, thickness_factor) =
1426         set_char_box (0, width_factor * solfa_base_notewidth#,
1427                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1428
1429         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1430         path p_down_in, p_down_out, p_up_in, p_up_out;
1431         save path_a, path_b, path_c;
1432         path path_a, path_b, path_c;
1433         pair nw_dist, nw;
1434
1435         pickup pencircle scaled solfa_pen_thick;
1436
1437         lft x1 = 0;
1438         top y1 = h;
1439
1440         rt x2 = w;
1441         y2 = y1;
1442         bot y3 = -d;
1443         x3 = x2;
1444
1445         y4 = y3;
1446         x4 = x1;
1447
1448         labels (1, 2, 3, 4);
1449
1450         nw = unitvector (z1 - z3);
1451         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1452
1453         path_a := (z1 - (0,1) * thickness_factor * solfa_pen_thick) --
1454                   (z2 - (0,1) * thickness_factor * solfa_pen_thick);
1455         path_b := (z2 - (1,0) * 0.5 solfa_pen_thick) --
1456                   (z3 - (1,0) * 0.5 solfa_pen_thick);
1457         path_c := (z3 - nw_dist) -- (z1 - nw_dist);
1458
1459         p_up_in := (path_a intersectionpoint path_b) --
1460                    (path_b intersectionpoint path_c) --
1461                    (path_c intersectionpoint path_a) --
1462                    cycle;
1463
1464         p_up_out := lft z1{down}
1465                     .. (z1 + nw_dist){-nw}
1466                     -- (z3 + nw_dist){-nw}
1467                     .. bot z3{right}
1468                     .. rt z3{up}
1469                     -- rt z2{up}
1470                     .. top z2{left}
1471                     -- top z1{left}
1472                     .. {down}cycle;
1473
1474         p_down_in := p_up_in rotated 180 shifted (w, 0);
1475         p_down_out := p_up_out rotated 180 shifted (w, 0);
1476
1477         charwy := 0.0;
1478         charwx := charwd;
1479 enddef;
1480
1481
1482 fet_beginchar ("Whole fa up head", "u0fa");
1483         draw_fa_head (solfa_whole_width, 1.5);
1484         fill p_up_out;
1485         unfill p_up_in;
1486 fet_endchar;
1487
1488
1489 fet_beginchar ("Whole fa down head", "d0fa");
1490         draw_fa_head (solfa_whole_width, 1.5);
1491         fill p_down_out;
1492         unfill p_down_in;
1493 fet_endchar;
1494
1495
1496 fet_beginchar ("half fa up head", "u1fa");
1497         draw_fa_head (solfa_half_width, 1.5);
1498         fill p_up_out;
1499         unfill p_up_in;
1500 fet_endchar;
1501
1502
1503 fet_beginchar ("Half fa down head", "d1fa");
1504         draw_fa_head (solfa_half_width, 1.5);
1505         fill p_down_out;
1506         unfill p_down_in;
1507 fet_endchar;
1508
1509
1510 fet_beginchar ("Quarter fa up head", "u2fa");
1511         draw_fa_head (solfa_quarter_width, 1.5);
1512         fill p_up_out;
1513 fet_endchar;
1514
1515
1516 fet_beginchar ("Quarter fa down head", "d2fa");
1517         draw_fa_head (solfa_quarter_width, 1.5);
1518         fill p_down_out;
1519 fet_endchar;
1520
1521
1522 fet_beginchar ("Whole thin fa up head", "u0faThin");
1523         draw_fa_head (solfa_whole_width, 1);
1524         fill p_up_out;
1525         unfill p_up_in;
1526 fet_endchar;
1527
1528
1529 fet_beginchar ("Whole thin fa down head", "d0faThin");
1530         draw_fa_head (solfa_whole_width, 1);
1531         fill p_down_out;
1532         unfill p_down_in;
1533 fet_endchar;
1534
1535
1536 fet_beginchar ("half thin fa up head", "u1faThin");
1537         draw_fa_head (solfa_half_width, 1);
1538         fill p_up_out;
1539         unfill p_up_in;
1540 fet_endchar;
1541
1542
1543 fet_beginchar ("Half thin fa down head", "d1faThin");
1544         draw_fa_head (solfa_half_width, 1);
1545         fill p_down_out;
1546         unfill p_down_in;
1547 fet_endchar;
1548
1549
1550 fet_beginchar ("Quarter thin fa up head", "u2faThin");
1551         draw_fa_head (solfa_quarter_width, 1);
1552         fill p_up_out;
1553 fet_endchar;
1554
1555
1556 fet_beginchar ("Quarter thin fa down head", "d2faThin");
1557         draw_fa_head (solfa_quarter_width, 1);
1558         fill p_down_out;
1559 fet_endchar;
1560
1561
1562
1563 %%%% sol head
1564 %%
1565 %%  Note -- sol head is the same shape as a standard music
1566 %%          head, and doesn't vary from style to style.
1567 %%          However, width is constant with duration, so we
1568 %%          can't just use the standard note font.
1569
1570 def draw_sol_head (expr filled) =
1571         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
1572         if not filled:
1573           undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
1574         fi
1575         draw_staff (-2, 2, 0);
1576 enddef;
1577
1578 fet_beginchar ("Whole solhead", "s0sol");
1579         draw_sol_head ( false);
1580 fet_endchar;
1581
1582
1583 fet_beginchar ("Half solhead", "s1sol");
1584         draw_sol_head ( false);
1585 fet_endchar;
1586
1587
1588 fet_beginchar ("Quart solhead", "s2sol");
1589         draw_sol_head ( true);
1590 fet_endchar;
1591
1592
1593
1594 %%%% la head
1595
1596 def draw_la_head (expr width_factor, thickness_factor) =
1597         set_char_box (0, width_factor * solfa_base_notewidth#,
1598                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1599         save p_in, p_out;
1600         path p_in, p_out;
1601
1602         pickup pencircle scaled solfa_pen_thick;
1603
1604         lft x1 = 0;
1605         top y1 = h;
1606
1607         rt x2 = w;
1608         y2 = y1;
1609         bot y3 = -d;
1610         x3 = x2;
1611
1612         y4 = y3;
1613         x4 = x1;
1614
1615         labels (range 1 thru 4);
1616
1617         p_in := (z1 + 0.5 solfa_pen_thick * (1, -thickness_factor))
1618                 -- (z2 + 0.5 solfa_pen_thick * (-1, -thickness_factor))
1619                 -- (z3 + 0.5 solfa_pen_thick * (-1, thickness_factor))
1620                 -- (z4 + 0.5 solfa_pen_thick * (1, thickness_factor))
1621                 -- cycle;
1622
1623         p_out := top z1
1624                  -- top z2{right}
1625                  .. rt z2{down}
1626                  -- rt z3{down}
1627                  .. bot z3{left}
1628                  -- bot z4{left}
1629                  .. lft z4{up}
1630                  -- lft z1{up}
1631                  .. cycle;
1632 enddef;
1633
1634
1635 fet_beginchar ("Whole lahead", "s0la");
1636         draw_la_head (solfa_whole_width, 3);
1637         fill p_out;
1638         unfill p_in;
1639 fet_endchar;
1640
1641
1642 fet_beginchar ("Half lahead", "s1la");
1643         draw_la_head (solfa_half_width, 3);
1644         fill p_out;
1645         unfill p_in;
1646 fet_endchar;
1647
1648
1649 fet_beginchar ("Quart lahead", "s2la");
1650         draw_la_head (solfa_quarter_width, 3);
1651         fill p_out;
1652 fet_endchar;
1653
1654
1655 fet_beginchar ("Whole thin lahead", "s0laThin");
1656         draw_la_head (solfa_whole_width, 1);
1657         fill p_out;
1658         unfill p_in;
1659 fet_endchar;
1660
1661
1662 fet_beginchar ("Half thin lahead", "s1laThin");
1663         draw_la_head (solfa_half_width, 1);
1664         fill p_out;
1665         unfill p_in;
1666 fet_endchar;
1667
1668
1669 fet_beginchar ("Quart lahead", "s2laThin");
1670         draw_la_head (solfa_quarter_width, 1);
1671         fill p_out;
1672 fet_endchar;
1673
1674
1675
1676 %%%% ti head
1677
1678 def draw_ti_head (expr width_factor, dir, thickness_factor) =
1679         set_char_box (0, width_factor * solfa_base_notewidth#,
1680                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1681         save p_in, p_out, p_top, p_top_in;
1682         save nw_dist, sw_dist, nw, sw;
1683         path p_in, p_out, p_top, p_top_in;
1684         pair nw_dist, sw_dist, nw, sw;
1685         save cone_height;
1686         cone_height = 0.64;
1687
1688         pickup pencircle scaled solfa_pen_thick;
1689
1690         x1 = .5 [x2, x4];
1691         bot y1 = -d;
1692         lft x2 = 0;
1693         y2 = cone_height [y1, y3];
1694         rt x4 = w;
1695         y4 = y2;
1696         x3 = x1;
1697         top y3 = h;
1698         x5 = x1;
1699         y5 = y1 + thickness_factor * 0.5 * solfa_pen_thick;
1700
1701         labels (range 1 thru 4);
1702
1703         nw = unitvector (z2 - z1);
1704         sw = unitvector (z1 - z4);
1705
1706         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1707         sw_dist = (sw rotated 90) * 0.5 solfa_pen_thick;
1708
1709         p_top := (z2 - sw_dist)
1710                  .. (top z3){right}
1711                  .. (z4 - nw_dist);
1712
1713         p_top_in := (z2 + sw_dist * thickness_factor) {- sw}
1714                     .. ((top z3) - (0,1) * thickness_factor * 0.5 solfa_pen_thick) {right}
1715                     .. (z4 + nw_dist * thickness_factor){- nw};
1716
1717         save path_a, path_b;
1718         path path_a, path_b;
1719         path_a := z2 -- z5;
1720         path_b := z5 -- z4;
1721
1722         z6 = path_a intersectionpoint p_top_in;
1723         z7 = path_b intersectionpoint p_top_in;
1724
1725         p_in := z5 -- z6 .. bot z3 .. z7 -- cycle;
1726
1727         p_out := bot z1
1728                  .. (z1 + nw_dist)
1729                  -- (z2 + nw_dist)
1730                  .. lft z2
1731                  .. (z2 - sw_dist){direction 0 of p_top}
1732                  & p_top
1733                  & {direction infinity of p_top}(z4 - nw_dist)
1734                  .. rt z4
1735                  .. (z4 + sw_dist)
1736                  -- (z1 + sw_dist)
1737                  .. cycle;
1738
1739         charwx := charwd;
1740         charwy := cone_height [-chardp, charht];
1741         if dir = -1:
1742                 charwy := -charwy;
1743         fi;
1744 enddef;
1745
1746
1747 fet_beginchar ("Whole up tihead", "s0ti");
1748         draw_ti_head (solfa_whole_width, 1, 3);
1749         fill p_out;
1750         unfill p_in;
1751 fet_endchar;
1752
1753
1754 fet_beginchar ("Half up tihead", "u1ti");
1755         draw_ti_head (solfa_half_width, 1, 3);
1756         fill p_out;
1757         unfill p_in;
1758 fet_endchar;
1759
1760
1761 fet_beginchar ("Half down tihead", "d1ti");
1762         draw_ti_head (solfa_half_width, -1, 3);
1763         fill p_out;
1764         unfill p_in;
1765 fet_endchar;
1766
1767
1768 fet_beginchar ("Quart up tihead", "u2ti");
1769         draw_ti_head (solfa_quarter_width, 1, 3);
1770         fill p_out;
1771 fet_endchar;
1772
1773
1774 fet_beginchar ("Quart down tihead", "d2ti");
1775         draw_ti_head (solfa_quarter_width, -1, 3);
1776         fill p_out;
1777 fet_endchar;
1778
1779
1780 fet_beginchar ("Whole thin up tihead", "s0tiThin");
1781         draw_ti_head (solfa_whole_width, 1, 1);
1782         fill p_out;
1783         unfill p_in;
1784 fet_endchar;
1785
1786
1787 fet_beginchar ("Half thin up tihead", "u1tiThin");
1788         draw_ti_head (solfa_half_width, 1, 1);
1789         fill p_out;
1790         unfill p_in;
1791 fet_endchar;
1792
1793
1794 fet_beginchar ("Half thin down tihead", "d1tiThin");
1795         draw_ti_head (solfa_half_width, -1, 1);
1796         fill p_out;
1797         unfill p_in;
1798 fet_endchar;
1799
1800
1801 fet_beginchar ("Quart thin up tihead", "u2tiThin");
1802         draw_ti_head (solfa_quarter_width, 1, 1);
1803         fill p_out;
1804 fet_endchar;
1805
1806
1807 fet_beginchar ("Quart thin down tihead", "d2tiThin");
1808         draw_ti_head (solfa_quarter_width, -1, 1);
1809         fill p_out;
1810 fet_endchar;
1811
1812
1813
1814 fet_endgroup ("noteheads");
1815
1816
1817
1818 %
1819 % we derive black_notehead_width# from the quarter head,
1820 % so we have to define black_notehead_width (pixel qty)
1821 % after the black_notehead_width# itself.
1822 %
1823 % Let's keep it outside the group as well.
1824 %
1825
1826 define_pixels (black_notehead_width);