mf/parmesan-noteheads.mf

   1 % Feta (not the Font-En-Tja) music font --  ancient note heads
   2 % This file is part of LilyPond, the GNU music typesetter.
   3 %
   4 % Copyright (C) 2001--2011 Juergen Reuter <reuter@ipd.uka.de>
   5 %
   6 % Neo-mensural heads originally by
   7 % Christian Mondrup and Mats Bengtsson
   8 %
   9 %
  10 % LilyPond is free software: you can redistribute it and/or modify
  11 % it under the terms of the GNU General Public License as published by
  12 % the Free Software Foundation, either version 3 of the License, or
  13 % (at your option) any later version.
  14 %
  15 % LilyPond is distributed in the hope that it will be useful,
  16 % but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 % GNU General Public License for more details.
  19 %
  20 % You should have received a copy of the GNU General Public License
  21 % along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 save black_notehead_width;
  24 numeric black_notehead_width;
  25
  26 fet_begingroup ("noteheads");
  27
  28 %
  29 % character aligment:
  30 %
  31 %   The head is assumed to be vertically centered around (0, 0).
  32 %   The left-most edge of the head should touch the vertical line
  33 %   that goes though the point (0, 0).
  34 %
  35 % set_char_box() conventions:
  36 %
  37 % * breapth: Ignored (as far as I know).  Should be set to 0.
  38 %
  39 % * width: Should match the head's width.
  40 %
  41 % * depth: Should match the bottom edge of the head.  Affects vertical
  42 %   collision handling.
  43 %
  44 % * height: Should match the top edge of the head.  Affects vertical
  45 %   collision handling.
  46 %
  47 % TODO: should depth/height include appendages/stems?
  48
  49 overdone_heads = 0;
  50 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
  51 define_pixels (noteheight);
  52
  53
  54 %%%%%%%%
  55 %
  56 %
  57 %
  58 % MENSURAL NOTATION
  59 %
  60 %
  61 %
  62
  63 def draw_neomensural_brevis (expr brevwid, open, full) =
  64         save beamheight, head_width;
  65         save holeheight, stem_width;
  66         save serif_size, serif_protrude;
  67
  68         head_width# = brevwid;
  69         holeheight = 3 stafflinethickness;
  70         stem_width = 1.4 stafflinethickness;
  71
  72         define_pixels (head_width);
  73
  74         set_char_box (0, head_width#,
  75                       noteheight# / 2, noteheight# / 2);
  76
  77         2 beamheight + holeheight = noteheight;
  78         serif_size = (holeheight - stafflinethickness) / 2;
  79         serif_protrude = 1.5 serif_size;
  80
  81         z1l = (0, 0);
  82         z2l = (0, -stafflinethickness / 2);
  83         z3r = z2r + serif_size * (1, -1);
  84         y4r = y3r;
  85         x4r = head_width / 2;
  86         z5l = z3l + (-serif_size, -serif_protrude);
  87
  88         penpos1 (stem_width, 0);
  89         penpos2 (stem_width, 0);
  90         penpos3 (beamheight, 90);
  91         penpos4 (beamheight, 90);
  92         penpos5 (stem_width, 180);
  93
  94         save pat_out;
  95         path pat_out;
  96
  97         pat_out := z4l
  98                    -- z3l{left}
  99                    .. z5l{down}
 100                    .. z5r{up}
 101                    -- z1l;
 102         pat_out := pat_out
 103                    -- reverse pat_out yscaled -1;
 104         pat_out := pat_out
 105                    -- reverse pat_out shifted (-x4r, 0)
 106                                       xscaled -1
 107                                       shifted (x4l, 0)
 108                    -- cycle;
 109         fill pat_out;
 110
 111         if open:
 112                 save pat_in;
 113                 path pat_in;
 114
 115                 pat_in := z4r
 116                           -- z3r{left}
 117                           .. z2r{up}
 118                           -- z1r;
 119                 pat_in := pat_in
 120                           -- reverse pat_in yscaled -1;
 121                 if full:
 122                         pat_in := pat_in
 123                                   -- reverse pat_in shifted (-x4r, 0)
 124                                                     xscaled -1
 125                                                     shifted (x4l, 0);
 126                 fi;
 127                 pat_in := pat_in
 128                           -- cycle;
 129                 unfill pat_in;
 130         fi;
 131
 132         penlabels (1, 2, 3, 4, 5);
 133 enddef;
 134
 135
 136 %%% This head does not seem to be used anywhere.  Junk me?  -- jr
 137 def draw_neomensural_left_stemmed_head (expr wid) =
 138         draw_neomensural_brevis (wid, true, true);
 139
 140         x6 = x7 = stem_width / 2;
 141         y6 = y5;
 142         y7 = y5 - 2.25 staff_space;
 143
 144         z17 = (x7, y7 - stem_width / 2);
 145
 146         penpos6 (stem_width, 0);
 147         penpos7 (stem_width, 0);
 148
 149         fill z7l
 150              -- z6l
 151              -- z6r
 152              -- z7r
 153              .. z17
 154              .. cycle;
 155
 156         penlabels (6, 7);
 157         labels (17);
 158 enddef;
 159
 160
 161 %%% This head does not seem to be used anywhere.  Junk me?  -- jr
 162 fet_beginchar ("Left stemmed notehead", "slneomensural");
 163         draw_neomensural_left_stemmed_head (2 staff_space#);
 164 fet_endchar;
 165
 166
 167 %
 168 % Some sources (eg. Musix/OpusTeX) think that the appendage should be on
 169 % the left, some say right.  Right wins democratically.
 170 %
 171 def draw_neomensural_longa (expr wid) =
 172         draw_neomensural_brevis (wid, true, true);
 173
 174         save theta;
 175
 176         x7r = head_width;
 177         y7 = y5;
 178         z6 - z7 = (stem_width / 2, -staff_space);
 179         theta = angle (z6 - z7) + 90;
 180
 181         penpos7 (stem_width, 0);
 182         penpos6 (1.2 stem_width, theta);
 183
 184         z7' = find_tangent (z6l, pat_out,
 185                             (x7l + 0.5 stem_width, y7l),
 186                             (x7l - 0.5 stem_width, y7l));
 187
 188         fill z7r
 189              .. z6r{z6 - z7}
 190              .. {z7 - z6}z6l
 191              -- z7'
 192              -- cycle;
 193
 194         penlabels (6, 7);
 195         labels (7');
 196 enddef;
 197
 198
 199 %
 200 % En wij presenteren U: de opvolgster van Emily
 201 %
 202 % (ze is wel breed)
 203 %
 204 fet_beginchar ("Neo-mensural maxima notehead", "sM3neomensural");
 205         draw_neomensural_longa (2.6 staff_space#);
 206 fet_endchar;
 207
 208
 209 fet_beginchar ("Neo-mensural longa notehead", "sM2neomensural");
 210         draw_neomensural_longa (2 staff_space#);
 211 fet_endchar;
 212
 213
 214 fet_beginchar ("Neo-mensural brevis notehead", "sM1neomensural");
 215         draw_neomensural_brevis (2 staff_space#, true, true);
 216 fet_endchar;
 217
 218
 219 def draw_neomensural_black_head (expr wid, height) =
 220         save head_width;
 221         save ne, nw, ne_dist, nw_dist;
 222         pair ne, nw, ne_dist, nw_dist;
 223
 224         head_width# = wid;
 225
 226         set_char_box (0, head_width#,
 227                       height / 2, height / 2);
 228
 229         charwx := head_width# / 2;
 230         charwy := height / 2;
 231
 232         y3 = y1 = 0;
 233         x2 = x4 = (x1 + x3) / 2;
 234
 235         pickup pencircle scaled blot_diameter;
 236
 237         top y2 = h;
 238         bot y4 = -d;
 239         lft x1 = 0;
 240         rt x3 = w;
 241
 242         ne := unitvector (z2 - z1);
 243         nw_dist := (ne rotated 90) * 0.5 blot_diameter;
 244         nw := unitvector (z2 - z3);
 245         ne_dist := (nw rotated -90) * 0.5 blot_diameter;
 246
 247         fill lft z1{up}
 248              .. (z1 + nw_dist){ne}
 249              -- (z2 + nw_dist){ne}
 250              .. top z2{right}
 251              .. (z2 + ne_dist){-nw}
 252              -- (z3 + ne_dist){-nw}
 253              .. rt z3{down}
 254              .. (z3 - nw_dist){-ne}
 255              -- (z4 - nw_dist){-ne}
 256              .. bot z4{left}
 257              .. (z4 - ne_dist){nw}
 258              -- (z1 - ne_dist){nw}
 259              .. cycle;
 260
 261         labels (1, 2, 3, 4);
 262 enddef;
 263
 264
 265 def draw_neomensural_open_head (expr wid, height)=
 266         draw_neomensural_black_head (wid, height);
 267
 268         save diamNW, diamSW;
 269
 270         diamNW = length (z2 - z1) + blot_diameter;
 271         diamSW = length (z4 - z1) + blot_diameter;
 272
 273         save hole_widthNW, hole_widthSW;
 274
 275         hole_widthNW = 0.34 diamNW ;
 276         hole_widthSW + 2.6 linethickness = diamSW;
 277
 278         (z7 + z5) / 2 = (w / 2, 0);
 279         (z8 + z6) / 2 = (w / 2, 0);
 280         z6 - z5 = hole_widthNW * unitvector (z2 - z1);
 281         z7 - z6 = hole_widthSW * unitvector (z4 - z1);
 282
 283         unfill z5
 284                -- z6
 285                -- z7
 286                -- z8
 287                -- cycle;
 288
 289         labels (5, 6, 7, 8);
 290 enddef;
 291
 292
 293 %
 294 % WL says the thin lines should be thinner.
 295 %
 296 fet_beginchar ("Harmonic notehead (Neo-mensural open)", "s0harmonic");
 297         draw_neomensural_open_head (1.3 staff_space#, 1.3 noteheight#);
 298         charwx := head_width#;
 299         charwy := 0;
 300 fet_endchar;
 301
 302
 303 fet_beginchar ("Harmonic notehead (Neo-mensural black)", "s2harmonic");
 304         draw_neomensural_black_head (1.3 staff_space#, 1.3 noteheight#);
 305         charwx := head_width#;
 306         charwy := 0;
 307 fet_endchar;
 308
 309
 310 fet_beginchar ("Neo-mensural semibrevis head", "s0neomensural");
 311         draw_neomensural_open_head (staff_space#, noteheight#);
 312 fet_endchar;
 313
 314
 315 fet_beginchar ("Neo-mensural minima head", "s1neomensural");
 316         draw_neomensural_open_head (staff_space#, noteheight#);
 317 fet_endchar;
 318
 319
 320 fet_beginchar ("Neo-mensural semiminima head", "s2neomensural");
 321         draw_neomensural_black_head (staff_space#, noteheight#);
 322 fet_endchar;
 323
 324
 325 def draw_mensural_brevis (expr wid, open, full) =
 326         % TODO.  For the moment, fall back to draw_neomensural_brevis.
 327         draw_neomensural_brevis (wid, open, full);
 328 enddef;
 329
 330
 331 %%% This head does not seem to be used anywhere.  Junk me?  -- jr
 332 def draw_mensural_left_stemmed_head (expr wid, open, full) =
 333         draw_mensural_brevis (wid, open, full);
 334
 335         x6 = x7 = stem_width / 2;
 336         y6 = y5;
 337         y7 = y5 - 2.25 staff_space;
 338
 339         z17 = (x7, y7 - stem_width / 2);
 340
 341         penpos6 (stem_width, 0);
 342         penpos7 (stem_width, 0);
 343
 344         fill z7l
 345              -- z6l
 346              -- z6r
 347              -- z7r
 348              .. z17
 349              .. cycle;
 350
 351         penlabels (6, 7);
 352         labels (17);
 353 enddef;
 354
 355
 356 def draw_mensural_longa (expr wid, open, full) =
 357         draw_mensural_brevis (wid, open, full);
 358
 359         x6 = x7 = head_width - stem_width / 2;
 360         y6 = y5;
 361         y7 = y5 - 2.25 staff_space;
 362
 363         z17 = (x7, y7 - stem_width / 2);
 364
 365         penpos6 (stem_width, 0);
 366         penpos7 (stem_width, 0);
 367
 368         fill z7l
 369              -- z6l
 370              -- z6r
 371              -- z7r
 372              .. z17
 373              .. cycle;
 374
 375         penlabels (6, 7);
 376         labels (17);
 377 enddef;
 378
 379
 380 %%% This head does not seem to be used anywhere.  Junk me?  -- jr
 381 fet_beginchar ("Mensural left stemmed notehead", "slmensural");
 382         draw_mensural_left_stemmed_head (staff_space#, true, true);
 383 fet_endchar;
 384
 385
 386 fet_beginchar ("Mensural maxima notehead", "sM3mensural");
 387         draw_mensural_longa (2.0 staff_space#, true, true);
 388 fet_endchar;
 389
 390
 391 fet_beginchar ("Mensural maxima notehead in ligaturae", "sM3ligmensural");
 392         draw_mensural_brevis (2.0 staff_space#, true, true);
 393 fet_endchar;
 394
 395
 396 fet_beginchar ("Mensural longa notehead", "sM2mensural");
 397         draw_mensural_longa (staff_space#, true, true);
 398 fet_endchar;
 399
 400
 401 fet_beginchar ("Mensural brevis notehead", "sM1mensural");
 402         draw_mensural_brevis (staff_space#, true, true);
 403 fet_endchar;
 404
 405
 406 fet_beginchar ("Black mensural maxima notehead", "sM3blackmensural");
 407         draw_mensural_longa (2.0 staff_space#, false, false);
 408 fet_endchar;
 409
 410
 411 fet_beginchar ("Black mensural maxima notehead in ligaturae", "sM3blackligmensural");
 412         draw_mensural_brevis (2.0 staff_space#, false, false);
 413 fet_endchar;
 414
 415
 416 fet_beginchar ("Black mensural longa notehead", "sM2blackmensural");
 417         draw_mensural_longa (staff_space#, false, false);
 418 fet_endchar;
 419
 420
 421 fet_beginchar ("Black mensural brevis notehead", "sM1blackmensural");
 422         draw_mensural_brevis (staff_space#, false, false);
 423 fet_endchar;
 424
 425
 426 fet_beginchar ("Semi-colored mensural maxima notehead", "sM3semimensural");
 427         draw_mensural_longa (2.0 staff_space#, true, false);
 428 fet_endchar;
 429
 430
 431 fet_beginchar ("Semi-colored mensural maxima notehead in ligaturae", "sM3semiligmensural");
 432         draw_mensural_brevis (2.0 staff_space#, true, false);
 433 fet_endchar;
 434
 435
 436 fet_beginchar ("Semi-colored mensural longa notehead", "sM2semimensural");
 437         draw_mensural_longa (staff_space#, true, false);
 438 fet_endchar;
 439
 440
 441 fet_beginchar ("Semi-colored mensural brevis notehead", "sM1semimensural");
 442         draw_mensural_brevis (staff_space#, true, false);
 443 fet_endchar;
 444
 445
 446 def draw_diamond_head (expr head_h, pen_w, pen_h, angle, open) =
 447         save head_width, head_height;
 448         save ellipse, ellipse_r;
 449         path ellipse, ellipse_r, diamond_shape;
 450
 451         head_height# = head_h;
 452         head_width# / head_height# = tand (angle);
 453
 454         set_char_box (0, head_width#,
 455                       head_height# / 2, head_height# / 2);
 456
 457         charwx := head_width# / 2;
 458         charwy := head_height# / 2 - linethickness#;
 459
 460         define_pixels (head_width, head_height);
 461
 462         ellipse := reverse fullcircle
 463                      xscaled (max (blot_diameter, pen_w * head_width))
 464                      yscaled (max (blot_diameter, pen_h * head_width))
 465                      rotated -angle;
 466
 467         z1 = find_tangent_shift (((0, h) -- (0, -h)), ellipse,
 468                                  (0, 0), (w / 2, 0));
 469         z2 = find_tangent_shift (((0, h) -- (w, h)), ellipse,
 470                                  (w / 2, h), (w / 2, 0));
 471         z3 = find_tangent_shift (((w, h) -- (w, -h)), ellipse,
 472                                  (w, 0), (w / 2, 0));
 473         z4 = find_tangent_shift (((0, -h) -- (w, -h)), ellipse,
 474                                  (w / 2, -h), (w / 2, 0));
 475
 476         diamond_shape := get_subpath (ellipse, z1 - z4, z2 - z1, z1)
 477                          -- get_subpath (ellipse, z2 - z1, z3 - z2, z2)
 478                          -- get_subpath (ellipse, z3 - z2, z4 - z3, z3)
 479                          -- get_subpath (ellipse, z4 - z3, z1 - z4, z4)
 480                          -- cycle;
 481         fill diamond_shape;
 482
 483         if open:
 484                 save l;
 485                 path l[];
 486
 487                 l12 := (directionpoint (z1 - z2) of ellipse) shifted z1
 488                         -- (directionpoint (z1 - z2) of ellipse) shifted z2;
 489                 l23 := (directionpoint (z2 - z3) of ellipse) shifted z2
 490                         -- (directionpoint (z2 - z3) of ellipse) shifted z3;
 491                 l34 := (directionpoint (z3 - z4) of ellipse) shifted z3
 492                         -- (directionpoint (z3 - z4) of ellipse) shifted z4;
 493                 l41 := (directionpoint (z4 - z1) of ellipse) shifted z4
 494                         -- (directionpoint (z4 - z1) of ellipse) shifted z1;
 495
 496                 unfill l12 intersectionpoint l23
 497                        -- l23 intersectionpoint l34
 498                        -- l34 intersectionpoint l41
 499                        -- l41 intersectionpoint l12
 500                        -- cycle;
 501         fi;
 502
 503         labels (1, 2, 3, 4);
 504 enddef;
 505
 506
 507 fet_beginchar ("Mensural semibrevis head", "s0mensural");
 508         draw_diamond_head (staff_space#, 0.15, 0.30, 30, true);
 509 fet_endchar;
 510
 511
 512 fet_beginchar ("Mensural minima head", "s1mensural");
 513         draw_diamond_head (staff_space#, 0.15, 0.30, 30, true);
 514 fet_endchar;
 515
 516
 517 fet_beginchar ("Mensural semiminima head", "s2mensural");
 518         draw_diamond_head (staff_space#, 0.15, 0.30, 30, false);
 519 fet_endchar;
 520
 521
 522 fet_beginchar ("Black mensural semibrevis head", "s0blackmensural");
 523         draw_diamond_head (staff_space#, 0.15, 0.30, 30, false);
 524 fet_endchar;
 525
 526
 527 fet_beginchar ("Petrucci semibrevis head", "s0petrucci");
 528 %       draw_diamond_head (1.8 staff_space#, 0.15, 0.40, 30, true);
 529         draw_neomensural_open_head (staff_space#, 1.8 staff_space#);
 530 fet_endchar;
 531
 532
 533 fet_beginchar ("Petrucci minima head", "s1petrucci");
 534 %       draw_diamond_head (1.8 staff_space#, 0.15, 0.40, 30, true);
 535         draw_neomensural_open_head (staff_space#, 1.8 staff_space#);
 536 fet_endchar;
 537
 538
 539 fet_beginchar ("Petrucci semiminima head", "s2petrucci");
 540 %       draw_diamond_head (1.8 staff_space#, 0.15, 0.40, 30, false);
 541         draw_neomensural_black_head (staff_space#, 1.8 staff_space#);
 542 fet_endchar;
 543
 544
 545 fet_beginchar ("Petrucci colored semibrevis head", "s0blackpetrucci");
 546 %       draw_diamond_head (1.8 staff_space#, 0.15, 0.40, 30, true);
 547         draw_neomensural_black_head (staff_space#, 1.8 staff_space#);
 548 fet_endchar;
 549
 550
 551 fet_beginchar ("Petrucci colored minima head", "s1blackpetrucci");
 552 %       draw_diamond_head (1.8 staff_space#, 0.15, 0.40, 30, true);
 553         draw_neomensural_black_head (staff_space#, 1.8 staff_space#);
 554 fet_endchar;
 555
 556
 557 fet_beginchar ("Petrucci colored semiminima head", "s2blackpetrucci");
 558 %       draw_diamond_head (1.8 staff_space#, 0.15, 0.40, 30, true);
 559         draw_neomensural_black_head (staff_space#, 1.8 staff_space#);
 560 fet_endchar;
 561
 562
 563 %%%%%%%%
 564 %
 565 %
 566 %
 567 % EDITIO VATICANA (including solesmes extensions)
 568 %
 569 %
 570 %
 571
 572 def vat_punctum_char (expr verbose_name, internal_name,
 573                            linea, cavum, straight, auctum,
 574                            d_up, up_shift, down_shift, mag) =
 575         fet_beginchar (verbose_name, "s" & internal_name);
 576                 save a_b, b_h, a_w;
 577
 578                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
 579                 b_h := 0.85;
 580                 a_w := 1.09;
 581
 582                 save a, beta, ht, wd;
 583
 584                 ht# = noteheight# * mag;
 585                 2 beta = ht# * b_h;
 586                 a = beta * a_b;
 587                 wd# = 2 a / a_w;
 588                 black_notehead_width# := wd#;
 589
 590                 % direction
 591                 save d_, d_sign;
 592                 pair d_;
 593
 594                 if d_up:
 595                         d_ := up;
 596                         d_sign := 1;
 597                 else:
 598                         d_ := down;
 599                         d_sign := -1;
 600                 fi;
 601
 602                 % convexity and eccentricity
 603                 save u_convexity, u_eccentricity;
 604
 605                 if straight:
 606                         u_convexity# := -0.01 ht#;
 607                         u_eccentricity# := 0.0 ht#; % dummy
 608                 elseif auctum:
 609                         u_convexity# := -0.03 ht#;
 610                         u_eccentricity# := +0.25 ht#;
 611                 else:
 612                         u_convexity# := -0.05 ht#;
 613                         u_eccentricity# := 0.0 ht#; % dummy
 614                 fi;
 615
 616                 save convexity, eccentricity;
 617
 618                 convexity# := d_sign * u_convexity#;
 619                 eccentricity# := d_sign * u_eccentricity#;
 620
 621                 % y shift offset
 622                 save yoffs;
 623
 624                 if up_shift:
 625                         yoffs# := 0.08 ht#;
 626                 elseif down_shift:
 627                         yoffs# := -0.11 ht#;
 628                 else:
 629                         yoffs# := 0.00 ht#;
 630                 fi;
 631
 632                 define_pixels (convexity, eccentricity, yoffs, ht, wd);
 633
 634                 pickup pencircle scaled linethickness;
 635
 636                 save height, yoffs_bt, p, circle, circle_r;
 637                 path p, circle, circle_r;
 638
 639                 height# = 0.47 ht#;
 640                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
 641
 642                 define_pixels (height, yoffs_bt);
 643
 644                 circle := fullcircle scaled linethickness;
 645
 646                 x1 = x6;
 647                 x2 = x5;
 648                 x3 = x4;
 649                 y1 + height = y6;
 650                 y2 + height = y5;
 651                 y3 + height = y4;
 652
 653                 save box_top, box_bt;
 654
 655                 if auctum:
 656                         z1 = (0.00 wd + linethickness / 2, yoffs_bt);
 657                         z2 = (0.21 wd, yoffs_bt + convexity);
 658                         z3 = (0.42 wd - linethickness/ 2,
 659                               yoffs_bt + eccentricity);
 660                         box_top# = height# + yoffs_bt# +
 661                                      max (0, convexity#, eccentricity#);
 662                         box_bt# = yoffs_bt# +
 663                                      min (0, convexity#, eccentricity#);
 664                         p = z1
 665                             .. {right}z2
 666                             .. {d_}z3
 667                             -- z4{-d_}
 668                             .. z5{left}
 669                             .. z6
 670                             -- cycle;
 671                 else:
 672                         z1 = (0.00 wd + linethickness / 2, yoffs_bt);
 673                         z2 = (0.21 wd, yoffs_bt + convexity);
 674                         z3 = (0.42 wd - linethickness / 2, yoffs_bt);
 675                         box_top# = height# + yoffs_bt# + max (0, convexity#);
 676                         box_bt# = yoffs_bt# + min (0, convexity#);
 677                         p = z1
 678                             .. z2
 679                             .. z3
 680                             -- z4
 681                             .. z5
 682                             .. z6
 683                             -- cycle;
 684                 fi;
 685
 686                 labels (1, 2, 3, 4, 5, 6);
 687
 688                 save dirs;
 689                 pair dirs[];
 690
 691                 dirs12 := direction (0 + epsilon) of p;
 692                 dirs2 := direction 1 of p;
 693                 dirs32 := direction (2 - epsilon) of p;
 694                 dirs45 := direction (3 + epsilon) of p;
 695                 dirs5 := direction 4 of p;
 696                 dirs65 := direction (5 - epsilon) of p;
 697
 698                 fill get_subpath (circle, down, dirs12, z1)
 699                      .. (bot z2){dirs2}
 700                      .. get_subpath (circle, dirs32, up, z3)
 701                      -- get_subpath (circle, up, dirs45, z4)
 702                      .. (top z5){dirs5}
 703                      .. get_subpath (circle, dirs65, down, z6)
 704                      -- cycle;
 705
 706                 if cavum:
 707                         save pat, t;
 708                         path pat[];
 709                         numeric t[];
 710
 711                         pat123 := ((directionpoint -dirs12 of circle)
 712                                     shifted z1){dirs12}
 713                                   .. (top z2){dirs2}
 714                                   .. {dirs32}((directionpoint -dirs32 of circle)
 715                                        shifted z3);
 716                         pat34 := lft z3
 717                                  -- lft z4;
 718                         pat456 := ((directionpoint -dirs45 of circle)
 719                                     shifted z4){dirs45}
 720                                   .. (bot z5){dirs5}
 721                                   .. {dirs65}((directionpoint -dirs65 of circle)
 722                                        shifted z6);
 723                         pat61 := rt z6
 724                                  -- rt z1;
 725
 726                         t61 := ypart (pat61 intersectiontimes pat123);
 727                         t12 := xpart (pat123 intersectiontimes pat34);
 728                         t34 := ypart (pat34 intersectiontimes pat456);
 729                         t45 := xpart (pat456 intersectiontimes pat61);
 730
 731                         unfill subpath (t61, t12) of pat123
 732                                -- subpath (t34, t45) of pat456
 733                                -- cycle;
 734                 fi;
 735
 736                 set_char_box (0.00 wd#, 0.42 wd#,
 737                               max (0, -box_bt#) + linethickness# / 2,
 738                               max (0, box_top#) + linethickness# / 2);
 739
 740                 if linea:
 741                         save linea_width, linea_height;
 742
 743                         linea_width# = 0.6 linethickness#;
 744                         linea_height# = 0.7 ht#;
 745
 746                         define_pixels (linea_width, linea_height);
 747
 748                         pickup pencircle scaled 0.6 linethickness;
 749
 750                         draw_rounded_block ((-0.10 wd - linea_width / 2,
 751                                              -linea_height / 2),
 752                                             (-0.10 wd + linea_width / 2,
 753                                              +linea_height / 2),
 754                                             0.6 linethickness);
 755                         draw_rounded_block ((+0.52 wd - linea_width / 2,
 756                                              -linea_height / 2),
 757                                             (+0.52 wd + linea_width / 2,
 758                                              +linea_height / 2),
 759                                             0.6 linethickness);
 760
 761                         set_char_box (0, 0.62 wd# + linea_width#,
 762                                       linea_height# / 2,
 763                                       linea_height# / 2);
 764
 765                         currentpicture := currentpicture
 766                                 shifted (0.10 wd + linea_width / 2, 0);
 767                 fi;
 768         fet_endchar;
 769 enddef;
 770
 771
 772 def plica_char (expr verbose_name, internal_name,
 773                      d_up, mag) =
 774         fet_beginchar (verbose_name, "s" & internal_name);
 775                 save a_b, b_h, a_w;
 776
 777                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
 778                 b_h := 0.85;
 779                 a_w := 1.09;
 780
 781                 save a, beta, ht, wd;
 782
 783                 ht# = noteheight# * mag;
 784                 2 beta = ht# * b_h;
 785                 a = beta * a_b;
 786                 wd# = 2 a / a_w;
 787                 black_notehead_width# := wd#;
 788
 789                 % direction
 790                 save d_, d_sign;
 791                 pair d_;
 792
 793                 if d_up:
 794                         d_ := up;
 795                         d_sign := 1;
 796                 else:
 797                         d_ := down;
 798                         d_sign := -1;
 799                 fi;
 800
 801                 % convexity and eccentricity
 802                 save convexity, eccentricity;
 803
 804                 convexity# := d_sign * -0.10 ht#;
 805                 eccentricity# := d_sign * -0.12 ht#;
 806
 807                 % y shift offset
 808                 save yoffs;
 809
 810                 yoffs# := -0.11 ht#;
 811
 812                 define_pixels (convexity, eccentricity, yoffs, ht, wd);
 813
 814                 pickup pencircle scaled linethickness;
 815
 816                 save height, yoffs_bt, p, circle, circle_r;
 817                 path p, circle, circle_r;
 818
 819                 height# = 0.47 ht#;
 820                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
 821
 822                 define_pixels (height, yoffs_bt);
 823
 824                 circle := fullcircle scaled linethickness;
 825
 826                 x1 = x6;
 827                 x2 = x5;
 828                 x3 = x4;
 829                 y1 + height = y6;
 830                 y2 + height = y5;
 831                 y3 + height = y4;
 832
 833                 save box_top, box_bt;
 834
 835                 z1 = (0.00 wd + linethickness / 2, yoffs_bt);
 836                 z2 = (0.21 wd, yoffs_bt + convexity);
 837                 z3 = (0.42 wd - linethickness/ 2, yoffs_bt + eccentricity);
 838                 box_top# = height# + yoffs_bt# +
 839                              max (0, convexity#, eccentricity#);
 840                 box_bt# = yoffs_bt# +
 841                              min (0, convexity#, eccentricity#);
 842                 p = z1
 843                     .. z2{right}
 844                     .. z3
 845                     -- z4
 846                     .. z5{left}
 847                     .. z6
 848                     -- cycle;
 849
 850                 labels (1, 2, 3, 4, 5, 6);
 851
 852                 save dirs;
 853                 pair dirs[];
 854
 855                 dirs12 := direction (0 + epsilon) of p;
 856                 dirs2 := direction 1 of p;
 857                 dirs32 := direction (2 - epsilon) of p;
 858                 dirs45 := direction (3 + epsilon) of p;
 859                 dirs5 := direction 4 of p;
 860                 dirs65 := direction (5 - epsilon) of p;
 861
 862                 fill get_subpath (circle, down, dirs12, z1)
 863                      .. (bot z2){dirs2}
 864                      .. get_subpath (circle, dirs32, up, z3)
 865                      -- get_subpath (circle, up, dirs45, z4)
 866                      .. (top z5){dirs5}
 867                      .. get_subpath (circle, dirs65, down, z6)
 868                      -- cycle;
 869
 870                 pickup pencircle scaled 0.6 linethickness;
 871
 872                 save stem_bt;
 873
 874                 set_char_box (0.00 wd#, 0.42 wd#,
 875                               max (0, -box_bt#) + linethickness# / 2,
 876                               max (0, box_top#) + linethickness# / 2);
 877
 878         fet_endchar;
 879 enddef;
 880
 881
 882 def epiphonus_char (expr verbose_name, internal_name,
 883                          left_stem, d_up, down_shift, mag) =
 884         fet_beginchar (verbose_name, "s" & internal_name);
 885                 save a_b, b_h, a_w;
 886
 887                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
 888                 b_h := 0.85;
 889                 a_w := 1.09;
 890
 891                 save a, beta, ht, wd;
 892
 893                 ht# = noteheight# * mag;
 894                 2 beta = ht# * b_h;
 895                 a = beta * a_b;
 896                 wd# = 2 a / a_w;
 897                 black_notehead_width# := wd#;
 898
 899                 % direction
 900                 save d_, d_sign;
 901                 pair d_;
 902
 903                 if d_up:
 904                         d_ := up;
 905                         d_sign := 1;
 906                 else:
 907                         d_ := down;
 908                         d_sign := -1;
 909                 fi;
 910
 911                 % convexity and eccentricity
 912                 save convexity;
 913
 914                 convexity# := d_sign * -0.05ht#;
 915
 916                 % y shift offset
 917                 save yoffs;
 918
 919                 if down_shift:
 920                         yoffs# := -0.11 ht#;
 921                 else:
 922                         yoffs# := 0.00 ht#;
 923                 fi;
 924
 925                 define_pixels (convexity, yoffs, ht, wd);
 926
 927                 pickup pencircle scaled linethickness;
 928
 929                 save height, yoffs_bt, p, circle, circle_r;
 930                 path p, circle, circle_r;
 931
 932                 height# = 0.47 ht#;
 933                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
 934
 935                 define_pixels (height, yoffs_bt);
 936
 937                 circle := fullcircle scaled linethickness;
 938
 939                 x1 = x6;
 940                 x2 = x5;
 941                 x3 = x4;
 942                 y1 + height = y6;
 943                 y2 + height = y5;
 944                 y3 + height = y4;
 945
 946                 save box_top, box_bt;
 947
 948                 z1 = (0.00 wd + linethickness / 2, yoffs_bt - 2.5 convexity);
 949                 z2 = (0.06 wd, yoffs_bt + 1.4 convexity);
 950                 z3 = (0.42 wd - linethickness / 2, yoffs_bt - 1.0 convexity);
 951                 box_top# = height# + yoffs_bt# +
 952                              max (-1.0 convexity#, 1.4 convexity#, 0);
 953                 box_bt# = yoffs_bt# +
 954                              min (-1.0 convexity#, 1.4 convexity#, 0);
 955                 p = z1{-d_}
 956                     .. {curl 1}z2{right}
 957                     .. z3
 958                     -- z4
 959                     .. {left}z5{curl 1}
 960                     .. {d_}z6
 961                     -- cycle;
 962
 963                 labels (1, 2, 3, 4, 5, 6);
 964
 965                 save dirs;
 966                 pair dirs[];
 967
 968                 dirs12 := direction (0 + epsilon) of p;
 969                 dirs21 := direction (1 - epsilon) of p;
 970                 dirs23 := direction (1 + epsilon) of p;
 971                 dirs32 := direction (2 - epsilon) of p;
 972                 dirs45 := direction (3 + epsilon) of p;
 973                 dirs54 := direction (4 - epsilon) of p;
 974                 dirs56 := direction (4 + epsilon) of p;
 975                 dirs65 := direction (5 - epsilon) of p;
 976
 977                 fill get_subpath (circle, down, dirs12, z1)
 978                      .. get_subpath (circle, dirs21, dirs23, z2)
 979                      .. get_subpath (circle, dirs32, up, z3)
 980                      -- get_subpath (circle, up, dirs45, z4)
 981                      .. get_subpath (circle, dirs54, dirs56, z5)
 982                      .. get_subpath (circle, dirs65, down, z6)
 983                      -- cycle;
 984
 985                 save stem_bt;
 986
 987                 if left_stem:
 988                         pickup pencircle scaled 0.6 linethickness;
 989
 990                         lft x11 = x1 - linethickness / 2;
 991                         bot y11 = yoffs - 1.1 ht - linethickness / 2;
 992                         x12 = x11;
 993                         y12 = y1;
 994
 995                         draw_rounded_block (bot lft z11, top rt z12,
 996                                             0.6 linethickness);
 997                         stem_bt# = yoffs# - 1.1 ht#;
 998
 999                         labels (11, 12);
1000                 else:
1001                         stem_bt# = 0;
1002                 fi;
1003
1004                 set_char_box (0.00 wd#, 0.42 wd#,
1005                               max (0, -box_bt#, -stem_bt#) + linethickness# / 2,
1006                               max (0, box_top#) + linethickness# / 2);
1007         fet_endchar;
1008 enddef;
1009
1010
1011 def inclinatum_char (expr verbose_name, internal_name,
1012                           small, stropha, auctum) =
1013         fet_beginchar (verbose_name, "s" & internal_name);
1014                 save ht, alpha;
1015
1016                 alpha := 35;
1017
1018                 if small:
1019                         ht# = 0.50 noteheight#;
1020                 else:
1021                         ht# = 0.80 noteheight#;
1022                 fi;
1023
1024                 draw_diamond_head (ht#, 0, 0, alpha, false);
1025
1026                 save off_angle;
1027
1028                 off_angle := alpha + 15;
1029
1030                 save stropha_ellipse, auctum_hook, circle;
1031                 path stropha_ellipse, auctum_hook, circle;
1032
1033                 circle := reverse fullcircle scaled linethickness;
1034
1035                 stropha_ellipse := fullcircle xscaled 0.25 head_height
1036                                               yscaled 0.55 head_height
1037                                               rotated alpha;
1038
1039                 z11 = z12
1040                       + linethickness / 2 * dir (180 - off_angle)
1041                       - directionpoint dir (90 - off_angle)
1042                           of stropha_ellipse;
1043                 z12 = directionpoint -dir (90 - off_angle) of diamond_shape +
1044                         linethickness / 2 * dir (180 - off_angle);
1045                 z13 = (0, -0.5 head_height + linethickness);
1046
1047                 auctum_hook := z12{-dir (90 - off_angle)}
1048                                .. {dir (90 + alpha)}z13;
1049
1050                 labels (12);
1051
1052                 if (stropha and not auctum):
1053                         clearit;
1054
1055                         save t_in, t_out;
1056
1057                         t_in := xpart ((stropha_ellipse shifted z11)
1058                                        intersectiontimes
1059                                        get_subpath (diamond_shape,
1060                                                     left, up,
1061                                                     (0, 0)));
1062                         t_out := xpart ((stropha_ellipse shifted z11)
1063                                         intersectiontimes
1064                                         get_subpath (diamond_shape,
1065                                                      up, right,
1066                                                      (0, 0)));
1067
1068                         % the addition or subtraction of `1' is necessary
1069                         % so that we get the right starting point
1070                         fill get_subpath_i (diamond_shape,
1071                                             dir (angle (z2 - z1) - 1),
1072                                             dir (angle (z1 - z4) + 1),
1073                                             (0, 0))
1074                              -- get_subpath (stropha_ellipse,
1075                                              direction t_in of stropha_ellipse,
1076                                              direction t_out of stropha_ellipse,
1077                                              z11)
1078                              -- cycle;
1079
1080                         labels (11);
1081                 fi;
1082
1083                 if (auctum and not stropha):
1084                         clearit;
1085
1086                         fill get_subpath (diamond_shape,
1087                                           left,
1088                                           -dir (90 - off_angle),
1089                                           (0, 0))
1090                              .. get_subpath (circle,
1091                                              dir (90 + alpha),
1092                                              -dir (90 + alpha),
1093                                              z13)
1094                              .. get_subpath (circle,
1095                                              dir (90 - off_angle),
1096                                              right,
1097                                              z12)
1098                              -- cycle;
1099
1100                         labels (13);
1101                 fi;
1102
1103                 if (auctum and stropha):
1104                         clearit;
1105
1106                         save t;
1107
1108                         t := xpart ((stropha_ellipse shifted z11)
1109                                     intersectiontimes
1110                                     get_subpath (diamond_shape, up, right,
1111                                                  (0, 0)));
1112
1113                         % the addition or subtraction of `1' is necessary
1114                         % so that we get the right starting point
1115                         fill get_subpath_i (diamond_shape,
1116                                             dir (angle (z2 - z1) - 1),
1117                                             -dir (90 - off_angle),
1118                                             (0, 0))
1119                              .. get_subpath (circle,
1120                                              dir (90 + alpha),
1121                                              -dir (90 + alpha),
1122                                              z13)
1123                              .. get_subpath (stropha_ellipse,
1124                                              dir (90 - off_angle),
1125                                              direction t of stropha_ellipse,
1126                                              z11)
1127                              -- cycle;
1128
1129                         labels (11, 13);
1130                 fi;
1131         fet_endchar;
1132 enddef;
1133
1134
1135 % punctum
1136 vat_punctum_char ("Ed. Vat. punctum", "vaticana.punctum",
1137                   false, false, false, false,
1138                   false, false, false, 1.0);
1139
1140
1141 % punctum cavum (for OpusTeX compatibility)
1142 vat_punctum_char ("Ed. Vat. punctum cavum", "vaticana.punctum.cavum",
1143                   false, true, false, false,
1144                   false, false, false, 1.0);
1145
1146
1147 % linea punctum (for OpusTeX compatibility)
1148 vat_punctum_char ("Ed. Vat. linea punctum", "vaticana.linea.punctum",
1149                   true, false, false, false,
1150                   false, false, false, 1.0);
1151
1152
1153 % linea punctum cavum (for OpusTeX compatibility)
1154 vat_punctum_char ("Ed. Vat. linea punctum cavum", "vaticana.linea.punctum.cavum",
1155                   true, true, false, false,
1156                   false, false, false, 1.0);
1157
1158
1159 % punctum inclinatum
1160 inclinatum_char ("Ed. Vat. inclinatum", "vaticana.inclinatum",
1161                  false, false, false);
1162
1163
1164 % pes lower punctum
1165 vat_punctum_char ("Ed. Vat. pes lower punctum", "vaticana.lpes",
1166                   false, false, true, false,
1167                   true, false, false, 1.0);
1168
1169
1170 % pes lower punctum
1171 vat_punctum_char ("Ed. Vat. pes var lower punctum", "vaticana.vlpes",
1172                   false, false, true, false,
1173                   true, false, true, 1.0);
1174
1175
1176 % pes upper punctum
1177 vat_punctum_char ("Ed. Vat. pes upper punctum", "vaticana.upes",
1178                   false, false, true, false,
1179                   false, false, false, 1.0);
1180
1181
1182 % pes upper punctum (shifted variation)
1183 %
1184 % This note head is used instead of the regular pes upper punctum to
1185 % avoid collision with the lower punctum note of the pes when the upper
1186 % punctum sits directly on top of the lower punctum.
1187 %
1188 vat_punctum_char ("Ed. Vat. var pes upper punctum", "vaticana.vupes",
1189                   false, false, true, false,
1190                   false, true, false, 1.0);
1191
1192
1193 % small punctum as used in epiphonus
1194 vat_punctum_char ("Ed. Vat. plica", "vaticana.plica",
1195                   false, false, false, false,
1196                   false, false, false, 0.6);
1197
1198
1199 % small punctum as used in epiphonus
1200 plica_char ("Ed. Vat. var plica", "vaticana.vplica",
1201             false, 0.6);
1202
1203
1204 % eccentric punctum as used in epiphonus
1205 epiphonus_char ("Ed. Vat. epiphonus", "vaticana.epiphonus",
1206                 false, true, false, 1.0);
1207
1208
1209 % eccentric punctum as used in epiphonus (shifted variation)
1210 %
1211 % This note head is used instead of the regular epiphonus punctum to
1212 % avoid collision with the plica head when the plica sits directly on
1213 % top of the lower head.
1214 %
1215 epiphonus_char ("Ed. Vat. var epiphonus", "vaticana.vepiphonus",
1216                 false, true, true, 1.0);
1217
1218
1219 % small punctum as used in cephalicus
1220 vat_punctum_char ("Ed. Vat. rev. plica", "vaticana.reverse.plica",
1221                   false, false, false, false,
1222                   true, false, false, 0.6);
1223
1224
1225 % small punctum as used in cephalicus
1226 plica_char ("Ed. Vat. rev. var plica", "vaticana.reverse.vplica",
1227             true, 0.6);
1228
1229
1230 % eccentric punctum as used in cephalicus; without left stem
1231 epiphonus_char ("Ed. Vat. inner cephalicus", "vaticana.inner.cephalicus",
1232                 false, false, false, 1.0);
1233
1234
1235 % eccentric punctum as used in cephalicus; with left stem
1236 epiphonus_char ("Ed. Vat. cephalicus", "vaticana.cephalicus",
1237                 true, false, false, 1.0);
1238
1239
1240 % quilisma
1241 fet_beginchar ("Ed. Vat. quilisma", "svaticana.quilisma");
1242         save a_b, b_h, a_w;
1243
1244         a_b := 1.54; % b_h * a_b / a_w = wd / ht
1245         b_h := 0.85;
1246         a_w := 1.09;
1247
1248         save a, beta, ht, wd;
1249
1250         ht# = noteheight#;
1251         2 beta = ht# * b_h;
1252         a = beta * a_b;
1253         wd# = 2 a / a_w;
1254
1255         set_char_box (0, 0.42 wd#, 0.28 ht#, 0.36 ht#);
1256
1257         black_notehead_width# := wd#;
1258
1259         define_pixels (ht, wd);
1260
1261         save ellipse, T;
1262         path ellipse;
1263         transform T;
1264
1265         T := identity xscaled linethickness
1266                       yscaled 0.44 ht;
1267         pickup pencircle transformed T;
1268         ellipse := reverse fullcircle transformed T;
1269
1270         z1 = (rt 0.00 wd, top -0.28 ht);
1271         z2 = (0.11 wd, -0.14 ht);
1272         z3 = (0.12 wd, +0.03 ht);
1273         z4 = (0.25 wd, -0.09 ht);
1274         z5 = (0.25 wd, +0.08 ht);
1275         z6 = (lft 0.42 wd, -0.04 ht);
1276         z7 = (lft 0.40 wd, bot +0.36 ht);
1277
1278         fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
1279              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
1280              -- cycle;
1281         fill get_subpath (ellipse, z3 - z4, z4 - z3, z3)
1282              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
1283              -- cycle;
1284         fill get_subpath (ellipse, z5 - z6, z6 - z5, z5)
1285              -- point 0 of get_subpath (ellipse, z6 - z5, z5 - z6, z6)
1286              -- get_subpath (ellipse, z7 - z6, z6 - z7, z7)
1287              -- get_subpath (ellipse, z6 - z7, z5 - z6, z6)
1288              -- cycle;
1289
1290         labels (1, 2, 3, 4, 5, 6, 7);
1291 fet_endchar;
1292
1293
1294 % solesmes punctum inclinatum parvum
1295 inclinatum_char ("Solesmes punctum inclinatum parvum", "solesmes.incl.parvum",
1296                  true, false, false);
1297
1298
1299 % solesmes punctum auctum ascendens
1300 vat_punctum_char ("Solesmes punctum auctum ascendens", "solesmes.auct.asc",
1301                   false, false, false, true,
1302                   true, false, false, 1.0);
1303
1304
1305 % solesmes punctum auctum descendens
1306 vat_punctum_char ("Solesmes punctum auctum descendens", "solesmes.auct.desc",
1307                   false, false, false, true,
1308                   false, false, false, 1.0);
1309
1310
1311 % solesmes punctum inclinatum auctum
1312 inclinatum_char ("Solesmes punctum incl. auctum", "solesmes.incl.auctum",
1313                  false, false, true);
1314
1315
1316 % solesmes stropha
1317 inclinatum_char ("Solesmes stropha", "solesmes.stropha",
1318                  false, true, false);
1319
1320
1321 % solesmes stropha aucta
1322 inclinatum_char ("Solesmes stropha aucta", "solesmes.stropha.aucta",
1323                  false, true, true);
1324
1325
1326 % solesmes oriscus
1327 fet_beginchar ("Solesmes oriscus", "ssolesmes.oriscus");
1328         save a_b, b_h, a_w;
1329
1330         a_b := 1.54; % b_h * a_b / a_w = wd / ht
1331         b_h := 0.85;
1332         a_w := 1.09;
1333
1334         save a, beta, ht, wd;
1335
1336         ht# = noteheight#;
1337         2 beta = ht# * b_h;
1338         a = beta * a_b;
1339         wd# = 2 a / a_w;
1340         black_notehead_width# := wd#;
1341
1342         save convexity;
1343
1344         convexity# = +0.05 ht#;
1345
1346         define_pixels (ht, wd, convexity);
1347
1348         set_char_box (0.00 wd#, 0.50 wd#,
1349                       0.25 ht# + convexity#, 0.25 ht# + convexity#);
1350
1351         z1 = (0.00 wd + blot_diameter / 2, -convexity);
1352         z2 = (1/6 wd, +convexity);
1353         z3 = (2/6 wd, -convexity);
1354         z4 = (0.50 wd - blot_diameter / 2, +convexity);
1355
1356
1357         save height;
1358
1359         height = 2 ypart (directionpoint right of (z1
1360                                                    .. z2
1361                                                    .. z3
1362                                                    .. z4));
1363
1364         save ellipse, T;
1365         path ellipse;
1366         transform T;
1367
1368         T := identity xscaled blot_diameter
1369                       yscaled (h + d - height);
1370         pickup pencircle transformed T;
1371         ellipse := fullcircle transformed T;
1372
1373         % Adjust vertical coordinates to touch bounding box.
1374         y1 := top -d;
1375         y4 := bot h;
1376
1377         save d_;
1378         pair d_;
1379
1380         d_ := direction 0 of (z1
1381                               .. z2
1382                               .. z3
1383                               .. z4);
1384
1385         fill get_subpath (ellipse, -d_, d_, z1)
1386              .. bot z2
1387              .. bot z3
1388              .. get_subpath (ellipse, d_, -d_, z4)
1389              .. top z3
1390              .. top z2
1391              .. cycle;
1392
1393         labels (1, 2, 3, 4);
1394 fet_endchar;
1395
1396
1397 %%%%%%%%
1398 %
1399 %
1400 %
1401 % EDITIO MEDICAEA
1402 %
1403 %
1404 %
1405
1406 % inclinatum
1407 fet_beginchar ("Ed. Med. inclinatum", "smedicaea.inclinatum");
1408         draw_diamond_head (1.2 staff_space#, 0, 0, 35, false);
1409 fet_endchar;
1410
1411
1412 def med_punctum_char (expr verbose_name, internal_name,
1413                            left_up_stem, left_down_stem) =
1414         fet_beginchar (verbose_name, "s" & internal_name);
1415                 save a, ht, wd;
1416
1417                 ht# = 2 staff_space#;
1418                 wd# = ht#;
1419                 black_notehead_width# := wd#;
1420
1421                 define_pixels (ht, wd);
1422
1423                 save ellipse;
1424                 path ellipse;
1425
1426                 ellipse := fullcircle xscaled blot_diameter
1427                                       yscaled 0.50 ht;
1428
1429                 z1 = (0.00 wd + blot_diameter / 2, 0);
1430                 z2 = (0.4 wd - blot_diameter / 2, 0);
1431
1432                 labels (1, 2);
1433
1434                 pickup pencircle scaled linethickness;
1435
1436                 if left_down_stem:
1437                         z4 = (0.00 wd + linethickness / 2, -1.25 ht);
1438
1439                         fill get_subpath (ellipse, left, down, z1)
1440                              -- top lft z4{down}
1441                              .. z4{right}
1442                              .. top rt z4{up}
1443                              -- (rt x4, -.5 ht / 2)
1444                              -- get_subpath (ellipse, right, left, z2)
1445                              -- cycle;
1446
1447                         labels (4);
1448
1449                         set_char_box (0.0, 0.4 wd#, 1.25 ht#, 0.25 ht#);
1450                 elseif left_up_stem:
1451                         z4 = (0.00 wd + linethickness / 2, +1.25 ht);
1452
1453                         fill get_subpath (ellipse, down, right, z1)
1454                              -- get_subpath (ellipse, right, left, z2)
1455                              -- (rt x4, .5 ht / 2)
1456                              -- bot rt z4{up}
1457                              .. z4{left}
1458                              .. bot lft z4{down}
1459                              -- cycle;
1460
1461                         labels (4);
1462
1463                         set_char_box (0.0, 0.4 wd#, 0.25 ht#, 1.25 ht#);
1464                 else:
1465                         fill get_subpath (ellipse, left, right, z1)
1466                              -- get_subpath (ellipse, right, left, z2)
1467                              -- cycle;
1468
1469                         set_char_box (0.0, 0.4 wd#, 0.25 ht#, 0.25 ht#);
1470                 fi;
1471
1472         fet_endchar;
1473 enddef;
1474
1475
1476 % punctum
1477 med_punctum_char ("Ed. Med. punctum", "medicaea.punctum",
1478                   false, false);
1479
1480
1481 % left up-stemmed punctum
1482 med_punctum_char ("Ed. Med. reverse virga", "medicaea.rvirga",
1483                   true, false);
1484
1485
1486 % virga (i.e. left down-stemmed punctum)
1487 med_punctum_char ("Ed. Med. virga", "medicaea.virga",
1488                   false, true);
1489
1490
1491 %%%%%%%%
1492 %
1493 %
1494 %
1495 % HUFNAGEL
1496 %
1497 %
1498 %
1499
1500 def huf_punctum_char (expr verbose_name, internal_name,
1501                            down_stem) =
1502         fet_beginchar (verbose_name, "s" & internal_name);
1503                 save alpha;
1504
1505                 alpha = 55;
1506
1507                 draw_diamond_head (staff_space#, 0, 0, alpha, false);
1508
1509                 if down_stem:
1510                         set_char_box (0, head_width#,
1511                                       1.5 staff_space#, head_height# / 2);
1512
1513                         save ellipse;
1514                         path ellipse;
1515
1516                         ellipse := reverse fullcircle xscaled blot_diameter
1517                                                       yscaled 0.7 staff_space
1518                                                       rotated -alpha;
1519
1520                         z11 = (head_width / 2, 0);
1521                         z12 = find_tangent_shift (((0, -d) -- (w, -d)), ellipse,
1522                                                   (w / 2, -d), (w / 2, 0));
1523
1524                         fill get_subpath (ellipse, up, down, z11)
1525                              -- get_subpath (ellipse, down, up, z12)
1526                              -- cycle;
1527
1528                         labels (11, 12);
1529                 fi;
1530         fet_endchar;
1531 enddef;
1532
1533
1534 % punctum
1535 huf_punctum_char ("Hufnagel punctum", "hufnagel.punctum", false)
1536
1537
1538 % virga
1539 huf_punctum_char ("Hufnagel virga", "hufnagel.virga", true)
1540
1541
1542 % pes lower punctum
1543 fet_beginchar ("Hufnagel pes lower punctum", "shufnagel.lpes")
1544         save width, height, alpha;
1545
1546         width# = 2 * staff_space#;
1547         height# = 0.7 * staff_space#;
1548         alpha = 35;
1549
1550         set_char_box (0, width#, height# / 2, height# / 2);
1551
1552         define_pixels (width, height);
1553
1554         save circle;
1555         path circle;
1556
1557         circle := reverse fullcircle scaled linethickness;
1558
1559         pickup pencircle scaled linethickness;
1560
1561         rt x3 = -lft x1 = width / 2;
1562         y2 = y3 = height / 2;
1563         y1 = y4 = -height / 2;
1564
1565         tand (alpha) * (y2 - y1) = x2 - x1 = x3 - x4;
1566
1567         fill get_subpath (circle, left, z2 - z1, z1)
1568              -- get_subpath (circle, z2 - z1, right, z2)
1569              -- get_subpath (circle, right, z4 - z3, z3)
1570              -- get_subpath (circle, z4 - z3, left, z4)
1571              -- cycle;
1572
1573         currentpicture := currentpicture shifted (width/2, 0);
1574
1575 %       labels (1, 2, 3, 4);
1576 fet_endchar;
1577
1578
1579 fet_endgroup ("noteheads");