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.75 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) =
1019         save p_in, p_out;
1020         save left_dist, right_dist;
1021         path p_in, p_out;
1022         pair left_dist, right_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         bot y1 = -d;
1030         y1 = y2;
1031         lft x1 = 0;
1032         rt x2 = w;
1033         top y3 = h;
1034         x3 =.5 [x1, x2];
1035
1036         left_dist = (unitvector (z3 - z1) rotated 90) * 0.5 solfa_pen_thick;
1037         right_dist = (unitvector (z2 - z3) rotated 90) * 0.5 solfa_pen_thick;
1038
1039         p_in := (((z1 - left_dist) -- (z3 - left_dist)) intersectionpoint
1040                   (top z1 -- top z2))
1041                 -- ((top z1 -- top z2) intersectionpoint
1042                     ((z2 - right_dist) -- (z3 - right_dist)))
1043                 -- (((z2 - right_dist) -- (z3 - right_dist)) intersectionpoint
1044                     ((z1 - left_dist) -- (z3 - left_dist)))
1045                 -- cycle;
1046
1047         p_out := bot z1
1048                  -- bot z2{right}
1049                  .. rt z2{up}
1050                  .. (z2 + right_dist){z3 - z2}
1051                  -- (z3 + right_dist){z3 - z2}
1052                  .. top z3{left}
1053                  .. (z3 + left_dist){z1 - z3}
1054                  -- (z1 + left_dist){z1 - z3}
1055                  .. lft z1{down}
1056                  .. {right}cycle;
1057
1058
1059         labels (1, 2, 3);
1060
1061         charwx := charwd;
1062         charwy := -chardp + 0.5 stafflinethickness#;
1063         if dir = -1:
1064                 charwy := -charwy;
1065         fi;
1066 enddef;
1067
1068
1069 fet_beginchar ("Whole dohead", "s0do");
1070         draw_do_head (solfa_whole_width, 1);
1071         fill p_out;
1072         unfill p_in;
1073 fet_endchar;
1074
1075
1076 fet_beginchar ("Half dohead", "d1do");
1077         draw_do_head (solfa_half_width, -1);
1078         fill p_out;
1079         unfill p_in;
1080 fet_endchar;
1081
1082
1083 fet_beginchar ("Half dohead", "u1do");
1084         draw_do_head (solfa_half_width, 1);
1085         fill p_out;
1086         unfill p_in;
1087 fet_endchar;
1088
1089
1090 fet_beginchar ("Quart dohead", "d2do");
1091         draw_do_head (solfa_quarter_width, -1);
1092         fill p_out;
1093 fet_endchar;
1094
1095
1096 fet_beginchar ("Quart dohead", "u2do");
1097         draw_do_head (solfa_quarter_width, 1);
1098         fill p_out;
1099 fet_endchar;
1100
1101
1102 %
1103 % re - flat top, curved bottom:
1104 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
1105 % (broader along the base and with more vertical sides for half and
1106 % whole notes)
1107 % stem attachment: h/2
1108 %
1109
1110 def draw_re_head (expr width_factor, dir) =
1111         save p_in, p_out;
1112         path p_in, p_out;
1113
1114         set_char_box (0, width_factor * solfa_base_notewidth#,
1115                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1116
1117         pickup pencircle scaled solfa_pen_thick;
1118
1119         save curve_start;
1120         curve_start = 0.7;
1121         lft x1 = 0;
1122         y1 = y5;
1123         x1 = x2;
1124         y2 = curve_start [y3, y1];
1125         bot y3 = -d;
1126         x3 = .5 [x2, x4];
1127         rt x4 = w;
1128         y4 = y2;
1129         top y5 = h;
1130         x5 = x4;
1131
1132         labels (range 1 thru 5);
1133
1134         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1135                 -- rt z2{down}
1136                 .. top z3
1137                 .. lft z4{up}
1138                 -- (z5 + 0.5 solfa_pen_thick * (-1, -1))
1139                 -- cycle;
1140
1141         p_out := lft z1
1142                  -- lft z2{down}
1143                  .. bot z3
1144                  .. rt z4{up}
1145                  -- rt z5{up}
1146                  .. top z5{left}
1147                  -- top z1{left}
1148                  .. {down}cycle;
1149
1150         charwx := charwd;
1151         charwy := curve_start [-chardp, charht];
1152
1153         if dir = -1:
1154                 charwy := -charwy;
1155         fi;
1156 enddef;
1157
1158
1159 fet_beginchar ("Whole rehead", "s0re");
1160         draw_re_head (solfa_whole_width, 1);
1161         fill p_out;
1162         unfill p_in;
1163 fet_endchar;
1164
1165
1166 fet_beginchar ("Half up rehead", "u1re");
1167         draw_re_head (solfa_half_width, 1);
1168         fill p_out;
1169         unfill p_in;
1170 fet_endchar;
1171
1172
1173 fet_beginchar ("Half down rehead", "d1re");
1174         draw_re_head (solfa_half_width, -1);
1175         fill p_out;
1176         unfill p_in;
1177 fet_endchar;
1178
1179
1180 fet_beginchar ("Quart rehead", "u2re");
1181         draw_re_head (solfa_quarter_width, 1);
1182         fill p_out;
1183 fet_endchar;
1184
1185
1186 fet_beginchar ("Quart rehead", "d2re");
1187         draw_re_head (solfa_quarter_width, -1);
1188         fill p_out;
1189 fet_endchar;
1190
1191
1192 def draw_mi_head (expr width_factor) =
1193         save path_out, path_in;
1194         save ne_dist, se_dist, ne, se;
1195         path path_out, path_in;
1196         pair ne_dist, se_dist, ne, se;
1197
1198         set_char_box (0, width_factor * solfa_base_notewidth#,
1199                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1200
1201         pickup pencircle scaled solfa_pen_thick;
1202
1203         lft x1 = 0;
1204         y1 = 0;
1205         bot y2 = -d;
1206         x2 = .5 [x1, x3];
1207         rt x3 = w;
1208         x4 = x2;
1209         y3 = y1;
1210         top y4 = h;
1211
1212         z6 - z5 = whatever * (z2 - z1);
1213         z8 - z7 = whatever * (z2 - z1);
1214         z8 - z5 = whatever * (z4 - z1);
1215         z6 - z7 = whatever * (z4 - z1);
1216
1217         ne = unitvector (z4 - z1);
1218         se = unitvector (z1 - z2);
1219
1220         ne_dist = (ne rotated 90) * 0.5 solfa_pen_thick;
1221         se_dist = (se rotated 90) * 0.5 solfa_pen_thick;
1222
1223         z5 = whatever [z1, z4] - ne_dist;
1224         z5 = whatever [z1, z2] - 1.5 se_dist;
1225
1226         z5 - z1 = -(z7 - z3);
1227
1228         labels (range 1 thru 8);
1229
1230         path_in := z5
1231                    -- z6
1232                    -- z7
1233                    -- z8
1234                    -- cycle;
1235
1236         path_out := lft z1
1237                     .. (z1 + se_dist){-se}
1238                     -- (z2 + se_dist){-se}
1239                     .. bot z2
1240                     .. (z2 - ne_dist){ne}
1241                     -- (z3 - ne_dist){ne}
1242                     .. rt z3
1243                     .. (z3 - se_dist){se}
1244                     -- (z4 - se_dist){se}
1245                     .. top z4
1246                     .. (z4 + ne_dist){-ne}
1247                     -- (z1 + ne_dist){-ne}
1248                     .. cycle;
1249 enddef;
1250
1251
1252 fet_beginchar ("Whole mihead", "s0mi");
1253         draw_mi_head (solfa_whole_width);
1254         fill path_out;
1255         unfill path_in;
1256 fet_endchar;
1257
1258
1259 fet_beginchar ("Half mihead", "s1mi");
1260         draw_mi_head (solfa_quarter_width);
1261         fill path_out;
1262         unfill path_in;
1263 fet_endchar;
1264
1265
1266 fet_beginchar ("Quart mihead", "s2mi");
1267         draw_mi_head (solfa_quarter_width);
1268         fill path_out;
1269 fet_endchar;
1270
1271
1272 def draw_fa_head (expr width_factor) =
1273         set_char_box (0, width_factor * solfa_base_notewidth#,
1274                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1275
1276         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1277         path p_down_in, p_down_out, p_up_in, p_up_out;
1278         pair nw_dist, nw;
1279
1280         pickup pencircle scaled solfa_pen_thick;
1281
1282         lft x1 = 0;
1283         top y1 = h;
1284
1285         rt x2 = w;
1286         y2 = y1;
1287         bot y3 = -d;
1288         x3 = x2;
1289
1290         y4 = y3;
1291         x4 = x1;
1292
1293         labels (1, 2, 3, 4);
1294
1295         nw = unitvector (z1 - z3);
1296         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1297
1298         p_up_in := (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1299                      (bot z1 -- bot z2))
1300                    -- (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1301                         (lft z3 -- lft z2))
1302                    -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1303                    -- cycle;
1304
1305         p_up_out := lft z1{down}
1306                     .. (z1 + nw_dist){-nw}
1307                     -- (z3 + nw_dist){-nw}
1308                     .. bot z3{right}
1309                     .. rt z3{up}
1310                     -- rt z2{up}
1311                     .. top z2{left}
1312                     -- top z1{left}
1313                     .. {down}cycle;
1314
1315         p_down_in := p_up_in rotated 180 shifted (w, 0);
1316         p_down_out := p_up_out rotated 180 shifted (w, 0);
1317
1318         charwy := 0.0;
1319         charwx := charwd;
1320 enddef;
1321
1322
1323 fet_beginchar ("Whole fa up head", "u0fa");
1324         draw_fa_head (solfa_whole_width);
1325         fill p_up_out;
1326         unfill p_up_in;
1327 fet_endchar;
1328
1329
1330 fet_beginchar ("Whole fa down head", "d0fa");
1331         draw_fa_head (solfa_whole_width);
1332         fill p_down_out;
1333         unfill p_down_in;
1334 fet_endchar;
1335
1336
1337 fet_beginchar ("half fa up head", "u1fa");
1338         draw_fa_head (solfa_half_width);
1339         fill p_up_out;
1340         unfill p_up_in;
1341 fet_endchar;
1342
1343
1344 fet_beginchar ("Half fa down head", "d1fa");
1345         draw_fa_head (solfa_half_width);
1346         fill p_down_out;
1347         unfill p_down_in;
1348 fet_endchar;
1349
1350
1351 fet_beginchar ("Quarter fa up head", "u2fa");
1352         draw_fa_head (solfa_quarter_width);
1353         fill p_up_out;
1354 fet_endchar;
1355
1356
1357 fet_beginchar ("Quarter fa down head", "d2fa");
1358         draw_fa_head (solfa_quarter_width);
1359         fill p_down_out;
1360 fet_endchar;
1361
1362
1363 def draw_la_head (expr width_factor) =
1364         set_char_box (0, width_factor * solfa_base_notewidth#,
1365                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1366         save p_in, p_out;
1367         path p_in, p_out;
1368
1369         pickup pencircle scaled solfa_pen_thick;
1370
1371         lft x1 = 0;
1372         top y1 = h;
1373
1374         rt x2 = w;
1375         y2 = y1;
1376         bot y3 = -d;
1377         x3 = x2;
1378
1379         y4 = y3;
1380         x4 = x1;
1381
1382         labels (range 1 thru 4);
1383
1384         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1385                 -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1386                 -- (z3 + 0.5 solfa_pen_thick * (-1, 1))
1387                 -- (z4 + 0.5 solfa_pen_thick * (1, 1))
1388                 -- cycle;
1389
1390         p_out := top z1
1391                  -- top z2{right}
1392                  .. rt z2{down}
1393                  -- rt z3{down}
1394                  .. bot z3{left}
1395                  -- bot z4{left}
1396                  .. lft z4{up}
1397                  -- lft z1{up}
1398                  .. cycle;
1399 enddef;
1400
1401
1402 fet_beginchar ("Whole lahead", "s0la");
1403         draw_la_head (solfa_whole_width);
1404         fill p_out;
1405         unfill p_in;
1406 fet_endchar;
1407
1408
1409 fet_beginchar ("Half lahead", "s1la");
1410         draw_la_head (solfa_half_width);
1411         fill p_out;
1412         unfill p_in;
1413 fet_endchar;
1414
1415
1416 fet_beginchar ("Quart lahead", "s2la");
1417         draw_la_head (solfa_quarter_width);
1418         fill p_out;
1419 fet_endchar;
1420
1421
1422 def draw_ti_head (expr width_factor, dir) =
1423         set_char_box (0, width_factor * solfa_base_notewidth#,
1424                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1425         save p_in, p_out, p_top;
1426         save nw_dist, sw_dist, nw, sw;
1427         path p_in, p_out, p_top;
1428         pair nw_dist, sw_dist, nw, sw;
1429         save cone_height;
1430         cone_height = 0.64;
1431
1432         pickup pencircle scaled solfa_pen_thick;
1433
1434         x1 = .5 [x2, x4];
1435         bot y1 = -d;
1436         lft x2 = 0;
1437         y2 = cone_height [y1, y3];
1438         rt x4 = w;
1439         y4 = y2;
1440         x3 = x1;
1441         top y3 = h;
1442
1443         labels (range 1 thru 4);
1444
1445         nw = unitvector (z2 - z1);
1446         sw = unitvector (z1 - z4);
1447
1448         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1449         sw_dist = (sw rotated 90) * 0.5 solfa_pen_thick;
1450
1451         p_top := (z2 - sw_dist)
1452                  .. (top z3){right}
1453                  .. (z4 - nw_dist);
1454
1455         p_in := (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1456                   ((z1 - sw_dist) -- (z4 - sw_dist)))
1457                 -- (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1458                      ((z2 + sw_dist) .. {right}(bot z3)))
1459                 .. bot z3
1460                 .. (((bot z3){right} .. (z4 + nw_dist)) intersectionpoint
1461                      ((z1 - sw_dist) -- (z4 - sw_dist)))
1462                 -- cycle;
1463
1464         p_out := bot z1
1465                  .. (z1 + nw_dist)
1466                  -- (z2 + nw_dist)
1467                  .. lft z2
1468                  .. (z2 - sw_dist){direction 0 of p_top}
1469                  & p_top
1470                  & {direction infinity of p_top}(z4 - nw_dist)
1471                  .. rt z4
1472                  .. (z4 + sw_dist)
1473                  -- (z1 + sw_dist)
1474                  .. cycle;
1475
1476         charwx := charwd;
1477         charwy := cone_height [-chardp, charht];
1478         if dir = -1:
1479                 charwy := -charwy;
1480         fi;
1481 enddef;
1482
1483
1484 fet_beginchar ("Whole up tihead", "s0ti");
1485         draw_ti_head (solfa_whole_width, 1);
1486         fill p_out;
1487         unfill p_in;
1488 fet_endchar;
1489
1490
1491 fet_beginchar ("Half up tihead", "u1ti");
1492         draw_ti_head (solfa_half_width, 1);
1493         fill p_out;
1494         unfill p_in;
1495 fet_endchar;
1496
1497
1498 fet_beginchar ("Half down tihead", "d1ti");
1499         draw_ti_head (solfa_half_width, -1);
1500         fill p_out;
1501         unfill p_in;
1502 fet_endchar;
1503
1504
1505 fet_beginchar ("Quart up tihead", "u2ti");
1506         draw_ti_head (solfa_quarter_width, 1);
1507         fill p_out;
1508 fet_endchar;
1509
1510
1511 fet_beginchar ("Quart down tihead", "d2ti");
1512         draw_ti_head (solfa_quarter_width, -1);
1513         fill p_out;
1514 fet_endchar;
1515
1516
1517 fet_endgroup ("noteheads");
1518
1519
1520 %
1521 % we derive black_notehead_width# from the quarter head,
1522 % so we have to define black_notehead_width (pixel qty)
1523 % after the black_notehead_width# itself.
1524 %
1525 % Let's keep it outside the group as well.
1526 %
1527
1528 define_pixels (black_notehead_width);