mf/parmesan-clefs.mf

   1 % -%-Fundamental-%- -*-Metafont-*-
   2 % parmesan-clefs.mf -- implement ancient clefs
   3 %
   4 % source file of LilyPond's pretty-but-neat music font
   5 %
   6 % (c) 2001--2009 Juergen Reuter <reuter@ipd.uka.de>
   7 %
   8
   9 fet_begingroup ("clefs");
  10
  11 %
  12 % character aligment:
  13 %
  14 %   Each clef is associated with a particular pitch: the treble clef
  15 %   with the `g', the alto clef with the `c', the bass clef with the
  16 %   `f', etc.  The shape of each clef character defines a vertical
  17 %   position that is assumed to represent this pitch.  For the treble
  18 %   clef, it is the vertical position of the center of the spiral
  19 %   ending that represents the `g' pitch.  For the bass clef, it is
  20 %   the center between the two fat dots that define the vertical
  21 %   position of the `f' pitch.  For the alto clef, it is the vertical
  22 %   center of the clef that is aligned with the `c' pitch.  For each
  23 %   clef character, this center should be vertically aligned with the
  24 %   point (0, 0).  The horizontal alignment of each clef character
  25 %   should be such that the vertical line through the point (0, 0)
  26 %   touches the left-most edge of the clef.
  27 %
  28 %   TODO: document exact_center
  29 %
  30 % set_char_box() conventions:
  31 %
  32 % * breapth: Ignored (as far as I know).  Should be set to 0.
  33 %
  34 % * width: Should match the clef's width.
  35 %
  36 % * depth: Should match the bottom edge of the clef.  Affects vertical
  37 %   collision handling.
  38 %
  39 % * height: Should match the top edge of the clef.  Affects vertical
  40 %   collision handling.
  41 %
  42
  43
  44 %%%%%%%%
  45 %
  46 %
  47 %
  48 % Editio Vaticana
  49 %
  50 %
  51 %
  52 def draw_vaticana_do_clef (expr exact_center, reduction) =
  53         save reduced_il;
  54
  55         reduced_il# = staff_space# * reduction;
  56
  57         set_char_box (0 - xpart exact_center,
  58                       0.5 reduced_il# + xpart exact_center,
  59                       0.8 reduced_il# - ypart exact_center,
  60                       0.8 reduced_il# + ypart exact_center);
  61
  62         define_pixels (reduced_il);
  63
  64         save pat, ellipse, clef, T;
  65         path pat, ellipse, clef;
  66         transform T;
  67
  68         T := identity xscaled 0.6 linethickness
  69                       yscaled 0.6 reduced_il;
  70         pickup pencircle transformed T;
  71         ellipse := reverse fullcircle transformed T;
  72
  73         save xoffs, yoffs;
  74
  75         xoffs# = xpart exact_center;
  76         yoffs# = ypart exact_center;
  77
  78         define_pixels (xoffs, yoffs);
  79
  80         rt z11 = (xoffs + 0.50 reduced_il, yoffs - .45 reduced_il);
  81         z12 = (xoffs + 0.25 reduced_il, yoffs - .50 reduced_il);
  82         lft z13 = (xoffs + 0.00 reduced_il, yoffs - .28 reduced_il);
  83         lft z14 = (xoffs, yoffs);
  84
  85         pat := z11
  86                .. z12
  87                .. z13
  88                -- z14;
  89
  90         save shift;
  91         pair shift;
  92
  93         % adjust vertically to fit into bounding box
  94         shift = find_tangent_shift (((0, -d + 0.3 reduced_il)
  95                                      -- (w, -d + 0.3 reduced_il)), pat,
  96                                     (0, -d / 2), (0, d / 2));
  97         pat := pat shifted shift;
  98
  99         clef := rt z14{down}
 100                 .. top (point 1 of pat)
 101                 .. get_subpath (ellipse,
 102                                 -direction 0 of pat, direction 0 of pat,
 103                                 point 0 of pat)
 104                 .. bot (point 1 of pat)
 105                 .. get_subpath (ellipse,
 106                                 direction 2 of pat, up,
 107                                 point 2 of pat);
 108
 109         fill clef
 110              -- reverse clef yscaled -1
 111              -- cycle;
 112
 113         labels (11, 12, 13, 14);
 114 enddef;
 115
 116
 117 fet_beginchar ("Ed. Vat. do clef", "vaticana.do");
 118         if test = 1:
 119                 draw_staff (-1, 3, 0.0);
 120         fi;
 121         draw_vaticana_do_clef ((0, 0), 1.0);
 122 fet_endchar;
 123
 124
 125 fet_beginchar ("Ed. Vat. do clef", "vaticana.do_change");
 126         draw_vaticana_do_clef ((0, 0), 1.0); % no reduction
 127 fet_endchar;
 128
 129
 130 def draw_vaticana_fa_clef (expr exact_center, reduction) =
 131         save reduced_il, xoffs, yoffs;
 132
 133         reduced_il# = staff_space# * reduction;
 134         xoffs# = xpart exact_center;
 135         yoffs# = ypart exact_center;
 136
 137         define_pixels (reduced_il, xoffs, yoffs);
 138
 139         % left-handed punctum
 140         save ellipse, pat, T;
 141         path ellipse, pat;
 142         transform T;
 143
 144         T := identity xscaled 0.6 linethickness
 145                       yscaled 0.5 reduced_il;
 146         pickup pencircle transformed T;
 147         ellipse := reverse fullcircle transformed T;
 148
 149         lft z21 = (xoffs + 0.00 reduced_il, yoffs + 0.00 reduced_il);
 150         z22 = (xoffs + 0.25 reduced_il, yoffs + 0.05 reduced_il);
 151         rt z23 = (xoffs + 0.50 reduced_il, yoffs - 0.05 reduced_il);
 152
 153         pat := z21
 154                .. z22
 155                .. z23;
 156
 157         fill get_subpath (ellipse,
 158                           -direction 0 of pat, direction 0 of pat, z21)
 159              .. top z22
 160              .. get_subpath (ellipse,
 161                              direction 2 of pat, -direction 2 of pat, z23)
 162              .. bot z22
 163              .. cycle;
 164
 165         % stem
 166         pickup pencircle scaled 0.6 linethickness;
 167
 168         x23 = x24;
 169         yoffs = bot y24 + 1.5 reduced_il;
 170
 171         draw_rounded_block (bot lft z24, top rt z23, 0.6 linethickness);
 172
 173         labels (21, 22, 23, 24);
 174
 175         % right-handed puncta as in do clef
 176         draw_vaticana_do_clef (exact_center + (0.55 reduced_il#, 0),
 177                                reduction);
 178
 179         set_char_box (0 - xpart exact_center,
 180                       1.05 reduced_il# + xpart exact_center,
 181                       1.5 reduced_il# - ypart exact_center,
 182                       0.8 reduced_il# + ypart exact_center);
 183 enddef;
 184
 185
 186 fet_beginchar ("Ed. Vat. fa clef", "vaticana.fa");
 187         if test = 1:
 188                 draw_staff (-1, 3, 0.0);
 189         fi;
 190         draw_vaticana_fa_clef ((0, 0), 1.0);
 191 fet_endchar;
 192
 193
 194 fet_beginchar ("Ed. Vat. fa clef", "vaticana.fa_change");
 195         draw_vaticana_fa_clef ((0, 0), 1.0); % no reduction
 196 fet_endchar;
 197
 198
 199 %%%%%%%%
 200 %
 201 %
 202 %
 203 % Editio Medicaea
 204 %
 205 %
 206 %
 207 def draw_medicaea_do_clef (expr exact_center, reduction) =
 208         save reduced_il, reduced_slt;
 209
 210         reduced_il# = staff_space# * reduction;
 211         reduced_slt# = linethickness# * reduction;
 212
 213         define_pixels (reduced_il);
 214         define_pixels (reduced_slt);
 215
 216         set_char_box (0 - xpart exact_center,
 217                       1.0 reduced_il# + xpart exact_center,
 218                       1.5 reduced_il# - ypart exact_center,
 219                       1.5 reduced_il# + ypart exact_center);
 220
 221         save flag_height;
 222
 223         flag_height# = 0.5 reduced_il#;
 224
 225         define_pixels (flag_height);
 226
 227         save xoffs, yoffs;
 228
 229         xoffs# = xpart exact_center;
 230         yoffs# = ypart exact_center;
 231
 232         define_pixels (xoffs, yoffs);
 233
 234         % flags
 235         save ellipse, T;
 236         path ellipse;
 237         transform T;
 238
 239         T := identity xscaled reduced_slt
 240                       yscaled flag_height;
 241         pickup pencircle transformed T;
 242         ellipse := reverse fullcircle transformed T;
 243
 244         xoffs = lft x1 = rt x2 - reduced_il;
 245         y1 = yoffs + 0.5 (reduced_il - flag_height - staff_space);
 246         y2 = y1 - reduced_il + flag_height;
 247
 248         fill top z1
 249              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
 250              -- bot z1
 251              -- cycle;
 252
 253         xoffs = lft x3 = rt x4 - reduced_il;
 254         y3 = yoffs + 0.5 (reduced_il - flag_height + staff_space);
 255         y4 = y3 - reduced_il + flag_height;
 256
 257         fill top z3
 258              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
 259              -- bot z3
 260              -- cycle;
 261
 262         % stem
 263         pickup pencircle scaled reduced_slt;
 264
 265         lft x5 = lft x6 = xoffs;
 266         yoffs = top y6 - 1.5 reduced_il = bot y5 + 1.5 reduced_il;
 267
 268         draw_rounded_block (bot lft z5, top rt z6, reduced_slt);
 269
 270         labels (1, 2, 3, 4, 5, 6);
 271 enddef;
 272
 273
 274 fet_beginchar ("Ed. Med. do clef", "medicaea.do");
 275         if test = 1:
 276                 draw_staff (-1, 3, 0.0);
 277         fi;
 278         draw_medicaea_do_clef ((0, 0), 1.0);
 279 fet_endchar;
 280
 281
 282 fet_beginchar ("Ed. Med. do clef", "medicaea.do_change");
 283         draw_medicaea_do_clef ((0, 0), .8);
 284 fet_endchar;
 285
 286
 287 def draw_medicaea_fa_clef (expr exact_center, reduction) =
 288         % inspired by Regensburger Edition of Medicaea (1885/86), in:
 289         % MGG, volume 2, col. 1327 ("Choralreform"), fig. 2.
 290
 291         save reduced_il, reduced_slt;
 292
 293         reduced_il# = staff_space# * reduction;
 294         reduced_slt# = linethickness# * reduction;
 295
 296         define_pixels (reduced_il);
 297         define_pixels (reduced_slt);
 298
 299         save xoffs, yoffs;
 300
 301         xoffs# = xpart exact_center;
 302         yoffs# = ypart exact_center;
 303
 304         define_pixels (xoffs, yoffs);
 305
 306         % stem
 307         pickup pencircle scaled reduced_slt;
 308
 309         x11 = x12 = xoffs + 0.4 reduced_il;
 310         y11 = yoffs = bot y12 + 1.5 reduced_il;
 311
 312         draw_rounded_block (bot lft z12, top rt z11, reduced_slt);
 313
 314         % left-handed punctum
 315         save ellipse, T;
 316         path ellipse;
 317         transform T;
 318
 319         T := identity xscaled reduced_slt
 320                       yscaled reduced_il;
 321         pickup pencircle transformed T;
 322         ellipse := reverse fullcircle transformed T;
 323
 324         lft z13 = (xoffs, yoffs);
 325         rt z14 = z11 + (reduced_slt / 2, 0);
 326
 327         fill get_subpath (ellipse, left, right, z13)
 328              -- get_subpath (ellipse, right, left, z14)
 329              -- cycle;
 330
 331         labels (11, 12, 13, 14);
 332
 333         % right-handed puncta as in do clef
 334         draw_medicaea_do_clef (exact_center + (0.7 reduced_il#, 0),
 335                                reduction);
 336
 337         set_char_box (0 - xpart exact_center,
 338                       1.7 reduced_il# + xpart exact_center,
 339                       1.5 reduced_il# - ypart exact_center,
 340                       1.5 reduced_il# + ypart exact_center);
 341 enddef;
 342
 343
 344 fet_beginchar ("Ed. Med. fa clef", "medicaea.fa");
 345         if test = 1:
 346                 draw_staff (-1, 3, 0.0);
 347         fi;
 348         draw_medicaea_fa_clef ((0, 0), 1.0);
 349 fet_endchar;
 350
 351
 352 fet_beginchar ("Ed. Med. fa clef", "medicaea.fa_change");
 353         draw_medicaea_fa_clef ((0, 0), .8);
 354 fet_endchar;
 355
 356
 357 %%%%%%%%
 358 %
 359 %
 360 %
 361 % Mensural Notation
 362 %
 363 %
 364 %
 365
 366 %
 367 % width:        interval from left end to right end
 368 % height:       interval from bottom of lower beam to top of upper beam
 369 % exact_center: the coordinates of the vertical center point of the
 370 %               left edge.
 371 %
 372 def draw_brevis (expr exact_center, bwidth, bheight, blinethickness) =
 373         save brevis_width, brevis_height, linethickness;
 374
 375         brevis_width# = bwidth;
 376         brevis_height# = bheight;
 377         linethickness# = blinethickness;
 378
 379         save beam_width, beam_height;
 380         save serif_size, serif_protrude, hole_height;
 381
 382         beam_width# = 1.4 linethickness#;
 383         hole_height# = 3 linethickness#;
 384         2 beam_height# + hole_height# = brevis_height#;
 385         serif_size# = (hole_height# - linethickness#) / 2;
 386         serif_protrude# = 1.5 serif_size#;
 387
 388         save xoffs, yoffs;
 389
 390         xoffs# = xpart exact_center;
 391         yoffs# = ypart exact_center;
 392
 393         define_pixels (xoffs, yoffs);
 394         define_pixels (brevis_width, brevis_height, linethickness);
 395         define_pixels (beam_width, beam_height, serif_size, serif_protrude);
 396
 397         z1l = (xoffs, yoffs - linethickness);
 398         z2r = z1r + serif_size * (1, -1);
 399         z3l = z2l + (-serif_size, -serif_protrude);
 400
 401         penpos1 (beam_width, 0);
 402         penpos2 (beam_height, 90);
 403         penpos3 (beam_width, 180);
 404
 405         save pat_in, pat_out;
 406         path pat_in, pat_out;
 407
 408         pat_out := z3r{down}
 409                    .. z3l{up}
 410                    .. z2l{right};
 411         pat_out := pat_out
 412                    -- reverse pat_out xscaled -1
 413                                       shifted (2 xoffs + brevis_width, 0);
 414         pat_out := pat_out
 415                    -- reverse pat_out yscaled -1
 416                                       shifted (0, 2 yoffs)
 417                    -- cycle;
 418
 419         pat_in := z1r{down}
 420                   .. z2r{right};
 421         pat_in := pat_in
 422                   -- reverse pat_in xscaled -1
 423                                     shifted (2 xoffs + brevis_width, 0);
 424         pat_in := pat_in
 425                   -- reverse pat_in yscaled -1
 426                                     shifted (0, 2 yoffs)
 427                   -- cycle;
 428
 429         fill pat_out;
 430         unfill pat_in;
 431
 432         penlabels (1, 2, 3);
 433 enddef;
 434
 435 %
 436 % Draw two brevis notes; the second one shifted down by `shift'.
 437 % The other parameters are the same as with `draw_brevis'.
 438 %
 439 def draw_double_brevis (expr exact_center, bwidth, bheight,
 440                              blinethickness, shift) =
 441         save brevis_width, brevis_height, linethickness;
 442
 443         brevis_width# = bwidth;
 444         brevis_height# = bheight;
 445         linethickness# = blinethickness;
 446
 447         save beam_width, beam_height;
 448         save serif_size, serif_protrude, hole_height;
 449
 450         beam_width# = 1.4 linethickness#;
 451         hole_height# = 3 linethickness#;
 452         2 beam_height# + hole_height# = brevis_height#;
 453         serif_size# = (hole_height# - linethickness#) / 2;
 454         serif_protrude# = 1.5 serif_size#;
 455
 456         save xoffs, yoffs;
 457
 458         xoffs# = xpart exact_center;
 459         yoffs# = ypart exact_center;
 460
 461         define_pixels (xoffs, yoffs);
 462         define_pixels (brevis_width, brevis_height, linethickness);
 463         define_pixels (beam_width, beam_height, serif_size, serif_protrude);
 464
 465         z1l = (xoffs, yoffs - linethickness);
 466         z2r = z1r + serif_size * (1, -1);
 467         z3l = z2l + (-serif_size, -serif_protrude);
 468
 469         penpos1 (beam_width, 0);
 470         penpos2 (beam_height, 90);
 471         penpos3 (beam_width, 180);
 472
 473         z4 = z1 shifted (0, -shift);
 474         z5 = z2 shifted (0, -shift);
 475         z6 = z3 shifted (0, -shift);
 476
 477         penpos4 (beam_width, 0);
 478         penpos5 (beam_height, 90);
 479         penpos6 (beam_width, 180);
 480
 481         save pat_in, pat_out;
 482         path pat_in, pat_out;
 483
 484         pat_out := z6r{down}
 485                    .. z6l{up}
 486                    .. z5l{right};
 487         pat_out := pat_out
 488                    -- reverse pat_out xscaled -1
 489                                       shifted (2 xoffs + brevis_width, 0);
 490         pat_out := pat_out
 491                    -- reverse pat_out yscaled -1
 492                                       shifted (0, shift - 2 yoffs)
 493                    -- cycle;
 494
 495         fill pat_out;
 496
 497         pat_in := z1r{down}
 498                   .. z2r{right};
 499         pat_in := pat_in
 500                   -- reverse pat_in xscaled -1
 501                                     shifted (2 xoffs + brevis_width, 0);
 502         pat_in := pat_in
 503                   -- reverse pat_in yscaled -1
 504                                     shifted (0, 2 yoffs)
 505                   -- cycle;
 506
 507         unfill pat_in;
 508         unfill pat_in shifted (0, -shift);
 509
 510         penlabels (1, 2, 3, 4, 5, 6);
 511 enddef;
 512
 513
 514 %
 515 % Draw three brevis notes; the second one shifted down by `shift',
 516 % the third one by `2 shift'.
 517 % The other parameters are the same as with `draw_brevis'.
 518 %
 519 def draw_triple_brevis (expr exact_center, bwidth, bheight,
 520                              blinethickness, shift) =
 521         save brevis_width, brevis_height, linethickness;
 522
 523         brevis_width# = bwidth;
 524         brevis_height# = bheight;
 525         linethickness# = blinethickness;
 526
 527         save beam_width, beam_height;
 528         save serif_size, serif_protrude, hole_height;
 529
 530         beam_width# = 1.4 linethickness#;
 531         hole_height# = 3 linethickness#;
 532         2 beam_height# + hole_height# = brevis_height#;
 533         serif_size# = (hole_height# - linethickness#) / 2;
 534         serif_protrude# = 1.5 serif_size#;
 535
 536         save xoffs, yoffs;
 537
 538         xoffs# = xpart exact_center;
 539         yoffs# = ypart exact_center;
 540
 541         define_pixels (xoffs, yoffs);
 542         define_pixels (brevis_width, brevis_height, linethickness);
 543         define_pixels (beam_width, beam_height, serif_size, serif_protrude);
 544
 545         z1l = (xoffs, yoffs - linethickness);
 546         z2r = z1r + serif_size * (1, -1);
 547         z3l = z2l + (-serif_size, -serif_protrude);
 548
 549         penpos1 (beam_width, 0);
 550         penpos2 (beam_height, 90);
 551         penpos3 (beam_width, 180);
 552
 553         z7 = z1 shifted (0, -2 shift);
 554         z8 = z2 shifted (0, -2 shift);
 555         z9 = z3 shifted (0, -2 shift);
 556
 557         penpos7 (beam_width, 0);
 558         penpos8 (beam_height, 90);
 559         penpos9 (beam_width, 180);
 560
 561         save pat_in, pat_out;
 562         path pat_in, pat_out;
 563
 564         pat_out := z9r{down}
 565                    .. z9l{up}
 566                    .. z8l{right};
 567         pat_out := pat_out
 568                    -- reverse pat_out xscaled -1
 569                                       shifted (2 xoffs + brevis_width, 0);
 570         pat_out := pat_out
 571                    -- reverse pat_out yscaled -1
 572                                       shifted (0, -2 yoffs)
 573                    -- cycle;
 574
 575         fill pat_out;
 576
 577         pat_in := z1r{down}
 578                   .. z2r{right};
 579         pat_in := pat_in
 580                   -- reverse pat_in xscaled -1
 581                                     shifted (2 xoffs + brevis_width, 0);
 582         pat_in := pat_in
 583                   -- reverse pat_in yscaled -1
 584                                     shifted (0, 2 yoffs)
 585                   -- cycle;
 586
 587         unfill pat_in;
 588         unfill pat_in shifted (0, -shift);
 589         unfill pat_in shifted (0, -2 shift);
 590
 591         penlabels (1, 2, 3, 7, 8, 9);
 592 enddef;
 593
 594
 595 def draw_neomensural_c_clef (expr exact_center, reduction) =
 596         save reduced_il, reduced_slt, stem_width;
 597
 598         reduced_il# = staff_space# * reduction;
 599         reduced_slt# = linethickness# * reduction;
 600         stem_width# = 1.4 reduced_slt#;
 601
 602         define_pixels (reduced_il, reduced_slt, stem_width);
 603
 604         set_char_box (0 - xpart exact_center,
 605                       2 reduced_il# + 6 reduced_slt# + xpart exact_center,
 606                       2 reduced_il# - ypart exact_center,
 607                       2 reduced_il# + ypart exact_center);
 608
 609         draw_brevis (exact_center + (3 reduced_slt#, 0),
 610                      2 reduced_il#, reduced_il#, reduced_slt#);
 611
 612         save xoffs, yoffs;
 613
 614         xoffs# = xpart exact_center;
 615         yoffs# = ypart exact_center;
 616
 617         define_pixels (xoffs, yoffs);
 618
 619         save ellipse, pat, T;
 620         path ellipse, pat;
 621         transform T;
 622
 623         T := identity xscaled stem_width
 624                       yscaled blot_diameter;
 625         pickup pencircle transformed T;
 626         ellipse := fullcircle transformed T;
 627
 628         lft x11 = lft x12 = xoffs;
 629         top y12 - bot y11 = 4 reduced_il;
 630         top y12 + bot y11 = 2 yoffs;
 631         x13 = x3;
 632         y13 = y11;
 633         rt x14 = rt x15 = w;
 634         y14 = y11;
 635         y15 = y12;
 636
 637         pat := get_subpath (ellipse, down, up, z13)
 638                -- z3l
 639                -- z3r
 640                -- cycle;
 641
 642         fill get_subpath (ellipse, down, up, z11)
 643              -- get_subpath (ellipse, up, down, z12)
 644              -- cycle;
 645         fill get_subpath (ellipse, down, up, z14)
 646              -- get_subpath (ellipse, up, down, z15)
 647              -- cycle;
 648
 649         fill pat;
 650         fill pat xscaled -1
 651                  shifted (w, 0);
 652         fill pat yscaled -1
 653                  shifted (0, 2 yoffs);
 654         fill pat scaled -1
 655                  shifted (w, 2 yoffs);
 656
 657         labels (11, 12, 13, 14, 15);
 658 enddef;
 659
 660
 661 fet_beginchar ("neo-mensural c clef", "neomensural.c");
 662         if test = 1:
 663                 draw_staff (-1, 3, 0.0);
 664         fi;
 665         draw_neomensural_c_clef ((0, 0), 1.0);
 666 fet_endchar;
 667
 668
 669 fet_beginchar ("neo-mensural c clef", "neomensural.c_change");
 670         draw_neomensural_c_clef ((0, 0), .8);
 671 fet_endchar;
 672
 673
 674 def draw_petrucci_c_clef (expr exact_center, flare_align, reduction) =
 675         % inspired by Josquin Desprez, "Stabat Mater", Libro tertio,
 676         % 1519, printed by Petrucci, in: MGG, volume 7, Table 11.
 677         % Also by Petrucci's Canti C, Venedig 1503.  In: MGG, volume
 678         % 9, p. 1681/1682.
 679
 680         save reduced_il, reduced_slt;
 681
 682         reduced_il# = staff_space# * reduction;
 683         reduced_slt# = linethickness# * reduction;
 684
 685         define_pixels (reduced_il);
 686
 687         draw_double_brevis (exact_center + (0, 0.5 staff_space#),
 688                             reduced_il#, reduced_il#, reduced_slt#,
 689                             staff_space);
 690
 691         save half_reduced_il, left_depth, left_height;
 692
 693         half_reduced_il# = staff_space# * sqrt (reduction);
 694         left_height# = half_reduced_il# * min (3.2, 3.2 + 0.2 + flare_align);
 695         left_depth# = half_reduced_il# * min (3.2, 3.2 + 0.2 - flare_align);
 696
 697         define_pixels (half_reduced_il);
 698         define_pixels (left_depth, left_height);
 699
 700         set_char_box (0 - xpart exact_center,
 701                       reduced_il# + xpart exact_center,
 702                       left_depth# - ypart exact_center,
 703                       left_height# + ypart exact_center);
 704
 705         save xoffs, yoffs;
 706
 707         xoffs# = xpart exact_center;
 708         yoffs# = ypart exact_center;
 709
 710         define_pixels (xoffs, yoffs);
 711
 712         save ellipse, T;
 713         path ellipse;
 714         transform T;
 715
 716         T := identity xscaled 1.4 linethickness
 717                       yscaled blot_diameter;
 718         pickup pencircle transformed T;
 719         ellipse := fullcircle transformed T;
 720
 721         lft x11 = lft x13 = xoffs;
 722         top y11 = yoffs + left_height;
 723         bot y13 = yoffs - left_depth;
 724         rt x15 = rt x17 = xoffs + brevis_width;
 725         y15 = min (y11 - 0.2 half_reduced_il, yoffs + 2.2 half_reduced_il);
 726         y17 = max (y13 + 0.2 half_reduced_il, yoffs - 2.2 half_reduced_il);
 727
 728         z12 = z14 yscaled -1;
 729         z14 = z6;
 730         z16 = z18 yscaled -1;
 731         rt z18 = lft z14 shifted (brevis_width, 0);
 732
 733         penpos12 (1.4 linethickness, 0);
 734         penpos14 (1.4 linethickness, 0);
 735         penpos16 (1.4 linethickness, 0);
 736         penpos18 (1.4 linethickness, 0);
 737
 738         if top y11 > -y6 + 0.7 linethickness:
 739                 fill get_subpath (ellipse, up, down, z11)
 740                      -- z12l
 741                      -- z12r
 742                      -- cycle;
 743         fi;
 744         if bot y13 < y6 - 0.7 linethickness:
 745                 fill get_subpath (ellipse, down, up, z13)
 746                      -- z14r
 747                      -- z14l
 748                      -- cycle;
 749         fi;
 750         if top y15 > -y6 + 0.7 linethickness:
 751                 fill get_subpath (ellipse, up, down, z15)
 752                      -- z16l
 753                      -- z16r
 754                      -- cycle;
 755         fi;
 756         if bot y17 < y6 - 0.7 linethickness:
 757                 fill get_subpath (ellipse, down, up, z17)
 758                      -- z18r
 759                      -- z18l
 760                      -- cycle;
 761         fi;
 762
 763         labels (11, 13, 15, 17);
 764         penlabels (12, 14, 16, 18);
 765 enddef;
 766
 767
 768 fet_beginchar ("petrucci c1 clef", "petrucci.c1");
 769         if test = 1:
 770                 draw_staff (-1, 3, 0.0);
 771         fi;
 772         draw_petrucci_c_clef ((0, 0), +2, 1.0);
 773 fet_endchar;
 774
 775
 776 fet_beginchar ("petrucci c1 clef", "petrucci.c1_change");
 777         draw_petrucci_c_clef ((0, 0), +2, .8);
 778 fet_endchar;
 779
 780
 781 fet_beginchar ("petrucci c2 clef", "petrucci.c2");
 782         if test = 1:
 783                 draw_staff (-1, 3, 0.0);
 784         fi;
 785         draw_petrucci_c_clef ((0, 0), +1, 1.0);
 786 fet_endchar;
 787
 788
 789 fet_beginchar ("petrucci c2 clef", "petrucci.c2_change");
 790         draw_petrucci_c_clef ((0, 0), +1, .8);
 791 fet_endchar;
 792
 793
 794 fet_beginchar ("petrucci c3 clef", "petrucci.c3");
 795         if test = 1:
 796                 draw_staff (-1, 3, 0.0);
 797         fi;
 798         draw_petrucci_c_clef ((0, 0), 0, 1.0);
 799 fet_endchar;
 800
 801
 802 fet_beginchar ("petrucci c3 clef", "petrucci.c3_change");
 803         draw_petrucci_c_clef ((0, 0), 0, .8);
 804 fet_endchar;
 805
 806
 807 fet_beginchar ("petrucci c4 clef", "petrucci.c4");
 808         if test = 1:
 809                 draw_staff (-1, 3, 0.0);
 810         fi;
 811         draw_petrucci_c_clef ((0, 0), -1, 1.0);
 812 fet_endchar;
 813
 814
 815 fet_beginchar ("petrucci c4 clef", "petrucci.c4_change");
 816         draw_petrucci_c_clef ((0, 0), -1, .8);
 817 fet_endchar;
 818
 819
 820 fet_beginchar ("petrucci c5 clef", "petrucci.c5");
 821         if test = 1:
 822                 draw_staff (-1, 3, 0.0);
 823         fi;
 824         draw_petrucci_c_clef ((0, 0), -2, 1.0);
 825 fet_endchar;
 826
 827
 828 fet_beginchar ("petrucci c5 clef", "petrucci.c5_change");
 829         draw_petrucci_c_clef ((0, 0), -2, .8);
 830 fet_endchar;
 831
 832
 833 def draw_mensural_c_clef (expr exact_center, reduction) =
 834         % inspired by Ockeghem, "Missa Prolationum", in: MGG, volume
 835         % 9, table 94.
 836
 837         save reduced_il;
 838
 839         reduced_il# = staff_space# * reduction;
 840
 841         define_pixels (reduced_il);
 842
 843         draw_triple_brevis (exact_center + (0, 0.5 staff_space#),
 844                             2 reduced_il#, 0.8 staff_space#,
 845                             0.8 linethickness#, staff_space);
 846
 847         save half_reduced_il;
 848
 849         half_reduced_il# = staff_space# * sqrt (reduction);
 850
 851         define_pixels (half_reduced_il);
 852
 853         set_char_box (0 - xpart exact_center,
 854                       2 reduced_il# + xpart exact_center,
 855                       2.2 half_reduced_il# + staff_space# -
 856                         2 ypart exact_center,
 857                       2.2 half_reduced_il# + 2 ypart exact_center);
 858
 859         save xoffs, yoffs;
 860
 861         xoffs# = xpart exact_center;
 862         yoffs# = ypart exact_center;
 863
 864         define_pixels (xoffs, yoffs);
 865
 866         save ellipse, T;
 867         path ellipse;
 868         transform T;
 869
 870         T := identity xscaled 1.4 linethickness
 871                       yscaled blot_diameter;
 872         pickup pencircle transformed T;
 873         ellipse := fullcircle transformed T;
 874
 875         lft x11 = lft x13 = xoffs;
 876         top y11 = yoffs + 2.2 half_reduced_il;
 877         bot y13 = yoffs - 2.2 half_reduced_il - staff_space;
 878         rt x15 = rt x17 = xoffs + brevis_width;
 879         y15 = yoffs + 1.4 half_reduced_il;
 880         y17 = yoffs - 1.4 half_reduced_il - staff_space;
 881
 882         z12 = z14 yscaled -1 shifted (0, -staff_space);
 883         z14 = z9;
 884         z16 = z18 yscaled -1 shifted (0, -staff_space);
 885         rt z18 = lft z14 shifted (brevis_width, 0);
 886
 887         penpos12 (1.4 linethickness, 0);
 888         penpos14 (1.4 linethickness, 0);
 889         penpos16 (1.4 linethickness, 0);
 890         penpos18 (1.4 linethickness, 0);
 891
 892         fill get_subpath (ellipse, up, down, z11)
 893              -- z12l
 894              -- z12r
 895              -- cycle;
 896         fill get_subpath (ellipse, down, up, z13)
 897              -- z14r
 898              -- z14l
 899              -- cycle;
 900         fill get_subpath (ellipse, up, down, z15)
 901              -- z16l
 902              -- z16r
 903              -- cycle;
 904         fill get_subpath (ellipse, down, up, z17)
 905              -- z18r
 906              -- z18l
 907              -- cycle;
 908
 909         labels (11, 13, 15, 17);
 910         penlabels (12, 14, 16, 18);
 911 enddef;
 912
 913
 914 fet_beginchar ("mensural c clef", "mensural.c");
 915         if test = 1:
 916                 draw_staff (-1, 3, 0.0);
 917         fi;
 918         draw_mensural_c_clef ((0, 0), 1.0);
 919 fet_endchar;
 920
 921
 922 fet_beginchar ("mensural c clef", "mensural.c_change");
 923         draw_mensural_c_clef ((0, 0), .8);
 924 fet_endchar;
 925
 926
 927 def draw_diamond (expr exact_center, reduction) =
 928         save stem_width, reduced_nht, holeheight, beamheight;
 929         save rh_height, rh_width;
 930
 931         stem_width# = 1.4 reduced_slt#;
 932         reduced_nht# = noteheight# * reduction;
 933         holeheight# = 3 reduced_slt#;
 934         beamheight# = 0.4 (reduced_nht# - holeheight#);
 935
 936         rh_height# = 1.2 staff_space# * reduction;
 937         rh_width# / rh_height# = tand (30);
 938
 939         define_pixels (beamheight, stem_width);
 940         define_pixels (rh_height, rh_width);
 941
 942         save xoffs, yoffs;
 943
 944         xoffs# = xpart exact_center;
 945         yoffs# = ypart exact_center;
 946
 947         define_pixels (xoffs, yoffs);
 948
 949         save ellipse, T;
 950         path ellipse;
 951         transform T;
 952
 953         T := identity xscaled beamheight
 954                       yscaled stem_width
 955                       rotated 45;
 956         pickup pencircle transformed T;
 957         ellipse := reverse fullcircle transformed T;
 958
 959         x21 := xoffs - rh_width / 2;
 960         y21 := yoffs;
 961         x22 := xoffs;
 962         y22 := yoffs + rh_height / 2;
 963         x23 := xoffs + rh_width / 2;
 964         y23 := yoffs;
 965         x24 := xoffs;
 966         y24 := yoffs - rh_height / 2;
 967
 968         fill get_subpath (ellipse, z21 - z24, z22 - z21, z21)
 969              -- get_subpath (ellipse, z22 - z21, z23 - z22, z22)
 970              -- get_subpath (ellipse, z23 - z22, z24 - z23, z23)
 971              -- get_subpath (ellipse, z24 - z23, z21 - z24, z24)
 972              -- cycle;
 973
 974         save l;
 975         path l[];
 976
 977         l2122 := (directionpoint (z21 - z22) of ellipse) shifted z21
 978                  -- (directionpoint (z21 - z22) of ellipse) shifted z22;
 979         l2223 := (directionpoint (z22 - z23) of ellipse) shifted z22
 980                  -- (directionpoint (z22 - z23) of ellipse) shifted z23;
 981         l2324 := (directionpoint (z23 - z24) of ellipse) shifted z23
 982                  -- (directionpoint (z23 - z24) of ellipse) shifted z24;
 983         l2421 := (directionpoint (z24 - z21) of ellipse) shifted z24
 984                  -- (directionpoint (z24 - z21) of ellipse) shifted z21;
 985
 986         unfill l2122 intersectionpoint l2223
 987                -- l2223 intersectionpoint l2324
 988                -- l2324 intersectionpoint l2421
 989                -- l2421 intersectionpoint l2122
 990                -- cycle;
 991
 992         labels (21, 22, 23, 24);
 993 enddef;
 994
 995
 996 def draw_petrucci_f_clef (expr exact_center, reduction) =
 997         % inspired by L'homme arme super voces musicales in Misse
 998         % Josquin, 1502, Petrucci, in: MGG, volume 7, col. 200; also
 999         % inspired by Gaspar van Weerbeke, "Virgo Maria" (1502), in:
1000         % MGG, volume 9, col. 653 ("Motette"), fig. 3.; also by Andr'e
1001         % Campra, "Entr'ee des s'er'enades" (1710), in: MGG, volume 2,
1002         % col. 1649 ("Contredanse"), fig. 2.
1003
1004         save interline, reduced_il, reduced_slt;
1005
1006         interline# = staff_space#;
1007         reduced_il# = staff_space# * reduction;
1008         reduced_slt# = linethickness# * reduction;
1009
1010         draw_brevis (exact_center, reduced_il#, reduced_il#, reduced_slt#);
1011         draw_diamond (exact_center +
1012                         (1.6 interline# * reduction, interline# / 2),
1013                      reduction);
1014         draw_diamond (exact_center +
1015                         (1.6 interline# * reduction, -interline# / 2),
1016                      reduction);
1017
1018         define_pixels (interline, reduced_il, reduced_slt);
1019
1020         save stem_width;
1021
1022         stem_width# = 1.4 reduced_slt#;
1023
1024         define_pixels (stem_width);
1025
1026         save xoffs, yoffs;
1027
1028         xoffs# = xpart exact_center;
1029         yoffs# = ypart exact_center;
1030
1031         define_pixels (xoffs, yoffs);
1032
1033         % brevis stem
1034         save ellipse, T;
1035         path ellipse;
1036         transform T;
1037
1038         T := identity xscaled stem_width
1039                       yscaled blot_diameter;
1040         pickup pencircle transformed T;
1041         ellipse := fullcircle transformed T;
1042
1043         rt x8 = xoffs + reduced_il;
1044         y8 = y3;
1045         rt z9 = (xoffs + reduced_il, yoffs - 4 reduced_il);
1046
1047         penpos8 (stem_width, 0);
1048
1049         fill get_subpath (ellipse, down, up, z9)
1050              -- z8r
1051              -- z8l
1052              -- cycle;
1053
1054         % upper diamond's stem
1055         z10 = (xoffs + 1.6 interline * reduction + stem_width / 2,
1056                yoffs + interline * reduction);
1057         top z11 = z10 + (0, 1.5 interline * reduction);
1058
1059         penpos10 (stem_width, 0);
1060
1061         fill get_subpath (ellipse, up, down, z11)
1062              -- z10l
1063              -- z10r
1064              -- cycle;
1065
1066         % lower diamond's stem
1067         z12 = (xoffs + 1.6 interline * reduction - stem_width / 2,
1068                yoffs - interline * reduction);
1069         bot z13 = z12 + (0, -3.5 interline * reduction);
1070
1071         penpos12 (stem_width, 0);
1072
1073         fill get_subpath (ellipse, down, up, z13)
1074              -- z12r
1075              -- z12l
1076              -- cycle;
1077
1078         save reduced_il, rh_height, rh_width;
1079
1080         reduced_il# = staff_space# * reduction;
1081         rh_height# = 1.2 reduced_il#;
1082         rh_width# / rh_height# = tand (30);
1083
1084         set_char_box (0 - xpart exact_center,
1085                       1.6 interline# * reduction + 0.5 rh_width# +
1086                         xpart exact_center,
1087                       4.5 interline# * reduction - ypart exact_center,
1088                       2.5 interline# * reduction + ypart exact_center);
1089
1090         labels (9, 11, 13);
1091         penlabels (8, 10, 12);
1092 enddef;
1093
1094
1095 fet_beginchar ("petrucci f clef", "petrucci.f");
1096         if test = 1:
1097                 draw_staff (-1, 3, 0.0);
1098         fi;
1099         draw_petrucci_f_clef ((0, 0), 1.0);
1100 fet_endchar;
1101
1102
1103 fet_beginchar ("petrucci f clef", "petrucci.f_change");
1104         draw_petrucci_f_clef ((0, 0), .8);
1105 fet_endchar;
1106
1107
1108 def draw_mensural_f_clef (expr exact_center, reduction) =
1109         % inspired by Philippe le Duc, "Dite Signori" (1590), in: MGG,
1110         % volume 3, col. 848 ("Duc"); also by John Dowland, "The First
1111         % Booke of Songes" (1597), in: MGG, volume 3, col. 721
1112         % ("Dowland"), fig. 3.
1113
1114         save width, reduced_slt, stem_width, dot_diameter;
1115
1116         width# = 1.2 staff_space# * reduction;
1117         reduced_slt# = linethickness# * reduction;
1118         stem_width# = 1.4 reduced_slt#;
1119         dot_diameter# = 0.1 reduction * staff_space#;
1120
1121         define_pixels (width, stem_width, staff_space, dot_diameter);
1122
1123         save xoffs, yoffs;
1124
1125         xoffs# = xpart exact_center;
1126         yoffs# = ypart exact_center;
1127
1128         define_pixels (xoffs, yoffs);
1129
1130         save ellipse, T;
1131         path ellipse;
1132         transform T;
1133
1134         T := identity xscaled 0.2 width
1135                       yscaled stem_width
1136                       rotated 45;
1137         pickup pencircle transformed T;
1138         ellipse := fullcircle transformed T;
1139
1140         % half circle
1141         lft z10 = (0, 0);
1142
1143         save pat;
1144         path pat;
1145
1146         pat := halfcircle scaled width
1147                           rotated -90
1148                           shifted (z10 - (xoffs, yoffs));
1149
1150         z5 = point 0 of pat;
1151         z6 = point 1 of pat;
1152         z7 = point 2 of pat;
1153         z8 = point 3 of pat;
1154         z9 = point 4 of pat;
1155
1156         save dirs;
1157         pair dirs[];
1158
1159         dirs5 := direction 0 of pat;
1160         dirs6 := direction 1 of pat;
1161         dirs7 := direction 2 of pat;
1162         dirs8 := direction 3 of pat;
1163         dirs9 := direction 4 of pat;
1164
1165         % we approximate `draw pat'
1166         fill get_subpath (ellipse, -dirs5, dirs5, z5)
1167              .. get_subpoint (ellipse, dirs6, z6)
1168              .. get_subpoint (ellipse, dirs7, z7)
1169              .. get_subpoint (ellipse, dirs8, z8)
1170              .. get_subpath (ellipse, dirs9, -dirs9, z9)
1171              .. get_subpoint (ellipse, -dirs8, z8)
1172              .. get_subpoint (ellipse, -dirs7, z7)
1173              .. get_subpoint (ellipse, -dirs6, z6)
1174              .. cycle;
1175
1176         % upper dot
1177         rt x2 = xoffs + width;
1178         top y1 = yoffs + 0.5 width;
1179         z2 - z1 = (dot_diameter, -dot_diameter);
1180
1181         fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
1182              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
1183              -- cycle;
1184
1185         % lower dot
1186         x3 = x1;
1187         top y1 - bot y4 = width;
1188         z4 - z3 = (dot_diameter, -dot_diameter);
1189
1190         fill get_subpath (ellipse, z3 - z4, z4 - z3, z3)
1191              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
1192              -- cycle;
1193
1194         set_char_box (0 - xpart exact_center,
1195                       width# + xpart exact_center,
1196                       0.5 width# - ypart exact_center,
1197                       0.5 width# + ypart exact_center);
1198
1199         labels (1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
1200 enddef;
1201
1202
1203 fet_beginchar ("mensural f clef", "mensural.f");
1204         if test = 1:
1205                 draw_staff (-1, 3, 0.0);
1206         fi;
1207         draw_mensural_f_clef ((0, 0), 1.0);
1208 fet_endchar;
1209
1210
1211 fet_beginchar ("mensural f clef", "mensural.f_change");
1212         draw_mensural_f_clef ((0, 0), .8);
1213 fet_endchar;
1214
1215
1216 def draw_petrucci_g_clef (expr exact_center, reduction) =
1217         % inspired by Josquin Desprez, "Stabat Mater", Libro tertio,
1218         % 1519, printed by Petrucci, in: MGG, volume 7, Table 11.
1219
1220         save reduced_il, reduced_slt;
1221
1222         reduced_il# = staff_space# * reduction;
1223         reduced_slt# = linethickness# * reduction;
1224         define_pixels (reduced_il, reduced_slt);
1225
1226         set_char_box (0 - xpart exact_center,
1227                       1.25 reduced_il# + xpart exact_center,
1228                       0.65 reduced_il# - ypart exact_center,
1229                       3.80 reduced_il# + ypart exact_center);
1230
1231         save xoffs, yoffs;
1232
1233         xoffs# = xpart exact_center;
1234         yoffs# = ypart exact_center;
1235
1236         define_pixels (xoffs, yoffs);
1237
1238         save ellipse, paths, sub_path, outlines, sub_outlines, T;
1239         path ellipse, paths[], sub_path, outlines[], sub_outlines[];
1240         transform T;
1241
1242         T := identity xscaled 0.5 reduced_slt
1243                       yscaled 0.22 reduced_il
1244                       rotated -35;
1245         pickup pencircle transformed T;
1246         ellipse := fullcircle transformed T;
1247
1248         lft z1 = (xoffs + 0.80 reduced_il, yoffs + 0.00 reduced_il);
1249         lft z2 = (xoffs + 1.00 reduced_il, yoffs + 1.20 reduced_il);
1250         lft z3 = (xoffs + 0.70 reduced_il, yoffs + 2.00 reduced_il);
1251         lft z4 = (xoffs + 0.30 reduced_il, yoffs + 3.00 reduced_il);
1252         lft z5 = (xoffs + 0.80 reduced_il, yoffs + 3.70 reduced_il);
1253         lft z6 = (xoffs + 1.00 reduced_il, yoffs + 3.00 reduced_il);
1254         lft z7 = (xoffs + 0.60 reduced_il, yoffs + 2.00 reduced_il);
1255         lft z8 = (xoffs + 0.30 reduced_il, yoffs + 1.70 reduced_il);
1256         lft z9 = (xoffs + 0.00 reduced_il, yoffs + 0.75 reduced_il);
1257         lft z10 = (xoffs + 0.20 reduced_il, yoffs + 0.60 reduced_il);
1258
1259         paths1 := z1{-1, 2}
1260                   .. z2
1261                   .. z3
1262                   .. z4
1263                   .. z5
1264                   .. z6
1265                   .. z7
1266                   .. z8
1267                   .. z9
1268                   .. z10;
1269
1270         save dirs, s;
1271         pair dirs[];
1272
1273         s := 1/4;
1274
1275         % we approximate `draw paths1'
1276         for i = 1 step s until (length paths1 + 1):
1277                 dirs[i] := direction (i - 1) of paths1;
1278         endfor;
1279
1280         outlines1 := get_subpath (ellipse, -dirs1, dirs1, z1)
1281                      for i = (1 + s) step s until (length paths1 + 1 - s):
1282                              .. get_subpoint (ellipse, dirs[i],
1283                                               point (i - 1) of paths1)
1284                      endfor
1285                      .. get_subpath (ellipse, dirs10, -dirs10, z10)
1286                      for i = (length paths1 + 1 - s) step -s until (1 + s):
1287                              .. get_subpoint (ellipse, -dirs[i],
1288                                               point (i - 1) of paths1)
1289                      endfor
1290                      .. cycle;
1291
1292         save len;
1293
1294         len := length outlines1;
1295
1296         sub_outlines1 := subpath (0,
1297                                   floor (1/4 len)) of outlines1;
1298         sub_outlines2 := subpath (floor (1/4 len),
1299                                   floor (2/4 len)) of outlines1;
1300         sub_outlines3 := subpath (floor (2/4 len),
1301                                   floor (3/4 len)) of outlines1;
1302         sub_outlines4 := subpath (floor (3/4 len),
1303                                   len) of outlines1;
1304
1305         save times;
1306         numeric times[];
1307
1308         (times12, times21) = sub_outlines1 intersectiontimes sub_outlines2;
1309         (times13, times31) = sub_outlines1 intersectiontimes sub_outlines3;
1310         (times42, times24) = sub_outlines4 intersectiontimes sub_outlines2;
1311         (times43, times34) = sub_outlines4 intersectiontimes sub_outlines3;
1312
1313         T := identity xscaled 0.75 reduced_slt
1314                       yscaled 0.33 reduced_il
1315                       rotated -35;
1316         pickup pencircle transformed T;
1317         ellipse := fullcircle transformed T;
1318
1319         lft z21 = (xoffs + 1.05 reduced_il, yoffs + 0.45 reduced_il);
1320         lft z22 = (xoffs + 0.55 reduced_il, yoffs + 0.45 reduced_il);
1321         lft z23 = (xoffs + 0.55 reduced_il, yoffs - 0.45 reduced_il);
1322         lft z24 = (xoffs + 1.05 reduced_il, yoffs - 0.45 reduced_il);
1323         lft z25 = (xoffs + 1.10 reduced_il, yoffs + 0.00 reduced_il);
1324         lft z26 = (xoffs + 0.80 reduced_il, yoffs + 0.00 reduced_il);
1325
1326         paths2 := z21
1327                   .. z22
1328                   .. z23
1329                   .. z24
1330                   .. {up}z25
1331                   -- z26;
1332
1333         sub_path := subpath (0, 1) of paths2;
1334
1335         times1 = xpart (sub_outlines1 intersectiontimes sub_path);
1336         times4 = xpart (sub_outlines4 intersectiontimes sub_path);
1337
1338         % we have to find the envelope intersections (if any)
1339         save t;
1340         numeric t[];
1341
1342         t1 = find_envelope_cusp (reverse ellipse,
1343                                  subpath (1, 2) of paths2,
1344                                  1/256) + 1;
1345         if t1 < 1:
1346                 t1 := 1;
1347                 t2 := 1;
1348         else:
1349                 t2 = find_envelope_cusp (ellipse,
1350                                          subpath (3, 4) of reverse paths2,
1351                                          1/256) + 3;
1352                 t2 := length paths2 - t2;
1353         fi;
1354
1355         t3 = find_envelope_cusp (reverse ellipse,
1356                                  subpath (2, 4 - epsilon) of paths2,
1357                                  1/256) + 2;
1358         if t3 < 2:
1359                 t3 := 3;
1360                 t4 := 3;
1361         else:
1362                 t4 = find_envelope_cusp (ellipse,
1363                                          subpath (1 + epsilon, 3)
1364                                            of reverse paths2,
1365                                          1/256) + 1;
1366                 t4 := length paths2 - t4;
1367         fi;
1368
1369         fill subpath (times1 + s / 4, times13) of sub_outlines1
1370              -- subpath (times31, infinity) of sub_outlines3
1371              & subpath (0, times42) of sub_outlines4
1372              -- subpath (times24, infinity) of sub_outlines2
1373              & subpath (0, times34) of sub_outlines3
1374              -- subpath (times43, times4 - s / 4) of sub_outlines4
1375              -- cycle;
1376         unfill subpath (times12, infinity) of sub_outlines1
1377                & subpath (0, times21) of sub_outlines2
1378                -- cycle;
1379         fill subpath (times4 + s / 4, infinity) of sub_outlines4
1380              & subpath (0, times1 - s / 4) of sub_outlines1
1381              -- cycle;
1382
1383
1384         % we approximate `draw paths2'
1385         for i = 1 step s until (length paths2 - s):
1386                 dirs[i + 20] := direction (i - 1) of paths2;
1387         endfor;
1388
1389         sub_outlines21 := get_subpath (ellipse, -dirs21, dirs21, z21)
1390                           for i = (1 + s) step s until (length paths2 - s):
1391                                   .. get_subpoint (ellipse, dirs[i + 20],
1392                                                    point (i - 1) of paths2)
1393                           endfor
1394                           .. get_subpath (ellipse, up, z26 - z25, z25);
1395         sub_outlines22 := get_subpath (ellipse, z26 - z25, z25 - z26, z26)
1396                           -- get_subpoint (ellipse, z25 - z26, z25);
1397         sub_outlines23 := get_subpoint (ellipse, down, z25)
1398                           for i = (length paths2 - s) step -s until (t4 + 1):
1399                                   .. get_subpoint (ellipse, -dirs[i + 20],
1400                                                    point (i - 1) of paths2)
1401                           endfor
1402                           .. get_subpoint (ellipse, -direction t4 of paths2,
1403                                            point t4 of paths2);
1404         sub_outlines24 := get_subpoint (ellipse, -direction t3 of paths2,
1405                                         point t3 of paths2)
1406                           for i = (floor (t3 / s) * s + 1) step -s until (t2 + 1):
1407                                   .. get_subpoint (ellipse, -dirs[i + 20],
1408                                                    point (i - 1) of paths2)
1409                           endfor
1410                           .. get_subpoint (ellipse, -direction t2 of paths2,
1411                                            point t2 of paths2);
1412         sub_outlines25 := get_subpoint (ellipse, -direction t1 of paths2,
1413                                         point t1 of paths2)
1414                           for i = (floor (t1 / s) * s + 1) step -s until (1 + s):
1415                                   .. get_subpoint (ellipse, -dirs[i + 20],
1416                                                    point (i - 1) of paths2)
1417                           endfor;
1418
1419         (times2223, times2322) = sub_outlines22 intersectiontimes sub_outlines23;
1420         (times2324, times2423) = sub_outlines23 intersectiontimes sub_outlines24;
1421         (times2425, times2524) = sub_outlines24 intersectiontimes sub_outlines25;
1422
1423         fill sub_outlines21
1424              -- subpath (0, times2223) of sub_outlines22
1425              -- subpath (times2322, times2324) of sub_outlines23
1426              -- subpath (times2423, times2425) of sub_outlines24
1427              -- subpath (times2524, infinity) of sub_outlines25
1428              .. cycle;
1429
1430         labels (1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
1431         labels (21, 22, 23, 24, 25, 26);
1432 enddef;
1433
1434
1435 fet_beginchar ("petrucci g clef", "petrucci.g");
1436         if test = 1:
1437                 draw_staff (-1, 3, 0.0);
1438         fi;
1439         draw_petrucci_g_clef ((0, 0), 1.0);
1440 fet_endchar;
1441
1442
1443 fet_beginchar ("petrucci g clef", "petrucci.g_change");
1444         draw_petrucci_g_clef ((0, 0), .8);
1445 fet_endchar;
1446
1447
1448 def draw_mensural_g_clef (expr exact_center, reduction) =
1449   % TODO: Rewrite me.  The former mensural g clef looked ugly, and the
1450   % code was removed when it broke for small font sizes after some
1451   % global changes in the font.  Currently, the character is mapped to
1452   % a copy of the petrucci g clef (which, after all, *is* a mensural g
1453   % clef, but not the one that we have in mind here). -- jr
1454   %
1455   % Possible sources of inspiration for this clef include: Francisco
1456   % Guerrero, "Lib. 1.  Missarum" (1566), in: MGG, volume 3, col. 858
1457   % ("Ducis"); Stefano Fabri, "Quam speciosa veteranis" (1611), in:
1458   % MGG, volume 3, col. 1698 ("Fabri"); Philippus Dulichius,
1459   % "Fasciculus novus ..."  (1598), in: MGG, volume 3, col. 919
1460   % ("Dulichius"), fig. 1; Noe Faignient, "Ic sal de Heer myn God
1461   % gebenedye" (1568), in: MGG, volume 3, col. 1735 ("Faignient").
1462 enddef;
1463
1464
1465 %
1466 % FIXME: This clef is preliminarily mapped to the petrucci g clef
1467 % until the code for the mensural g clef will be rewritten.
1468 %
1469 fet_beginchar ("mensural g clef", "mensural.g");
1470         if test = 1:
1471                 draw_staff (-1, 3, 0.0);
1472         fi;
1473         draw_petrucci_g_clef ((0, 0), 1.0);
1474 fet_endchar;
1475
1476
1477 fet_beginchar ("mensural g clef", "mensural.g_change");
1478         draw_petrucci_g_clef ((0, 0), .8);
1479 fet_endchar;
1480
1481
1482
1483 %%%%%%%%
1484 %
1485 %
1486 %
1487 % Hufnagel
1488 %
1489 %
1490 %
1491 def draw_hufnagel_do_clef (expr exact_center, reduction) =
1492         % inspired by Graduale of Friedrich Zollner (1442), in: MGG,
1493         % volume 9, col. 1413 ("Neustift"), fig. 1.
1494
1495         save reduced_il;
1496
1497         reduced_il# = staff_space# * reduction;
1498
1499         define_pixels (reduced_il);
1500
1501         set_char_box (0 - xpart exact_center,
1502                       1.10 reduced_il# + xpart exact_center,
1503                       0.70 reduced_il# - ypart exact_center,
1504                       0.75 reduced_il# + ypart exact_center);
1505
1506         save xoffs, yoffs;
1507
1508         xoffs# = xpart exact_center;
1509         yoffs# = ypart exact_center;
1510
1511         define_pixels (xoffs, yoffs);
1512
1513         save ellipse, pat, T;
1514         path ellipse, pat;
1515         transform T;
1516
1517         T := identity xscaled 0.6 reduced_il
1518                       yscaled 0.1 reduced_il
1519                       rotated 40;
1520         pickup pencircle transformed T;
1521         ellipse := fullcircle transformed T;
1522
1523         z1 = (xoffs + 0.90 reduced_il, yoffs + .45 reduced_il);
1524         z2 = (xoffs + 0.80 reduced_il, yoffs + .45 reduced_il);
1525         z3 = (xoffs + 0.50 reduced_il, yoffs + .60 reduced_il);
1526         z4 = (xoffs + 0.20 reduced_il, yoffs + .45 reduced_il);
1527         z5 = (xoffs + 0.20 reduced_il, yoffs - .45 reduced_il);
1528         z6 = (xoffs + 0.40 reduced_il, yoffs - .55 reduced_il);
1529
1530         pat := z1
1531                .. z2
1532                .. z3
1533                -- z4
1534                -- z5
1535                -- z6;
1536
1537         fill get_subpath (ellipse,
1538                           -direction 0 of pat, direction 0 of pat, z1)
1539              .. get_subpoint (ellipse, direction 1 of pat, z2)
1540              .. get_subpath (ellipse,
1541                              direction (2 - epsilon) of pat, z4 - z3, z3)
1542              -- get_subpath (ellipse,
1543                              z4 - z3, z5 - z4, z4)
1544              -- get_subpath (ellipse,
1545                              z5 - z4, z6 - z5, z5)
1546              -- get_subpath (ellipse,
1547                              z6 - z5, z5 - z6, z6)
1548              -- get_subpoint (ellipse, z5 - z6, z5)
1549              -- get_subpoint (ellipse, z4 - z5, z5)
1550              -- get_subpoint (ellipse, z4 - z5, z4)
1551              -- get_subpoint (ellipse, -direction (2 - epsilon) of pat, z3)
1552              .. get_subpath (ellipse,
1553                              -direction 1 of pat, -direction 1 of pat, z2)
1554              .. cycle;
1555
1556         labels (1, 2, 3, 4, 5, 6);
1557 enddef;
1558
1559
1560 fet_beginchar ("Hufnagel do clef", "hufnagel.do");
1561         if test = 1:
1562                 draw_staff (-1, 3, 0.0);
1563         fi;
1564         draw_hufnagel_do_clef ((0, 0), 1.0);
1565 fet_endchar;
1566
1567
1568 fet_beginchar ("Hufnagel do clef", "hufnagel.do_change");
1569         draw_hufnagel_do_clef ((0, 0), .8);
1570 fet_endchar;
1571
1572
1573 def draw_hufnagel_fa_clef (expr exact_center, reduction) =
1574         % inspired by Bamberger Manuscript (15th century), in:
1575         % MGG, volume 2, table 59.
1576
1577         save reduced_il;
1578
1579         reduced_il# = staff_space# * reduction;
1580
1581         define_pixels (reduced_il);
1582
1583         set_char_box (0 - xpart exact_center,
1584                       1.20 reduced_il# + xpart exact_center,
1585                       1.15 reduced_il# - ypart exact_center,
1586                       1.00 reduced_il# + ypart exact_center);
1587
1588         save xoffs, yoffs;
1589
1590         xoffs# = xpart exact_center;
1591         yoffs# = ypart exact_center;
1592
1593         define_pixels (xoffs, yoffs);
1594
1595         save ellipse, pat, T;
1596         path ellipse, pat;
1597         transform T;
1598
1599         T := identity xscaled 0.6 reduced_il
1600                       yscaled 0.1 reduced_il
1601                       rotated 40;
1602         pickup pencircle transformed T;
1603         ellipse := fullcircle transformed T;
1604
1605         z11 = (xoffs + 0.90 reduced_il, yoffs + 0.70 reduced_il);
1606         z12 = (xoffs + 0.80 reduced_il, yoffs + 0.70 reduced_il);
1607         z13 = (xoffs + 0.50 reduced_il, yoffs + 0.85 reduced_il);
1608         z14 = (xoffs + 0.20 reduced_il, yoffs + 0.70 reduced_il);
1609         z15 = (xoffs + 0.20 reduced_il, yoffs - 1.10 reduced_il);
1610
1611         pat := z11
1612                .. z12
1613                .. z13
1614                -- z14
1615                -- z15;
1616
1617         fill get_subpath (ellipse,
1618                           -direction 0 of pat, direction 0 of pat, z11)
1619              .. get_subpoint (ellipse, direction 1 of pat, z12)
1620              .. get_subpath (ellipse,
1621                              direction (2 - epsilon) of pat, z14 - z13, z13)
1622              -- get_subpath (ellipse,
1623                              z14 - z13, z15 - z14, z14)
1624              -- get_subpath (ellipse,
1625                              z15 - z14, z14 - z15, z15)
1626              -- get_subpoint (ellipse, z14 - z15, z14)
1627              -- get_subpoint (ellipse, -direction (2 - epsilon) of pat, z13)
1628              .. get_subpath (ellipse,
1629                              -direction 1 of pat, -direction 1 of pat, z12)
1630              .. cycle;
1631
1632         z16 = (xoffs + 0.90 reduced_il, yoffs - 0.05 reduced_il);
1633         z17 = (xoffs + 0.80 reduced_il, yoffs - 0.05 reduced_il);
1634         z18 = (xoffs + 0.50 reduced_il, yoffs + 0.10 reduced_il);
1635         z19 = (xoffs + 0.20 reduced_il, yoffs - 0.05 reduced_il);
1636
1637         pat := z16
1638                .. z17
1639                .. z18
1640                -- z19;
1641
1642         fill get_subpath (ellipse,
1643                           -direction 0 of pat, direction 0 of pat, z16)
1644              .. get_subpoint (ellipse, direction 1 of pat, z17)
1645              .. get_subpath (ellipse,
1646                              direction (2 - epsilon) of pat, z19 - z18, z18)
1647              -- get_subpoint (ellipse, z19 - z18, z19)
1648              -- get_subpoint (ellipse, -direction (2 - epsilon) of pat, z18)
1649              .. get_subpoint (ellipse, -direction 1 of pat, z17)
1650              .. cycle;
1651
1652         labels (11, 12, 13, 14, 15, 16, 17, 18, 19);
1653 enddef;
1654
1655
1656 fet_beginchar ("Hufnagel fa clef", "hufnagel.fa");
1657         if test = 1:
1658                 draw_staff (-1, 3, 0.0);
1659         fi;
1660         draw_hufnagel_fa_clef ((0, 0), 1.0);
1661 fet_endchar;
1662
1663
1664 fet_beginchar ("Hufnagel fa clef", "hufnagel.fa_change");
1665         draw_hufnagel_fa_clef ((0, 0), .8);
1666 fet_endchar;
1667
1668
1669 def draw_hufnagel_do_fa_clef (expr exact_center, reduction) =
1670         draw_hufnagel_do_clef (exact_center, reduction);
1671         draw_hufnagel_fa_clef (exact_center + (0, -2 staff_space#), reduction);
1672
1673         set_char_box (0 - xpart exact_center,
1674                       1.20 reduced_il# + xpart exact_center,
1675                       1.15 reduced_il# + 2 staff_space# - ypart exact_center,
1676                       0.75 reduced_il# + ypart exact_center);
1677 enddef;
1678
1679
1680 fet_beginchar ("Hufnagel do/fa clef", "hufnagel.do.fa");
1681         if test = 1:
1682                 draw_staff (-1, 3, 0.0);
1683         fi;
1684         draw_hufnagel_do_fa_clef ((0, 0), 1.0);
1685 fet_endchar;
1686
1687
1688 fet_beginchar ("Hufnagel do/fa clef", "hufnagel.do.fa_change");
1689         draw_hufnagel_do_fa_clef ((0, 0), .8);
1690 fet_endchar;
1691
1692
1693 fet_endgroup ("clefs");