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