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