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