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