mf/feta-bolletjes.mf

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