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 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 p;
  65         path p;
  66
  67         p := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
  68                            (-ellipticity, 0), (slant * ellipticity, -1.0),
  69                            superness);
  70         p := p rotated tilt;
  71
  72         save top_point, right_point;
  73         pair top_point, right_point;
  74
  75         top_point := directionpoint left of p;
  76         right_point := directionpoint up of p;
  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         p := p scaled scaling shifted (w / 2, .5 (h - d));
  93
  94         width := hround width;
  95
  96         if test_outlines = 1:
  97                 draw p;
  98         else:
  99                 fill p;
 100         fi;
 101 enddef;
 102
 103
 104 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) =
 105 begingroup
 106         save p;
 107         path p;
 108
 109         p := superellipse ((ellipticity, 0), (0, 1.0),
 110                            (-ellipticity, 0), (0, -1.0),
 111                            superness);
 112         p := p rotated tilt;
 113
 114         save top_point, right_point;
 115         pair top_point, right_point;
 116
 117         top_point := directionpoint left of p;
 118         right_point := directionpoint up of p;
 119
 120         save height, scaling;
 121
 122         height# = staff_space# + stafflinethickness# - clearance;
 123         scaling# = height# / (2 ypart (top_point));
 124         define_pixels (scaling);
 125         p := (p scaled scaling) shifted (w / 2, .5 (h - d));
 126
 127         if test_outlines = 1:
 128                 draw p;
 129         else:
 130                 unfill p;
 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_dir;
 539         pair ne_dir;
 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_dir := unitvector (z3 - z4);
 565
 566         fill bot z1{left}
 567              .. lft z1{ne_dir}
 568              -- lft z2{ne_dir}
 569              .. top z2{right}
 570              -- top z3{right}
 571              .. rt z3{-ne_dir}
 572              -- rt z4{-ne_dir}
 573              .. bot z4{left}
 574              -- cycle;
 575
 576         if hwid_hash > 2 slash_thick#:
 577                 save th;
 578
 579                 th = slash_thick - blot_diameter;
 580                 y6 = y7;
 581                 y5 = y8;
 582                 y3 - y7 = th;
 583                 y5 - y1 = th;
 584                 z6 - z5 = whatever * ne_dir;
 585                 z8 - z7 = whatever * ne_dir;
 586
 587                 z5  = z1 + whatever * ne_dir + th * (ne_dir rotated -90);
 588                 z8  = z4 + whatever * ne_dir + th * (ne_dir rotated 90);
 589
 590                 unfill z5
 591                        -- z6
 592                        -- z7
 593                        -- z8
 594                        -- cycle;
 595         fi
 596         labels (range 1 thru 10);
 597 enddef;
 598
 599
 600 fet_beginchar ("Whole slashhead", "s0slash");
 601         draw_slash (4 slash_thick# + 0.5 staff_space#);
 602
 603         draw_staff (-2, 2, 0);
 604 fet_endchar;
 605
 606
 607 fet_beginchar ("Half slashhead", "s1slash");
 608         draw_slash (3.0 slash_thick# + 0.15 staff_space#);
 609
 610         draw_staff (-2, 2, 0);
 611 fet_endchar;
 612
 613
 614 fet_beginchar ("Quart slashhead", "s2slash");
 615         draw_slash (1.5 slash_thick#);
 616
 617         draw_staff (-2, 2, 0);
 618 fet_endchar;
 619
 620
 621 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 622 %
 623 % `thick' is the distance between the NE/SW parallel lines in the cross
 624 % (distance between centres of lines) in multiples of stafflinethickness
 625 %
 626 def draw_cross (expr thick) =
 627         save ne_dir, nw_dir;
 628         save horz_dist, vert_dist;
 629         save crz_in, crz_out;
 630         save thickness;
 631         pair ne_dir, nw_dir;
 632         path crz_in, crz_out;
 633
 634         pen_thick# := 1.2 stafflinethickness#;
 635         thickness# := thick * stafflinethickness#;
 636         define_pixels (thickness);
 637         define_blacker_pixels (pen_thick);
 638
 639         pickup pencircle scaled pen_thick;
 640
 641         h := h - feta_shift;
 642
 643         top y3 = h;
 644         ne_dir := unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
 645         rt x4 = w / 2;
 646         y5 = 0;
 647         z4 - z5 = whatever * ne_dir;
 648         x6 = 0;
 649         z6 - z3 = whatever * ne_dir;
 650         z3 - z4 = whatever * (ne_dir yscaled -1);
 651
 652         z4 - z3 = whatever * (ne_dir) + (ne_dir rotated -90) * thickness;
 653
 654
 655         x1 = charwd / 2 - .5 pen_thick#;
 656         z1 = whatever * ne_dir
 657              + thick / 2 * stafflinethickness# * (ne_dir rotated -90);
 658
 659         % labels (1, 2, 3, 4, 5, 6);
 660
 661         nw_dir = unitvector (z3 - z4);
 662
 663         vert_dist = 0.5 pen_thick / cosd (angle (ne_dir));
 664         horz_dist = 0.5 pen_thick / sind (angle (ne_dir));
 665
 666         x4' := x4;
 667         x5' := x5;
 668         y6' := y6;
 669
 670         x4 := hround (x4' + .5 pen_thick) - .5 pen_thick;
 671         x5 := hfloor (x5' + horz_dist) - horz_dist;
 672         y6 := vfloor (y6' + vert_dist) - vert_dist;
 673
 674         crz_out = (z6 + up * vert_dist)
 675                   -- (z3 + nw_dir * 0.5 pen_thick){ne_dir}
 676                   .. (top z3)
 677                   .. (z3 + ne_dir * 0.5 pen_thick){-nw_dir}
 678                   -- (z4 + ne_dir * 0.5 pen_thick){-nw_dir}
 679                   .. (rt z4)
 680                   .. (z4 - nw_dir * 0.5 pen_thick){-ne_dir}
 681                   -- (z5 + right * horz_dist);
 682         crz_out := crz_out shifted (0, feta_shift)
 683                    -- reverse crz_out yscaled -1 shifted (0, -feta_eps);
 684         fill crz_out
 685              -- reverse crz_out xscaled -1 shifted (-feta_eps, 0)
 686              -- cycle;
 687
 688         if (thick > 1):
 689                 x4 := hround (x4' - horz_dist) + horz_dist;
 690                 x5 := hceiling (x5' - .5 pen_thick) + .5 pen_thick;
 691                 y6 := vfloor (y6' - .5 pen_thick) + .5 pen_thick;
 692
 693                 crz_in = (bot z6){right}
 694                          .. (z6 - nw_dir * 0.5 pen_thick){ne_dir}
 695                          -- (z3 + down * vert_dist)
 696                          -- (z4 + left * horz_dist)
 697                          -- (z5 + nw_dir * 0.5 pen_thick){-ne_dir}
 698                          .. {down}(lft z5);
 699                 crz_in := crz_in shifted (0, feta_shift)
 700                           -- reverse crz_in yscaled -1 shifted (0, -feta_eps);
 701                 unfill crz_in
 702                        -- reverse crz_in xscaled -1 shifted (-feta_eps, 0)
 703                        -- cycle;
 704         fi
 705
 706         % ugh
 707         currentpicture := currentpicture shifted (hround (w / 2), 0);
 708
 709         charwx := charwd;
 710         charwy := y1 + feta_shift;
 711
 712         z12 = (charwx * hppp, y1 * vppp);
 713
 714         labels (12);
 715 enddef;
 716
 717
 718 fet_beginchar ("Whole Crossed notehead", "s0cross");
 719         save wid, hei;
 720
 721         wid# := black_notehead_width# + 4 stafflinethickness#;
 722         hei# := noteheight# + stafflinethickness#;
 723
 724         set_char_box (0, wid#, hei# / 2, hei# / 2);
 725
 726         draw_cross (3.75);
 727
 728         remember_pic := currentpicture;
 729
 730         draw_staff (-2, 2, 0);
 731 fet_endchar;
 732
 733
 734 if test > 0:
 735         fet_beginchar ("Whole Crossed notehead", "s0cross");
 736                 save wid, hei;
 737
 738                 wid# := black_notehead_width# + 4 stafflinethickness#;
 739                 hei# := noteheight# + stafflinethickness#;
 740
 741                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 742
 743                 currentpicture := remember_pic;
 744
 745                 draw_staff (-2, 2, 0.5);
 746         fet_endchar;
 747 fi;
 748
 749
 750 fet_beginchar ("Half Crossed notehead", "s1cross");
 751         save wid, hei;
 752
 753         wid# := black_notehead_width# + 2 stafflinethickness#;
 754         hei# := noteheight# + stafflinethickness# / 2;
 755
 756         set_char_box (0, wid#, hei# / 2, hei# / 2);
 757
 758         draw_cross (3.0);
 759
 760         remember_pic := currentpicture;
 761
 762         draw_staff (-2, 2, 0);
 763 fet_endchar;
 764
 765
 766 if test > 0:
 767         fet_beginchar ("Half Crossed notehead", "s1cross");
 768                 save wid, hei;
 769
 770                 wid# := black_notehead_width# + 2 stafflinethickness#;
 771                 hei# := noteheight# + stafflinethickness# / 2;
 772
 773                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 774
 775                 currentpicture := remember_pic;
 776
 777                 draw_staff (-2, 2, 0.5);
 778         fet_endchar;
 779 fi;
 780
 781
 782 fet_beginchar ("Crossed notehead", "s2cross");
 783         wid# := black_notehead_width#;
 784         hei# := noteheight#;
 785         set_char_box (0, wid#, hei# / 2, hei# / 2);
 786
 787         draw_cross (1.0);
 788
 789         remember_pic := currentpicture;
 790
 791         draw_staff (-2, 2, 0);
 792 fet_endchar;
 793
 794
 795 if test > 0:
 796         fet_beginchar ("Crossed notehead", "s2cross");
 797                 wid# := black_notehead_width#;
 798                 hei# := noteheight#;
 799                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 800
 801                 currentpicture := remember_pic;
 802
 803                 draw_staff (-2, 2, 0.5);
 804         fet_endchar;
 805 fi;
 806
 807
 808 fet_beginchar ("X-Circled notehead", "s2xcircle");
 809         save wid, hei;
 810         save cthick, cxd, cyd, dy;
 811
 812         wid# := black_notehead_width# * sqrt (sqrt2);
 813         hei# := noteheight# * sqrt (sqrt2);
 814
 815         set_char_box (0, wid#, hei# / 2, hei# / 2);
 816
 817         d := d - feta_space_shift;
 818
 819         cthick# := (1.2 + 1/4) * stafflinethickness#;
 820         define_blacker_pixels (cthick);
 821
 822         cxd := w - cthick;
 823         cyd := h + d - cthick / 2;
 824
 825         dy = .5 (h - d);
 826
 827         pickup pencircle scaled cthick;
 828
 829         fill fullcircle xscaled (cxd + cthick)
 830                         yscaled (cyd + cthick)
 831                         shifted (w / 2, dy);
 832         unfill fullcircle xscaled (cxd - cthick)
 833                           yscaled (cyd - cthick)
 834                           shifted (w / 2, dy);
 835
 836         xpos := .5 cxd / sqrt2;
 837         ypos := .5 cyd / sqrt2;
 838
 839         pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
 840         draw (-xpos + w / 2, -ypos + dy) -- (xpos + w / 2, ypos + dy);
 841
 842         pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
 843         draw (-xpos + w / 2, ypos + dy) -- (xpos + w / 2, -ypos + dy);
 844
 845         charwx := charwd;
 846         charwy := 0;
 847
 848         z12 = (charwx * hppp, charwy * vppp);
 849         labels (12);
 850
 851         remember_pic := currentpicture;
 852
 853         draw_staff (-2, 2, 0);
 854 fet_endchar;
 855
 856
 857 if test > 0:
 858         fet_beginchar ("X-Circled notehead", "s2xcircle");
 859                 save wid, hei;
 860                 save cthick, cxr, cyr;
 861
 862                 wid# := black_notehead_width# * sqrt (sqrt2);
 863                 hei# := noteheight# * sqrt (sqrt2);
 864
 865                 set_char_box (0, wid#, hei# / 2, hei# / 2);
 866
 867                 currentpicture := remember_pic;
 868
 869                 draw_staff (-2, 2, 0.5);
 870         fet_endchar;
 871 fi;
 872
 873
 874 %%%%%%%%
 875 %
 876 % SOLFA SHAPED NOTES
 877 %
 878
 879 save solfa_pen_thick;
 880 solfa_pen_thick# = 2 stafflinethickness#;
 881 define_blacker_pixels (solfa_pen_thick);
 882
 883
 884 def draw_do_head (expr width_factor, dir) =
 885         save p_in, p_out;
 886         save left_dist, right_dist;
 887         path p_in, p_out;
 888         pair left_dist, right_dist;
 889
 890         set_char_box (0, width_factor * noteheight#,
 891                       0.5 noteheight#, 0.5 noteheight#);
 892
 893         pickup pencircle scaled solfa_pen_thick;
 894
 895         bot y1 = -d;
 896         y1 = y2;
 897         lft x1 = 0;
 898         rt x2 = w;
 899         top y3 = h;
 900         x3 =.5 [x1, x2];
 901
 902         left_dist = (unitvector (z3 - z1) rotated 90) * 0.5 solfa_pen_thick;
 903         right_dist = (unitvector (z2 - z3) rotated 90) * 0.5 solfa_pen_thick;
 904
 905         p_in := (((z1 - left_dist) -- (z3 - left_dist)) intersectionpoint
 906                   (top z1 -- top z2))
 907                 -- ((top z1 -- top z2) intersectionpoint
 908                     ((z2 - right_dist) -- (z3 - right_dist)))
 909                 -- (((z2 - right_dist) -- (z3 - right_dist)) intersectionpoint
 910                     ((z1 - left_dist) -- (z3 - left_dist)))
 911                 -- cycle;
 912
 913         p_out := bot z1
 914                  -- bot z2{right}
 915                  .. rt z2{up}
 916                  .. (z2 + right_dist){z3 - z2}
 917                  -- (z3 + right_dist){z3 - z2}
 918                  .. top z3{left}
 919                  .. (z3 + left_dist){z1 - z3}
 920                  -- (z1 + left_dist){z1 - z3}
 921                  .. lft z1{down}
 922                  .. {right}cycle;
 923
 924
 925         labels (1, 2, 3);
 926
 927         charwx := charwd;
 928         charwy := -chardp + 0.5 stafflinethickness#;
 929         if dir = -1:
 930                 charwy := -charwy;
 931         fi;
 932 enddef;
 933
 934
 935 fet_beginchar ("Whole dohead", "s0do");
 936         draw_do_head (1.8, 1);
 937         fill p_out;
 938         unfill p_in;
 939 fet_endchar;
 940
 941
 942 fet_beginchar ("Half dohead", "d1do");
 943         draw_do_head (1.5, -1);
 944         fill p_out;
 945         unfill p_in;
 946 fet_endchar;
 947
 948
 949 fet_beginchar ("Half dohead", "s1do");
 950         draw_do_head (1.5, 1);
 951         fill p_out;
 952         unfill p_in;
 953 fet_endchar;
 954
 955
 956 fet_beginchar ("Quart dohead", "d2do");
 957         draw_do_head (1.55, -1);
 958         fill p_out;
 959 fet_endchar;
 960
 961
 962 fet_beginchar ("Quart dohead", "s2do");
 963         draw_do_head (1.55, 1);
 964         fill p_out;
 965 fet_endchar;
 966
 967
 968 %
 969 % re - flat top, curved bottom:
 970 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
 971 % (broader along the base and with more vertical sides for half and
 972 % whole notes)
 973 % stem attachment: h/2
 974 %
 975
 976 def draw_re_head (expr width_factor, dir) =
 977         save p_in, p_out;
 978         path p_in, p_out;
 979
 980         set_char_box (0, width_factor * noteheight#,
 981                       0.5 noteheight#, 0.5 noteheight#);
 982
 983         pickup pencircle scaled solfa_pen_thick;
 984
 985         save curve_start;
 986         curve_start = 0.7;
 987         lft x1 = 0;
 988         y1 = y5;
 989         x1 = x2;
 990         y2 = curve_start [y3, y1];
 991         bot y3 = -d;
 992         x3 = .5 [x2, x4];
 993         rt x4 = w;
 994         y4 = y2;
 995         top y5 = h;
 996         x5 = x4;
 997
 998         labels (range 1 thru 5);
 999
1000         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1001                 -- rt z2{down}
1002                 .. top z3
1003                 .. lft z4{up}
1004                 -- (z5 + 0.5 solfa_pen_thick * (-1, -1))
1005                 -- cycle;
1006
1007         p_out := lft z1
1008                  -- lft z2{down}
1009                  .. bot z3
1010                  .. rt z4{up}
1011                  -- rt z5{up}
1012                  .. top z5{left}
1013                  -- top z1{left}
1014                  .. {down}cycle;
1015
1016         charwx := charwd;
1017         charwy := curve_start [-chardp, charht];
1018
1019         if dir = -1:
1020                 charwy := -charwy;
1021         fi;
1022 enddef;
1023
1024
1025 fet_beginchar ("Whole rehead", "s0re");
1026         draw_re_head (1.8, 1);
1027         fill p_out;
1028         unfill p_in;
1029 fet_endchar;
1030
1031
1032 fet_beginchar ("Half up rehead", "u1re");
1033         draw_re_head (1.5, 1);
1034         fill p_out;
1035         unfill p_in;
1036 fet_endchar;
1037
1038
1039 fet_beginchar ("Half down rehead", "d1re");
1040         draw_re_head (1.5, -1);
1041         fill p_out;
1042         unfill p_in;
1043 fet_endchar;
1044
1045
1046 fet_beginchar ("Quart rehead", "u2re");
1047         draw_re_head (1.55, 1);
1048         fill p_out;
1049 fet_endchar;
1050
1051
1052 fet_beginchar ("Quart rehead", "d2re");
1053         draw_re_head (1.55, -1);
1054         fill p_out;
1055 fet_endchar;
1056
1057
1058 def draw_mi_head (expr width_factor) =
1059         save path_out, path_in;
1060         save ne_dist, se_dist, ne, se;
1061         path path_out, path_in;
1062         pair ne_dist, se_dist, ne, se;
1063
1064         set_char_box (0, width_factor * noteheight#,
1065                       0.5 noteheight#, 0.5 noteheight#);
1066
1067         pickup pencircle scaled solfa_pen_thick;
1068
1069         lft x1 = 0;
1070         y1 = 0;
1071         bot y2 = -d;
1072         x2 = .5 [x1, x3];
1073         rt x3 = w;
1074         x4 = x2;
1075         y3 = y1;
1076         top y4 = h;
1077
1078         z6 - z5 = whatever * (z2 - z1);
1079         z8 - z7 = whatever * (z2 - z1);
1080         z8 - z5 = whatever * (z4 - z1);
1081         z6 - z7 = whatever * (z4 - z1);
1082
1083         ne = unitvector (z4 - z1);
1084         se = unitvector (z1 - z2);
1085
1086         ne_dist = (ne rotated 90) * 0.5 solfa_pen_thick;
1087         se_dist = (se rotated 90) * 0.5 solfa_pen_thick;
1088
1089         z5 = whatever [z1, z4] - ne_dist;
1090         z5 = whatever [z1, z2] - 1.5 se_dist;
1091
1092         z5 - z1 = -(z7 - z3);
1093
1094         labels (range 1 thru 8);
1095
1096         path_in := z5
1097                    -- z6
1098                    -- z7
1099                    -- z8
1100                    -- cycle;
1101
1102         path_out := lft z1
1103                     .. (z1 + se_dist){-se}
1104                     -- (z2 + se_dist){-se}
1105                     .. bot z2
1106                     .. (z2 - ne_dist){ne}
1107                     -- (z3 - ne_dist){ne}
1108                     .. rt z3
1109                     .. (z3 - se_dist){se}
1110                     -- (z4 - se_dist){se}
1111                     .. top z4
1112                     .. (z4 + ne_dist){-ne}
1113                     -- (z1 + ne_dist){-ne}
1114                     .. cycle;
1115 enddef;
1116
1117
1118 fet_beginchar ("Whole mihead", "s0mi");
1119         draw_mi_head (1.8);
1120         fill path_out;
1121         unfill path_in;
1122 fet_endchar;
1123
1124
1125 fet_beginchar ("Half mihead", "s1mi");
1126         draw_mi_head (1.6);
1127         fill path_out;
1128         unfill path_in;
1129 fet_endchar;
1130
1131
1132 fet_beginchar ("Quart mihead", "s2mi");
1133         draw_mi_head (1.65);
1134         fill path_out;
1135 fet_endchar;
1136
1137
1138 def draw_fa_head (expr width_factor) =
1139         set_char_box (0, width_factor * noteheight#,
1140                       0.5 noteheight#, 0.5 noteheight#);
1141
1142         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1143         path p_down_in, p_down_out, p_up_in, p_up_out;
1144         pair nw_dist, nw;
1145
1146         pickup pencircle scaled solfa_pen_thick;
1147
1148         lft x1 = 0;
1149         top y1 = h;
1150
1151         rt x2 = w;
1152         y2 = y1;
1153         bot y3 = -d;
1154         x3 = x2;
1155
1156         y4 = y3;
1157         x4 = x1;
1158
1159         labels (1, 2, 3, 4);
1160
1161         nw = unitvector (z1 - z3);
1162         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1163
1164         p_up_in := (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1165                      (bot z1 -- bot z2))
1166                    -- (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1167                         (lft z3 -- lft z2))
1168                    -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1169                    -- cycle;
1170
1171         p_up_out := lft z1{down}
1172                     .. (z1 + nw_dist){-nw}
1173                     -- (z3 + nw_dist){-nw}
1174                     .. bot z3{right}
1175                     .. rt z3{up}
1176                     -- rt z2{up}
1177                     .. top z2{left}
1178                     -- top z1{left}
1179                     .. {down}cycle;
1180
1181         p_down_in := p_up_in rotated 180 shifted (w, 0);
1182         p_down_out := p_up_out rotated 180 shifted (w, 0);
1183
1184         charwy := 0.0;
1185         charwx := charwd;
1186 enddef;
1187
1188
1189 fet_beginchar ("Whole fa up head", "d0fa");
1190         draw_fa_head (1.8);
1191         fill p_up_out;
1192         unfill p_up_in;
1193 fet_endchar;
1194
1195
1196 fet_beginchar ("Whole fa down head", "u0fa");
1197         draw_fa_head (1.8);
1198         fill p_down_out;
1199         unfill p_down_in;
1200 fet_endchar;
1201
1202
1203 fet_beginchar ("half fa up head", "d1fa");
1204         draw_fa_head (1.5);
1205         fill p_up_out;
1206         unfill p_up_in;
1207 fet_endchar;
1208
1209
1210 fet_beginchar ("Half fa down head", "u1fa");
1211         draw_fa_head (1.5);
1212         fill p_down_out;
1213         unfill p_down_in;
1214 fet_endchar;
1215
1216
1217 fet_beginchar ("Quarter fa up head", "u2fa");
1218         draw_fa_head (1.55);
1219         fill p_up_out;
1220 fet_endchar;
1221
1222
1223 fet_beginchar ("Quarter fa down head", "d2fa");
1224         draw_fa_head (1.55);
1225         fill p_down_out;
1226 fet_endchar;
1227
1228
1229 def draw_la_head (expr width_factor) =
1230         set_char_box (0, width_factor * noteheight#,
1231                       0.5 noteheight#, 0.5 noteheight#);
1232         save p_in, p_out;
1233         path p_in, p_out;
1234
1235         pickup pencircle scaled solfa_pen_thick;
1236
1237         lft x1 = 0;
1238         top y1 = h;
1239
1240         rt x2 = w;
1241         y2 = y1;
1242         bot y3 = -d;
1243         x3 = x2;
1244
1245         y4 = y3;
1246         x4 = x1;
1247
1248         labels (range 1 thru 4);
1249
1250         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1251                 -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1252                 -- (z3 + 0.5 solfa_pen_thick * (-1, 1))
1253                 -- (z4 + 0.5 solfa_pen_thick * (1, 1))
1254                 -- cycle;
1255
1256         p_out := top z1
1257                  -- top z2{right}
1258                  .. rt z2{down}
1259                  -- rt z3{down}
1260                  .. bot z3{left}
1261                  -- bot z4{left}
1262                  .. lft z4{up}
1263                  -- lft z1{up}
1264                  .. cycle;
1265 enddef;
1266
1267
1268 fet_beginchar ("Whole lahead", "s0la");
1269         draw_la_head (1.8);
1270         fill p_out;
1271         unfill p_in;
1272 fet_endchar;
1273
1274
1275 fet_beginchar ("Half lahead", "s1la");
1276         draw_la_head (1.5);
1277         fill p_out;
1278         unfill p_in;
1279 fet_endchar;
1280
1281
1282 fet_beginchar ("Quart lahead", "s2la");
1283         draw_la_head (1.55);
1284         fill p_out;
1285 fet_endchar;
1286
1287
1288 def draw_ti_head (expr width_factor, dir) =
1289         set_char_box (0, width_factor * noteheight#,
1290                       0.5 noteheight#, 0.5 noteheight#);
1291         save p_in, p_out, p_top;
1292         save nw_dist, sw_dist, nw, sw;
1293         path p_in, p_out, p_top;
1294         pair nw_dist, sw_dist, nw, sw;
1295         save cone_height;
1296         cone_height = 0.64;
1297
1298         pickup pencircle scaled solfa_pen_thick;
1299
1300         x1 = .5 [x2, x4];
1301         bot y1 = -d;
1302         lft x2 = 0;
1303         y2 = cone_height [y1, y3];
1304         rt x4 = w;
1305         y4 = y2;
1306         x3 = x1;
1307         top y3 = h;
1308
1309         labels (range 1 thru 4);
1310
1311         nw = unitvector (z2 - z1);
1312         sw = unitvector (z1 - z4);
1313
1314         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1315         sw_dist = (sw rotated 90) * 0.5 solfa_pen_thick;
1316
1317         p_top := (z2 - sw_dist)
1318                  .. (top z3){right}
1319                  .. (z4 - nw_dist);
1320
1321         p_in := (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1322                   ((z1 - sw_dist) -- (z4 - sw_dist)))
1323                 -- (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1324                      ((z2 + sw_dist) .. {right}(bot z3)))
1325                 .. bot z3
1326                 .. (((bot z3){right} .. (z4 + nw_dist)) intersectionpoint
1327                      ((z1 - sw_dist) -- (z4 - sw_dist)))
1328                 -- cycle;
1329
1330         p_out := bot z1
1331                  .. (z1 + nw_dist)
1332                  -- (z2 + nw_dist)
1333                  .. lft z2
1334                  .. (z2 - sw_dist){direction 0 of p_top}
1335                  & p_top
1336                  & {direction infinity of p_top}(z4 - nw_dist)
1337                  .. rt z4
1338                  .. (z4 + sw_dist)
1339                  -- (z1 + sw_dist)
1340                  .. cycle;
1341
1342         charwx := charwd;
1343         charwy := cone_height [-chardp, charht];
1344         if dir = -1:
1345                 charwy := -charwy;
1346         fi;
1347 enddef;
1348
1349
1350 fet_beginchar ("Whole up tihead", "s0ti");
1351         draw_ti_head (1.8, 1);
1352         fill p_out;
1353         unfill p_in;
1354 fet_endchar;
1355
1356
1357 fet_beginchar ("Half up tihead", "u1ti");
1358         draw_ti_head (1.5, 1);
1359         fill p_out;
1360         unfill p_in;
1361 fet_endchar;
1362
1363
1364 fet_beginchar ("Half down tihead", "d1ti");
1365         draw_ti_head (1.5, -1);
1366         fill p_out;
1367         unfill p_in;
1368 fet_endchar;
1369
1370
1371 fet_beginchar ("Quart up tihead", "u2ti");
1372         draw_ti_head (1.55, 1);
1373         fill p_out;
1374 fet_endchar;
1375
1376
1377 fet_beginchar ("Quart down tihead", "d2ti");
1378         draw_ti_head (1.55, -1);
1379         fill p_out;
1380 fet_endchar;
1381
1382
1383 fet_endgroup ("noteheads");
1384
1385
1386 %
1387 % we derive black_notehead_width# from the quarter head,
1388 % so we have to define black_notehead_width (pixel qty)
1389 % after the black_notehead_width# itself.
1390 %
1391 % Let's keep it outside the group as well.
1392 %
1393
1394 define_pixels (black_notehead_width);