lily/stem.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 1996--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
   5   Jan Nieuwenhuizen <janneke@gnu.org>
   6
   7   TODO: This is way too hairy
   8
   9   TODO: fix naming.
  10
  11   Stem-end, chord-start, etc. is all confusing naming.
  12
  13   LilyPond is free software: you can redistribute it and/or modify
  14   it under the terms of the GNU General Public License as published by
  15   the Free Software Foundation, either version 3 of the License, or
  16   (at your option) any later version.
  17
  18   LilyPond is distributed in the hope that it will be useful,
  19   but WITHOUT ANY WARRANTY; without even the implied warranty of
  20   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21   GNU General Public License for more details.
  22
  23   You should have received a copy of the GNU General Public License
  24   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  25 */
  26
  27 /*
  28   Note that several internal functions have a calc_beam bool argument.
  29   This argument means: "If set, acknowledge the fact that there is a beam
  30   and deal with it.  If not, give me the measurements as if there is no beam."
  31   Most pure functions are called WITHOUT calc_beam, whereas non-pure functions
  32   are called WITH calc_beam.
  33
  34   The only exception to this is ::pure_height, which calls internal_pure_height
  35   with "true" for calc_beam in order to trigger the calculations of other
  36   pure heights in case there is a beam.  It passes false, however, to
  37   internal_height and internal_pure_height for all subsequent iterations.
  38 */
  39
  40 #include "stem.hh"
  41 #include "spanner.hh"
  42
  43 #include <cmath>                // rint
  44 using namespace std;
  45
  46 #include "beam.hh"
  47 #include "directional-element-interface.hh"
  48 #include "dot-column.hh"
  49 #include "font-interface.hh"
  50 #include "international.hh"
  51 #include "lookup.hh"
  52 #include "misc.hh"
  53 #include "note-head.hh"
  54 #include "output-def.hh"
  55 #include "paper-column.hh"
  56 #include "pointer-group-interface.hh"
  57 #include "rest.hh"
  58 #include "rhythmic-head.hh"
  59 #include "side-position-interface.hh"
  60 #include "staff-symbol-referencer.hh"
  61 #include "stem-tremolo.hh"
  62 #include "warn.hh"
  63
  64 using std::string;
  65 using std::vector;
  66
  67 void
  68 Stem::set_beaming (Grob *me, int beam_count, Direction d)
  69 {
  70   SCM pair = me->get_property ("beaming");
  71
  72   if (!scm_is_pair (pair))
  73     {
  74       pair = scm_cons (SCM_EOL, SCM_EOL);
  75       me->set_property ("beaming", pair);
  76     }
  77
  78   SCM lst = index_get_cell (pair, d);
  79   if (beam_count)
  80     for (int i = 0; i < beam_count; i++)
  81       lst = scm_cons (scm_from_int (i), lst);
  82   else
  83     lst = SCM_BOOL_F;
  84
  85   index_set_cell (pair, d, lst);
  86 }
  87
  88 int
  89 Stem::get_beaming (Grob *me, Direction d)
  90 {
  91   SCM pair = me->get_property ("beaming");
  92   if (!scm_is_pair (pair))
  93     return 0;
  94
  95   SCM lst = index_get_cell (pair, d);
  96
  97   int len = scm_ilength (lst);
  98   return max (len, 0);
  99 }
 100
 101 Interval
 102 Stem::head_positions (Grob *me)
 103 {
 104   if (head_count (me))
 105     {
 106       Drul_array<Grob *> e (extremal_heads (me));
 107       return Interval (Staff_symbol_referencer::get_position (e[DOWN]),
 108                        Staff_symbol_referencer::get_position (e[UP]));
 109     }
 110   return Interval ();
 111 }
 112
 113 Real
 114 Stem::chord_start_y (Grob *me)
 115 {
 116   if (head_count (me))
 117     return Staff_symbol_referencer::get_position (last_head (me))
 118       * Staff_symbol_referencer::staff_space (me) * 0.5;
 119
 120   return 0;
 121 }
 122
 123 void
 124 Stem::set_stem_positions (Grob *me, Real se)
 125 {
 126   // todo: margins
 127   Direction d = get_grob_direction (me);
 128
 129   Grob *beam = unsmob<Grob> (me->get_object ("beam"));
 130   if (d && d * head_positions (me)[get_grob_direction (me)] >= se * d)
 131     me->warning (_ ("weird stem size, check for narrow beams"));
 132
 133   // trigger note collision mechanisms
 134   Real stem_beg = internal_calc_stem_begin_position (me, false);
 135   Real staff_space = Staff_symbol_referencer::staff_space (me);
 136   Real half_space = staff_space * 0.5;
 137
 138   Interval height;
 139   height[-d] = stem_beg * half_space;
 140   height[d] = se * half_space + beam_end_corrective (me);
 141
 142   Real stemlet_length = robust_scm2double (me->get_property ("stemlet-length"),
 143                                            0.0);
 144   bool stemlet = stemlet_length > 0.0;
 145
 146   Grob *lh = get_reference_head (me);
 147
 148   if (!lh)
 149     {
 150       if (stemlet && beam)
 151         {
 152           Real beam_translation = Beam::get_beam_translation (beam);
 153           Real beam_thickness = Beam::get_beam_thickness (beam);
 154           int beam_count = beam_multiplicity (me).length () + 1;
 155
 156           height[-d] = (height[d] - d
 157                         * (0.5 * beam_thickness
 158                            + beam_translation * max (0, (beam_count - 1))
 159                            + stemlet_length));
 160         }
 161       else if (!stemlet && beam)
 162         height[-d] = height[d];
 163       else if (stemlet && !beam)
 164         me->programming_error ("Can't have a stemlet without a beam.");
 165     }
 166
 167   me->set_property ("stem-begin-position", scm_from_double (height[-d] * 2 / staff_space));
 168   me->set_property ("length", scm_from_double (height.length () * 2 / staff_space));
 169 }
 170
 171 /* Note head that determines hshift for upstems
 172    WARNING: triggers direction  */
 173 Grob *
 174 Stem::support_head (Grob *me)
 175 {
 176   extract_grob_set (me, "note-heads", heads);
 177   if (heads.size () == 1)
 178     return heads[0];
 179
 180   return first_head (me);
 181 }
 182
 183 int
 184 Stem::head_count (Grob *me)
 185 {
 186   return Pointer_group_interface::count (me, ly_symbol2scm ("note-heads"));
 187 }
 188
 189 /* The note head which forms one end of the stem.
 190    WARNING: triggers direction  */
 191 Grob *
 192 Stem::first_head (Grob *me)
 193 {
 194   Direction d = get_grob_direction (me);
 195   if (d)
 196     return extremal_heads (me)[-d];
 197   return 0;
 198 }
 199
 200 /* The note head opposite to the first head.  */
 201 Grob *
 202 Stem::last_head (Grob *me)
 203 {
 204   Direction d = get_grob_direction (me);
 205   if (d)
 206     return extremal_heads (me)[d];
 207   return 0;
 208 }
 209
 210 /*
 211   START is part where stem reaches `last' head.
 212
 213   This function returns a drul with (bottom-head, top-head).
 214 */
 215 Drul_array<Grob *>
 216 Stem::extremal_heads (Grob *me)
 217 {
 218   const int inf = INT_MAX;
 219   Drul_array<int> extpos;
 220   extpos[DOWN] = inf;
 221   extpos[UP] = -inf;
 222
 223   Drul_array<Grob *> exthead (0, 0);
 224   extract_grob_set (me, "note-heads", heads);
 225
 226   for (vsize i = heads.size (); i--;)
 227     {
 228       Grob *n = heads[i];
 229       int p = Staff_symbol_referencer::get_rounded_position (n);
 230
 231       for (LEFT_and_RIGHT (d))
 232         {
 233           if (d * p > d * extpos[d])
 234             {
 235               exthead[d] = n;
 236               extpos[d] = p;
 237             }
 238         }
 239     }
 240   return exthead;
 241 }
 242
 243 /* The staff positions, in ascending order.
 244  * If FILTER, include the main column of noteheads only */
 245 vector<int>
 246 Stem::note_head_positions (Grob *me, bool filter)
 247 {
 248   vector<int> ps;
 249   extract_grob_set (me, "note-heads", heads);
 250   Grob *xref = common_refpoint_of_array (heads, me, X_AXIS);
 251
 252   for (vsize i = heads.size (); i--;)
 253     {
 254       Grob *n = heads[i];
 255       if (filter
 256           && n->relative_coordinate (xref, X_AXIS) != 0.0)
 257         continue;
 258
 259       int p = Staff_symbol_referencer::get_rounded_position (n);
 260       ps.push_back (p);
 261     }
 262
 263   vector_sort (ps, less<int> ());
 264   return ps;
 265 }
 266
 267 void
 268 Stem::add_head (Grob *me, Grob *n)
 269 {
 270   n->set_object ("stem", me->self_scm ());
 271
 272   if (has_interface<Note_head> (n))
 273     Pointer_group_interface::add_grob (me, ly_symbol2scm ("note-heads"), n);
 274   else if (has_interface<Rest> (n))
 275     Pointer_group_interface::add_grob (me, ly_symbol2scm ("rests"), n);
 276 }
 277
 278 bool
 279 Stem::is_invisible (Grob *me)
 280 {
 281   if (is_normal_stem (me))
 282     return false;
 283   else if (head_count (me))
 284     return true;
 285   else // if there are no note-heads, we might want stemlets
 286     return 0.0 == robust_scm2double (me->get_property ("stemlet-length"), 0.0);
 287 }
 288
 289 bool
 290 Stem::is_normal_stem (Grob *me)
 291 {
 292   if (!head_count (me))
 293     return false;
 294
 295   return scm_to_int (me->get_property ("duration-log")) >= 1;
 296 }
 297
 298 MAKE_SCHEME_CALLBACK (Stem, pure_height, 3)
 299 SCM
 300 Stem::pure_height (SCM smob,
 301                    SCM /* start */,
 302                    SCM /* end */)
 303 {
 304   Grob *me = unsmob<Grob> (smob);
 305   return ly_interval2scm (internal_pure_height (me, true));
 306 }
 307
 308 Interval
 309 Stem::internal_pure_height (Grob *me, bool calc_beam)
 310 {
 311   if (!is_normal_stem (me))
 312     return Interval (0.0, 0.0);
 313
 314   Grob *beam = unsmob<Grob> (me->get_object ("beam"));
 315
 316   Interval iv = internal_height (me, false);
 317
 318   if (!beam)
 319     return iv;
 320   if (calc_beam)
 321     {
 322       Interval overshoot;
 323       Direction dir = get_grob_direction (me);
 324       for (DOWN_and_UP (d))
 325         overshoot[d] = d == dir ? dir * infinity_f : iv[d];
 326
 327       vector<Interval> heights;
 328       vector<Grob *> my_stems;
 329       extract_grob_set (beam, "normal-stems", normal_stems);
 330       for (vsize i = 0; i < normal_stems.size (); i++)
 331         if (get_grob_direction (normal_stems[i]) == dir)
 332           {
 333             if (normal_stems[i] != me)
 334               heights.push_back (Stem::internal_pure_height (normal_stems[i], false));
 335             else
 336               heights.push_back (iv);
 337             my_stems.push_back (normal_stems[i]);
 338           }
 339       //iv.unite (heights.back ());
 340       // look for cross staff effects
 341       vector<Real> coords;
 342       Grob *common = common_refpoint_of_array (my_stems, me, Y_AXIS);
 343       Real min_pos = infinity_f;
 344       Real max_pos = -infinity_f;
 345       for (vsize i = 0; i < my_stems.size (); i++)
 346         {
 347           coords.push_back (my_stems[i]->pure_relative_y_coordinate (common, 0, INT_MAX));
 348           min_pos = min (min_pos, coords[i]);
 349           max_pos = max (max_pos, coords[i]);
 350         }
 351       for (vsize i = 0; i < heights.size (); i++)
 352         {
 353           heights[i][dir] += dir == DOWN
 354                              ? coords[i] - max_pos
 355                              : coords[i] - min_pos;
 356         }
 357
 358       for (vsize i = 0; i < heights.size (); i++) iv.unite (heights[i]);
 359
 360       for (vsize i = 0; i < my_stems.size (); i++)
 361         cache_pure_height (my_stems[i], iv, heights[i]);
 362       iv.intersect (overshoot);
 363     }
 364
 365   return iv;
 366 }
 367
 368 void
 369 Stem::cache_pure_height (Grob *me, Interval iv, Interval my_iv)
 370 {
 371   Interval overshoot;
 372   Direction dir = get_grob_direction (me);
 373   for (DOWN_and_UP (d))
 374     overshoot[d] = d == dir ? dir * infinity_f : my_iv[d];
 375
 376   iv.intersect (overshoot);
 377   dynamic_cast<Item *> (me)->cache_pure_height (iv);
 378 }
 379
 380 MAKE_SCHEME_CALLBACK (Stem, calc_stem_end_position, 1)
 381 SCM
 382 Stem::calc_stem_end_position (SCM smob)
 383 {
 384   Grob *me = unsmob<Grob> (smob);
 385   return scm_from_double (internal_calc_stem_end_position (me, true));
 386 }
 387
 388 MAKE_SCHEME_CALLBACK (Stem, pure_calc_stem_end_position, 3)
 389 SCM
 390 Stem::pure_calc_stem_end_position (SCM smob,
 391                                    SCM, /* start */
 392                                    SCM /* end */)
 393 {
 394   Grob *me = unsmob<Grob> (smob);
 395   return scm_from_double (internal_calc_stem_end_position (me, false));
 396 }
 397
 398 Real
 399 Stem::internal_calc_stem_end_position (Grob *me, bool calc_beam)
 400 {
 401   if (!head_count (me))
 402     return 0.0;
 403
 404   Grob *beam = get_beam (me);
 405   Real ss = Staff_symbol_referencer::staff_space (me);
 406   Direction dir = get_grob_direction (me);
 407
 408   if (beam && calc_beam)
 409     {
 410       (void) beam->get_property ("quantized-positions");
 411       return robust_scm2double (me->get_property ("length"), 0.0)
 412              + dir * robust_scm2double (me->get_property ("stem-begin-position"), 0.0);
 413     }
 414
 415   vector<Real> a;
 416
 417   /* WARNING: IN HALF SPACES */
 418   SCM details = me->get_property ("details");
 419   int durlog = duration_log (me);
 420
 421   Real staff_rad = Staff_symbol_referencer::staff_radius (me);
 422   Real length = 7;
 423   SCM s = ly_assoc_get (ly_symbol2scm ("lengths"), details, SCM_EOL);
 424   if (scm_is_pair (s))
 425     length = 2 * scm_to_double (robust_list_ref (durlog - 2, s));
 426
 427   /* Stems in unnatural (forced) direction should be shortened,
 428      according to [Roush & Gourlay] */
 429   Interval hp = head_positions (me);
 430   if (dir && dir * hp[dir] >= 0)
 431     {
 432       SCM sshorten = ly_assoc_get (ly_symbol2scm ("stem-shorten"), details, SCM_EOL);
 433       SCM scm_shorten = scm_is_pair (sshorten)
 434                         ? robust_list_ref (max (duration_log (me) - 2, 0), sshorten) : SCM_EOL;
 435       Real shorten_property = 2 * robust_scm2double (scm_shorten, 0);
 436       /*  change in length between full-size and shortened stems is executed gradually.
 437           "transition area" = stems between full-sized and fully-shortened.
 438           */
 439       Real quarter_stem_length = 2 * scm_to_double (robust_list_ref (0, s));
 440       /*  shortening_step = difference in length between consecutive stem lengths
 441           in transition area. The bigger the difference between full-sized
 442           and shortened stems, the bigger shortening_step is.
 443           (but not greater than 1/2 and not smaller than 1/4).
 444           value 6 is heuristic; it determines the suggested transition slope steepnesas.
 445           */
 446       Real shortening_step = min (max (0.25, (shorten_property / 6)), 0.5);
 447       /*  Shortening of unflagged stems should begin on the first stem that sticks
 448           more than 1 staffspace (2 units) out of the staff.
 449           Shortening of flagged stems begins in the same moment as unflagged ones,
 450           but not earlier than on the middle line note.
 451           */
 452       Real which_step = (min (1.0, quarter_stem_length - (2 * staff_rad) - 2.0)) + abs (hp[dir]);
 453       Real shorten = min (max (0.0, (shortening_step * which_step)), shorten_property);
 454
 455       length -= shorten;
 456     }
 457
 458   length *= robust_scm2double (me->get_property ("length-fraction"), 1.0);
 459
 460   /* Tremolo stuff.  */
 461   Grob *t_flag = unsmob<Grob> (me->get_object ("tremolo-flag"));
 462   if (t_flag && (!unsmob<Grob> (me->get_object ("beam")) || !calc_beam))
 463     {
 464       /* Crude hack: add extra space if tremolo flag is there.
 465
 466       We can't do this for the beam, since we get into a loop
 467       (Stem_tremolo::raw_stencil () looks at the beam.) --hwn  */
 468
 469       Real minlen = 1.0
 470                     + 2 * Stem_tremolo::vertical_length (t_flag) / ss;
 471
 472       /* We don't want to add the whole extent of the flag because the trem
 473          and the flag can overlap partly. beam_translation gives a good
 474          approximation */
 475       if (durlog >= 3)
 476         {
 477           Real beam_trans = Stem_tremolo::get_beam_translation (t_flag);
 478           /* the obvious choice is (durlog - 2) here, but we need a bit more space. */
 479           minlen += 2 * (durlog - 1.5) * beam_trans;
 480
 481           /* up-stems need even a little more space to avoid collisions. This
 482              needs to be in sync with the tremolo positioning code in
 483              Stem_tremolo::print */
 484           if (dir == UP)
 485             minlen += beam_trans;
 486         }
 487       length = max (length, minlen + 1.0);
 488     }
 489
 490   Real stem_end = dir ? hp[dir] + dir * length : 0;
 491
 492   /* TODO: change name  to extend-stems to staff/center/'()  */
 493   bool no_extend = to_boolean (me->get_property ("no-stem-extend"));
 494   if (!no_extend && dir * stem_end < 0)
 495     stem_end = 0.0;
 496
 497   return stem_end;
 498 }
 499
 500 /* The log of the duration (Number of hooks on the flag minus two)  */
 501 int
 502 Stem::duration_log (Grob *me)
 503 {
 504   SCM s = me->get_property ("duration-log");
 505   return (scm_is_number (s)) ? scm_to_int (s) : 2;
 506 }
 507
 508 MAKE_SCHEME_CALLBACK (Stem, calc_positioning_done, 1);
 509 SCM
 510 Stem::calc_positioning_done (SCM smob)
 511 {
 512   Grob *me = unsmob<Grob> (smob);
 513   if (!head_count (me))
 514     return SCM_BOOL_T;
 515
 516   me->set_property ("positioning-done", SCM_BOOL_T);
 517
 518   extract_grob_set (me, "note-heads", ro_heads);
 519   vector<Grob *> heads (ro_heads);
 520   vector_sort (heads, position_less);
 521   Direction dir = get_grob_direction (me);
 522
 523   if (dir < 0)
 524     reverse (heads);
 525
 526   Real thick = thickness (me);
 527
 528   Grob *hed = support_head (me);
 529   if (!dir)
 530     {
 531       programming_error ("Stem dir must be up or down.");
 532       dir = UP;
 533       set_grob_direction (me, dir);
 534     }
 535
 536   bool is_harmonic_centered = false;
 537   for (vsize i = 0; i < heads.size (); i++)
 538     is_harmonic_centered = is_harmonic_centered
 539                            || scm_is_eq (heads[i]->get_property ("style"),
 540                                          ly_symbol2scm ("harmonic"));
 541   is_harmonic_centered = is_harmonic_centered && is_invisible (me);
 542
 543   Real w = hed->extent (hed, X_AXIS)[dir];
 544   for (vsize i = 0; i < heads.size (); i++)
 545     {
 546       Real amount = w - heads[i]->extent (heads[i], X_AXIS)[dir];
 547
 548       if (is_harmonic_centered)
 549         amount
 550           = hed->extent (hed, X_AXIS).linear_combination (CENTER)
 551             - heads[i]->extent (heads[i], X_AXIS).linear_combination (CENTER);
 552
 553       if (!isnan (amount)) // empty heads can produce NaN
 554         heads[i]->translate_axis (amount, X_AXIS);
 555     }
 556   bool parity = true;
 557   Real lastpos = Real (Staff_symbol_referencer::get_position (heads[0]));
 558   for (vsize i = 1; i < heads.size (); i++)
 559     {
 560       Real p = Staff_symbol_referencer::get_position (heads[i]);
 561       Real dy = fabs (lastpos - p);
 562
 563       /*
 564         dy should always be 0.5, 0.0, 1.0, but provide safety margin
 565         for rounding errors.
 566       */
 567       if (dy < 1.1)
 568         {
 569           if (parity)
 570             {
 571               Real ell = heads[i]->extent (heads[i], X_AXIS).length ();
 572
 573               Direction d = get_grob_direction (me);
 574               /*
 575                 Reversed head should be shifted ell-thickness, but this
 576                 looks too crowded, so we only shift ell-0.5*thickness.
 577
 578                 This leads to assymetry: Normal heads overlap the
 579                 stem 100% whereas reversed heads only overlaps the
 580                 stem 50%
 581               */
 582               Real reverse_overlap = 0.5;
 583
 584               /*
 585                 However, the first reverse head has to be shifted even
 586                 more than the full reverse overlap if it is the same
 587                 height as the first head or there will be a gap
 588                 because of the head slant (issue 346).
 589               */
 590
 591               if (i == 1 && dy < 0.1)
 592                 reverse_overlap = 1.1;
 593
 594               if (is_invisible (me))
 595                 {
 596                   // Semibreves and longer are tucked in considerably
 597                   // to be recognizable as chorded rather than
 598                   // parallel voices.  During the course of issue 346
 599                   // there was a discussion to change this for unisons
 600                   // (dy < 0.1) to reduce overlap but without reaching
 601                   // agreement and with Gould being rather on the
 602                   // overlapping front.
 603                   reverse_overlap = 2;
 604                 }
 605
 606               heads[i]->translate_axis ((ell - thick * reverse_overlap) * d,
 607                                         X_AXIS);
 608
 609               /* TODO:
 610
 611               For some cases we should kern some more: when the
 612               distance between the next or prev note is too large, we'd
 613               get large white gaps, eg.
 614
 615               |
 616               X|
 617               |X  <- kern this.
 618               |
 619               X
 620
 621               */
 622             }
 623           parity = !parity;
 624         }
 625       else
 626         parity = true;
 627
 628       lastpos = int (p);
 629     }
 630
 631   return SCM_BOOL_T;
 632 }
 633
 634 MAKE_SCHEME_CALLBACK (Stem, calc_direction, 1);
 635 SCM
 636 Stem::calc_direction (SCM smob)
 637 {
 638   Grob *me = unsmob<Grob> (smob);
 639   Direction dir = CENTER;
 640   if (Grob *beam = unsmob<Grob> (me->get_object ("beam")))
 641     {
 642       SCM ignore_me = beam->get_property ("direction");
 643       (void) ignore_me;
 644       dir = get_grob_direction (me);
 645     }
 646   else
 647     {
 648       SCM dd = me->get_property ("default-direction");
 649       dir = to_dir (dd);
 650       if (!dir)
 651         return me->get_property ("neutral-direction");
 652     }
 653
 654   return scm_from_int (dir);
 655 }
 656
 657 MAKE_SCHEME_CALLBACK (Stem, calc_default_direction, 1);
 658 SCM
 659 Stem::calc_default_direction (SCM smob)
 660 {
 661   Grob *me = unsmob<Grob> (smob);
 662
 663   Direction dir = CENTER;
 664   int staff_center = 0;
 665   if (head_count (me))
 666     {
 667       Interval hp = head_positions (me);
 668       int udistance = (int) (UP * hp[UP] - staff_center);
 669       int ddistance = (int) (DOWN * hp[DOWN] - staff_center);
 670
 671       dir = Direction (sign (ddistance - udistance));
 672     }
 673
 674   return scm_from_int (dir);
 675 }
 676
 677 // note - height property necessary to trigger quantized beam positions
 678 // otherwise, we could just use Grob::stencil_height_proc
 679 MAKE_SCHEME_CALLBACK (Stem, height, 1);
 680 SCM
 681 Stem::height (SCM smob)
 682 {
 683   Grob *me = unsmob<Grob> (smob);
 684   return ly_interval2scm (internal_height (me, true));
 685 }
 686
 687 Grob *
 688 Stem::get_reference_head (Grob *me)
 689 {
 690   return to_boolean (me->get_property ("avoid-note-head"))
 691          ? last_head (me)
 692          : first_head (me);
 693 }
 694
 695 Real
 696 Stem::beam_end_corrective (Grob *me)
 697 {
 698   Grob *beam = unsmob<Grob> (me->get_object ("beam"));
 699   Direction dir = get_grob_direction (me);
 700   if (beam)
 701     {
 702       if (dir == CENTER)
 703         {
 704           programming_error ("no stem direction");
 705           dir = UP;
 706         }
 707       return dir * Beam::get_beam_thickness (beam) * 0.5;
 708     }
 709   return 0.0;
 710 }
 711
 712 Interval
 713 Stem::internal_height (Grob *me, bool calc_beam)
 714 {
 715   Grob *beam = get_beam (me);
 716   if (!is_valid_stem (me) && !beam)
 717     return Interval ();
 718
 719   Direction dir = get_grob_direction (me);
 720
 721   if (beam && calc_beam)
 722     {
 723       /* trigger set-stem-lengths. */
 724       (void) beam->get_property ("quantized-positions");
 725     }
 726
 727   /*
 728     If there is a beam but no stem, slope calculations depend on this
 729     routine to return where the stem end /would/ be.
 730   */
 731   if (calc_beam && !beam && !unsmob<Stencil> (me->get_property ("stencil")))
 732     return Interval ();
 733
 734   Real y1 = robust_scm2double ((calc_beam
 735                                 ? me->get_property ("stem-begin-position")
 736                                 : me->get_pure_property ("stem-begin-position", 0, INT_MAX)),
 737                                0.0);
 738
 739   Real y2 = dir * robust_scm2double ((calc_beam
 740                                       ? me->get_property ("length")
 741                                       : me->get_pure_property ("length", 0, INT_MAX)),
 742                                      0.0)
 743             + y1;
 744
 745   Real half_space = Staff_symbol_referencer::staff_space (me) * 0.5;
 746
 747   Interval stem_y = Interval (min (y1, y2), max (y2, y1)) * half_space;
 748
 749   return stem_y;
 750 }
 751
 752 MAKE_SCHEME_CALLBACK (Stem, width, 1);
 753 SCM
 754 Stem::width (SCM e)
 755 {
 756   Grob *me = unsmob<Grob> (e);
 757
 758   Interval r;
 759
 760   if (is_invisible (me))
 761     r.set_empty ();
 762   else
 763     {
 764       r = Interval (-1, 1);
 765       r *= thickness (me) / 2;
 766     }
 767
 768   return ly_interval2scm (r);
 769 }
 770
 771 Real
 772 Stem::thickness (Grob *me)
 773 {
 774   return scm_to_double (me->get_property ("thickness"))
 775          * Staff_symbol_referencer::line_thickness (me);
 776 }
 777
 778 MAKE_SCHEME_CALLBACK (Stem, calc_stem_begin_position, 1);
 779 SCM
 780 Stem::calc_stem_begin_position (SCM smob)
 781 {
 782   Grob *me = unsmob<Grob> (smob);
 783   return scm_from_double (internal_calc_stem_begin_position (me, true));
 784 }
 785
 786 MAKE_SCHEME_CALLBACK (Stem, pure_calc_stem_begin_position, 3);
 787 SCM
 788 Stem::pure_calc_stem_begin_position (SCM smob,
 789                                      SCM, /* start */
 790                                      SCM /* end */)
 791 {
 792   Grob *me = unsmob<Grob> (smob);
 793   return scm_from_double (internal_calc_stem_begin_position (me, false));
 794 }
 795
 796 Real
 797 Stem::internal_calc_stem_begin_position (Grob *me, bool calc_beam)
 798 {
 799   Grob *beam = get_beam (me);
 800   Real ss = Staff_symbol_referencer::staff_space (me);
 801   if (beam && calc_beam)
 802     {
 803       (void) beam->get_property ("quantized-positions");
 804       return robust_scm2double (me->get_property ("stem-begin-position"), 0.0);
 805     }
 806
 807   Direction d = get_grob_direction (me);
 808   Grob *lh = get_reference_head (me);
 809
 810   if (!lh)
 811     return 0.0;
 812
 813   Real pos = Staff_symbol_referencer::get_position (lh);
 814
 815   if (Grob *head = support_head (me))
 816     {
 817       Interval head_height = head->extent (head, Y_AXIS);
 818       Real y_attach = Note_head::stem_attachment_coordinate (head, Y_AXIS);
 819
 820       y_attach = head_height.linear_combination (y_attach);
 821       if (!isinf (y_attach) && !isnan (y_attach)) // empty heads
 822         pos += d * y_attach * 2 / ss;
 823     }
 824
 825   return pos;
 826 }
 827
 828
 829 MAKE_SCHEME_CALLBACK (Stem, pure_calc_length, 3);
 830 SCM
 831 Stem::pure_calc_length (SCM smob, SCM /*start*/, SCM /*end*/)
 832 {
 833   Grob *me = unsmob<Grob> (smob);
 834   Real beg = robust_scm2double (me->get_pure_property ("stem-begin-position", 0, INT_MAX), 0.0);
 835   Real res = fabs (internal_calc_stem_end_position (me, false) - beg);
 836   return scm_from_double (res);
 837 }
 838
 839 MAKE_SCHEME_CALLBACK (Stem, calc_length, 1);
 840 SCM
 841 Stem::calc_length (SCM smob)
 842 {
 843   Grob *me = unsmob<Grob> (smob);
 844   if (unsmob<Grob> (me->get_object ("beam")))
 845     {
 846       me->programming_error ("ly:stem::calc-length called but will not be used for beamed stem.");
 847       return scm_from_double (0.0);
 848     }
 849
 850   Real beg = robust_scm2double (me->get_property ("stem-begin-position"), 0.0);
 851   Real res = fabs (internal_calc_stem_end_position (me, true) - beg);
 852   return scm_from_double (res);
 853 }
 854
 855 bool
 856 Stem::is_valid_stem (Grob *me)
 857 {
 858   /* TODO: make the stem start a direction ?
 859      This is required to avoid stems passing in tablature chords.  */
 860   if (!me)
 861     return false;
 862   Grob *lh = get_reference_head (me);
 863   Grob *beam = unsmob<Grob> (me->get_object ("beam"));
 864
 865   if (!lh && !beam)
 866     return false;
 867
 868   if (is_invisible (me))
 869     return false;
 870
 871   return true;
 872 }
 873
 874 MAKE_SCHEME_CALLBACK (Stem, print, 1);
 875 SCM
 876 Stem::print (SCM smob)
 877 {
 878   Grob *me = unsmob<Grob> (smob);
 879   if (!is_valid_stem (me))
 880     return SCM_EOL;
 881
 882   Direction dir = get_grob_direction (me);
 883   Real y1 = robust_scm2double (me->get_property ("stem-begin-position"), 0.0);
 884   Real y2 = dir * robust_scm2double (me->get_property ("length"), 0.0) + y1;
 885
 886   Real half_space = Staff_symbol_referencer::staff_space (me) * 0.5;
 887
 888   Interval stem_y = Interval (min (y1, y2), max (y2, y1)) * half_space;
 889
 890   stem_y[dir] -= beam_end_corrective (me);
 891
 892   // URG
 893   Real stem_width = thickness (me);
 894   Real blot
 895     = me->layout ()->get_dimension (ly_symbol2scm ("blot-diameter"));
 896
 897   Box b = Box (Interval (-stem_width / 2, stem_width / 2),
 898                stem_y);
 899
 900   Stencil mol;
 901   Stencil ss = Lookup::round_filled_box (b, blot);
 902   mol.add_stencil (ss);
 903
 904   return mol.smobbed_copy ();
 905 }
 906
 907 /*
 908   move the stem to right of the notehead if it is up.
 909 */
 910 MAKE_SCHEME_CALLBACK (Stem, offset_callback, 1);
 911 SCM
 912 Stem::offset_callback (SCM smob)
 913 {
 914   Grob *me = unsmob<Grob> (smob);
 915
 916   extract_grob_set (me, "rests", rests);
 917   if (rests.size ())
 918     {
 919       Grob *rest = rests.back ();
 920       Real r = robust_relative_extent (rest, rest, X_AXIS).center ();
 921       return scm_from_double (r);
 922     }
 923
 924   if (Grob *f = first_head (me))
 925     {
 926       Interval head_wid = f->extent (f, X_AXIS);
 927       Real attach = 0.0;
 928
 929       if (is_invisible (me))
 930         attach = 0.0;
 931       else
 932         attach = Note_head::stem_attachment_coordinate (f, X_AXIS);
 933
 934       Direction d = get_grob_direction (me);
 935       Real real_attach = head_wid.linear_combination (d * attach);
 936       Real r = isnan(real_attach)? 0.0: real_attach;
 937
 938       /* If not centered: correct for stem thickness.  */
 939       string style = robust_symbol2string (f->get_property ("style"), "default");
 940       if (attach && style != "mensural"
 941           && style != "neomensural"
 942           && style != "petrucci")
 943         {
 944           Real rule_thick = thickness (me);
 945           r += -d * rule_thick * 0.5;
 946         }
 947       return scm_from_double (r);
 948     }
 949
 950   programming_error ("Weird stem.");
 951   return scm_from_double (0.0);
 952 }
 953
 954 Spanner *
 955 Stem::get_beam (Grob *me)
 956 {
 957   SCM b = me->get_object ("beam");
 958   return unsmob<Spanner> (b);
 959 }
 960
 961 Stem_info
 962 Stem::get_stem_info (Grob *me)
 963 {
 964   Stem_info si;
 965   si.dir_ = get_grob_direction (me);
 966
 967   SCM scm_info = me->get_property ("stem-info");
 968   si.ideal_y_ = scm_to_double (scm_car (scm_info));
 969   si.shortest_y_ = scm_to_double (scm_cadr (scm_info));
 970   return si;
 971 }
 972
 973 MAKE_SCHEME_CALLBACK (Stem, calc_stem_info, 1);
 974 SCM
 975 Stem::calc_stem_info (SCM smob)
 976 {
 977   Grob *me = unsmob<Grob> (smob);
 978   Direction my_dir = get_grob_direction (me);
 979
 980   if (!my_dir)
 981     {
 982       programming_error ("no stem dir set");
 983       my_dir = UP;
 984     }
 985
 986   Real staff_space = Staff_symbol_referencer::staff_space (me);
 987   Grob *beam = get_beam (me);
 988
 989   if (beam)
 990     {
 991       (void) beam->get_property ("beaming");
 992     }
 993
 994   Real beam_translation = Beam::get_beam_translation (beam);
 995   Real beam_thickness = Beam::get_beam_thickness (beam);
 996   int beam_count = Beam::get_direction_beam_count (beam, my_dir);
 997   Real length_fraction
 998     = robust_scm2double (me->get_property ("length-fraction"), 1.0);
 999
1000   /* Simple standard stem length */
1001   SCM details = me->get_property ("details");
1002   SCM lengths = ly_assoc_get (ly_symbol2scm ("beamed-lengths"), details, SCM_EOL);
1003
1004   Real ideal_length
1005     = (scm_is_pair (lengths)
1006        ? (scm_to_double (robust_list_ref (beam_count - 1, lengths))
1007           * staff_space
1008           * length_fraction
1009           /*
1010             stem only extends to center of beam
1011           */
1012           - 0.5 * beam_thickness)
1013        : 0.0);
1014
1015   /* Condition: sane minimum free stem length (chord to beams) */
1016   lengths = ly_assoc_get (ly_symbol2scm ("beamed-minimum-free-lengths"),
1017                           details, SCM_EOL);
1018
1019   Real ideal_minimum_free
1020     = (scm_is_pair (lengths)
1021        ? (scm_to_double (robust_list_ref (beam_count - 1, lengths))
1022           * staff_space
1023           * length_fraction)
1024        : 0.0);
1025
1026   Real height_of_my_trem = 0.0;
1027   Grob *trem = unsmob<Grob> (me->get_object ("tremolo-flag"));
1028   if (trem)
1029     {
1030       height_of_my_trem
1031         = Stem_tremolo::vertical_length (trem)
1032           /* hack a bit of space around the trem. */
1033           + beam_translation;
1034     }
1035
1036   /* UGH
1037      It seems that also for ideal minimum length, we must use
1038      the maximum beam count (for this direction):
1039
1040      \score { \relative c'' { a8[ a32] } }
1041
1042      must be horizontal. */
1043   Real height_of_my_beams = beam_thickness
1044                             + (beam_count - 1) * beam_translation;
1045
1046   Real ideal_minimum_length = ideal_minimum_free
1047                               + height_of_my_beams
1048                               + height_of_my_trem
1049                               /* stem only extends to center of beam */
1050                               - 0.5 * beam_thickness;
1051
1052   ideal_length = max (ideal_length, ideal_minimum_length);
1053
1054   /* Convert to Y position, calculate for dir == UP */
1055   Real note_start
1056     =     /* staff positions */
1057       head_positions (me)[my_dir] * 0.5
1058       * my_dir * staff_space;
1059   Real ideal_y = note_start + ideal_length;
1060
1061   /* Conditions for Y position */
1062
1063   /* Lowest beam of (UP) beam must never be lower than second staffline
1064
1065   Reference?
1066
1067   Although this (additional) rule is probably correct,
1068   I expect that highest beam (UP) should also never be lower
1069   than middle staffline, just as normal stems.
1070
1071   Reference?
1072
1073   Obviously not for grace beams.
1074
1075   Also, not for knees.  Seems to be a good thing. */
1076   bool no_extend = to_boolean (me->get_property ("no-stem-extend"));
1077   bool is_knee = Beam::is_knee (beam);
1078   if (!no_extend && !is_knee)
1079     {
1080       /* Highest beam of (UP) beam must never be lower than middle
1081          staffline */
1082       ideal_y = max (ideal_y, 0.0);
1083       /* Lowest beam of (UP) beam must never be lower than second staffline */
1084       ideal_y = max (ideal_y, (-staff_space
1085                                - beam_thickness + height_of_my_beams));
1086     }
1087
1088   ideal_y -= robust_scm2double (beam->get_property ("shorten"), 0);
1089
1090   SCM bemfl = ly_assoc_get (ly_symbol2scm ("beamed-extreme-minimum-free-lengths"),
1091                             details, SCM_EOL);
1092
1093   Real minimum_free
1094     = (scm_is_pair (bemfl)
1095        ? (scm_to_double (robust_list_ref (beam_count - 1, bemfl))
1096           * staff_space
1097           * length_fraction)
1098        : 0.0);
1099
1100   Real minimum_length = max (minimum_free, height_of_my_trem)
1101                         + height_of_my_beams
1102                         /* stem only extends to center of beam */
1103                         - 0.5 * beam_thickness;
1104
1105   ideal_y *= my_dir;
1106   Real minimum_y = note_start + minimum_length;
1107   Real shortest_y = minimum_y * my_dir;
1108
1109   return scm_list_2 (scm_from_double (ideal_y),
1110                      scm_from_double (shortest_y));
1111 }
1112
1113 Slice
1114 Stem::beam_multiplicity (Grob *stem)
1115 {
1116   SCM beaming = stem->get_property ("beaming");
1117   Slice le = int_list_to_slice (scm_car (beaming));
1118   Slice ri = int_list_to_slice (scm_cdr (beaming));
1119   le.unite (ri);
1120   return le;
1121 }
1122
1123 bool
1124 Stem::is_cross_staff (Grob *stem)
1125 {
1126   Grob *beam = unsmob<Grob> (stem->get_object ("beam"));
1127   return beam && Beam::is_cross_staff (beam);
1128 }
1129
1130 MAKE_SCHEME_CALLBACK (Stem, calc_cross_staff, 1)
1131 SCM
1132 Stem::calc_cross_staff (SCM smob)
1133 {
1134   return scm_from_bool (is_cross_staff (unsmob<Grob> (smob)));
1135 }
1136
1137 Grob *
1138 Stem::flag (Grob *me)
1139 {
1140   return unsmob<Grob> (me->get_object ("flag"));
1141 }
1142
1143 /* FIXME:  Too many properties  */
1144 ADD_INTERFACE (Stem,
1145                "The stem represents the graphical stem.  In addition, it"
1146                " internally connects note heads, beams, and tremolos.  Rests"
1147                " and whole notes have invisible stems.\n"
1148                "\n"
1149                "The following properties may be set in the @code{details}"
1150                " list.\n"
1151                "\n"
1152                "@table @code\n"
1153                "@item beamed-lengths\n"
1154                "List of stem lengths given beam multiplicity.\n"
1155                "@item beamed-minimum-free-lengths\n"
1156                "List of normal minimum free stem lengths (chord to beams)"
1157                " given beam multiplicity.\n"
1158                "@item beamed-extreme-minimum-free-lengths\n"
1159                "List of extreme minimum free stem lengths (chord to beams)"
1160                " given beam multiplicity.\n"
1161                "@item lengths\n"
1162                "Default stem lengths.  The list gives a length for each"
1163                " flag count.\n"
1164                "@item stem-shorten\n"
1165                "How much a stem in a forced direction should be shortened."
1166                "  The list gives an amount depending on the number of flags"
1167                " and beams.\n"
1168                "@end table\n",
1169
1170                /* properties */
1171                "avoid-note-head "
1172                "beam "
1173                "beaming "
1174                "beamlet-default-length "
1175                "beamlet-max-length-proportion "
1176                "default-direction "
1177                "details "
1178                "direction "
1179                "double-stem-separation "
1180                "duration-log "
1181                "flag "
1182                "french-beaming "
1183                "length "
1184                "length-fraction "
1185                "max-beam-connect "
1186                "melody-spanner "
1187                "neutral-direction "
1188                "no-stem-extend "
1189                "note-heads "
1190                "positioning-done "
1191                "rests "
1192                "stem-begin-position "
1193                "stem-info "
1194                "stemlet-length "
1195                "thickness "
1196                "tremolo-flag "
1197                "tuplet-start "
1198               );
1199
1200 /****************************************************************/
1201
1202 Stem_info::Stem_info ()
1203 {
1204   ideal_y_ = shortest_y_ = 0;
1205   dir_ = CENTER;
1206 }
1207
1208 void
1209 Stem_info::scale (Real x)
1210 {
1211   ideal_y_ *= x;
1212   shortest_y_ *= x;
1213 }