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@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 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 solfa_whole_width := 1.8;
 889 solfa_half_width := 1.35;
 890 solfa_quarter_width := 1.35;
 891
 892
 893 def draw_do_head (expr width_factor, dir) =
 894         save p_in, p_out;
 895         save left_dist, right_dist;
 896         path p_in, p_out;
 897         pair left_dist, right_dist;
 898
 899         set_char_box (0, width_factor * noteheight#,
 900                       0.5 noteheight#, 0.5 noteheight#);
 901
 902         pickup pencircle scaled solfa_pen_thick;
 903
 904         bot y1 = -d;
 905         y1 = y2;
 906         lft x1 = 0;
 907         rt x2 = w;
 908         top y3 = h;
 909         x3 =.5 [x1, x2];
 910
 911         left_dist = (unitvector (z3 - z1) rotated 90) * 0.5 solfa_pen_thick;
 912         right_dist = (unitvector (z2 - z3) rotated 90) * 0.5 solfa_pen_thick;
 913
 914         p_in := (((z1 - left_dist) -- (z3 - left_dist)) intersectionpoint
 915                   (top z1 -- top z2))
 916                 -- ((top z1 -- top z2) intersectionpoint
 917                     ((z2 - right_dist) -- (z3 - right_dist)))
 918                 -- (((z2 - right_dist) -- (z3 - right_dist)) intersectionpoint
 919                     ((z1 - left_dist) -- (z3 - left_dist)))
 920                 -- cycle;
 921
 922         p_out := bot z1
 923                  -- bot z2{right}
 924                  .. rt z2{up}
 925                  .. (z2 + right_dist){z3 - z2}
 926                  -- (z3 + right_dist){z3 - z2}
 927                  .. top z3{left}
 928                  .. (z3 + left_dist){z1 - z3}
 929                  -- (z1 + left_dist){z1 - z3}
 930                  .. lft z1{down}
 931                  .. {right}cycle;
 932
 933
 934         labels (1, 2, 3);
 935
 936         charwx := charwd;
 937         charwy := -chardp + 0.5 stafflinethickness#;
 938         if dir = -1:
 939                 charwy := -charwy;
 940         fi;
 941 enddef;
 942
 943
 944 fet_beginchar ("Whole dohead", "s0do");
 945         draw_do_head (solfa_whole_width, 1);
 946         fill p_out;
 947         unfill p_in;
 948 fet_endchar;
 949
 950
 951 fet_beginchar ("Half dohead", "d1do");
 952         draw_do_head (solfa_half_width, -1);
 953         fill p_out;
 954         unfill p_in;
 955 fet_endchar;
 956
 957
 958 fet_beginchar ("Half dohead", "u1do");
 959         draw_do_head (solfa_half_width, 1);
 960         fill p_out;
 961         unfill p_in;
 962 fet_endchar;
 963
 964
 965 fet_beginchar ("Quart dohead", "d2do");
 966         draw_do_head (solfa_quarter_width, -1);
 967         fill p_out;
 968 fet_endchar;
 969
 970
 971 fet_beginchar ("Quart dohead", "u2do");
 972         draw_do_head (solfa_quarter_width, 1);
 973         fill p_out;
 974 fet_endchar;
 975
 976
 977 %
 978 % re - flat top, curved bottom:
 979 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
 980 % (broader along the base and with more vertical sides for half and
 981 % whole notes)
 982 % stem attachment: h/2
 983 %
 984
 985 def draw_re_head (expr width_factor, dir) =
 986         save p_in, p_out;
 987         path p_in, p_out;
 988
 989         set_char_box (0, width_factor * noteheight#,
 990                       0.5 noteheight#, 0.5 noteheight#);
 991
 992         pickup pencircle scaled solfa_pen_thick;
 993
 994         save curve_start;
 995         curve_start = 0.7;
 996         lft x1 = 0;
 997         y1 = y5;
 998         x1 = x2;
 999         y2 = curve_start [y3, y1];
1000         bot y3 = -d;
1001         x3 = .5 [x2, x4];
1002         rt x4 = w;
1003         y4 = y2;
1004         top y5 = h;
1005         x5 = x4;
1006
1007         labels (range 1 thru 5);
1008
1009         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1010                 -- rt z2{down}
1011                 .. top z3
1012                 .. lft z4{up}
1013                 -- (z5 + 0.5 solfa_pen_thick * (-1, -1))
1014                 -- cycle;
1015
1016         p_out := lft z1
1017                  -- lft z2{down}
1018                  .. bot z3
1019                  .. rt z4{up}
1020                  -- rt z5{up}
1021                  .. top z5{left}
1022                  -- top z1{left}
1023                  .. {down}cycle;
1024
1025         charwx := charwd;
1026         charwy := curve_start [-chardp, charht];
1027
1028         if dir = -1:
1029                 charwy := -charwy;
1030         fi;
1031 enddef;
1032
1033
1034 fet_beginchar ("Whole rehead", "s0re");
1035         draw_re_head (solfa_whole_width, 1);
1036         fill p_out;
1037         unfill p_in;
1038 fet_endchar;
1039
1040
1041 fet_beginchar ("Half up rehead", "u1re");
1042         draw_re_head (solfa_half_width, 1);
1043         fill p_out;
1044         unfill p_in;
1045 fet_endchar;
1046
1047
1048 fet_beginchar ("Half down rehead", "d1re");
1049         draw_re_head (solfa_half_width, -1);
1050         fill p_out;
1051         unfill p_in;
1052 fet_endchar;
1053
1054
1055 fet_beginchar ("Quart rehead", "u2re");
1056         draw_re_head (solfa_quarter_width, 1);
1057         fill p_out;
1058 fet_endchar;
1059
1060
1061 fet_beginchar ("Quart rehead", "d2re");
1062         draw_re_head (solfa_quarter_width, -1);
1063         fill p_out;
1064 fet_endchar;
1065
1066
1067 def draw_mi_head (expr width_factor) =
1068         save path_out, path_in;
1069         save ne_dist, se_dist, ne, se;
1070         path path_out, path_in;
1071         pair ne_dist, se_dist, ne, se;
1072
1073         set_char_box (0, width_factor * noteheight#,
1074                       0.5 noteheight#, 0.5 noteheight#);
1075
1076         pickup pencircle scaled solfa_pen_thick;
1077
1078         lft x1 = 0;
1079         y1 = 0;
1080         bot y2 = -d;
1081         x2 = .5 [x1, x3];
1082         rt x3 = w;
1083         x4 = x2;
1084         y3 = y1;
1085         top y4 = h;
1086
1087         z6 - z5 = whatever * (z2 - z1);
1088         z8 - z7 = whatever * (z2 - z1);
1089         z8 - z5 = whatever * (z4 - z1);
1090         z6 - z7 = whatever * (z4 - z1);
1091
1092         ne = unitvector (z4 - z1);
1093         se = unitvector (z1 - z2);
1094
1095         ne_dist = (ne rotated 90) * 0.5 solfa_pen_thick;
1096         se_dist = (se rotated 90) * 0.5 solfa_pen_thick;
1097
1098         z5 = whatever [z1, z4] - ne_dist;
1099         z5 = whatever [z1, z2] - 1.5 se_dist;
1100
1101         z5 - z1 = -(z7 - z3);
1102
1103         labels (range 1 thru 8);
1104
1105         path_in := z5
1106                    -- z6
1107                    -- z7
1108                    -- z8
1109                    -- cycle;
1110
1111         path_out := lft z1
1112                     .. (z1 + se_dist){-se}
1113                     -- (z2 + se_dist){-se}
1114                     .. bot z2
1115                     .. (z2 - ne_dist){ne}
1116                     -- (z3 - ne_dist){ne}
1117                     .. rt z3
1118                     .. (z3 - se_dist){se}
1119                     -- (z4 - se_dist){se}
1120                     .. top z4
1121                     .. (z4 + ne_dist){-ne}
1122                     -- (z1 + ne_dist){-ne}
1123                     .. cycle;
1124 enddef;
1125
1126
1127 fet_beginchar ("Whole mihead", "s0mi");
1128         draw_mi_head (solfa_whole_width);
1129         fill path_out;
1130         unfill path_in;
1131 fet_endchar;
1132
1133
1134 fet_beginchar ("Half mihead", "s1mi");
1135         draw_mi_head (1.6);
1136         fill path_out;
1137         unfill path_in;
1138 fet_endchar;
1139
1140
1141 fet_beginchar ("Quart mihead", "s2mi");
1142         draw_mi_head (1.65);
1143         fill path_out;
1144 fet_endchar;
1145
1146
1147 def draw_fa_head (expr width_factor) =
1148         set_char_box (0, width_factor * noteheight#,
1149                       0.5 noteheight#, 0.5 noteheight#);
1150
1151         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1152         path p_down_in, p_down_out, p_up_in, p_up_out;
1153         pair nw_dist, nw;
1154
1155         pickup pencircle scaled solfa_pen_thick;
1156
1157         lft x1 = 0;
1158         top y1 = h;
1159
1160         rt x2 = w;
1161         y2 = y1;
1162         bot y3 = -d;
1163         x3 = x2;
1164
1165         y4 = y3;
1166         x4 = x1;
1167
1168         labels (1, 2, 3, 4);
1169
1170         nw = unitvector (z1 - z3);
1171         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1172
1173         p_up_in := (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1174                      (bot z1 -- bot z2))
1175                    -- (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1176                         (lft z3 -- lft z2))
1177                    -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1178                    -- cycle;
1179
1180         p_up_out := lft z1{down}
1181                     .. (z1 + nw_dist){-nw}
1182                     -- (z3 + nw_dist){-nw}
1183                     .. bot z3{right}
1184                     .. rt z3{up}
1185                     -- rt z2{up}
1186                     .. top z2{left}
1187                     -- top z1{left}
1188                     .. {down}cycle;
1189
1190         p_down_in := p_up_in rotated 180 shifted (w, 0);
1191         p_down_out := p_up_out rotated 180 shifted (w, 0);
1192
1193         charwy := 0.0;
1194         charwx := charwd;
1195 enddef;
1196
1197
1198 fet_beginchar ("Whole fa up head", "u0fa");
1199         draw_fa_head (solfa_whole_width);
1200         fill p_up_out;
1201         unfill p_up_in;
1202 fet_endchar;
1203
1204
1205 fet_beginchar ("Whole fa down head", "d0fa");
1206         draw_fa_head (solfa_whole_width);
1207         fill p_down_out;
1208         unfill p_down_in;
1209 fet_endchar;
1210
1211
1212 fet_beginchar ("half fa up head", "u1fa");
1213         draw_fa_head (solfa_half_width);
1214         fill p_up_out;
1215         unfill p_up_in;
1216 fet_endchar;
1217
1218
1219 fet_beginchar ("Half fa down head", "d1fa");
1220         draw_fa_head (solfa_half_width);
1221         fill p_down_out;
1222         unfill p_down_in;
1223 fet_endchar;
1224
1225
1226 fet_beginchar ("Quarter fa up head", "u2fa");
1227         draw_fa_head (solfa_quarter_width);
1228         fill p_up_out;
1229 fet_endchar;
1230
1231
1232 fet_beginchar ("Quarter fa down head", "d2fa");
1233         draw_fa_head (solfa_quarter_width);
1234         fill p_down_out;
1235 fet_endchar;
1236
1237
1238 def draw_la_head (expr width_factor) =
1239         set_char_box (0, width_factor * noteheight#,
1240                       0.5 noteheight#, 0.5 noteheight#);
1241         save p_in, p_out;
1242         path p_in, p_out;
1243
1244         pickup pencircle scaled solfa_pen_thick;
1245
1246         lft x1 = 0;
1247         top y1 = h;
1248
1249         rt x2 = w;
1250         y2 = y1;
1251         bot y3 = -d;
1252         x3 = x2;
1253
1254         y4 = y3;
1255         x4 = x1;
1256
1257         labels (range 1 thru 4);
1258
1259         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1260                 -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1261                 -- (z3 + 0.5 solfa_pen_thick * (-1, 1))
1262                 -- (z4 + 0.5 solfa_pen_thick * (1, 1))
1263                 -- cycle;
1264
1265         p_out := top z1
1266                  -- top z2{right}
1267                  .. rt z2{down}
1268                  -- rt z3{down}
1269                  .. bot z3{left}
1270                  -- bot z4{left}
1271                  .. lft z4{up}
1272                  -- lft z1{up}
1273                  .. cycle;
1274 enddef;
1275
1276
1277 fet_beginchar ("Whole lahead", "s0la");
1278         draw_la_head (solfa_whole_width);
1279         fill p_out;
1280         unfill p_in;
1281 fet_endchar;
1282
1283
1284 fet_beginchar ("Half lahead", "s1la");
1285         draw_la_head (solfa_half_width);
1286         fill p_out;
1287         unfill p_in;
1288 fet_endchar;
1289
1290
1291 fet_beginchar ("Quart lahead", "s2la");
1292         draw_la_head (solfa_quarter_width);
1293         fill p_out;
1294 fet_endchar;
1295
1296
1297 def draw_ti_head (expr width_factor, dir) =
1298         set_char_box (0, width_factor * noteheight#,
1299                       0.5 noteheight#, 0.5 noteheight#);
1300         save p_in, p_out, p_top;
1301         save nw_dist, sw_dist, nw, sw;
1302         path p_in, p_out, p_top;
1303         pair nw_dist, sw_dist, nw, sw;
1304         save cone_height;
1305         cone_height = 0.64;
1306
1307         pickup pencircle scaled solfa_pen_thick;
1308
1309         x1 = .5 [x2, x4];
1310         bot y1 = -d;
1311         lft x2 = 0;
1312         y2 = cone_height [y1, y3];
1313         rt x4 = w;
1314         y4 = y2;
1315         x3 = x1;
1316         top y3 = h;
1317
1318         labels (range 1 thru 4);
1319
1320         nw = unitvector (z2 - z1);
1321         sw = unitvector (z1 - z4);
1322
1323         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1324         sw_dist = (sw rotated 90) * 0.5 solfa_pen_thick;
1325
1326         p_top := (z2 - sw_dist)
1327                  .. (top z3){right}
1328                  .. (z4 - nw_dist);
1329
1330         p_in := (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1331                   ((z1 - sw_dist) -- (z4 - sw_dist)))
1332                 -- (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1333                      ((z2 + sw_dist) .. {right}(bot z3)))
1334                 .. bot z3
1335                 .. (((bot z3){right} .. (z4 + nw_dist)) intersectionpoint
1336                      ((z1 - sw_dist) -- (z4 - sw_dist)))
1337                 -- cycle;
1338
1339         p_out := bot z1
1340                  .. (z1 + nw_dist)
1341                  -- (z2 + nw_dist)
1342                  .. lft z2
1343                  .. (z2 - sw_dist){direction 0 of p_top}
1344                  & p_top
1345                  & {direction infinity of p_top}(z4 - nw_dist)
1346                  .. rt z4
1347                  .. (z4 + sw_dist)
1348                  -- (z1 + sw_dist)
1349                  .. cycle;
1350
1351         charwx := charwd;
1352         charwy := cone_height [-chardp, charht];
1353         if dir = -1:
1354                 charwy := -charwy;
1355         fi;
1356 enddef;
1357
1358
1359 fet_beginchar ("Whole up tihead", "s0ti");
1360         draw_ti_head (solfa_whole_width, 1);
1361         fill p_out;
1362         unfill p_in;
1363 fet_endchar;
1364
1365
1366 fet_beginchar ("Half up tihead", "u1ti");
1367         draw_ti_head (solfa_half_width, 1);
1368         fill p_out;
1369         unfill p_in;
1370 fet_endchar;
1371
1372
1373 fet_beginchar ("Half down tihead", "d1ti");
1374         draw_ti_head (solfa_half_width, -1);
1375         fill p_out;
1376         unfill p_in;
1377 fet_endchar;
1378
1379
1380 fet_beginchar ("Quart up tihead", "u2ti");
1381         draw_ti_head (solfa_quarter_width, 1);
1382         fill p_out;
1383 fet_endchar;
1384
1385
1386 fet_beginchar ("Quart down tihead", "d2ti");
1387         draw_ti_head (solfa_quarter_width, -1);
1388         fill p_out;
1389 fet_endchar;
1390
1391
1392 fet_endgroup ("noteheads");
1393
1394
1395 %
1396 % we derive black_notehead_width# from the quarter head,
1397 % so we have to define black_notehead_width (pixel qty)
1398 % after the black_notehead_width# itself.
1399 %
1400 % Let's keep it outside the group as well.
1401 %
1402
1403 define_pixels (black_notehead_width);