1% Feta (not the Font-En-Tja) music font -- implement noteheads 2% This file is part of LilyPond, the GNU music typesetter. 3% 4% Copyright (C) 1997--2020 Jan Nieuwenhuizen <janneke@gnu.org> 5% & Han-Wen Nienhuys <hanwen@xs4all.nl> 6% & Juergen Reuter <reuter@ipd.uka.de> 7% 8% The LilyPond font is free software: you can redistribute it and/or modify 9% it under the terms of the GNU General Public License as published by 10% the Free Software Foundation, either version 3 of the License, or 11% (at your option) any later version, or under the SIL Open Font License. 12% 13% LilyPond is distributed in the hope that it will be useful, 14% but WITHOUT ANY WARRANTY; without even the implied warranty of 15% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16% GNU General Public License for more details. 17% 18% You should have received a copy of the GNU General Public License 19% along with LilyPond. If not, see <http://www.gnu.org/licenses/>. 20 21test_outlines := 0; 22 23 24% Most beautiful noteheads are pronounced, not circular, 25% and not even symmetric. 26% These examples are inspired by [Wanske]; see literature list. 27 28 29%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30% NOTE HEAD VARIABLES 31%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 32 33save half_notehead_width, whole_notehead_width; 34save solfa_noteheight; 35 36numeric whole_notehead_width; 37numeric half_notehead_width; 38 39fet_begingroup ("noteheads"); 40 41 42% 43% solfa heads should not overlap on chords. 44% 45solfa_noteheight# := staff_space# - stafflinethickness#; 46 47def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) = 48 begingroup 49 save pat; 50 path pat; 51 52 pat := superellipse ((ellipticity, 0), (0, 1.0), 53 (-ellipticity, 0), (0, -1.0), 54 superness); 55 pat := pat rotated tilt; 56 57 save top_point, right_point; 58 pair top_point, right_point; 59 60 top_point := directionpoint left of pat; 61 right_point := directionpoint up of pat; 62 63 save height, scaling; 64 65 height# = staff_space# + stafflinethickness# - clearance; 66 scaling# = height# / (2 ypart (top_point)); 67 define_pixels (scaling); 68 pat := pat scaled scaling shifted (w / 2, .5 (h - d)); 69 70 if test_outlines = 1: 71 draw pat; 72 else: 73 unfill pat; 74 fi 75 endgroup; 76enddef; 77 78 79def draw_longa (expr up) = 80 save stemthick, fudge; 81 82 stemthick# = 2 stafflinethickness#; 83 define_whole_blacker_pixels (stemthick); 84 85 % Longas of smaller design sizes should have their lines farther 86 % apart (the overlap with notehead ellipsoid should be smaller). 87 fudge = hround (blot_diameter 88 * min (max (-0.15, (0.9 - (20 / (design_size + 4)))), 0.3)); 89 90 draw_outside_ellipse (1.80, 0, 0.707, 0); 91 undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#); 92 93 pickup pencircle scaled stemthick; 94 95 % Longas of smaller design sizes should have their lines longer. 96 line_length := min (max (0.7, (64/60 - (design_size / 60))), 0.85); 97 98 % Line lengths between 0.72 and 0.77 are not nice 99 % because they are neither separate nor connected 100 % when there is an interval of fourth. 101 if line_length < 0.75: 102 quanted_line_length := min (0.72, line_length); 103 else: 104 quanted_line_length := max (0.77, line_length); 105 fi; 106 107 108 final_line_length := quanted_line_length * staff_space; 109 110 save boxtop, boxbot; 111 define_pixels (boxtop, boxbot); 112 113 if up: 114 bot y1 = -final_line_length; 115 top y2 = final_line_length; 116 rt x1 - fudge = 0; 117 x1 = x2; 118 119 fudge + lft x3 = width; 120 x4 = x3; 121 top y4 = h + 3.0 staff_space; 122 y3 = y1; 123 boxtop# := staff_space# * (quanted_line_length + 3.0) - stemthick# ; 124 boxbot# := staff_space# * quanted_line_length; 125 else: 126 bot y1 = -d - 3.0 staff_space; 127 top y2 = final_line_length; 128 rt x1 - fudge = 0; 129 x1 = x2; 130 131 fudge + lft x3 = width; 132 x4 = x3; 133 y4 = y2; 134 bot y3 = -final_line_length; 135 boxtop# := staff_space# * quanted_line_length; 136 boxbot# := staff_space# * (quanted_line_length + 3.0) - stemthick# ; 137 fi; 138 139 draw_gridline (z1, z2, stemthick); 140 draw_gridline (z3, z4, stemthick); 141 142 set_char_box (stemthick#, 143 width# + stemthick#, 144 boxbot#, 145 boxtop#); 146 147 labels (1, 2, 3, 4); 148enddef; 149 150 151fet_beginchar ("Longa notehead", "uM2"); 152 draw_longa (true); 153 154 draw_staff_if_debugging (-2, 2); 155fet_endchar; 156 157 158fet_beginchar ("Longa notehead", "dM2"); 159 draw_longa (false); 160 161 draw_staff_if_debugging (-2, 2); 162fet_endchar; 163 164 165def draw_brevis (expr linecount, line_thickness_multiplier) = 166 save stemthick, fudge, gap; 167 168 stemthick# = line_thickness_multiplier * 2 * stafflinethickness#; 169 define_whole_blacker_pixels (stemthick); 170 171 % double-lined breves of smaller design sizes should have 172 % bigger gap between the lines. 173 gap# := (0.95 - 0.008 * design_size) * stemthick#; 174 175 % Breves of smaller design sizes should have their lines farther 176 % apart (the overlap with notehead ellipsoid should be smaller). 177 fudge = hround (blot_diameter 178 * min (max (-0.15, 179 (0.8 - (20 / (design_size + 4)) + .1 linecount)), 180 0.3)); 181 182 draw_outside_ellipse (1.80, 0, 0.707, 0); 183 undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#); 184 185 define_pixels (gap); 186 pickup pencircle scaled stemthick; 187 188 % Breves of smaller design sizes should have their lines longer. 189 line_length := min (max (0.7, (64/60 - (design_size / 60))), 0.85); 190 191 % Line lengths between 0.72 and 0.77 are not nice 192 % because they are neither separate nor connected 193 % when there is an interval of fourth. 194 if line_length < 0.75: 195 quanted_line_length := min (0.72, line_length); 196 else: 197 quanted_line_length := max (0.77, line_length); 198 fi; 199 200 set_char_box (stemthick# * linecount + gap# * (linecount - 1), 201 width# + stemthick# * linecount + gap# * (linecount - 1), 202 staff_space# * quanted_line_length, 203 staff_space# * quanted_line_length); 204 205 bot y1 = -quanted_line_length * staff_space; 206 top y2 = quanted_line_length * staff_space; 207 rt x1 - fudge = 0; 208 x1 = x2; 209 210 fudge + lft x3 = width; 211 x4 = x3; 212 y4 = y2; 213 y3 = y1; 214 215 for i := 0 step 1 until linecount - 1: 216 line_distance := i * (gap + stemthick); 217 draw_gridline (z1 - (line_distance, 0), 218 z2 - (line_distance, 0), 219 stemthick); 220 draw_gridline (z3 + (line_distance, 0), 221 z4 + (line_distance, 0), 222 stemthick); 223 endfor; 224enddef; 225 226 227fet_beginchar ("Brevis notehead", "sM1"); 228 draw_brevis (1, 1); 229 230 draw_staff_if_debugging (-2, 2); 231fet_endchar; 232 233 234fet_beginchar ("Double-lined brevis notehead", "sM1double"); 235 draw_brevis (2, 0.8); 236 237 draw_staff_if_debugging (-2, 2); 238fet_endchar; 239 240 241fet_beginchar ("Whole notehead", "s0"); 242 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0); 243 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10, 244 0.68, 2 stafflinethickness#); 245 246 whole_notehead_width# := charwd; 247 248 draw_staff_if_debugging (-2, 2); 249fet_endchar; 250 251 252fet_beginchar ("Half notehead", "s1"); 253 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17); 254 undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#); 255 256 half_notehead_width# := charwd; 257 258 draw_staff_if_debugging (-2, 2); 259fet_endchar; 260 261 262fet_beginchar ("Quarter notehead", "s2"); 263 draw_quarter_path; 264 draw_staff_if_debugging (-2, 2); 265fet_endchar; 266 267 268%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 269 270 271fet_beginchar ("Whole diamondhead", "s0diamond"); 272 draw_outside_ellipse (1.80, 0, 0.495, 0); 273 undraw_inside_ellipse (1.30, 125, 0.6, 274 .4 staff_space# + stafflinethickness#); 275 276 draw_staff_if_debugging (-2, 2); 277fet_endchar; 278 279 280fet_beginchar ("Half diamondhead", "s1diamond"); 281 draw_outside_ellipse (1.50, 34, 0.49, 0.17); 282 undraw_inside_ellipse (3.5, 33, 0.80, 283 .3 staff_space# + 1.5 stafflinethickness#); 284 285 draw_staff_if_debugging (-2, 2); 286fet_endchar; 287 288 289fet_beginchar ("Quarter diamondhead", "s2diamond"); 290 draw_outside_ellipse (1.80, 35, 0.495, -0.25); 291 292 draw_staff_if_debugging (-2, 2); 293fet_endchar; 294 295 296%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 297 298 299vardef penposx@# (expr d) = 300 begingroup; 301 save pat; 302 path pat; 303 304 pat = top z@# 305 .. lft z@# 306 .. bot z@# 307 .. rt z@# 308 .. cycle; 309 z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180)); 310 z@#r = pat intersectionpoint (z@# -- infinity * dir (d)); 311 endgroup 312enddef; 313 314 315% 316% UGH: xs not declared as argument. 317% 318def define_triangle_shape (expr stemdir) = 319 save triangle_a, triangle_b, triangle_c; 320 save triangle_out_a, triangle_out_b, triangle_out_c; 321 save triangle_in, triangle_out; 322 save width, depth, height; 323 save origin, left_up_dir; 324 save exact_left_point, exact_right_point, exact_down_point; 325 326 path triangle_a, triangle_b, triangle_c; 327 path triangle_out_a, triangle_out_b, triangle_out_c; 328 path triangle_in, triangle_out; 329 pair origin, left_up_dir; 330 pair exact_down_point, exact_left_point, exact_right_point; 331 332 save pen_thick; 333 pen_thick# = stafflinethickness# + .1 staff_space#; 334 define_pixels (llap); 335 define_blacker_pixels (pen_thick); 336 337 left_up_dir = llap# * dir (90 + tilt); 338 339 xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0; 340 ypart origin = 0; 341 342 exact_left_point := origin + (left_up_dir xscaled xs); 343 exact_down_point := origin + (left_up_dir rotated 120 xscaled xs); 344 exact_right_point := origin + (left_up_dir rotated 240 xscaled xs); 345 346 height# = ypart (exact_left_point + origin) + pen_thick# / 2; 347 depth# = -ypart (exact_down_point + origin) + pen_thick# / 2; 348 width# = xpart (exact_right_point - exact_left_point) 349 + pen_thick# * xs; 350 351 set_char_box (0, width#, depth#, height#); 352 353 % Formerly, the shape has simply been drawn with an elliptical pen 354 % (`scaled pen_thick xscaled xs'), but the envelope of such a curve 355 % is of 6th degree. For the sake of mf2pt1, we approximate it. 356 357 pickup pencircle scaled pen_thick xscaled xs; 358 359 z0 = (hround_pixels (xpart origin), 0); 360 361 z1 = z1' = z0 + llap * dir (90 + tilt) xscaled xs; 362 z2 = z2' = z0 + llap * dir (90 + tilt + 120) xscaled xs; 363 z3 = z3' = z0 + llap * dir (90 + tilt + 240) xscaled xs; 364 365 z12 = caveness [.5[z1, z2], z3]; 366 z23 = caveness [.5[z2, z3], z1]; 367 z31 = caveness [.5[z3, z1], z2]; 368 369 triangle_a = z1 .. z12 .. z2; 370 triangle_b = z2 .. z23 .. z3; 371 triangle_c = z3 .. z31 .. z1; 372 373 penposx1 (angle (direction 0 of triangle_a) - 90); 374 penposx2 (angle (direction 0 of triangle_b) - 90); 375 penposx3 (angle (direction 0 of triangle_c) - 90); 376 377 penposx1' (angle (direction infinity of triangle_c) + 90); 378 penposx2' (angle (direction infinity of triangle_a) + 90); 379 penposx3' (angle (direction infinity of triangle_b) + 90); 380 381 penposx12 (angle (z12 - z0)); 382 penposx23 (angle (z23 - z0)); 383 penposx31 (angle (z31 - z0)); 384 385 z10 = (z0 -- z1) intersectionpoint (z1l .. z12l .. z2'r); 386 z20 = (z0 -- z2) intersectionpoint (z2l .. z23l .. z3'r); 387 z30 = (z0 -- z3) intersectionpoint (z3l .. z31l .. z1'r); 388 389 triangle_in = z10 390 .. z12l 391 .. z20 392 & z20 393 .. z23l 394 .. z30 395 & z30 396 .. z31l 397 .. z10 398 & cycle; 399 400 triangle_out_a = z1r .. z12r .. z2'l; 401 triangle_out_b = z2r .. z23r .. z3'l; 402 triangle_out_c = z3r .. z31r .. z1'l; 403 404 triangle_out = top z1 405 .. lft z1 406 .. z1r{direction 0 of triangle_out_a} 407 & triangle_out_a 408 & {direction infinity of triangle_out_a}z2'l 409 .. lft z2 410 .. bot z2 411 .. z2r{direction 0 of triangle_out_b} 412 & triangle_out_b 413 & {direction infinity of triangle_out_b}z3'l 414 .. rt z3 415 .. top z3 416 .. z3r{direction 0 of triangle_out_c} 417 & triangle_out_c 418 & {direction infinity of triangle_out_c}z1'l 419 .. cycle; 420 421 labels (0, 10, 20, 30); 422 penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31); 423 424 % attachment Y 425 if stemdir = 1: 426 charwy := ypart exact_right_point; 427 charwx := xpart exact_right_point + .5 pen_thick# * xs; 428 else: 429 charwy := -ypart exact_down_point; 430 charwx := width# - (xpart exact_down_point - .5 pen_thick# * xs); 431 fi 432enddef; 433 434 435def draw_whole_triangle_head = 436 save hei, xs; 437 save llap; 438 save tilt; 439 440 tilt = 40; 441 llap# = 3/4 noteheight#; 442 443 xs = 1.5; 444 caveness := 0.1; 445 define_triangle_shape (1); 446 fill triangle_out; 447 unfill triangle_in; 448enddef; 449 450 451fet_beginchar ("Whole trianglehead", "s0triangle"); 452 draw_whole_triangle_head; 453 454 draw_staff_if_debugging (-2, 2); 455fet_endchar; 456 457 458def draw_small_triangle_head (expr dir) = 459 save hei, xs; 460 save llap; 461 save tilt; 462 463 tilt = 40; 464 llap# = 2/3 noteheight#; 465 xs = 1.2; 466 caveness := 0.1; 467 define_triangle_shape (dir); 468 469 pickup feta_fillpen; 470 471 filldraw triangle_out; 472 unfilldraw triangle_in; 473enddef; 474 475 476fet_beginchar ("Half trianglehead (downstem)", "d1triangle"); 477 draw_small_triangle_head (-1); 478 479 draw_staff_if_debugging (-2, 2); 480fet_endchar; 481 482 483fet_beginchar ("Half trianglehead (upstem)", "u1triangle"); 484 draw_small_triangle_head (1); 485 486 draw_staff_if_debugging (-2, 2); 487fet_endchar; 488 489 490def draw_closed_triangle_head (expr dir) = 491 save hei, xs; 492 save llap; 493 save tilt; 494 495 tilt = 40; 496 llap# = 2/3 noteheight#; 497 xs = 1.0; 498 caveness := 0.1; 499 define_triangle_shape (dir); 500 fill triangle_out; 501enddef; 502 503 504fet_beginchar ("Quarter trianglehead (upstem)", "u2triangle"); 505 draw_closed_triangle_head (1); 506 507 draw_staff_if_debugging (-2, 2); 508fet_endchar; 509 510 511fet_beginchar ("Quarter trianglehead (downstem)", "d2triangle"); 512 draw_closed_triangle_head (-1); 513 514 draw_staff_if_debugging (-2, 2); 515fet_endchar; 516 517 518%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 519% 520% Slash heads are for indicating improvisation. They are 521% twice as high as normal heads. 522% 523def draw_slash (expr hwid_hash) = 524 save exact_height; 525 save ne, nw_dist; 526 pair ne, nw_dist; 527 exact_height = staff_space# + stafflinethickness# / 2; 528 529 set_char_box (0, 2 exact_height / slash_slope + hwid_hash, 530 exact_height, exact_height); 531 532 charwx := charwd; 533 charwy := charht; 534 535 clearxy; 536 537 d := d - feta_shift; 538 539 pickup pencircle scaled blot_diameter; 540 541 bot y1 = -d; 542 top y2 = h; 543 lft x1 = 0; 544 lft x2 = 2 h / slash_slope; 545 546 rt x3 = w; 547 y3 = y2; 548 y4 = y1; 549 x3 - x2 = x4 - x1; 550 551 ne = unitvector (z3 - z4); 552 nw_dist = (ne rotated 90) * 0.5 blot_diameter; 553 554 fill bot z1{left} 555 .. (z1 + nw_dist){ne} 556 -- (z2 + nw_dist){ne} 557 .. top z2{right} 558 -- top z3{right} 559 .. (z3 - nw_dist){-ne} 560 -- (z4 - nw_dist){-ne} 561 .. bot z4{left} 562 -- cycle; 563 564 if hwid_hash > 2 slash_thick#: 565 save th; 566 567 th = slash_thick - blot_diameter; 568 y6 = y7; 569 y5 = y8; 570 y3 - y7 = th; 571 y5 - y1 = th; 572 z6 - z5 = whatever * ne; 573 z8 - z7 = whatever * ne; 574 575 z5 = z1 + whatever * ne + th * (ne rotated -90); 576 z8 = z4 + whatever * ne + th * (ne rotated 90); 577 578 unfill z5 579 -- z6 580 -- z7 581 -- z8 582 -- cycle; 583 fi 584 labels (range 1 thru 10); 585enddef; 586 587 588fet_beginchar ("Whole slashhead", "s0slash"); 589 draw_slash (4 slash_thick# + 0.5 staff_space#); 590 591 draw_staff_if_debugging (-2, 2); 592fet_endchar; 593 594 595fet_beginchar ("Half slashhead", "s1slash"); 596 draw_slash (3.0 slash_thick# + 0.15 staff_space#); 597 598 draw_staff_if_debugging (-2, 2); 599fet_endchar; 600 601 602fet_beginchar ("Quarter slashhead", "s2slash"); 603 draw_slash (1.5 slash_thick#); 604 605 draw_staff_if_debugging (-2, 2); 606fet_endchar; 607 608 609%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 610% 611% `thick' is the distance between the NE/SW parallel lines in the cross 612% (distance between centres of lines) in multiples of stafflinethickness 613% 614def draw_cross (expr thick) = 615 save ne, nw; 616 save ne_dist, nw_dist, rt_dist, up_dist; 617 save crz_in, crz_out; 618 save thickness; 619 pair ne, nw; 620 pair ne_dist, nw_dist, rt_dist, up_dist; 621 path crz_in, crz_out; 622 623 pen_thick# := 1.2 stafflinethickness#; 624 thickness# := thick * stafflinethickness#; 625 define_pixels (thickness); 626 define_blacker_pixels (pen_thick); 627 628 pickup pencircle scaled pen_thick; 629 630 h := h - feta_shift; 631 632 top y3 = h; 633 ne = unitvector ((1, (2 h - pen_thick) / (w - pen_thick))); 634 rt x4 = w / 2; 635 y5 = 0; 636 z4 - z5 = whatever * ne; 637 x6 = 0; 638 z6 - z3 = whatever * ne; 639 z3 - z4 = whatever * (ne yscaled -1); 640 641 z4 - z3 = whatever * (ne) + (ne rotated -90) * thickness; 642 643 644 x1 = charwd / 2 - .5 pen_thick#; 645 z1 = whatever * ne 646 + thick / 2 * stafflinethickness# * (ne rotated -90); 647 648 % labels (1, 2, 3, 4, 5, 6); 649 650 nw = unitvector (z3 - z4); 651 652 up_dist = up * 0.5 pen_thick / cosd (angle (ne)); 653 rt_dist = right * 0.5 pen_thick / sind (angle (ne)); 654 nw_dist = (ne rotated 90) * 0.5 pen_thick; 655 ne_dist = (nw rotated -90) * 0.5 pen_thick; 656 657 x4' := x4; 658 x5' := x5; 659 y6' := y6; 660 661 x4 := hround (x4' + .5 pen_thick) - .5 pen_thick; 662 x5 := hfloor (x5' + xpart rt_dist) - xpart rt_dist; 663 y6 := vfloor (y6' + ypart up_dist) - ypart up_dist; 664 665 crz_out = (z6 + up_dist) 666 -- (z3 + nw_dist){ne} 667 .. (top z3) 668 .. (z3 + ne_dist){-nw} 669 -- (z4 + ne_dist){-nw} 670 .. (rt z4) 671 .. (z4 - nw_dist){-ne} 672 -- (z5 + rt_dist); 673 crz_out := crz_out shifted (0, feta_shift) 674 -- reverse crz_out yscaled -1 shifted (0, -feta_eps); 675 fill crz_out 676 -- reverse crz_out xscaled -1 shifted (-feta_eps, 0) 677 -- cycle; 678 679 if (thick > 1): 680 x4 := hround (x4' - xpart rt_dist) + xpart rt_dist; 681 x5 := hceiling (x5' - .5 pen_thick) + .5 pen_thick; 682 y6 := vfloor (y6' - .5 pen_thick) + .5 pen_thick; 683 684 crz_in = (bot z6){right} 685 .. (z6 - nw_dist){ne} 686 -- (z3 - up_dist) 687 -- (z4 - rt_dist) 688 -- (z5 + nw_dist){-ne} 689 .. {down}(lft z5); 690 crz_in := crz_in shifted (0, feta_shift) 691 -- reverse crz_in yscaled -1 shifted (0, -feta_eps); 692 unfill crz_in 693 -- reverse crz_in xscaled -1 shifted (-feta_eps, 0) 694 -- cycle; 695 fi 696 697 % ugh 698 currentpicture := currentpicture shifted (hround (w / 2), 0); 699 700 charwx := charwd; 701 charwy := y1 + feta_shift; 702 703 z12 = (charwx * hppp, y1 * vppp); 704 705 labels (12); 706enddef; 707 708 709fet_beginchar ("Whole Crossed notehead", "s0cross"); 710 save wid, hei; 711 712 wid# := black_notehead_width# + 4 stafflinethickness#; 713 hei# := noteheight# + stafflinethickness#; 714 715 set_char_box (0, wid#, hei# / 2, hei# / 2); 716 717 draw_cross (3.75); 718 719 draw_staff_if_debugging (-2, 2); 720fet_endchar; 721 722 723fet_beginchar ("Half Crossed notehead", "s1cross"); 724 save wid, hei; 725 726 wid# := black_notehead_width# + 2 stafflinethickness#; 727 hei# := noteheight# + stafflinethickness# / 2; 728 729 set_char_box (0, wid#, hei# / 2, hei# / 2); 730 731 draw_cross (3.0); 732 733 draw_staff_if_debugging (-2, 2); 734fet_endchar; 735 736 737fet_beginchar ("Crossed notehead", "s2cross"); 738 wid# := black_notehead_width#; 739 hei# := noteheight#; 740 set_char_box (0, wid#, hei# / 2, hei# / 2); 741 742 draw_cross (1.0); 743 744 draw_staff_if_debugging (-2, 2); 745fet_endchar; 746 747 748fet_beginchar ("X-Circled notehead", "s2xcircle"); 749 save wid, hei; 750 save cthick, cxd, cyd, dy; 751 752 wid# := black_notehead_width# * sqrt (sqrt2); 753 hei# := noteheight# * sqrt (sqrt2); 754 755 set_char_box (0, wid#, hei# / 2, hei# / 2); 756 757 d := d - feta_space_shift; 758 759 cthick# := (1.2 + 1/4) * stafflinethickness#; 760 define_blacker_pixels (cthick); 761 762 cxd := w - cthick; 763 cyd := h + d - cthick / 2; 764 765 dy = .5 (h - d); 766 767 pickup pencircle scaled cthick; 768 769 fill fullcircle xscaled (cxd + cthick) 770 yscaled (cyd + cthick) 771 shifted (w / 2, dy); 772 unfill fullcircle xscaled (cxd - cthick) 773 yscaled (cyd - cthick) 774 shifted (w / 2, dy); 775 776 xpos := .5 cxd / sqrt2; 777 ypos := .5 cyd / sqrt2; 778 779 pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90); 780 draw (-xpos + w / 2, -ypos + dy) 781 -- (xpos + w / 2, ypos + dy); 782 783 pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90); 784 draw (-xpos + w / 2, ypos + dy) 785 -- (xpos + w / 2, -ypos + dy); 786 787 charwx := charwd; 788 charwy := 0; 789 790 z12 = (charwx * hppp, charwy * vppp); 791 labels (12); 792 793 draw_staff_if_debugging (-2, 2); 794fet_endchar; 795 796 797%%%%%%%% 798% 799% SOLFA SHAPED NOTES 800% 801% 802% Note: For whole and half notes, the `fill' curve (p_out) is offset from 803% the points that specify the outer geometry, because we need to add 804% the rounding. In contrast, the inner curve is not offset, because 805% there is no rounding. 806% 807% This means that to get a line of thick_factor * pen_thickness, 808% we need to offset the inner curve by 809% 810% (thick_factor - 0.5) * pen_thickness 811% 812% or by 813% 814% (2 * thick_factor - 1) * half_pen_thickness 815% 816save solfa_pen_thick; 817solfa_pen_thick# = 1.3 stafflinethickness#; 818define_blacker_pixels (solfa_pen_thick); 819 820save solfa_pen_radius; 821solfa_pen_radius = 0.5 solfa_pen_thick; 822 823save solfa_base_notewidth; 824solfa_base_notewidth# := black_notehead_width#; 825 826solfa_whole_width := 1.0; 827solfa_half_width := 1.0; 828solfa_quarter_width := 1.0; 829 830 831%%% Do head 832% 833% Triangle with base parallel to staff lines. 834% 835 836def draw_do_head (expr width_factor, dir, thickness_factor) = 837 save p_in, p_out; 838 save left_dist, right_dist, bottom_dist; 839 path p_in, p_out; 840 pair left_dist, right_dist, bottom_dist; 841 842 set_char_box (0, width_factor * solfa_base_notewidth#, 843 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 844 845 bottom_thick_factor := 2 * thickness_factor - 1; 846 % no different thickness for left side if we want uniform thickness 847 if thickness_factor = 1: 848 left_thick_factor := 1; 849 else: 850 left_thick_factor := 0.7 * bottom_thick_factor; 851 fi 852 853 save pen_radius; 854 pen_radius := min (solfa_pen_radius, 855 (h + d) / (3 * (1 + bottom_thick_factor))); 856 857 pickup pencircle scaled (2 * pen_radius); 858 859 bot y1 = -d; 860 y1 = y2; 861 lft x1 = 0; 862 rt x2 = w; 863 top y3 = h; 864 x3 = .5 [x1, x2]; 865 866 left_dist = (unitvector (z3 - z1) rotated 90) * pen_radius; 867 right_dist = (unitvector (z2 - z3) rotated 90) * pen_radius; 868 bottom_dist = (0,1) * pen_radius; 869 870 save pa, pb, pc; 871 path pa, pb, pc; 872 save point_a, point_b, point_c; 873 pair point_a, point_b, point_c; 874 875 pa := (z1 - left_thick_factor * left_dist) 876 -- (z3 - left_thick_factor * left_dist); 877 pb := (z1 + bottom_thick_factor * bottom_dist) 878 -- (z2 + bottom_thick_factor * bottom_dist); 879 pc := (z2 - right_dist) 880 -- (z3 - right_dist); 881 882 point_a := pa intersectionpoint pb; 883 point_b := pb intersectionpoint pc; 884 point_c := pc intersectionpoint pa; 885 886 p_in := point_a 887 -- point_b 888 -- point_c 889 -- cycle; 890 891 p_out := bot z1 892 -- bot z2{right} 893 .. rt z2{up} 894 .. (z2 + right_dist){z3 - z2} 895 -- (z3 + right_dist){z3 - z2} 896 .. top z3{left} 897 .. (z3 + left_dist){z1 - z3} 898 -- (z1 + left_dist){z1 - z3} 899 .. lft z1{down} 900 .. {right}cycle; 901 902 labels (1, 2, 3); 903 904 charwx := charwd; 905 charwy := -chardp + 0.5 stafflinethickness#; 906 if dir = -1: 907 charwy := -charwy; 908 fi; 909enddef; 910 911save do_weight; 912do_weight := 2; 913 914 915fet_beginchar ("Whole dohead", "s0do"); 916 draw_do_head (solfa_whole_width, 1, do_weight); 917 fill p_out; 918 unfill p_in; 919fet_endchar; 920 921 922fet_beginchar ("Half dohead", "d1do"); 923 draw_do_head (solfa_half_width, -1, do_weight); 924 fill p_out; 925 unfill p_in; 926fet_endchar; 927 928 929fet_beginchar ("Half dohead", "u1do"); 930 draw_do_head (solfa_half_width, 1, do_weight); 931 fill p_out; 932 unfill p_in; 933fet_endchar; 934 935 936fet_beginchar ("Quarter dohead", "d2do"); 937 draw_do_head (solfa_quarter_width, -1, do_weight); 938 fill p_out; 939fet_endchar; 940 941 942fet_beginchar ("Quarter dohead", "u2do"); 943 draw_do_head (solfa_quarter_width, 1, do_weight); 944 fill p_out; 945fet_endchar; 946 947 948fet_beginchar ("Whole thin dohead", "s0doThin"); 949 draw_do_head (solfa_whole_width, 1, 1); 950 fill p_out; 951 unfill p_in; 952fet_endchar; 953 954 955fet_beginchar ("Half thin dohead", "d1doThin"); 956 draw_do_head (solfa_half_width, -1, 1); 957 fill p_out; 958 unfill p_in; 959fet_endchar; 960 961 962fet_beginchar ("Half thin dohead", "u1doThin"); 963 draw_do_head (solfa_half_width, 1, 1); 964 fill p_out; 965 unfill p_in; 966fet_endchar; 967 968 969fet_beginchar ("Quarter thin dohead", "d2doThin"); 970 draw_do_head (solfa_quarter_width, -1, 1); 971 fill p_out; 972fet_endchar; 973 974 975fet_beginchar ("Quarter thin dohead", "u2doThin"); 976 draw_do_head (solfa_quarter_width, 1, 1); 977 fill p_out; 978fet_endchar; 979 980 981% 982% re - flat top, curved bottom: 983% 984% (0,h/2) {dir -90} 985% .. (w/2,-h/2) 986% .. {dir 90} (w,h/2) 987% -- cycle; 988% 989% (broader along the base and with more vertical sides for half and 990% whole notes) 991% 992% Note: According to some shape-note singers, there should be no size 993% differences for half and whole notes, contrary to the comment above. 994% Consequently, we have made them all the same width. 995% 996% stem attachment: h/2 997% 998def draw_re_head (expr width_factor, dir, thickness_factor) = 999 save p_in, p_out; 1000 path p_in, p_out; 1001 1002 set_char_box (0, width_factor * solfa_base_notewidth#, 1003 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1004 1005 save offset; 1006 offset = (2 * thickness_factor - 1); 1007 1008 save curve_start; 1009 curve_start = 0.7; 1010 1011 save pen_radius; 1012 1013 pen_radius := min (solfa_pen_radius, 1014 (h + d) * (1-curve_start) / (1+ offset)); 1015 1016 pickup pencircle scaled (2 * pen_radius); 1017 1018 lft x1 = 0; 1019 top y1 = h; 1020 x2 = x1; 1021 y2 = curve_start [y3, y1]; 1022 bot y3 = -d; 1023 x3 = .5 [x2, x4]; 1024 rt x4 = w; 1025 y4 = y2; 1026 y5 = y1; 1027 x5 = x4; 1028 1029 labels (range 1 thru 5); 1030 1031 p_in := (z1 + pen_radius * (1, -1 * offset)) 1032 -- rt z2{down} 1033 .. ((top z3) + (0, offset * pen_radius)) 1034 .. lft z4{up} 1035 -- (z5 + pen_radius * (-1, -1 * offset)) 1036 -- cycle; 1037 1038 p_out := lft z1 1039 -- lft z2{down} 1040 .. bot z3 1041 .. rt z4{up} 1042 -- rt z5{up} 1043 .. top z5{left} 1044 -- top z1{left} 1045 .. {down}cycle; 1046 1047 charwx := charwd; 1048 charwy := curve_start [-chardp, charht]; 1049 1050 if dir = -1: 1051 charwy := -charwy; 1052 fi; 1053enddef; 1054 1055 1056save re_weight; 1057re_weight := 2; 1058 1059fet_beginchar ("Whole rehead", "s0re"); 1060 draw_re_head (solfa_whole_width, 1, re_weight); 1061 fill p_out; 1062 unfill p_in; 1063fet_endchar; 1064 1065 1066fet_beginchar ("Half up rehead", "u1re"); 1067 draw_re_head (solfa_half_width, 1, re_weight); 1068 fill p_out; 1069 unfill p_in; 1070fet_endchar; 1071 1072 1073fet_beginchar ("Half down rehead", "d1re"); 1074 draw_re_head (solfa_half_width, -1, re_weight); 1075 fill p_out; 1076 unfill p_in; 1077fet_endchar; 1078 1079 1080fet_beginchar ("Quarter up rehead", "u2re"); 1081 draw_re_head (solfa_quarter_width, 1, re_weight); 1082 fill p_out; 1083fet_endchar; 1084 1085 1086fet_beginchar ("Quarter down rehead", "d2re"); 1087 draw_re_head (solfa_quarter_width, -1, re_weight); 1088 fill p_out; 1089fet_endchar; 1090 1091 1092fet_beginchar ("Whole thin rehead", "s0reThin"); 1093 draw_re_head (solfa_whole_width, 1, 1); 1094 fill p_out; 1095 unfill p_in; 1096fet_endchar; 1097 1098 1099fet_beginchar ("Half up thin rehead", "u1reThin"); 1100 draw_re_head (solfa_half_width, 1, 1); 1101 fill p_out; 1102 unfill p_in; 1103fet_endchar; 1104 1105 1106fet_beginchar ("Half down thin rehead", "d1reThin"); 1107 draw_re_head (solfa_half_width, -1, 1); 1108 fill p_out; 1109 unfill p_in; 1110fet_endchar; 1111 1112 1113fet_beginchar ("Quarter thin rehead", "u2reThin"); 1114 draw_re_head (solfa_quarter_width, 1, 1); 1115 fill p_out; 1116fet_endchar; 1117 1118 1119fet_beginchar ("Quarter thin rehead", "d2reThin"); 1120 draw_re_head (solfa_quarter_width, -1, 1); 1121 fill p_out; 1122fet_endchar; 1123 1124 1125%%%% mi head -- diamond shape 1126% 1127% two versions, depending on whether the `strong' lines are on the nw & se 1128% or the ne & sw 1129% 1130def draw_mi_head (expr width_factor, thickness_factor, mirror) = 1131 save path_out, path_in; 1132 save ne_dist, se_dist, ne, se; 1133 save path_a, path_b, path_c, path_d; 1134 path path_out, path_in; 1135 pair ne_dist, se_dist, ne, se; 1136 path path_a, path_b, path_c, path_d; 1137 save inner_path; 1138 path inner_path; 1139 1140 set_char_box (0, width_factor * solfa_base_notewidth#, 1141 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1142 1143 save offset; 1144 offset := 2 * thickness_factor - 1; 1145 1146 save note_diagonal; 1147 1148 note_diagonal := w / 2 ++ (h + d) / 2; 1149 1150 save pen_radius; 1151 1152 pen_radius := min (solfa_pen_radius, 1153 .3 * note_diagonal / (1 + offset)); 1154 1155 pickup pencircle scaled (2 * pen_radius); 1156 1157 lft x1 = 0; 1158 y1 = 0; 1159 bot y2 = -d; 1160 x2 = .5 [x1, x3]; 1161 rt x3 = w; 1162 x4 = x2; 1163 y3 = y1; 1164 top y4 = h; 1165 1166 % inner sides are parallel to outer sides 1167 z6 - z5 = whatever * (z2 - z1); 1168 z8 - z7 = whatever * (z4 - z3); 1169 z8 - z5 = whatever * (z4 - z1); 1170 z7 - z6 = whatever * (z3 - z2); 1171 1172 ne = unitvector (z4 - z1); 1173 se = unitvector (z2 - z1); 1174 1175 ne_dist = (ne rotated 90) * pen_radius; 1176 se_dist = (se rotated 90) * pen_radius; 1177 1178 path_a := (z1 + se_dist) 1179 -- (z2 + se_dist); 1180 path_b := (z2 + (ne_dist * offset)) 1181 -- (z3 + (ne_dist * offset)); 1182 path_c := (z3 - se_dist) 1183 -- (z4 - se_dist); 1184 path_d := (z4 - (ne_dist * offset)) 1185 -- (z1 - (ne_dist * offset)); 1186 1187 z5 = path_a intersectionpoint path_d; 1188 z7 = path_b intersectionpoint path_c; 1189 1190 labels (range 1 thru 8); 1191 1192 inner_path := z5 1193 -- z6 1194 -- z7 1195 -- z8 1196 -- cycle; 1197 1198 if mirror: 1199 path_in := inner_path; 1200 else: 1201 path_in := inner_path reflectedabout (z2, z4); 1202 fi 1203 1204 path_out := lft z1 {down} 1205 .. (z1 - se_dist){se} 1206 -- (z2 - se_dist){se} 1207 .. bot z2 {right} 1208 .. (z2 - ne_dist){ne} 1209 -- (z3 - ne_dist){ne} 1210 .. rt z3 {up} 1211 .. (z3 + se_dist){-se} 1212 -- (z4 + se_dist){-se} 1213 .. top z4 {left} 1214 .. (z4 + ne_dist){-ne} 1215 -- (z1 + ne_dist){-ne} 1216 .. cycle; 1217enddef; 1218 1219 1220save mi_weight; 1221mi_weight := 2; 1222 1223fet_beginchar ("Whole mihead", "s0mi"); 1224 draw_mi_head (solfa_whole_width, mi_weight, false); 1225 fill path_out; 1226 unfill path_in; 1227fet_endchar; 1228 1229 1230fet_beginchar ("Half mihead", "s1mi"); 1231 draw_mi_head (solfa_quarter_width, mi_weight, false); 1232 fill path_out; 1233 unfill path_in; 1234fet_endchar; 1235 1236 1237fet_beginchar ("Quarter mihead", "s2mi"); 1238 draw_mi_head (solfa_quarter_width, mi_weight, false); 1239 fill path_out; 1240fet_endchar; 1241 1242 1243fet_beginchar ("Whole mirror mihead", "s0miMirror"); 1244 draw_mi_head (solfa_whole_width, mi_weight, true); 1245 fill path_out; 1246 unfill path_in; 1247fet_endchar; 1248 1249 1250fet_beginchar ("Half mirror mihead", "s1miMirror"); 1251 draw_mi_head (solfa_quarter_width, mi_weight, true); 1252 fill path_out; 1253 unfill path_in; 1254fet_endchar; 1255 1256 1257fet_beginchar ("Quarter mirror mihead", "s2miMirror"); 1258 draw_mi_head (solfa_quarter_width, mi_weight, true); 1259 fill path_out; 1260fet_endchar; 1261 1262 1263fet_beginchar ("Whole thin mihead", "s0miThin"); 1264 draw_mi_head (solfa_whole_width, 1, false); 1265 fill path_out; 1266 unfill path_in; 1267fet_endchar; 1268 1269 1270fet_beginchar ("Half thin mihead", "s1miThin"); 1271 draw_mi_head (solfa_quarter_width, 1, false); 1272 fill path_out; 1273 unfill path_in; 1274fet_endchar; 1275 1276 1277fet_beginchar ("Quarter thin mihead", "s2miThin"); 1278 draw_mi_head (solfa_quarter_width, 1, false); 1279 fill path_out; 1280fet_endchar; 1281 1282 1283%%%% fa head 1284% 1285% Right triangle, hypotenuse from nw to se corner. Stem attaches on 1286% vertical side in direction of horizontal side. 1287% 1288def draw_fa_head (expr width_factor, thickness_factor) = 1289 set_char_box (0, width_factor * solfa_base_notewidth#, 1290 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1291 1292 save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw; 1293 path p_down_in, p_down_out, p_up_in, p_up_out; 1294 save path_a, path_b, path_c; 1295 path path_a, path_b, path_c; 1296 pair nw_dist, nw; 1297 1298 save offset; 1299 offset := 2 * thickness_factor - 1; 1300 1301 save pen_radius; 1302 pen_radius := min (solfa_pen_radius, 1303 .33 * (h + d) / (1 + offset)); 1304 1305 pickup pencircle scaled (2 * pen_radius); 1306 1307 lft x1 = 0; 1308 top y1 = h; 1309 1310 rt x2 = w; 1311 y2 = y1; 1312 bot y3 = -d; 1313 x3 = x2; 1314 1315 y4 = y3; 1316 x4 = x1; 1317 1318 labels (1, 2, 3, 4); 1319 1320 nw = unitvector (z1 - z3); 1321 nw_dist = (nw rotated 90) * pen_radius; 1322 1323 path_a := (z1 - (0,1) * offset * pen_radius) 1324 -- (z2 - (0,1) * offset * pen_radius); 1325 path_b := (z2 - (1,0) * pen_radius) 1326 -- (z3 - (1,0) * pen_radius); 1327 path_c := (z3 - nw_dist) 1328 -- (z1 - nw_dist); 1329 1330 p_up_in := (path_a intersectionpoint path_b) 1331 -- (path_b intersectionpoint path_c) 1332 -- (path_c intersectionpoint path_a) 1333 -- cycle; 1334 1335 p_up_out := lft z1{down} 1336 .. (z1 + nw_dist){-nw} 1337 -- (z3 + nw_dist){-nw} 1338 .. bot z3{right} 1339 .. rt z3{up} 1340 -- rt z2{up} 1341 .. top z2{left} 1342 -- top z1{left} 1343 .. cycle; 1344 1345 p_down_in := p_up_in rotated 180 shifted (w, 0); 1346 p_down_out := p_up_out rotated 180 shifted (w, 0); 1347 1348 charwy := 0.0; 1349 charwx := charwd; 1350enddef; 1351 1352save fa_weight; 1353fa_weight := 1.75; 1354 1355fet_beginchar ("Whole fa up head", "u0fa"); 1356 draw_fa_head (solfa_whole_width, fa_weight); 1357 fill p_up_out; 1358 unfill p_up_in; 1359fet_endchar; 1360 1361 1362fet_beginchar ("Whole fa down head", "d0fa"); 1363 draw_fa_head (solfa_whole_width, fa_weight); 1364 fill p_down_out; 1365 unfill p_down_in; 1366fet_endchar; 1367 1368 1369fet_beginchar ("half fa up head", "u1fa"); 1370 draw_fa_head (solfa_half_width, fa_weight); 1371 fill p_up_out; 1372 unfill p_up_in; 1373fet_endchar; 1374 1375 1376fet_beginchar ("Half fa down head", "d1fa"); 1377 draw_fa_head (solfa_half_width, fa_weight); 1378 fill p_down_out; 1379 unfill p_down_in; 1380fet_endchar; 1381 1382 1383fet_beginchar ("Quarter fa up head", "u2fa"); 1384 draw_fa_head (solfa_quarter_width, fa_weight); 1385 fill p_up_out; 1386fet_endchar; 1387 1388 1389fet_beginchar ("Quarter fa down head", "d2fa"); 1390 draw_fa_head (solfa_quarter_width, fa_weight); 1391 fill p_down_out; 1392fet_endchar; 1393 1394 1395fet_beginchar ("Whole thin fa up head", "u0faThin"); 1396 draw_fa_head (solfa_whole_width, 1); 1397 fill p_up_out; 1398 unfill p_up_in; 1399fet_endchar; 1400 1401 1402fet_beginchar ("Whole thin fa down head", "d0faThin"); 1403 draw_fa_head (solfa_whole_width, 1); 1404 fill p_down_out; 1405 unfill p_down_in; 1406fet_endchar; 1407 1408 1409fet_beginchar ("half thin fa up head", "u1faThin"); 1410 draw_fa_head (solfa_half_width, 1); 1411 fill p_up_out; 1412 unfill p_up_in; 1413fet_endchar; 1414 1415 1416fet_beginchar ("Half thin fa down head", "d1faThin"); 1417 draw_fa_head (solfa_half_width, 1); 1418 fill p_down_out; 1419 unfill p_down_in; 1420fet_endchar; 1421 1422 1423fet_beginchar ("Quarter thin fa up head", "u2faThin"); 1424 draw_fa_head (solfa_quarter_width, 1); 1425 fill p_up_out; 1426fet_endchar; 1427 1428 1429fet_beginchar ("Quarter thin fa down head", "d2faThin"); 1430 draw_fa_head (solfa_quarter_width, 1); 1431 fill p_down_out; 1432fet_endchar; 1433 1434 1435 1436%%%% sol head 1437% 1438% Note: sol head is the same shape as a standard music head, and doesn't 1439% vary from style to style. However, width is constant with duration, 1440% so we can't just use the standard note font. 1441% 1442def draw_sol_head (expr filled) = 1443 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0); 1444 if not filled: 1445 undraw_inside_ellipse (2.5 - puff_up_factor / 3.0, 31, 0.707, 1446 3.5 stafflinethickness#); 1447 fi 1448 draw_staff_if_debugging (-2, 2); 1449enddef; 1450 1451fet_beginchar ("Whole solhead", "s0sol"); 1452 draw_sol_head ( false); 1453fet_endchar; 1454 1455 1456fet_beginchar ("Half solhead", "s1sol"); 1457 draw_sol_head ( false); 1458fet_endchar; 1459 1460 1461fet_beginchar ("Quarter solhead", "s2sol"); 1462 draw_sol_head ( true); 1463fet_endchar; 1464 1465 1466%%%% la head 1467% 1468% Rectangle head 1469% 1470def draw_la_head (expr width_factor, thickness_factor) = 1471 set_char_box (0, width_factor * solfa_base_notewidth#, 1472 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1473 save p_in, p_out; 1474 path p_in, p_out; 1475 1476 save offset; 1477 offset := 2 * thickness_factor - 1; 1478 1479 save pen_radius; 1480 pen_radius := min (solfa_pen_radius, 1481 .35 * (h + d) / (1 + offset)); 1482 1483 pickup pencircle scaled (2 * pen_radius); 1484 1485 lft x1 = 0; 1486 top y1 = h; 1487 1488 rt x2 = w; 1489 y2 = y1; 1490 bot y3 = -d; 1491 x3 = x2; 1492 1493 y4 = y3; 1494 x4 = x1; 1495 1496 labels (range 1 thru 4); 1497 1498 p_in := (z1 + pen_radius * (1, -offset)) 1499 -- (z2 + pen_radius * (-1, -offset)) 1500 -- (z3 + pen_radius * (-1, offset)) 1501 -- (z4 + pen_radius * (1, offset)) 1502 -- cycle; 1503 1504 p_out := top z1 1505 -- top z2{right} 1506 .. rt z2{down} 1507 -- rt z3{down} 1508 .. bot z3{left} 1509 -- bot z4{left} 1510 .. lft z4{up} 1511 -- lft z1{up} 1512 .. cycle; 1513enddef; 1514 1515 1516save la_weight; 1517la_weight := 2; 1518 1519fet_beginchar ("Whole lahead", "s0la"); 1520 draw_la_head (solfa_whole_width, la_weight); 1521 fill p_out; 1522 unfill p_in; 1523fet_endchar; 1524 1525 1526fet_beginchar ("Half lahead", "s1la"); 1527 draw_la_head (solfa_half_width, la_weight); 1528 fill p_out; 1529 unfill p_in; 1530fet_endchar; 1531 1532 1533fet_beginchar ("Quarter lahead", "s2la"); 1534 draw_la_head (solfa_quarter_width, la_weight); 1535 fill p_out; 1536fet_endchar; 1537 1538 1539fet_beginchar ("Whole thin lahead", "s0laThin"); 1540 draw_la_head (solfa_whole_width, 1); 1541 fill p_out; 1542 unfill p_in; 1543fet_endchar; 1544 1545 1546fet_beginchar ("Half thin lahead", "s1laThin"); 1547 draw_la_head (solfa_half_width, 1); 1548 fill p_out; 1549 unfill p_in; 1550fet_endchar; 1551 1552 1553fet_beginchar ("Quarter lahead", "s2laThin"); 1554 draw_la_head (solfa_quarter_width, 1); 1555 fill p_out; 1556fet_endchar; 1557 1558 1559%%%% ti head 1560% 1561% `Snow-cone', V with rounded top. 1562% 1563def draw_ti_head (expr width_factor, dir, thickness_factor) = 1564 set_char_box (0, width_factor * solfa_base_notewidth#, 1565 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1566 save p_in, p_out, p_top, p_top_in; 1567 path p_in, p_out, p_top, p_top_in; 1568 save cone_height; 1569 cone_height = 0.64; 1570 1571 save offset; 1572 offset := 2 * thickness_factor - 1; 1573 1574 save pen_radius; 1575 pen_radius := min (solfa_pen_radius, 1576 .4 * (h + d) / (1 + offset)); 1577 1578 pickup pencircle scaled (2 * pen_radius); 1579 1580 x1 = .5 [x2, x4]; 1581 bot y1 = -d; 1582 lft x2 = 0; 1583 y2 = cone_height [y1, y3]; 1584 rt x4 = w; 1585 y4 = y2; 1586 x3 = x1; 1587 top y3 = h; 1588 x5 = x1; 1589 y5 = y1 + offset * pen_radius; 1590 1591 labels (range 1 thru 4); 1592 1593 save nw_dist, sw_dist, nw, sw; 1594 pair nw_dist, sw_dist, nw, sw; 1595 1596 nw = unitvector (z2 - z1); 1597 sw = unitvector (z1 - z4); 1598 1599 nw_dist = (nw rotated 90) * pen_radius; 1600 sw_dist = (sw rotated 90) * pen_radius; 1601 1602 p_top := (z2 + nw * pen_radius) 1603 .. (top z3){right} 1604 .. (z4 - sw * pen_radius); 1605 1606 p_top_in := (z2 - nw * offset * pen_radius) 1607 .. (z3 - (0,1) * pen_radius) {right} 1608 .. (z4 + sw * offset * pen_radius); 1609 1610 save path_a, path_b; 1611 path path_a, path_b; 1612 path_a := z2 1613 -- z5; 1614 path_b := z5 1615 -- z4; 1616 1617 z6 = path_a intersectionpoint p_top_in; 1618 z7 = path_b intersectionpoint p_top_in; 1619 1620 p_in := z5 1621 -- z6 1622 .. bot z3 1623 .. z7 1624 -- cycle; 1625 1626 p_out := bot z1 1627 .. (z1 + nw_dist) 1628 -- (z2 + nw_dist) 1629 .. lft z2 1630 .. (z2 + nw * pen_radius){direction 0 of p_top} 1631 & p_top 1632 & {direction infinity of p_top}(z4 - sw * pen_radius) 1633 .. rt z4 1634 .. (z4 + sw_dist) 1635 -- (z1 + sw_dist) 1636 .. cycle; 1637 1638 charwx := charwd; 1639 charwy := cone_height [-chardp, charht]; 1640 if dir = -1: 1641 charwy := -charwy; 1642 fi; 1643enddef; 1644 1645 1646save ti_weight; 1647ti_weight := 2; 1648 1649fet_beginchar ("Whole up tihead", "s0ti"); 1650 draw_ti_head (solfa_whole_width, 1, ti_weight); 1651 fill p_out; 1652 unfill p_in; 1653fet_endchar; 1654 1655 1656fet_beginchar ("Half up tihead", "u1ti"); 1657 draw_ti_head (solfa_half_width, 1, ti_weight); 1658 fill p_out; 1659 unfill p_in; 1660fet_endchar; 1661 1662 1663fet_beginchar ("Half down tihead", "d1ti"); 1664 draw_ti_head (solfa_half_width, -1, ti_weight); 1665 fill p_out; 1666 unfill p_in; 1667 fet_endchar; 1668 1669 1670fet_beginchar ("Quarter up tihead", "u2ti"); 1671 draw_ti_head (solfa_quarter_width, 1, ti_weight); 1672 fill p_out; 1673fet_endchar; 1674 1675 1676fet_beginchar ("Quarter down tihead", "d2ti"); 1677 draw_ti_head (solfa_quarter_width, -1, ti_weight); 1678 fill p_out; 1679fet_endchar; 1680 1681 1682fet_beginchar ("Whole thin up tihead", "s0tiThin"); 1683 draw_ti_head (solfa_whole_width, 1, 1); 1684 fill p_out; 1685 unfill p_in; 1686fet_endchar; 1687 1688 1689fet_beginchar ("Half thin up tihead", "u1tiThin"); 1690 draw_ti_head (solfa_half_width, 1, 1); 1691 fill p_out; 1692 unfill p_in; 1693fet_endchar; 1694 1695 1696fet_beginchar ("Half thin down tihead", "d1tiThin"); 1697 draw_ti_head (solfa_half_width, -1, 1); 1698 fill p_out; 1699 unfill p_in; 1700fet_endchar; 1701 1702 1703fet_beginchar ("Quarter thin up tihead", "u2tiThin"); 1704 draw_ti_head (solfa_quarter_width, 1, 1); 1705 fill p_out; 1706fet_endchar; 1707 1708 1709fet_beginchar ("Quarter thin down tihead", "d2tiThin"); 1710 draw_ti_head (solfa_quarter_width, -1, 1); 1711 fill p_out; 1712fet_endchar; 1713 1714 1715%%%%%% Funk shape note heads 1716% 1717% Funk heads are narrower than Aiken and Sacred Harp, so we need a new 1718% width. 1719% 1720funk_notehead_width := 0.75; 1721 1722 1723%%%%%% Funk do head 1724% Parabolic on one side, vertical line on other 1725% Has up and down shapes for *all* notes 1726% 1727def draw_Funk_do_head (expr width_factor, thickness_factor) = 1728 set_char_box (0, width_factor * solfa_base_notewidth#, 1729 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1730 1731 save offset; 1732 offset := 2 * thickness_factor - 1; 1733 1734 save pen_radius; 1735 pen_radius := min (solfa_pen_radius, 1736 .3 * (h + d) / (1 + offset)); 1737 1738 pickup pencircle scaled (2 * pen_radius); 1739 1740 rt x1 = w; 1741 bot y1 = -d; 1742 1743 lft x2 = 0; 1744 y2 = 0.5 [y1, y3]; 1745 1746 x3 = x1; 1747 top y3 = h; 1748 1749 x4 = x1 - pen_radius; 1750 y4 = y1 + offset * pen_radius; 1751 1752 y5 = y2; 1753 x5 = x2 + pen_radius; 1754 1755 x6 = x4; 1756 y6 = y3 - offset * pen_radius; 1757 1758 save p_up_in, p_up_out, p_down_in, p_down_out; 1759 path p_up_in, p_up_out, p_down_in, p_down_out; 1760 1761 p_down_in := z4{left} 1762 ... z5{up} 1763 ... z6{right} 1764 -- cycle; 1765 1766 p_down_out := bot z1{left} 1767 .. lft z2{up} 1768 .. top z3{right} 1769 .. rt z3{down} 1770 -- rt z1{down} 1771 .. cycle; 1772 1773 p_up_in := p_down_in rotated 180 shifted (w,0); 1774 p_up_out := p_down_out rotated 180 shifted (w,0); 1775 1776enddef; 1777 1778 1779save funk_do_weight; 1780funk_do_weight := 1.7; 1781 1782fet_beginchar ("Whole up Funk dohead", "u0doFunk"); 1783 draw_Funk_do_head (funk_notehead_width, funk_do_weight); 1784 fill p_up_out; 1785 unfill p_up_in; 1786fet_endchar; 1787 1788 1789fet_beginchar ("Whole down Funk dohead", "d0doFunk"); 1790 draw_Funk_do_head (funk_notehead_width, funk_do_weight); 1791 fill p_down_out; 1792 unfill p_down_in; 1793fet_endchar; 1794 1795 1796fet_beginchar ("Half up Funk dohead", "u1doFunk"); 1797 draw_Funk_do_head (funk_notehead_width, funk_do_weight); 1798 fill p_up_out; 1799 unfill p_up_in; 1800fet_endchar; 1801 1802 1803fet_beginchar ("Half down Funk dohead", "d1doFunk"); 1804 draw_Funk_do_head (funk_notehead_width, funk_do_weight); 1805 fill p_down_out; 1806 unfill p_down_in; 1807fet_endchar; 1808 1809 1810fet_beginchar ("Quarter up Funk dohead", "u2doFunk"); 1811 draw_Funk_do_head (funk_notehead_width, funk_do_weight); 1812 fill p_up_out; 1813fet_endchar; 1814 1815 1816fet_beginchar ("Quarter down Funk dohead", "d2doFunk"); 1817 draw_Funk_do_head (funk_notehead_width, funk_do_weight); 1818 fill p_down_out; 1819fet_endchar; 1820 1821 1822%%%%%% Funk re head 1823% Arrowhead shape. 1824% Has up and down shapes for *all* notes 1825% 1826def draw_Funk_re_head (expr width_factor, thickness_factor) = 1827 set_char_box (0, width_factor * solfa_base_notewidth#, 1828 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 1829 1830 save offset; 1831 offset := 2 * thickness_factor - 1; 1832 1833 save pen_radius; 1834 pen_radius := min (solfa_pen_radius, .3 * (h + d) / (1 + offset)); 1835 1836 pickup pencircle scaled (2 * pen_radius); 1837 1838 save curve_in; 1839 curve_in := 0.9; 1840 1841 lft x1 = 0; 1842 y1 := 0.5 [y2, y4]; 1843 1844 rt x2 = w; 1845 top y2 = h; 1846 1847 x3 := curve_in [x1, x2]; 1848 y3 := y1; 1849 1850 x4 = x2; 1851 bot y4 = -d; 1852 1853 z6 = lft z3; 1854 1855 save ne, se, ne_perp, se_perp; 1856 pair ne, se, ne_perp, se_perp; 1857 1858 ne := unitvector (z2 - z1); 1859 se := unitvector (z4 - z1); 1860 ne_perp := ne rotated 90; 1861 se_perp := se rotated 90; 1862 1863 save path_a, path_b, path_c, path_d; 1864 path path_a, path_b, path_c, path_d; 1865 save arrow_a_perp, arrow_b_perp; 1866 pair arrow_a_perp, arrow_b_perp; 1867 1868 1869 path_d := z2 .. z3{down} .. z4; 1870 arrow_a_perp = unitvector (direction 0 of path_d rotated 90) 1871 * pen_radius; 1872 1873 arrow_b_perp = unitvector (direction 2 of path_d rotated 90) 1874 * pen_radius; 1875 1876 path_b := (z1 + se_perp * pen_radius) 1877 -- z4 + se_perp * offset * pen_radius; 1878 path_a := (z1 - ne_perp * pen_radius) 1879 -- z2 - ne_perp * offset * pen_radius; 1880 path_c := z2 - arrow_a_perp 1881 .. z6{down} 1882 .. z4 - arrow_b_perp; 1883 1884 z5 = path_a intersectionpoint path_b; 1885 z7 = path_a intersectionpoint path_c; 1886 z8 = path_b intersectionpoint path_c; 1887 1888 save p_up_in, p_down_in, p_up_out, p_down_out; 1889 path p_up_in, p_down_in, p_up_out, p_down_out; 1890 1891 p_down_in := z5 1892 -- z7 1893 .. z6{down} 1894 .. z8 1895 -- cycle; 1896 1897 p_down_out := lft z1{up} 1898 .. (z1 + ne_perp * pen_radius){ne} 1899 -- (z2 + ne_perp * pen_radius){ne} 1900 .. top z2 {right} 1901 .. rt z2{down} 1902 .. (z2 + arrow_a_perp) 1903 .. rt z3{down} 1904 .. (z4 + arrow_b_perp) 1905 .. rt z4{down} 1906 .. bot z4 {left} 1907 .. z4 - se_perp * pen_radius 1908 -- z1 - se_perp * pen_radius 1909 .. cycle; 1910 1911 p_up_in := p_down_in rotated 180 shifted (w, 0); 1912 p_up_out := p_down_out rotated 180 shifted (w, 0); 1913 1914 enddef; 1915 1916 1917save funk_re_weight; 1918funk_re_weight = 1.7; 1919 1920fet_beginchar ("Whole up Funk rehead", "u0reFunk"); 1921 draw_Funk_re_head (funk_notehead_width, funk_re_weight); 1922 fill p_up_out; 1923 unfill p_up_in; 1924fet_endchar; 1925 1926 1927fet_beginchar ("Whole down Funk rehead", "d0reFunk"); 1928 draw_Funk_re_head (funk_notehead_width, funk_re_weight); 1929 fill p_down_out; 1930 unfill p_down_in; 1931fet_endchar; 1932 1933 1934fet_beginchar ("Half up Funk rehead", "u1reFunk"); 1935 draw_Funk_re_head (funk_notehead_width, funk_re_weight); 1936 fill p_up_out; 1937 unfill p_up_in; 1938fet_endchar; 1939 1940 1941fet_beginchar ("Half down Funk rehead", "d1reFunk"); 1942 draw_Funk_re_head (funk_notehead_width, funk_re_weight); 1943 fill p_down_out; 1944 unfill p_down_in; 1945fet_endchar; 1946 1947 1948fet_beginchar ("Quarter up Funk rehead", "u2reFunk"); 1949 draw_Funk_re_head (funk_notehead_width, funk_re_weight); 1950 fill p_up_out; 1951fet_endchar; 1952 1953 1954fet_beginchar ("Quarter down Funk rehead", "d2reFunk"); 1955 draw_Funk_re_head (funk_notehead_width, funk_re_weight); 1956 fill p_down_out; 1957fet_endchar; 1958 1959 1960%%%%%% Funk mi head 1961% Diamond shape 1962% Has up and down shapes for all hollow notes 1963% 1964save funk_mi_weight; 1965funk_mi_weight := 1.9; 1966 1967fet_beginchar ("Whole up Funk mihead", "u0miFunk"); 1968 draw_mi_head (funk_notehead_width, funk_mi_weight, false); 1969 1970 fill path_out; 1971 unfill path_in; 1972fet_endchar; 1973 1974 1975fet_beginchar ("Whole down Funk mihead", "d0miFunk"); 1976 draw_mi_head (funk_notehead_width, funk_mi_weight, true); 1977 fill path_out; 1978 unfill path_in; 1979fet_endchar; 1980 1981 1982fet_beginchar ("Half up Funk mihead", "u1miFunk"); 1983 draw_mi_head (funk_notehead_width, funk_mi_weight, false); 1984 fill path_out; 1985 unfill path_in; 1986fet_endchar; 1987 1988 1989fet_beginchar ("Half down Funk mihead", "d1miFunk"); 1990 draw_mi_head (funk_notehead_width, funk_mi_weight, true); 1991 fill path_out; 1992 unfill path_in; 1993fet_endchar; 1994 1995 1996fet_beginchar ("Quarter Funk mihead", "s2miFunk"); 1997 draw_mi_head (funk_notehead_width, funk_mi_weight, false); 1998 fill path_out; 1999fet_endchar; 2000 2001 2002%%%%%% Funk fa 2003% Triangle shape 2004% Does it rotate for whole notes? 2005% Same as other shape note systems 2006% Need special notes because of special width 2007% 2008save funk_fa_weight; 2009funk_fa_weight := 1.9; 2010 2011fet_beginchar ("Whole up Funk fahead", "u0faFunk"); 2012 draw_fa_head (funk_notehead_width, funk_fa_weight); 2013 fill p_up_out; 2014 unfill p_up_in; 2015fet_endchar; 2016 2017 2018fet_beginchar ("Whole down Funk fahead", "d0faFunk"); 2019 draw_fa_head (funk_notehead_width, funk_fa_weight); 2020 fill p_down_out; 2021 unfill p_down_in; 2022fet_endchar; 2023 2024 2025fet_beginchar ("Half up Funk fahead", "u1faFunk"); 2026 draw_fa_head (funk_notehead_width, funk_fa_weight); 2027 fill p_up_out; 2028 unfill p_up_in; 2029fet_endchar; 2030 2031 2032fet_beginchar ("Half down Funk fahead", "d1faFunk"); 2033 draw_fa_head (funk_notehead_width, funk_fa_weight); 2034 fill p_down_out; 2035 unfill p_down_in; 2036fet_endchar; 2037 2038 2039fet_beginchar ("Quarter up Funk fahead", "u2faFunk"); 2040 draw_fa_head (funk_notehead_width, funk_fa_weight); 2041 fill p_up_out; 2042fet_endchar; 2043 2044 2045fet_beginchar ("Quarter down Funk fahead", "d2faFunk"); 2046 draw_fa_head (funk_notehead_width, funk_fa_weight); 2047 fill p_down_out; 2048fet_endchar; 2049 2050 2051%%%%%% Funk sol head is the same as the others 2052% Need special character because of skinnier head 2053% 2054def draw_Funk_sol_head (expr filled) = 2055 begingroup 2056 save noteheight; 2057 noteheight# := solfa_noteheight#; 2058 draw_outside_ellipse (1.2, 34, 0.71, 0.); 2059 if not filled: 2060 undraw_inside_ellipse (1.9, 33, 0.74, 5.5 stafflinethickness#); 2061 fi 2062 draw_staff_if_debugging (-2, 2); 2063 endgroup 2064enddef; 2065 2066 2067fet_beginchar ("Whole Funk solhead", "s0solFunk"); 2068 draw_Funk_sol_head ( false); 2069fet_endchar; 2070 2071 2072fet_beginchar ("Half Funk solhead", "s1solFunk"); 2073 draw_Funk_sol_head ( false); 2074fet_endchar; 2075 2076 2077fet_beginchar ("Quarter Funk solhead", "s2solFunk"); 2078 draw_Funk_sol_head ( true); 2079fet_endchar; 2080 2081 2082%%%%%% Funk la head 2083% Rectangle head 2084% Same as for other shape notes 2085% Smaller width requires special characters 2086% 2087save funk_la_weight; 2088funk_la_weight := 1.9; 2089 2090fet_beginchar ("Whole Funk lahead", "s0laFunk"); 2091 draw_la_head (funk_notehead_width, funk_notehead_width); 2092 fill p_out; 2093 unfill p_in; 2094fet_endchar; 2095 2096 2097fet_beginchar ("Half Funk lahead", "s1laFunk"); 2098 draw_la_head (funk_notehead_width, funk_notehead_width); 2099 fill p_out; 2100 unfill p_in; 2101fet_endchar; 2102 2103 2104fet_beginchar ("Quarter Funk lahead", "s2laFunk"); 2105 draw_la_head (funk_notehead_width, funk_notehead_width); 2106 fill p_out; 2107fet_endchar; 2108 2109 2110%%%%%% Funk ti head 2111% `Sideways snow cone'. 2112% Rotates for all notes. 2113% 2114def draw_Funk_ti_head (expr width_factor, thickness_factor) = 2115 set_char_box (0, width_factor * solfa_base_notewidth#, 2116 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 2117 save cone_width; 2118 cone_width = 0.8; 2119 2120 save offset; 2121 offset := 2 * thickness_factor - 1; 2122 2123 save pen_radius; 2124 pen_radius := min (solfa_pen_radius, 2125 .33 * (h + d) / (1 + offset)); 2126 2127 pickup pencircle scaled (2 * pen_radius); 2128 2129 lft x1 = 0; 2130 y1 = .5 [y2, y4]; 2131 2132 x2 = cone_width [x1, x3]; 2133 top y2 = h; 2134 2135 rt x3 = w; 2136 y3 = y1; 2137 2138 x4 = x2; 2139 bot y4 = -d; 2140 2141 save nw_dist, sw_dist, ne, se; 2142 pair nw_dist, sw_dist, ne, se; 2143 2144 ne = unitvector (z2 - z1); 2145 se = unitvector (z4 - z1); 2146 2147 nw_dist = (ne rotated 90) * pen_radius ; 2148 sw_dist = (se rotated -90) * pen_radius; 2149 2150 save path_a, path_b; 2151 path path_a, path_b; 2152 path_a := z1 - nw_dist 2153 -- z2 - offset * nw_dist; 2154 path_b := z1 - sw_dist 2155 -- z4 - offset * sw_dist; 2156 2157 save path_right, path_right_in; 2158 path path_right, path_right_in; 2159 path_right := (z2 + ne * pen_radius) 2160 .. (rt z3){down} 2161 .. (z4 + se * pen_radius); 2162 2163 path_right_in := (z2 - ne * pen_radius) 2164 .. lft z3{down} 2165 .. (z4 - se * pen_radius); 2166 2167 z5 = path_a intersectionpoint path_b; 2168 z6 = path_a intersectionpoint path_right_in; 2169 z7 = path_b intersectionpoint path_right_in; 2170 2171 save p_up_in, p_down_in, p_up_out, p_down_out; 2172 path p_up_in, p_down_in, p_up_out, p_down_out; 2173 2174 p_down_in := z5 2175 -- z6 2176 .. lft z3 2177 .. z7 2178 -- cycle; 2179 2180 p_down_out := lft z1 2181 .. (z1 + nw_dist) 2182 -- (z2 + nw_dist) 2183 .. top z2 2184 .. (z2 + ne * pen_radius){direction 0 of path_right} 2185 & path_right 2186 & {direction infinity of path_right}(z4 + se * pen_radius) 2187 .. bot z4 2188 .. (z4 + sw_dist) 2189 -- (z1 + sw_dist) 2190 .. cycle; 2191 2192 p_up_in := p_down_in rotated 180 shifted (w, 0); 2193 p_up_out := p_down_out rotated 180 shifted (w, 0); 2194enddef; 2195 2196 2197save funk_ti_weight; 2198funk_ti_weight := 1.6; 2199 2200fet_beginchar ("Whole up Funk tihead", "u0tiFunk"); 2201 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight); 2202 fill p_up_out; 2203 unfill p_up_in; 2204fet_endchar; 2205 2206 2207fet_beginchar ("Whole down Funk tihead", "d0tiFunk"); 2208 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight); 2209 fill p_down_out; 2210 unfill p_down_in; 2211fet_endchar; 2212 2213 2214fet_beginchar ("Half up Funk tihead", "u1tiFunk"); 2215 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight); 2216 fill p_up_out; 2217 unfill p_up_in; 2218fet_endchar; 2219 2220 2221fet_beginchar ("Half down Funk tihead", "d1tiFunk"); 2222 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight); 2223 fill p_down_out; 2224 unfill p_down_in; 2225fet_endchar; 2226 2227 2228fet_beginchar ("Quarter up Funk tihead", "u2tiFunk"); 2229 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight); 2230 fill p_up_out; 2231fet_endchar; 2232 2233 2234fet_beginchar ("Quarter down Funk tihead", "d2tiFunk"); 2235 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight); 2236 fill p_down_out; 2237fet_endchar; 2238 2239 2240%%%%%% Walker shape note heads 2241% 2242% Walker heads are narrow like Funk heads, so use funk_notehead_width. 2243% 2244 2245%%%%%% Walker do head 2246% 2247% Trapezoid, with largest side on stem side 2248% 2249def draw_Walker_do_head (expr width_factor, dir, thickness_factor) = 2250 set_char_box (0, width_factor * solfa_base_notewidth#, 2251 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 2252 2253 pickup pencircle scaled solfa_pen_thick; 2254 2255 save offset; 2256 offset := 2 * thickness_factor - 1; 2257 2258 % adjust width so stem can be centered 2259 if .5w <> good.x .5w: change_width; fi 2260 2261 save scaling; 2262 2263 scaling# = charwd / w; 2264 2265 save inset; 2266 inset := 0.25; 2267 2268 x1 = inset [x4, x3]; 2269 top y1 = h; 2270 2271 x2 = inset [x3, x4]; 2272 y2 = y1; 2273 2274 bot y3 = -d; 2275 rt x3 = w; 2276 2277 y4 = y3; 2278 lft x4 = 0; 2279 2280 labels (range 1 thru 4); 2281 2282 save left_dir, left_perp, right_dir, right_perp; 2283 pair left_dir, left_perp, right_dir, right_perp; 2284 2285 left_dir = unitvector(z1 - z4); 2286 left_perp = (left_dir rotated 90) * solfa_pen_radius; 2287 right_dir = unitvector(z3 - z2); 2288 right_perp = (right_dir rotated 90) * solfa_pen_radius; 2289 2290 save path_a, path_b, path_c, path_d; 2291 path path_a, path_b, path_c, path_d; 2292 2293 path_a := (z4 - left_perp) 2294 -- (z1 - left_perp); 2295 path_b := (z1 - (0, offset*solfa_pen_radius)) 2296 -- (z2 - (0, offset*solfa_pen_radius)); 2297 path_c := (z2 - right_perp) 2298 -- (z3 - right_perp); 2299 path_d := (z3 + (0, offset*solfa_pen_radius)) 2300 -- (z4 + (0, offset*solfa_pen_radius)); 2301 2302 save p_in, p_out; 2303 path p_in, p_out; 2304 2305 p_in := (path_a intersectionpoint path_b) 2306 -- (path_b intersectionpoint path_c) 2307 -- (path_c intersectionpoint path_d) 2308 -- (path_d intersectionpoint path_a) 2309 -- cycle; 2310 2311 p_out := top z1{right} 2312 -- top z2{right} 2313 .. z2 + right_perp {right_dir} 2314 -- z3 + right_perp {right_dir} 2315 .. bot z3{left} 2316 -- bot z4{left} 2317 .. z4 + left_perp {left_dir} 2318 .. z1 + left_perp {left_dir} 2319 .. cycle; 2320 2321 charwx := scaling# * (w/2 + solfa_pen_radius); 2322 charwy := scaling# * y2 ; 2323 2324 if dir = 1: 2325 p_in := p_in rotated 180 shifted (w,0); 2326 p_out := p_out rotated 180 shifted (w,0); 2327 fi; 2328enddef; 2329 2330 2331save walker_do_weight; 2332walker_do_weight := 1.5; 2333 2334fet_beginchar ("Whole Walker dohead", "s0doWalker"); 2335 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight); 2336 fill p_out; 2337 unfill p_in; 2338fet_endchar; 2339 2340 2341fet_beginchar ("Half up Walker dohead", "u1doWalker"); 2342 draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight); 2343 fill p_out; 2344 unfill p_in; 2345fet_endchar; 2346 2347 2348fet_beginchar ("Half down Walker dohead", "d1doWalker"); 2349 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight); 2350 fill p_out; 2351 unfill p_in; 2352fet_endchar; 2353 2354 2355fet_beginchar ("Quarter up Walker dohead", "u2doWalker"); 2356 draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight); 2357 fill p_out; 2358fet_endchar; 2359 2360 2361fet_beginchar ("Quarter down Walker dohead", "d2doWalker"); 2362 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight); 2363 fill p_out; 2364fet_endchar; 2365 2366 2367%%%%%% Walker re head 2368% Parabolic on one side, shallow parabola on other 2369% Has up and down shapes for *all* notes 2370% 2371def draw_Walker_re_head (expr width_factor, thickness_factor) = 2372 set_char_box (0, width_factor * solfa_base_notewidth#, 2373 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 2374 2375 save offset; 2376 offset := 2 * thickness_factor - 1; 2377 2378 save pen_radius; 2379 pen_radius := min (solfa_pen_radius, 2380 .3 * (h + d) / (1 + offset)); 2381 2382 pickup pencircle scaled (2 * pen_radius); 2383 2384 save dish_factor; 2385 dish_factor := 0.20; 2386 2387 rt x1 = w; 2388 bot y1 = -d; 2389 2390 lft x2 = 0; 2391 y2 = 0.5 [y1, y3]; 2392 2393 top y3 = h; 2394 x3 = x1; 2395 2396 x4 = dish_factor [x1, x2]; 2397 y4 = y2; 2398 2399 x5 = x1; 2400 y5 = y1 + offset * pen_radius; 2401 2402 y6 = y2; 2403 x6 = x2 + pen_radius; 2404 2405 x7 = x3; 2406 y7 = y3 - offset * pen_radius; 2407 2408 y8 = y4; 2409 x8 = x4 - pen_radius; 2410 2411 save path_a, path_d; 2412 path path_a, path_d; 2413 2414 save p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp; 2415 pair p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp; 2416 2417 path_a := z3 2418 .. z4{down} 2419 .. z1; 2420 2421 p_a_start_dir := unitvector(direction 0 of path_a); 2422 p_a_end_dir := unitvector(direction infinity of path_a); 2423 p_a_start_perp := (p_a_start_dir rotated 90) * pen_radius; 2424 p_a_end_perp := (p_a_end_dir rotated 90) * pen_radius; 2425 2426 path_d := (z3 - p_a_start_perp){p_a_start_dir} 2427 .. z4 {down} 2428 ..(z1 - p_a_end_perp){p_a_end_dir}; 2429 2430 save path_b, path_c; 2431 path path_b, path_c; 2432 2433 path_b := z5 {left} 2434 .. z6{up}; 2435 path_c := z7 {left} 2436 .. z6{down}; 2437 2438 z9 = path_d intersectionpoint path_b; 2439 z10 = path_d intersectionpoint path_c; 2440 2441 labels (range 1 thru 4); 2442 2443 save p_up_in, p_up_out, p_down_in, p_down_out; 2444 path p_up_in, p_up_out, p_down_in, p_down_out; 2445 2446 p_down_in := z6{up} 2447 ... {right} z10 {p_a_start_dir} 2448 .. z8{down} 2449 .. {p_a_end_dir} z9 {left} 2450 ... cycle; 2451 2452 p_down_out := lft z2{up} 2453 .. top z3{right} 2454 .. rt z3 2455 .. (z3 + p_a_start_perp){p_a_start_dir} 2456 .. rt z4{down} 2457 .. (z1 + p_a_end_perp) {p_a_end_dir} 2458 .. rt z1 2459 .. bot z1 {left} 2460 .. cycle; 2461 2462 p_up_in := p_down_in rotated 180 shifted (w,0); 2463 p_up_out := p_down_out rotated 180 shifted (w,0); 2464enddef; 2465 2466 2467save walker_re_weight; 2468walker_re_weight := 1.2; 2469 2470fet_beginchar ("Whole Walker rehead", "s0reWalker"); 2471 draw_Walker_re_head (funk_notehead_width, walker_re_weight); 2472 fill p_down_out; 2473 unfill p_down_in; 2474fet_endchar; 2475 2476 2477fet_beginchar ("Half up Walker rehead", "u1reWalker"); 2478 draw_Walker_re_head (funk_notehead_width, walker_re_weight); 2479 fill p_up_out; 2480 unfill p_up_in; 2481fet_endchar; 2482 2483 2484fet_beginchar ("Half down Walker rehead", "d1reWalker"); 2485 draw_Walker_re_head (funk_notehead_width, walker_re_weight); 2486 fill p_down_out; 2487 unfill p_down_in; 2488fet_endchar; 2489 2490 2491fet_beginchar ("Quarter up Walker rehead", "u2reWalker"); 2492 draw_Walker_re_head (funk_notehead_width, walker_re_weight); 2493 fill p_up_out; 2494fet_endchar; 2495 2496 2497fet_beginchar ("Quarter down Walker rehead", "d2reWalker"); 2498 draw_Walker_re_head (funk_notehead_width, walker_re_weight); 2499 fill p_down_out; 2500fet_endchar; 2501 2502 2503%%%%%% Walker mi head 2504% Diamond shape 2505% Symmetric for all hollow notes 2506% 2507save walker_mi_width, walker_mi_weight; 2508walker_mi_width := 1; 2509walker_mi_weight := 1.5; 2510 2511fet_beginchar ("Whole Walker mihead", "s0miWalker"); 2512 draw_mi_head (walker_mi_width * funk_notehead_width, 2513 walker_mi_weight, true); 2514 fill path_out; 2515 unfill path_in; 2516fet_endchar; 2517 2518 2519fet_beginchar ("Half Walker mihead", "s1miWalker"); 2520 draw_mi_head (walker_mi_width * funk_notehead_width, 2521 walker_mi_weight, true); 2522 fill path_out; 2523 unfill path_in; 2524fet_endchar; 2525 2526 2527fet_beginchar ("Quarter Walker mihead", "s2miWalker"); 2528 draw_mi_head (walker_mi_width * funk_notehead_width, 2529 walker_mi_weight, true); 2530 fill path_out; 2531fet_endchar; 2532 2533 2534%%%%%% Walker fa 2535% Triangle shape 2536% Does not rotate for whole notes 2537% Whole rotation is different from Funk, so special notes 2538 2539%%%%%% Funk sol head is the same as the others 2540% Need special character because of skinnier head 2541% 2542save walker_fa_weight; 2543walker_fa_weight := 1.5; 2544 2545fet_beginchar ("Whole Walker fahead", "s0faWalker"); 2546 draw_fa_head (funk_notehead_width, walker_fa_weight); 2547 fill p_down_out; 2548 unfill p_down_in; 2549fet_endchar; 2550 2551 2552fet_beginchar ("Half up Walker fahead", "u1faWalker"); 2553 draw_fa_head (funk_notehead_width, walker_fa_weight); 2554 fill p_up_out; 2555 unfill p_up_in; 2556fet_endchar; 2557 2558 2559fet_beginchar ("Half down Walker fahead", "d1faWalker"); 2560 draw_fa_head (funk_notehead_width, walker_fa_weight); 2561 fill p_down_out; 2562 unfill p_down_in; 2563fet_endchar; 2564 2565 2566fet_beginchar ("Quarter up Walker fahead", "u2faWalker"); 2567 draw_fa_head (funk_notehead_width, walker_fa_weight); 2568 fill p_up_out; 2569fet_endchar; 2570 2571 2572fet_beginchar ("Quarter down Walker fahead", "d2faWalker"); 2573 draw_fa_head (funk_notehead_width, walker_fa_weight); 2574 fill p_down_out; 2575fet_endchar; 2576 2577 2578%%%%%% Walker sol 2579% Same as Funk, no special notes 2580% 2581 2582%%%%%% Walker la head 2583% Rectcangle head 2584% Lighter weight requires separate notes 2585% 2586save walker_la_weight; 2587walker_la_weight := 1.5; 2588 2589fet_beginchar ("Whole Walker lahead", "s0laWalker"); 2590 draw_la_head (funk_notehead_width, walker_la_weight); 2591 fill p_out; 2592 unfill p_in; 2593fet_endchar; 2594 2595 2596fet_beginchar ("Half Funk lahead", "s1laWalker"); 2597 draw_la_head (funk_notehead_width, walker_la_weight); 2598 fill p_out; 2599 unfill p_in; 2600fet_endchar; 2601 2602 2603fet_beginchar ("Quarter Funk lahead", "s2laWalker"); 2604 draw_la_head (funk_notehead_width, walker_la_weight); 2605 fill p_out; 2606fet_endchar; 2607 2608 2609%%%%%% Walker ti head 2610% Triangular arrowhead 2611% Rotates for all but whole notes 2612% 2613def draw_Walker_ti_head (expr width_factor, thickness_factor) = 2614 set_char_box (0, width_factor * solfa_base_notewidth#, 2615 0.5 solfa_noteheight#, 0.5 solfa_noteheight#); 2616 2617 save offset; 2618 offset := 2 * thickness_factor - 1; 2619 2620 save pen_radius; 2621 pen_radius := min (solfa_pen_radius, 2622 .3 * (h + d) / (1 + offset)); 2623 2624 pickup pencircle scaled (2 * pen_radius); 2625 2626 lft x1 = 0; 2627 y1 = .5 [y2, y3]; 2628 2629 rt x2 = w; 2630 top y2 = h; 2631 2632 x3 = x2; 2633 bot y3 = -d; 2634 2635 2636 labels (range 1 thru 4); 2637 2638 save nw_dist, sw_dist, ne, se; 2639 pair nw_dist, sw_dist, ne, se; 2640 2641 ne = unitvector (z2 - z1); 2642 se = unitvector (z3 - z1); 2643 2644 nw_dist = (ne rotated 90) * pen_radius ; 2645 sw_dist = (se rotated -90) * pen_radius; 2646 2647 2648 save path_a, path_b, path_c; 2649 path path_a, path_b, path_c; 2650 path_a := z2 - nw_dist * offset 2651 -- z1 - nw_dist * offset; 2652 path_b := z3 - sw_dist * offset 2653 -- z1 - sw_dist * offset; 2654 path_c := z2 + left * pen_radius 2655 -- z3 + left * pen_radius; 2656 2657 z4 = path_a intersectionpoint path_b; 2658 z5 = path_a intersectionpoint path_c; 2659 z6 = path_b intersectionpoint path_c; 2660 2661 save p_up_in, p_down_in, p_up_out, p_down_out; 2662 path p_up_in, p_down_in, p_up_out, p_down_out; 2663 2664 p_down_in := z4 2665 -- z5 2666 -- z6 2667 -- cycle; 2668 2669 p_down_out := lft z1{up} 2670 .. (z1 + nw_dist){ne} 2671 -- (z2 + nw_dist){ne} 2672 .. top z2{right} 2673 .. rt z2 {down} 2674 -- rt z3 {down} 2675 .. bot z3 {left} 2676 .. (z3 + sw_dist){- se} 2677 .. (z1 + sw_dist){- se} 2678 .. cycle; 2679 2680 p_up_in := p_down_in rotated 180 shifted (w, 0); 2681 p_up_out := p_down_out rotated 180 shifted (w, 0); 2682enddef; 2683 2684 2685save walker_ti_weight; 2686walker_ti_weight := 1.4; 2687 2688fet_beginchar ("Whole Walker tihead", "s0tiWalker"); 2689 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight); 2690 fill p_down_out; 2691 unfill p_down_in; 2692fet_endchar; 2693 2694 2695fet_beginchar ("Half up Walker tihead", "u1tiWalker"); 2696 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight); 2697 fill p_up_out; 2698 unfill p_up_in; 2699fet_endchar; 2700 2701 2702fet_beginchar ("Half down Walker tihead", "d1tiWalker"); 2703 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight); 2704 fill p_down_out; 2705 unfill p_down_in; 2706fet_endchar; 2707 2708 2709fet_beginchar ("Quarter up Walker tihead", "u2tiWalker"); 2710 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight); 2711 fill p_up_out; 2712fet_endchar; 2713 2714 2715fet_beginchar ("Quarter down Walker tihead", "d2tiWalker"); 2716 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight); 2717 fill p_down_out; 2718fet_endchar; 2719 2720fet_endgroup ("noteheads"); 2721 2722 2723% 2724% we derive black_notehead_width# from the quarter head, 2725% so we have to define black_notehead_width (pixel qty) 2726% after the black_notehead_width# itself. 2727% 2728% Let's keep it outside the group as well. 2729% 2730 2731define_pixels (black_notehead_width); 2732