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