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--2004 Jan Nieuwenhuizen <janneke@gnu.org>
   7 % & Han-Wen Nienhuys <hanwen@cs.uu.nl>
   8 % & Juergen Reuter <reuter@ipd.uka.de>
   9 %
  10
  11 test_outlines := 0;
  12
  13
  14 % Most beautiful noteheads are pronounced, not circular,
  15 % and not even symmetric.
  16 % These examples are inspired by [Wanske]; see literature list.
  17
  18
  19
  20 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  21 % NOTE HEAD VARIABLES
  22 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  23
  24 save black_notehead_width, noteheight;
  25 save slash_thick, slash_slope, overdone_heads;
  26 numeric black_notehead_width, noteheight, slash_thick;
  27
  28
  29 fet_begingroup("noteheads");
  30
  31
  32 % Slope of slash.  From scm/grob-description.scm.  How to auto-copy?
  33 slash_slope := 1.7;
  34
  35 % Thickness of slash lines.  Quarter notes get 1.5slt width.
  36 slash_thick# := 2/3 * 0.48 staff_space#;
  37
  38
  39 %
  40 % Hand-engraved music often has balls extending above and below
  41 % the lines.  If you like that, modify overdone heads (unit:
  42 % stafflinethickness)
  43 %
  44 overdone_heads = 0.0;
  45 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
  46
  47 define_pixels (slash_thick, noteheight);
  48
  49
  50 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  51 %
  52 % SLANT moves both extrema on the long axis (by SLANT * ELLIPTICITY,
  53 % so SLANT = -1, puts the extreme on the long axis next to the short
  54 % axis one).
  55 %
  56
  57 def draw_outside_ellipse (expr ellipticity, tilt, superness, slant) =
  58         save attachment_y;
  59         save p;
  60         path p;
  61
  62         p := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
  63                            (- ellipticity, 0), (slant * ellipticity, -1.0),
  64                            superness);
  65         p := p rotated tilt;
  66
  67         save top_point, right_point;
  68         pair top_point, right_point;
  69
  70         top_point := directionpoint left of p;
  71         right_point := directionpoint up of p;
  72
  73         save scaling, width, height;
  74
  75         scaling# = noteheight# / (2 ypart (top_point));
  76         width# := 2 xpart (right_point) * scaling#;
  77
  78         define_pixels (width, scaling);
  79
  80         set_char_box (0, width#, noteheight# / 2, noteheight# / 2);
  81
  82         % attachment Y
  83         charwy := ypart (right_point) * scaling#;
  84         charwx := width#;
  85
  86         p := p scaled scaling shifted (width / 2, 0);
  87         if test_outlines = 1:
  88                 pickup pencircle scaled 1;
  89                 draw p;
  90         else:
  91                 fill p;
  92         fi;
  93 enddef;
  94
  95
  96 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance,
  97                            center) =
  98 begingroup
  99         save p;
 100         path p;
 101
 102         p := superellipse ((ellipticity, 0), (0, 1.0),
 103                            (-ellipticity, 0), (0, -1.0),
 104                            superness);
 105         p := p rotated tilt;
 106
 107         save top_point, right_point;
 108         pair top_point, right_point;
 109
 110         top_point := directionpoint left of p;
 111         right_point := directionpoint up of p;
 112
 113         save height, scaling;
 114
 115         height# = staff_space# + stafflinethickness# - clearance;
 116         scaling# = height# / (2 ypart (top_point));
 117
 118         define_pixels (scaling);
 119         p := (p scaled scaling) shifted center;
 120
 121         if test_outlines = 1:
 122                 pickup pencircle scaled 1;
 123                 draw p;
 124         else:
 125                 unfill p;
 126         fi
 127 endgroup;
 128 enddef;
 129
 130
 131 %
 132 % dimensions aren't entirely right.
 133 %
 134 fet_beginchar ("Brevis notehead", "s-1");
 135         save stemthick, fudge;
 136         define_pixels (stemthick);
 137         fudge = blot_diameter / 2;
 138         stemthick# = 2 stafflinethickness#;
 139
 140         draw_outside_ellipse (1.80, 0, 0.707, 0);
 141         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#,
 142                                (w / 2, 0));
 143
 144         pickup pencircle scaled stemthick;
 145
 146         bot y1 = -d;
 147         top y2 = h;
 148         rt x1 - fudge = 0;
 149         x1 = x2;
 150
 151         fudge + lft x3 = w;
 152         x4 = x3;
 153         y4 = y2;
 154         y3 = y1;
 155
 156         draw_gridline (z1, z2, stemthick);
 157         draw_gridline (z3, z4, stemthick);
 158 fet_endchar;
 159
 160
 161 fet_beginchar ("Whole notehead", "s0")
 162         draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0);
 163         undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
 164                                0.68, 2 stafflinethickness#, (w / 2, 0));
 165
 166 %       draw_staff_outline (-2, 2, 0.5);
 167 fet_endchar;
 168
 169
 170 fet_beginchar ("Half notehead", "s1")
 171         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
 172         undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#,
 173                                (w / 2, 0));
 174 fet_endchar;
 175
 176 fet_beginchar ("Quart notehead", "s2")
 177         % used to have 32. With 31, they are slightly bolder.
 178         draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0);
 179         black_notehead_width# := charwd;
 180 fet_endchar;
 181
 182
 183 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 184
 185
 186 fet_beginchar ("Whole diamondhead", "s0diamond")
 187         draw_outside_ellipse (1.80, 0, 0.495, 0);
 188         undraw_inside_ellipse (1.30, 125, 0.6,
 189                                .4 staff_space# +  stafflinethickness#,
 190                                (w / 2, 0));
 191 fet_endchar;
 192
 193
 194 fet_beginchar ("Half diamondhead", "s1diamond")
 195         draw_outside_ellipse (1.50, 34, 0.49, 0.17);
 196         undraw_inside_ellipse (3.5, 33, 0.80,
 197                                .3 staff_space# + 1.5 stafflinethickness#,
 198                                (w / 2, 0));
 199 fet_endchar;
 200
 201
 202 fet_beginchar ("Quart diamondhead", "s2diamond")
 203         draw_outside_ellipse (1.80, 35, 0.495, -0.25);
 204 fet_endchar;
 205
 206
 207 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 208
 209
 210 vardef penposx@# (expr d) =
 211 begingroup;
 212         save pat;
 213         path pat;
 214
 215         pat = top z@#
 216               .. lft z@#
 217               .. bot z@#
 218               .. rt z@#
 219               .. cycle;
 220         z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180));
 221         z@#r = pat intersectionpoint (z@# -- infinity * dir (d));
 222 endgroup
 223 enddef;
 224
 225
 226 def define_triangle_shape (expr stemdir) =
 227         save triangle_a, triangle_b, triangle_c;
 228         save triangle_out_a, triangle_out_b, triangle_out_c;
 229         save triangle_in, triangle_out;
 230         save width, depth, height;
 231         save origin, left_up_dir;
 232         save exact_left_point, exact_right_point, exact_down_point;
 233
 234         path triangle_a, triangle_b, triangle_c;
 235         path triangle_out_a, triangle_out_b, triangle_out_c;
 236         path triangle_in, triangle_out;
 237         pair origin, left_up_dir;
 238         pair exact_down_point, exact_left_point, exact_right_point;
 239
 240         save pen_thick;
 241         pen_thick# = stafflinethickness# + .1 staff_space#;
 242         define_pixels (pen_thick, llap);
 243
 244         left_up_dir = llap# * dir (90 + tilt);
 245
 246         xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0;
 247         ypart origin = 0;
 248
 249         exact_left_point := origin + (left_up_dir xscaled xs);
 250         exact_down_point := origin + (left_up_dir rotated 120 xscaled xs);
 251         exact_right_point := origin + (left_up_dir rotated 240 xscaled xs);
 252
 253         height# = ypart (exact_left_point + origin) + pen_thick# / 2;
 254         depth# = -ypart (exact_down_point + origin) + pen_thick# / 2;
 255         width# = xpart (exact_right_point - exact_left_point)
 256                  + pen_thick# * xs;
 257
 258         set_char_box (0, width#, depth#, height#);
 259
 260         % Formerly, the shape has simply been drawn with an elliptical pen
 261         % (`scaled pen_thick xsaled xs'), but the envelope of such a curve
 262         % is of 6th degree.  For the sake of mf2pt1, we approximate it.
 263
 264         pickup pencircle scaled pen_thick xscaled xs;
 265
 266         z0 = (hround_pixels (xpart origin), 0);
 267
 268         z1 = z1' = z0 + llap * dir (90 + tilt) xscaled xs;
 269         z2 = z2' = z0 + llap * dir (90 + tilt + 120) xscaled xs;
 270         z3 = z3' = z0 + llap * dir (90 + tilt + 240) xscaled xs;
 271
 272         z12 = caveness [.5[z1, z2], z3];
 273         z23 = caveness [.5[z2, z3], z1];
 274         z31 = caveness [.5[z3, z1], z2];
 275
 276         triangle_a = z1 .. z12 .. z2;
 277         triangle_b = z2 .. z23 .. z3;
 278         triangle_c = z3 .. z31 .. z1;
 279
 280         penposx1 (angle (direction 0 of triangle_a) - 90);
 281         penposx2 (angle (direction 0 of triangle_b) - 90);
 282         penposx3 (angle (direction 0 of triangle_c) - 90);
 283
 284         penposx1' (angle (direction infinity of triangle_c) + 90);
 285         penposx2' (angle (direction infinity of triangle_a) + 90);
 286         penposx3' (angle (direction infinity of triangle_b) + 90);
 287
 288         penposx12 (angle (z12 - z0));
 289         penposx23 (angle (z23 - z0));
 290         penposx31 (angle (z31 - z0));
 291
 292         z10 = (z0 -- z1) intersectionpoint (z1l .. z12l .. z2'r);
 293         z20 = (z0 -- z2) intersectionpoint (z2l .. z23l .. z3'r);
 294         z30 = (z0 -- z3) intersectionpoint (z3l .. z31l .. z1'r);
 295
 296         triangle_in = z10
 297                       .. z12l
 298                       .. z20
 299                       & z20
 300                       .. z23l
 301                       .. z30
 302                       & z30
 303                       .. z31l
 304                       .. z10
 305                       & cycle;
 306
 307         triangle_out_a = z1r .. z12r .. z2'l;
 308         triangle_out_b = z2r .. z23r .. z3'l;
 309         triangle_out_c = z3r .. z31r .. z1'l;
 310
 311         triangle_out = top z1
 312                        .. lft z1
 313                        .. z1r{direction 0 of triangle_out_a}
 314                        & triangle_out_a
 315                        & {direction infinity of triangle_out_a}z2'l
 316                        .. lft z2
 317                        .. bot z2
 318                        .. z2r{direction 0 of triangle_out_b}
 319                        & triangle_out_b
 320                        & {direction infinity of triangle_out_b}z3'l
 321                        .. rt z3
 322                        .. top z3
 323                        .. z3r{direction 0 of triangle_out_c}
 324                        & triangle_out_c
 325                        & {direction infinity of triangle_out_c}z1'l
 326                        .. cycle;
 327
 328         labels (0, 10, 20, 30);
 329         penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31);
 330
 331         % attachment Y
 332         if stemdir = 1:
 333                 charwy := ypart exact_right_point;
 334                 charwx := xpart exact_right_point;
 335         else:
 336                 charwy := -ypart exact_down_point;
 337                 charwx := (width# - xpart exact_down_point);
 338         fi
 339 enddef;
 340
 341
 342 fet_beginchar ("Whole trianglehead", "s0triangle")
 343         save hei, xs;
 344         save llap;
 345         save tilt;
 346
 347         tilt = 40;
 348         llap# = 3/4 noteheight#;
 349
 350         xs = 1.5;
 351         caveness := 0.1;
 352         define_triangle_shape (1);
 353         fill triangle_out;
 354         unfill triangle_in;
 355 fet_endchar;
 356
 357
 358 def draw_small_triangle_head (expr dir) =
 359         save hei, xs;
 360         save llap;
 361         save tilt;
 362
 363         tilt = 40;
 364         llap# = 2/3 noteheight#;
 365         xs = 1.2;
 366         caveness := 0.1;
 367         define_triangle_shape (dir);
 368         fill triangle_out;
 369         unfill triangle_in;
 370 enddef;
 371
 372
 373 fet_beginchar ("Half trianglehead", "d1triangle")
 374         draw_small_triangle_head (-1);
 375 fet_endchar;
 376
 377
 378 fet_beginchar ("Half trianglehead", "u1triangle")
 379         draw_small_triangle_head (1);
 380 fet_endchar;
 381
 382
 383 def draw_closed_triangle_head (expr dir) =
 384         save hei, xs;
 385         save llap;
 386         save tilt;
 387
 388         tilt = 40;
 389         llap# = 2/3 noteheight#;
 390         xs = 1.0;
 391         caveness := 0.1;
 392         define_triangle_shape (dir);
 393         fill triangle_out;
 394 enddef;
 395
 396
 397 fet_beginchar ("Quart trianglehead", "u2triangle")
 398         draw_closed_triangle_head (1);
 399 fet_endchar;
 400
 401
 402 fet_beginchar("Quart trianglehead", "d2triangle")
 403         draw_closed_triangle_head (-1);
 404 fet_endchar;
 405
 406
 407 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 408 %
 409 % Slash heads are for indicating improvisation.  They are
 410 % twice as high as normal heads.
 411 %
 412 def draw_slash (expr hwid_hash) =
 413         save exact_height;
 414         save ne_dir;
 415         pair ne_dir;
 416         exact_height = staff_space# + stafflinethickness# / 2;
 417
 418         set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
 419                       exact_height, exact_height);
 420
 421         charwx := charwd;
 422         charwy := charht;
 423
 424         clearxy;
 425         pickup pencircle scaled blot_diameter;
 426
 427         bot y1 = -d;
 428         top y2 = h;
 429         lft x1 = 0;
 430         lft x2 = 2 h / slash_slope;
 431
 432         rt x3 = w;
 433         y3 = y2;
 434         y4 = y1;
 435         x3 - x2 = x4 - x1;
 436
 437         ne_dir := unitvector (z3  - z4);
 438         fill bot z1
 439              .. lft z1
 440              --- lft z2
 441              .. top z2
 442              --- top z3
 443              .. rt z3
 444              --- rt z4
 445              .. bot z4
 446              --- cycle;
 447
 448         if hwid_hash > 2 slash_thick#:
 449                 save th;
 450
 451                 th = slash_thick - blot_diameter;
 452                 y6 = y7;
 453                 y5 = y8;
 454                 y3 - y7 = th;
 455                 y5 - y1 = th;
 456                 z6 - z5 = whatever * ne_dir;
 457                 z8 - z7 = whatever * ne_dir;
 458
 459                 z5  = z1 + whatever * ne_dir + th * (ne_dir rotated -90);
 460                 z8  = z4 + whatever * ne_dir + th * (ne_dir rotated 90);
 461
 462                 unfill z5
 463                        -- z6
 464                        -- z7
 465                        -- z8
 466                        -- cycle;
 467         fi
 468         labels (range 1 thru 10);
 469 enddef;
 470
 471
 472 fet_beginchar ("Whole slashhead", "s0slash")
 473         draw_slash (4 slash_thick# + 0.5 staff_space#);
 474 fet_endchar;
 475
 476
 477 fet_beginchar ("Half slashhead", "s1slash")
 478         draw_slash (3.0 slash_thick# + 0.15 staff_space#);
 479 fet_endchar;
 480
 481
 482 fet_beginchar ("Quart slashhead", "s2slash")
 483         draw_slash (1.5 slash_thick#);
 484 fet_endchar;
 485
 486
 487 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 488 %
 489 % `thick' is the distance between the NE/SW parallel lines in the cross
 490 % (distance between centres of lines) in multiples of stafflinethickness
 491 %
 492 def draw_cross (expr thick) =
 493         save ne_dir, nw_dir;
 494         save horz_dist, vert_dist;
 495         save crz_in, crz_out;
 496         pair ne_dir, nw_dir;
 497         path crz_in, crz_out;
 498
 499         pen_thick# := 1.2 stafflinethickness#;
 500         define_pixels (pen_thick);
 501         pickup pencircle scaled pen_thick;
 502
 503         top y3 = h;
 504         ne_dir := unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
 505         rt x4 = w / 2;
 506         y5 = 0;
 507         z4 - z5 = whatever * ne_dir;
 508         x6 = 0;
 509         z6 - z3 = whatever * ne_dir;
 510         z3 - z4 = whatever * (ne_dir yscaled -1);
 511
 512         z4 - z3 = whatever * (ne_dir)
 513                   + (ne_dir rotated -90) * thick * stafflinethickness;
 514
 515         x1 = charwd / 2 - .5 pen_thick#;
 516         z1 = whatever * ne_dir
 517              + thick / 2 * stafflinethickness# * (ne_dir rotated -90);
 518
 519         labels (1, 2, 3, 4, 5, 6);
 520
 521         nw_dir = unitvector (z3 - z4);
 522
 523         vert_dist = 0.5 pen_thick / cosd (angle (ne_dir));
 524         horz_dist = 0.5 pen_thick / sind (angle (nw_dir));
 525
 526         crz_out = (z6 + up * vert_dist)
 527                   --- (z3 + nw_dir * 0.5 pen_thick)
 528                   .. (top z3)
 529                   .. (z3 + ne_dir * 0.5 pen_thick)
 530                   --- (z4 + ne_dir * 0.5 pen_thick)
 531                   .. (rt z4)
 532                   .. (z4 - nw_dir * 0.5 pen_thick)
 533                   --- (z5 + right * horz_dist);
 534         crz_out := crz_out
 535                    & reverse crz_out yscaled -1;
 536         crz_out := crz_out
 537                    & reverse crz_out xscaled -1
 538                    & cycle;
 539         fill crz_out;
 540
 541         if (thick > 1):
 542                 crz_in = (bot z6){right}
 543                          .. (z6 - nw_dir * 0.5 pen_thick)
 544                          --- (z3 + down * vert_dist)
 545                          --- (z4 + left * horz_dist)
 546                          --- (z5 + nw_dir * 0.5 pen_thick)
 547                          .. {down}(lft z5);
 548                 crz_in := crz_in
 549                           .. reverse crz_in yscaled -1;
 550                 crz_in := crz_in
 551                           .. reverse crz_in xscaled -1
 552                           .. cycle;
 553                 unfill crz_in;
 554         fi
 555
 556         % ugh
 557         currentpicture := currentpicture shifted (w / 2, 0);
 558
 559         charwx := charwd;
 560         charwy := y1;
 561         z12 = (charwx * hppp, y1 * vppp);
 562         labels (12);
 563 enddef;
 564
 565
 566 fet_beginchar ("Whole Crossed notehead", "s0cross")
 567         wid# := black_notehead_width# + 4 stafflinethickness#;
 568         hei# := noteheight# + stafflinethickness#;
 569
 570         set_char_box (0, wid#, hei# / 2, hei# / 2);
 571
 572         draw_cross (3.75);
 573 fet_endchar;
 574
 575
 576 fet_beginchar ("Half Crossed notehead", "s1cross")
 577         wid# := black_notehead_width# + 2 stafflinethickness#;
 578         hei# := noteheight# + stafflinethickness# / 2;
 579
 580         set_char_box (0, wid#, hei# / 2, hei# / 2);
 581
 582         draw_cross (3.0);
 583 fet_endchar;
 584
 585
 586 fet_beginchar ("Crossed notehead", "s2cross")
 587         wid# := black_notehead_width#;
 588         hei# := noteheight#;
 589         set_char_box (0, wid#, hei# / 2, hei# / 2);
 590
 591         draw_cross (1.0);
 592 fet_endchar;
 593
 594
 595 fet_beginchar ("X-Circled notehead", "s2xcircle")
 596         wid# := black_notehead_width# * sqrt (sqrt2);
 597         hei# := noteheight# * sqrt (sqrt2);
 598
 599         set_char_box (0, wid#, hei# / 2, hei# / 2);
 600
 601         cthick := (1.2 + 1/4) * stafflinethickness;
 602         cxr := w / 2 - cthick / 2;
 603         cyr := h - cthick / 2;
 604
 605         pickup pencircle scaled cthick;
 606
 607         fill fullcircle xscaled (2 cxr + cthick)
 608                         yscaled (2 cyr + cthick)
 609                         shifted (w / 2, 0);
 610         unfill fullcircle xscaled (2 cxr - cthick)
 611                           yscaled (2 cyr - cthick)
 612                           shifted (w / 2, 0);
 613
 614         xpos := cxr / sqrt2;
 615         ypos := cyr / sqrt2;
 616
 617         pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
 618         draw (-xpos + w / 2, -ypos) -- (xpos + w / 2, ypos);
 619
 620         pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
 621         draw (-xpos + w / 2, ypos) -- (xpos + w / 2, -ypos);
 622
 623         charwx := charwd;
 624         charwy := 0;
 625
 626         z12 = (charwx * hppp, charwy * vppp);
 627         labels (12);
 628 fet_endchar;
 629
 630
 631 %%%%%%%%
 632 %
 633 % SOLFA SHAPED NOTES
 634 %
 635
 636 save solfa_pen_thick;
 637 solfa_pen_thick# = 2 stafflinethickness#;
 638 define_pixels (solfa_pen_thick);
 639
 640
 641 def draw_do_head (expr width_factor, dir) =
 642         save p_in, p_out;
 643         save left_dist, right_dist;
 644         path p_in, p_out;
 645         pair left_dist, right_dist;
 646
 647         set_char_box (0, width_factor * noteheight#,
 648                       0.5 noteheight#, 0.5 noteheight#);
 649
 650         pickup pencircle scaled solfa_pen_thick;
 651
 652         bot y1 = -d;
 653         y1 = y2;
 654         lft x1 = 0;
 655         rt x2 = w;
 656         top y3 = h;
 657         x3 =.5 [x1, x2];
 658
 659         left_dist = (unitvector (z3 - z1) rotated 90) * 0.5 solfa_pen_thick;
 660         right_dist = (unitvector (z2 - z3) rotated 90) * 0.5 solfa_pen_thick;
 661
 662         p_in := (((z1 - left_dist) -- (z3 - left_dist)) intersectionpoint
 663                   (top z1 -- top z2))
 664                 -- ((top z1 -- top z2) intersectionpoint
 665                     ((z2 - right_dist) -- (z3 - right_dist)))
 666                 -- (((z2 - right_dist) -- (z3 - right_dist)) intersectionpoint
 667                     ((z1 - left_dist) -- (z3 - left_dist)))
 668                 -- cycle;
 669
 670         p_out := bot z1
 671                  --- bot z2
 672                  .. rt z2
 673                  .. (z2 + right_dist)
 674                  --- (z3 + right_dist)
 675                  .. top z3
 676                  .. (z3 + left_dist)
 677                  --- (z1 + left_dist)
 678                  .. lft z1
 679                  .. cycle;
 680
 681
 682         labels (1, 2, 3);
 683
 684         charwx := charwd;
 685         charwy := -chardp + 0.5 stafflinethickness#;
 686         if dir = -1:
 687                 charwy := -charwy;
 688         fi;
 689 enddef;
 690
 691
 692 fet_beginchar ("Whole dohead", "s0do")
 693         draw_do_head (1.8, 1);
 694         fill p_out;
 695         unfill p_in;
 696 fet_endchar;
 697
 698
 699 fet_beginchar ("Half dohead", "d1do")
 700         draw_do_head (1.5, -1);
 701         fill p_out;
 702         unfill p_in;
 703 fet_endchar;
 704
 705
 706 fet_beginchar ("Half dohead", "s1do")
 707         draw_do_head (1.5, 1);
 708         fill p_out;
 709         unfill p_in;
 710 fet_endchar;
 711
 712
 713 fet_beginchar ("Quart dohead", "d2do")
 714         draw_do_head (1.55, -1);
 715         fill p_out;
 716 fet_endchar;
 717
 718
 719 fet_beginchar ("Quart dohead", "s2do")
 720         draw_do_head (1.55, 1);
 721         fill p_out;
 722 fet_endchar;
 723
 724
 725 %
 726 % re - flat top, curved bottom:
 727 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
 728 % (broader along the base and with more vertical sides for half and
 729 % whole notes)
 730 % stem attachment: h/2
 731 %
 732
 733 def draw_re_head (expr width_factor, dir) =
 734         save p_in, p_out;
 735         path p_in, p_out;
 736
 737         set_char_box (0, width_factor * noteheight#,
 738                       0.5 noteheight#, 0.5 noteheight#);
 739
 740         pickup pencircle scaled solfa_pen_thick;
 741
 742         save curve_start;
 743         curve_start = 0.7;
 744         lft x1 = 0;
 745         y1 = y5;
 746         x1 = x2;
 747         y2 = curve_start [y3, y1];
 748         bot y3 = - d;
 749         x3 = .5 [x2, x4];
 750         rt x4 = w;
 751         y4 = y2;
 752         top y5 = h;
 753         x5 = x4;
 754
 755         labels (range 1 thru 5);
 756
 757         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
 758                 --- rt z2
 759                 .. top z3{right}
 760                 .. lft z4
 761                 --- (z5 + 0.5 solfa_pen_thick * (-1, -1))
 762                 --- cycle;
 763
 764         p_out := lft z1
 765                  --- lft z2
 766                  .. bot z3{right}
 767                  .. rt z4
 768                  --- rt z5
 769                  .. top z5
 770                  --- top z1
 771                  .. cycle;
 772
 773         charwx := charwd;
 774         charwy := curve_start [-chardp, charht];
 775
 776         if dir = -1:
 777                 charwy := - charwy;
 778         fi;
 779 enddef;
 780
 781
 782 fet_beginchar ("Whole rehead", "s0re")
 783         draw_re_head (1.8, 1);
 784         fill p_out;
 785         unfill p_in;
 786 fet_endchar;
 787
 788
 789 fet_beginchar ("Half up rehead", "u1re")
 790         draw_re_head (1.5, 1);
 791         fill p_out;
 792         unfill p_in;
 793 fet_endchar;
 794
 795
 796 fet_beginchar ("Half down rehead", "d1re")
 797         draw_re_head (1.5, -1);
 798         fill p_out;
 799         unfill p_in;
 800 fet_endchar;
 801
 802
 803 fet_beginchar ("Quart rehead", "u2re")
 804         draw_re_head (1.55, 1);
 805         fill p_out;
 806 fet_endchar;
 807
 808
 809 fet_beginchar ("Quart rehead", "d2re")
 810         draw_re_head (1.55, -1);
 811         fill p_out;
 812 fet_endchar;
 813
 814
 815 def draw_mi_head (expr width_factor) =
 816         save path_out, path_in;
 817         save ne_dist, nw_dist;
 818         path path_out, path_in;
 819         pair ne_dist, nw_dist;
 820
 821         set_char_box (0, width_factor * noteheight#,
 822                       0.5 noteheight#, 0.5 noteheight#);
 823
 824         pickup pencircle scaled solfa_pen_thick;
 825
 826         lft x1 = 0;
 827         y1 = 0;
 828         bot y2 = -d;
 829         x2 = .5 [x1, x3];
 830         rt x3 = w;
 831         x4 = x2;
 832         y3 = y1;
 833         top y4 = h;
 834
 835         z6 - z5 = whatever * (z2 - z1);
 836         z8 - z7 = whatever * (z2 - z1);
 837         z8 - z5 = whatever * (z4 - z1);
 838         z6 - z7 = whatever * (z4 - z1);
 839
 840         ne_dist = (unitvector (z4 - z1) rotated 90) * 0.5 solfa_pen_thick;
 841         nw_dist = (unitvector (z1 - z2) rotated 90) * 0.5 solfa_pen_thick;
 842
 843         z5 = whatever [z1, z4] - ne_dist;
 844         z5 = whatever [z1, z2] - 1.5 nw_dist;
 845
 846         z5 - z1 = -(z7 - z3);
 847
 848         labels (range 1 thru 8);
 849
 850         path_in := z5
 851                    -- z6
 852                    -- z7
 853                    -- z8
 854                    -- cycle;
 855
 856         path_out := lft z1
 857                     .. (z1 + nw_dist)
 858                     --- (z2 + nw_dist)
 859                     .. bot z2
 860                     .. (z2 - ne_dist)
 861                     --- (z3 - ne_dist)
 862                     .. rt z3
 863                     .. (z3 - nw_dist)
 864                     --- (z4 - nw_dist)
 865                     .. top z4
 866                     .. (z4 + ne_dist)
 867                     --- (z1 + ne_dist)
 868                     .. cycle;
 869 enddef;
 870
 871
 872 fet_beginchar ("Whole mihead", "s0mi")
 873         draw_mi_head (1.8);
 874         fill path_out;
 875         unfill path_in;
 876 fet_endchar;
 877
 878
 879 fet_beginchar ("Half mihead", "s1mi")
 880         draw_mi_head (1.6);
 881         fill path_out;
 882         unfill path_in;
 883 fet_endchar;
 884
 885
 886 fet_beginchar ("Quart mihead", "s2mi")
 887         draw_mi_head (1.65);
 888         fill path_out;
 889 fet_endchar;
 890
 891
 892 def draw_fa_head (expr width_factor) =
 893         set_char_box (0, width_factor * noteheight#,
 894                       0.5 noteheight#, 0.5 noteheight#);
 895
 896         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist;
 897         path p_down_in, p_down_out, p_up_in, p_up_out;
 898         pair nw_dist;
 899
 900         pickup pencircle scaled solfa_pen_thick;
 901
 902         lft x1 = 0;
 903         top y1 = h;
 904
 905         rt x2 = w;
 906         y2 = y1;
 907         bot y3 = -d;
 908         x3 = x2;
 909
 910         y4 = y3;
 911         x4 = x1;
 912
 913         labels (range 1 thru 4);
 914
 915         nw_dist = (unitvector (z1 - z3) rotated 90) * 0.5 solfa_pen_thick;
 916
 917         p_up_in := (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
 918                      (bot z1 -- bot z2))
 919                    -- (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
 920                         (lft z3 -- lft z2))
 921                    -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
 922                    --- cycle;
 923
 924         p_up_out := lft z1
 925                     .. (z1 + nw_dist)
 926                     --- (z3 + nw_dist)
 927                     .. bot z3
 928                     .. rt z3
 929                     --- rt z2
 930                     .. top z2
 931                     --- top z1
 932                     .. cycle;
 933
 934         p_down_in := p_up_in rotated 180 shifted (w, 0);
 935         p_down_out := p_up_out rotated 180 shifted (w, 0);
 936
 937         charwy := 0.0;
 938         charwx := charwd;
 939 enddef;
 940
 941
 942 fet_beginchar ("Whole fa up head", "d0fa")
 943         draw_fa_head (1.8);
 944         fill p_up_out;
 945         unfill p_up_in;
 946 fet_endchar;
 947
 948
 949 fet_beginchar ("Whole fa down head", "u0fa")
 950         draw_fa_head (1.8);
 951         fill p_down_out;
 952         unfill p_down_in;
 953 fet_endchar;
 954
 955
 956 fet_beginchar ("half fa up head", "d1fa")
 957         draw_fa_head (1.5);
 958         fill p_up_out;
 959         unfill p_up_in;
 960 fet_endchar;
 961
 962
 963 fet_beginchar ("Half fa down head", "u1fa")
 964         draw_fa_head (1.5);
 965         fill p_down_out;
 966         unfill p_down_in;
 967 fet_endchar;
 968
 969
 970 fet_beginchar ("Quarter fa up head", "u2fa")
 971         draw_fa_head (1.55);
 972         fill p_up_out;
 973 fet_endchar;
 974
 975
 976 fet_beginchar ("Quarter fa down head", "d2fa")
 977         draw_fa_head (1.55);
 978         fill p_down_out;
 979 fet_endchar;
 980
 981
 982 def draw_la_head (expr width_factor) =
 983         set_char_box (0, width_factor * noteheight#,
 984                       0.5 noteheight#, 0.5 noteheight#);
 985         save p_in, p_out;
 986         path p_in, p_out;
 987
 988         pickup pencircle scaled solfa_pen_thick;
 989
 990         lft x1 = 0;
 991         top y1 = h;
 992
 993         rt x2 = w;
 994         y2 = y1;
 995         bot y3 = -d;
 996         x3 = x2;
 997
 998         y4 = y3;
 999         x4 = x1;
1000
1001         labels (range 1 thru 4);
1002
1003         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1004                 -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1005                 -- (z3 + 0.5 solfa_pen_thick * (-1, 1))
1006                 -- (z4 + 0.5 solfa_pen_thick * (1, 1))
1007                 -- cycle;
1008
1009         p_out := top z1
1010                  --- top z2
1011                  .. rt z2
1012                  --- rt z3
1013                  .. bot z3
1014                  --- bot z4
1015                  .. lft z4
1016                  --- lft z1
1017                  .. cycle;
1018 enddef;
1019
1020
1021 fet_beginchar ("Whole lahead", "s0la")
1022         draw_la_head (1.8);
1023         fill p_out;
1024         unfill p_in;
1025 fet_endchar;
1026
1027
1028 fet_beginchar ("Half lahead", "s1la")
1029         draw_la_head (1.5);
1030         fill p_out;
1031         unfill p_in;
1032 fet_endchar;
1033
1034
1035 fet_beginchar ("Quart lahead", "s2la")
1036         draw_la_head (1.55);
1037         fill p_out;
1038 fet_endchar;
1039
1040
1041 def draw_ti_head (expr width_factor, dir) =
1042         set_char_box (0, width_factor * noteheight#,
1043                       0.5 noteheight#, 0.5 noteheight#);
1044         save p_in, p_out, p_top;
1045         save left_dist, right_dist;
1046         path p_in, p_out, p_top;
1047         pair left_dist, right_dist;
1048         save cone_height;
1049         cone_height = 0.64;
1050
1051         pickup pencircle scaled solfa_pen_thick;
1052
1053         x1 = .5 [x2, x4];
1054         bot y1 = -d;
1055         lft x2 = 0;
1056         y2 = cone_height [y1, y3];
1057         rt x4 = w;
1058         y4 = y2;
1059         x3 = x1;
1060         top y3 = h;
1061
1062         labels (range 1 thru 4);
1063
1064         left_dist = (unitvector (z2 - z1) rotated 90) * 0.5 solfa_pen_thick;
1065         right_dist = (unitvector (z1 - z4) rotated 90) * 0.5 solfa_pen_thick;
1066
1067         p_top := (z2 - right_dist) .. (top z3){right} .. (z4 - left_dist);
1068
1069         p_in := (((z1 - left_dist) -- (z2 - left_dist)) intersectionpoint
1070                   ((z1 - right_dist) -- (z4 - right_dist)))
1071                 -- (((z1 - left_dist) -- (z2 - left_dist)) intersectionpoint
1072                      ((z2 + right_dist) .. {right}(bot z3)))
1073                 .. bot z3
1074                 .. (((bot z3){right} .. (z4 + left_dist)) intersectionpoint
1075                      ((z1 - right_dist) -- (z4 - right_dist)))
1076                 -- cycle;
1077
1078         p_out := bot z1
1079                  .. (z1 + left_dist)
1080                  --- (z2 + left_dist)
1081                  .. lft z2
1082                  .. (z2 - right_dist){direction 0 of p_top}
1083                  & p_top
1084                  & {direction infinity of p_top}(z4 - left_dist)
1085                  .. rt z4
1086                  .. (z4 + right_dist)
1087                  --- (z1 + right_dist)
1088                  .. cycle;
1089
1090         charwx := charwd;
1091         charwy := cone_height [-chardp, charht];
1092         if dir = -1:
1093                 charwy := - charwy;
1094         fi;
1095 enddef;
1096
1097
1098 fet_beginchar ("Whole up tihead", "s0ti")
1099         draw_ti_head (1.8, 1);
1100         fill p_out;
1101         unfill p_in;
1102 fet_endchar;
1103
1104
1105 fet_beginchar ("Half up tihead", "u1ti")
1106         draw_ti_head (1.5, 1);
1107         fill p_out;
1108         unfill p_in;
1109 fet_endchar;
1110
1111
1112 fet_beginchar ("Half down tihead", "d1ti")
1113         draw_ti_head (1.5, -1);
1114         fill p_out;
1115         unfill p_in;
1116 fet_endchar;
1117
1118
1119 fet_beginchar ("Quart up tihead", "u2ti")
1120         draw_ti_head (1.55, 1);
1121         fill p_out;
1122 fet_endchar;
1123
1124
1125 fet_beginchar ("Quart down tihead", "d2ti")
1126         draw_ti_head (1.55, -1);
1127         fill p_out;
1128 fet_endchar;
1129
1130
1131 fet_endgroup("noteheads");
1132
1133
1134 %
1135 % we derive black_notehead_width# from the quarter head,
1136 % so we have to define black_notehead_width (pixel qty)
1137 % after the black_notehead_width# itself.
1138 %
1139 % Let's keep it outside the group as well.
1140 %
1141
1142 define_pixels (black_notehead_width);