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