mf/feta-bolletjes.mf

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