lily/beam.cc

   1 /*
   2   beam.cc -- implement Beam
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1997--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7   Jan Nieuwenhuizen <janneke@gnu.org>
   8 */
   9
  10 /*
  11   TODO:
  12
  13   - Determine auto knees based on positions if it's set by the user.
  14
  15   - the code is littered with * and / staff_space calls for
  16   #'positions. Consider moving to real-world coordinates?
  17
  18   Problematic issue is user tweaks (user tweaks are in staff-coordinates.)
  19
  20   Notes:
  21
  22   - Stems run to the Y-center of the beam.
  23
  24   - beam_translation is the offset between Y centers of the beam.
  25 */
  26
  27 #include <math.h> // tanh.
  28
  29 #include "beam.hh"
  30 #include "interval-set.hh"
  31 #include "directional-element-interface.hh"
  32 #include "beaming.hh"
  33 #include "misc.hh"
  34 #include "least-squares.hh"
  35 #include "stem.hh"
  36 #include "output-def.hh"
  37 #include "lookup.hh"
  38 #include "group-interface.hh"
  39 #include "staff-symbol-referencer.hh"
  40 #include "item.hh"
  41 #include "spanner.hh"
  42 #include "warn.hh"
  43
  44 #if DEBUG_QUANTING
  45 #include "text-item.hh" // debug output.
  46 #include "font-interface.hh" // debug output.
  47 #endif
  48
  49 void
  50 Beam::add_stem (Grob *me, Grob *s)
  51 {
  52   Pointer_group_interface::add_grob (me, ly_symbol2scm ("stems"), s);
  53
  54   s->add_dependency (me);
  55
  56   assert (!Stem::get_beam (s));
  57   s->set_property ("beam", me->self_scm ());
  58
  59   add_bound_item (dynamic_cast<Spanner *> (me), dynamic_cast<Item *> (s));
  60 }
  61
  62 Real
  63 Beam::get_thickness (Grob *me)
  64 {
  65   return robust_scm2double (me->get_property ("thickness"), 0)
  66     * Staff_symbol_referencer::staff_space (me);
  67 }
  68
  69 /* Return the translation between 2 adjoining beams. */
  70 Real
  71 Beam::get_beam_translation (Grob *me)
  72 {
  73   SCM func = me->get_property ("space-function");
  74
  75   if (ly_c_procedure_p (func))
  76     {
  77       SCM s = scm_call_2 (func, me->self_scm (), scm_int2num (get_beam_count (me)));
  78       return scm_to_double (s);
  79     }
  80   else
  81     {
  82       return 0.81;
  83     }
  84 }
  85
  86 /* Maximum beam_count. */
  87 int
  88 Beam::get_beam_count (Grob *me)
  89 {
  90   int m = 0;
  91   for (SCM s = me->get_property ("stems"); scm_is_pair (s); s = scm_cdr (s))
  92     {
  93       Grob *stem = unsmob_grob (scm_car (s));
  94       m = m >? (Stem::beam_multiplicity (stem).length () + 1);
  95     }
  96   return m;
  97 }
  98
  99 /*
 100   Space return space between beams.
 101 */
 102 MAKE_SCHEME_CALLBACK (Beam, space_function, 2);
 103 SCM
 104 Beam::space_function (SCM smob, SCM beam_count)
 105 {
 106   Grob *me = unsmob_grob (smob);
 107
 108   Real staff_space = Staff_symbol_referencer::staff_space (me);
 109   Real line = Staff_symbol_referencer::line_thickness (me);
 110   Real thickness = get_thickness (me);
 111
 112   Real beam_translation = scm_to_int (beam_count) < 4
 113     ? (2*staff_space + line - thickness) / 2.0
 114     : (3*staff_space + line - thickness) / 3.0;
 115
 116   return scm_make_real (beam_translation);
 117 }
 118
 119 /* After pre-processing all directions should be set.
 120    Several post-processing routines (stem, slur, script) need stem/beam
 121    direction.
 122    Currenly, this means that beam has set all stem's directions.
 123    [Alternatively, stems could set its own directions, according to
 124    their beam, during 'final-pre-processing'.] */
 125 MAKE_SCHEME_CALLBACK (Beam, before_line_breaking, 1);
 126 SCM
 127 Beam::before_line_breaking (SCM smob)
 128 {
 129   Grob *me = unsmob_grob (smob);
 130
 131   /* Beams with less than 2 two stems don't make much sense, but could happen
 132      when you do
 133
 134      [r8 c8 r8].
 135
 136      For a beam that  only has one stem, we try to do some disappearance magic:
 137      we revert the flag, and move on to The Eternal Engraving Fields. */
 138
 139   int count = visible_stem_count (me);
 140   if (count < 2)
 141     {
 142       me->warning (_ ("beam has less than two visible stems"));
 143
 144       SCM stems = me->get_property ("stems");
 145       if (scm_ilength (stems) == 1)
 146         {
 147           me->warning (_ ("removing beam with less than two stems"));
 148
 149           unsmob_grob (scm_car (stems))->set_property ("beam", SCM_EOL);
 150           me->suicide ();
 151
 152           return SCM_UNSPECIFIED;
 153         }
 154       else if (scm_ilength (stems) == 0)
 155         {
 156           me->suicide ();
 157           return SCM_UNSPECIFIED;
 158         }
 159     }
 160   if (count >= 1)
 161     {
 162       Direction d = get_default_dir (me);
 163
 164       consider_auto_knees (me);
 165       set_stem_directions (me, d);
 166
 167       connect_beams (me);
 168
 169       set_stem_shorten (me);
 170     }
 171
 172   return SCM_EOL;
 173 }
 174
 175 /*
 176   We want a maximal number of shared beams, but if there is choice, we
 177   take the one that is closest to the end of the stem. This is for situations like
 178
 179        x
 180       |
 181       |
 182   |===|
 183   |=
 184   |
 185   x
 186 */
 187 int
 188 position_with_maximal_common_beams (SCM left_beaming, SCM right_beaming,
 189                                     Direction left_dir,
 190                                     Direction right_dir)
 191 {
 192   Slice lslice = int_list_to_slice (scm_cdr (left_beaming));
 193
 194   int best_count = 0;
 195   int best_start = 0;
 196   for (int i = lslice[-left_dir];
 197        (i - lslice[left_dir])* left_dir <= 0; i+= left_dir)
 198     {
 199       int count = 0;
 200       for (SCM s = scm_car (right_beaming); scm_is_pair (s); s = scm_cdr (s))
 201         {
 202           int k = -right_dir * scm_to_int (scm_car (s)) + i;
 203           if (scm_c_memq (scm_int2num (k), left_beaming) != SCM_BOOL_F)
 204             count++;
 205         }
 206
 207       if (count >= best_count)
 208         {
 209           best_count = count;
 210           best_start = i;
 211         }
 212     }
 213
 214   return best_start;
 215 }
 216
 217 void
 218 Beam::connect_beams (Grob *me)
 219 {
 220   Link_array<Grob> stems
 221     = extract_grob_array (me, ly_symbol2scm ("stems"));
 222
 223   Slice last_int;
 224   last_int.set_empty ();
 225   SCM last_beaming = SCM_EOL;
 226   Direction last_dir = CENTER;
 227   for (int i = 0; i< stems.size (); i++)
 228     {
 229       Grob *this_stem = stems[i];
 230       SCM this_beaming = this_stem->get_property ("beaming");
 231
 232       Direction this_dir = get_grob_direction (this_stem);
 233       if (scm_is_pair (last_beaming) && scm_is_pair (this_beaming))
 234         {
 235           int start_point = position_with_maximal_common_beams
 236             (last_beaming, this_beaming,
 237              last_dir, this_dir);
 238
 239           Direction d = LEFT;
 240           Slice new_slice;
 241           do
 242             {
 243               if (d == RIGHT && i == stems.size () - 1)
 244                 continue;
 245
 246               new_slice.set_empty ();
 247               SCM s = index_get_cell (this_beaming, d);
 248               for (; scm_is_pair (s); s = scm_cdr (s))
 249                 {
 250                   int new_beam_pos
 251                     = start_point - this_dir * scm_to_int (scm_car (s));
 252
 253                   new_slice.add_point (new_beam_pos);
 254                   scm_set_car_x (s, scm_int2num (new_beam_pos));
 255                 }
 256
 257             }
 258           while (flip (&d) != LEFT);
 259
 260           if (!new_slice.is_empty ())
 261             last_int = new_slice;
 262         }
 263       else
 264         {
 265           scm_set_car_x (this_beaming, SCM_EOL);
 266           SCM s = scm_cdr (this_beaming);
 267           for (; scm_is_pair (s); s = scm_cdr (s))
 268             {
 269               int np = -this_dir * scm_to_int (scm_car (s));
 270               scm_set_car_x (s, scm_int2num (np));
 271               last_int.add_point (np);
 272             }
 273         }
 274
 275       if (i == stems.size () -1)
 276         {
 277           scm_set_cdr_x (this_beaming, SCM_EOL);
 278         }
 279
 280       if (scm_ilength (scm_cdr (this_beaming)) > 0)
 281         {
 282           last_beaming = this_beaming;
 283           last_dir = this_dir;
 284         }
 285     }
 286 }
 287
 288 /*
 289   TODO: should not make beams per stem, but per Y-level.
 290 */
 291 MAKE_SCHEME_CALLBACK (Beam, print, 1);
 292 SCM
 293 Beam::print (SCM grob)
 294 {
 295   Spanner *me = unsmob_spanner (grob);
 296   position_beam (me);
 297
 298   Link_array<Grob> stems
 299     = extract_grob_array (me, ly_symbol2scm ("stems"));
 300   Grob *xcommon = common_refpoint_of_array (stems, me, X_AXIS);
 301
 302   xcommon = me->get_bound (LEFT)->common_refpoint (xcommon, X_AXIS);
 303   xcommon = me->get_bound (RIGHT)->common_refpoint (xcommon, X_AXIS);
 304
 305   Real x0, dx;
 306   if (visible_stem_count (me))
 307     {
 308       // ugh -> use commonx
 309       x0 = first_visible_stem (me)->relative_coordinate (xcommon, X_AXIS);
 310       dx = last_visible_stem (me)->relative_coordinate (xcommon, X_AXIS) - x0;
 311     }
 312   else
 313     {
 314       x0 = stems[0]->relative_coordinate (xcommon, X_AXIS);
 315       dx = stems.top ()->relative_coordinate (xcommon, X_AXIS) - x0;
 316     }
 317
 318   SCM posns = me->get_property ("positions");
 319   Drul_array<Real> pos;
 320   if (!is_number_pair (posns))
 321     {
 322       programming_error ("No beam posns");
 323       pos = Interval (0, 0);
 324     }
 325   else
 326     pos = ly_scm2realdrul (posns);
 327
 328   scale_drul (&pos, Staff_symbol_referencer::staff_space (me));
 329
 330   Real dy = pos[RIGHT] - pos[LEFT];
 331   Real slope = (dy && dx) ? dy / dx : 0;
 332
 333   Real thick = get_thickness (me);
 334   Real bdy = get_beam_translation (me);
 335
 336   SCM last_beaming = SCM_EOL;
 337   Real last_xposn = -1;
 338   Real last_stem_width = -1;
 339
 340   Real gap_length = robust_scm2double (me->get_property ("gap"), 0.0);
 341
 342   Stencil the_beam;
 343   Real lt = me->get_layout ()->get_dimension (ly_symbol2scm ("linethickness"));
 344
 345   for (int i = 0; i<= stems.size (); i++)
 346     {
 347       Grob *st = (i < stems.size ()) ? stems[i] : 0;
 348
 349       SCM this_beaming = st ? st->get_property ("beaming") : SCM_EOL;
 350       Real xposn = st ? st->relative_coordinate (xcommon, X_AXIS) : 0.0;
 351       Real stem_width = st ? robust_scm2double (st->get_property ("thickness"), 1.0) *lt : 0;
 352       Direction stem_dir = st ? to_dir (st->get_property ("direction")) : CENTER;
 353       /*
 354         We do the space left of ST, with lfliebertjes pointing to the
 355         right from the left stem, and rfliebertjes pointing left from
 356         right stem.
 357       */
 358       SCM left = (i > 0) ? scm_cdr (last_beaming) : SCM_EOL;
 359       SCM right = st ? scm_car (this_beaming) : SCM_EOL;
 360
 361       Array<int> full_beams;
 362       Array<int> lfliebertjes;
 363       Array<int> rfliebertjes;
 364
 365       for (SCM s = left;
 366            scm_is_pair (s); s = scm_cdr (s))
 367         {
 368           int b = scm_to_int (scm_car (s));
 369           if (scm_c_memq (scm_car (s), right) != SCM_BOOL_F)
 370             {
 371               full_beams.push (b);
 372             }
 373           else
 374             {
 375               lfliebertjes.push (b);
 376             }
 377         }
 378       for (SCM s = right;
 379            scm_is_pair (s); s = scm_cdr (s))
 380         {
 381           int b = scm_to_int (scm_car (s));
 382           if (scm_c_memq (scm_car (s), left) == SCM_BOOL_F)
 383             {
 384               rfliebertjes.push (b);
 385             }
 386         }
 387
 388       /*
 389         how much to stick out for beams across linebreaks
 390       */
 391       Real break_overshoot = 3.0;
 392       Real w = (i > 0 && st) ? (xposn - last_xposn) : break_overshoot;
 393
 394       Real stem_offset = 0.0;
 395       if (i > 0)
 396         {
 397           w += last_stem_width / 2;
 398           stem_offset = -last_stem_width / 2;
 399         }
 400
 401       if (st)
 402         w += stem_width/ 2;
 403
 404       Real blot = me->get_layout ()->get_dimension (ly_symbol2scm ("blotdiameter"));
 405       Stencil whole = Lookup::beam (slope, w, thick, blot);
 406       Stencil gapped;
 407
 408       int gap_count = 0;
 409       if (scm_is_number (me->get_property ("gap-count")))
 410         {
 411           gap_count = scm_to_int (me->get_property ("gap-count"));
 412           gapped = Lookup::beam (slope, w - 2 * gap_length, thick, blot);
 413
 414           full_beams.sort (default_compare);
 415           if (stem_dir == UP)
 416             full_beams.reverse ();
 417         }
 418
 419       int k = 0;
 420       for (int j = full_beams.size (); j--;)
 421         {
 422           Stencil b (whole);
 423
 424           if (k++ < gap_count)
 425             {
 426               b = gapped;
 427               b.translate_axis (gap_length, X_AXIS);
 428             }
 429           b.translate_axis (last_xposn - x0 + stem_offset, X_AXIS);
 430           b.translate_axis (slope * (last_xposn - x0) + bdy * full_beams[j], Y_AXIS);
 431
 432           the_beam.add_stencil (b);
 433         }
 434
 435       if (lfliebertjes.size () || rfliebertjes.size ())
 436         {
 437           Real nw_f;
 438
 439           if (st)
 440             {
 441               int t = Stem::duration_log (st);
 442
 443               SCM proc = me->get_property ("flag-width-function");
 444               SCM result = scm_call_1 (proc, scm_int2num (t));
 445               nw_f = scm_to_double (result);
 446             }
 447           else
 448             nw_f = break_overshoot / 2;
 449
 450           /* Half beam should be one note-width,
 451              but let's make sure two half-beams never touch */
 452           Real lw = nw_f;
 453           Real rw = nw_f;
 454           if (i > 0)
 455             rw = nw_f <? ((xposn - last_xposn) / 2);
 456           else
 457             /*
 458               TODO: 0.5 is a guess.
 459             */
 460             rw = xposn - me->get_bound (LEFT)->extent (xcommon, X_AXIS)[RIGHT]
 461               - 0.5;
 462
 463           if (st)
 464             lw = nw_f <? ((xposn - last_xposn) / 2);
 465           else
 466             lw = me->get_bound (RIGHT)->relative_coordinate (xcommon, X_AXIS)
 467               - last_xposn;
 468
 469           Stencil rhalf = Lookup::beam (slope, rw, thick, blot);
 470           Stencil lhalf = Lookup::beam (slope, lw, thick, blot);
 471           for (int j = lfliebertjes.size (); j--;)
 472             {
 473               Stencil b (lhalf);
 474               b.translate_axis (last_xposn - x0, X_AXIS);
 475               b.translate_axis (slope * (last_xposn - x0) + bdy * lfliebertjes[j], Y_AXIS);
 476               the_beam.add_stencil (b);
 477             }
 478           for (int j = rfliebertjes.size (); j--;)
 479             {
 480               Stencil b (rhalf);
 481               b.translate_axis (xposn - x0 - rw, X_AXIS);
 482               b.translate_axis (slope * (xposn - x0 -rw) + bdy * rfliebertjes[j], Y_AXIS);
 483               the_beam.add_stencil (b);
 484             }
 485         }
 486
 487       last_xposn = xposn;
 488       last_stem_width = stem_width;
 489       last_beaming = this_beaming;
 490     }
 491
 492   the_beam.translate_axis (x0 - me->relative_coordinate (xcommon, X_AXIS), X_AXIS);
 493   the_beam.translate_axis (pos[LEFT], Y_AXIS);
 494
 495 #if (DEBUG_QUANTING)
 496   SCM quant_score = me->get_property ("quant-score");
 497   if (to_boolean (me->get_layout ()->lookup_variable (ly_symbol2scm ("debug-beam-quanting")))
 498       && scm_is_string (quant_score))
 499     {
 500
 501       /*
 502         This code prints the demerits for each beam. Perhaps this
 503         should be switchable for those who want to twiddle with the
 504         parameters.
 505       */
 506       String str;
 507       SCM properties = Font_interface::text_font_alist_chain (me);
 508
 509       Direction stem_dir = stems.size () ? to_dir (stems[0]->get_property ("direction")) : UP;
 510
 511       Stencil tm = *unsmob_stencil (Text_interface::interpret_markup
 512                                     (me->get_layout ()->self_scm (), properties, quant_score));
 513       the_beam.add_at_edge (Y_AXIS, stem_dir, tm, 1.0, 0);
 514     }
 515 #endif
 516
 517   return the_beam.smobbed_copy ();
 518 }
 519
 520
 521 Direction
 522 Beam::get_default_dir (Grob *me)
 523 {
 524   Drul_array<int> total;
 525   total[UP] = total[DOWN] = 0;
 526   Drul_array<int> count;
 527   count[UP] = count[DOWN] = 0;
 528   Direction d = DOWN;
 529
 530   Link_array<Grob> stems
 531     = extract_grob_array (me, ly_symbol2scm ("stems"));
 532
 533   for (int i = 0; i < stems.size (); i++)
 534     do
 535       {
 536         Grob *s = stems[i];
 537         Direction sd = get_grob_direction (s);
 538
 539         int center_distance = int (- d * Stem::head_positions (s) [-d]) >? 0;
 540         int current = sd ? (1 + d * sd) / 2 : center_distance;
 541
 542         if (current)
 543           {
 544             total[d] += current;
 545             count[d]++;
 546           }
 547       }
 548     while (flip (&d) != DOWN);
 549
 550   SCM func = me->get_property ("dir-function");
 551   SCM s = scm_call_2 (func,
 552                       scm_cons (scm_int2num (count[UP]),
 553                                 scm_int2num (count[DOWN])),
 554                       scm_cons (scm_int2num (total[UP]),
 555                                 scm_int2num (total[DOWN])));
 556
 557   if (scm_is_number (s) && scm_to_int (s))
 558     return to_dir (s);
 559
 560   /* If dir is not determined: get default */
 561   return to_dir (me->get_property ("neutral-direction"));
 562 }
 563
 564 /* Set all stems with non-forced direction to beam direction.
 565    Urg: non-forced should become `without/with unforced' direction,
 566    once stem gets cleaned-up. */
 567 void
 568 Beam::set_stem_directions (Grob *me, Direction d)
 569 {
 570   Link_array<Grob> stems
 571     = extract_grob_array (me, ly_symbol2scm ("stems"));
 572
 573   for (int i = 0; i <stems.size (); i++)
 574     {
 575       Grob *s = stems[i];
 576
 577       SCM forcedir = s->get_property ("direction");
 578       if (!to_dir (forcedir))
 579         set_grob_direction (s, d);
 580     }
 581 }
 582
 583 /*
 584   Only try horizontal beams for knees.  No reliable detection of
 585   anything else is possible here, since we don't know funky-beaming
 586   settings, or X-distances (slopes!)  People that want sloped
 587   knee-beams, should set the directions manually.
 588
 589
 590   TODO:
 591
 592   this routine should take into account the stemlength scoring
 593   of a possible knee/nonknee beam.
 594
 595 */
 596 void
 597 Beam::consider_auto_knees (Grob *me)
 598 {
 599   SCM scm = me->get_property ("auto-knee-gap");
 600   if (!scm_is_number (scm))
 601     return;
 602
 603   Interval_set gaps;
 604
 605   gaps.set_full ();
 606
 607   Link_array<Grob> stems
 608     = extract_grob_array (me, ly_symbol2scm ("stems"));
 609
 610   Grob *common = common_refpoint_of_array (stems, me, Y_AXIS);
 611   Real staff_space = Staff_symbol_referencer::staff_space (me);
 612
 613   Array<Interval> head_extents_array;
 614   for (int i = 0; i < stems.size (); i++)
 615     {
 616       Grob *stem = stems[i];
 617       if (Stem::is_invisible (stem))
 618         continue;
 619
 620       Interval head_extents = Stem::head_positions (stem);
 621       if (!head_extents.is_empty ())
 622         {
 623           head_extents[LEFT] += -1;
 624           head_extents[RIGHT] += 1;
 625           head_extents *= staff_space * 0.5;
 626
 627           /*
 628             We could subtract beam Y position, but this routine only
 629             sets stem directions, a constant shift does not have an
 630             influence.
 631           */
 632           head_extents += stem->relative_coordinate (common, Y_AXIS);
 633
 634           if (to_dir (stem->get_property ("direction")))
 635             {
 636               Direction stemdir = to_dir (stem->get_property ("direction"));
 637               head_extents[-stemdir] = -stemdir * infinity_f;
 638             }
 639         }
 640       head_extents_array.push (head_extents);
 641
 642       gaps.remove_interval (head_extents);
 643     }
 644
 645   Interval max_gap;
 646   Real max_gap_len = 0.0;
 647
 648   for (int i = gaps.allowed_regions_.size () -1; i >= 0; i--)
 649     {
 650       Interval gap = gaps.allowed_regions_[i];
 651
 652       /*
 653         the outer gaps are not knees.
 654       */
 655       if (isinf (gap[LEFT]) || isinf (gap[RIGHT]))
 656         continue;
 657
 658       if (gap.length () >= max_gap_len)
 659         {
 660           max_gap_len = gap.length ();
 661           max_gap = gap;
 662         }
 663     }
 664
 665   Real beam_translation = get_beam_translation (me);
 666   Real beam_thickness = Beam::get_thickness (me);
 667   int beam_count = Beam::get_beam_count (me);
 668   Real height_of_beams = beam_thickness / 2
 669     + (beam_count - 1) * beam_translation;
 670   Real threshold = scm_to_double (scm) + height_of_beams;
 671
 672   if (max_gap_len > threshold)
 673     {
 674       int j = 0;
 675       for (int i = 0; i < stems.size (); i++)
 676         {
 677           Grob *stem = stems[i];
 678           if (Stem::is_invisible (stem))
 679             continue;
 680
 681           Interval head_extents = head_extents_array[j++];
 682
 683           Direction d = (head_extents.center () < max_gap.center ()) ?
 684             UP : DOWN;
 685
 686           stem->set_property ("direction", scm_int2num (d));
 687
 688           head_extents.intersect (max_gap);
 689           assert (head_extents.is_empty () || head_extents.length () < 1e-6);
 690         }
 691     }
 692 }
 693
 694 /* Set stem's shorten property if unset.
 695
 696 TODO:
 697 take some y-position (chord/beam/nearest?) into account
 698 scmify forced-fraction
 699
 700 This is done in beam because the shorten has to be uniform over the
 701 entire beam.
 702 */
 703 void
 704 Beam::set_stem_shorten (Grob *me)
 705 {
 706   /*
 707     shortening looks silly for x staff beams
 708   */
 709   if (is_knee (me))
 710     return;
 711
 712   Real forced_fraction = 1.0 * forced_stem_count (me)
 713     / visible_stem_count (me);
 714
 715   int beam_count = get_beam_count (me);
 716
 717   SCM shorten_list = me->get_property ("beamed-stem-shorten");
 718   if (shorten_list == SCM_EOL)
 719     return;
 720
 721   Real staff_space = Staff_symbol_referencer::staff_space (me);
 722
 723   SCM shorten_elt
 724     = robust_list_ref (beam_count -1, shorten_list);
 725   Real shorten_f = scm_to_double (shorten_elt) * staff_space;
 726
 727   /* your similar cute comment here */
 728   shorten_f *= forced_fraction;
 729
 730   if (shorten_f)
 731     me->set_property ("shorten", scm_make_real (shorten_f));
 732 }
 733
 734 /*  Call list of y-dy-callbacks, that handle setting of
 735     grob-properties
 736 */
 737 MAKE_SCHEME_CALLBACK (Beam, after_line_breaking, 1);
 738 SCM
 739 Beam::after_line_breaking (SCM smob)
 740 {
 741   Grob *me = unsmob_grob (smob);
 742
 743   position_beam (me);
 744   return SCM_UNSPECIFIED;
 745 }
 746
 747 void
 748 Beam::position_beam (Grob *me)
 749 {
 750   if (!me->is_live ())
 751     return;
 752   if (to_boolean (me->get_property ("positioning-done")))
 753     return;
 754
 755   me->set_property ("positioning-done", SCM_BOOL_T);
 756
 757   /* Copy to mutable list. */
 758   SCM s = ly_deep_copy (me->get_property ("positions"));
 759   me->set_property ("positions", s);
 760
 761   if (scm_car (s) == SCM_BOOL_F)
 762     {
 763       // one wonders if such genericity is necessary  --hwn.
 764       SCM callbacks = me->get_property ("position-callbacks");
 765       for (SCM i = callbacks; scm_is_pair (i); i = scm_cdr (i))
 766         scm_call_1 (scm_car (i), me->self_scm ());
 767     }
 768
 769   set_stem_lengths (me);
 770 }
 771
 772 void
 773 set_minimum_dy (Grob *me, Real *dy)
 774 {
 775   if (*dy)
 776     {
 777       /*
 778         If dy is smaller than the smallest quant, we
 779         get absurd direction-sign penalties.
 780       */
 781
 782       Real ss = Staff_symbol_referencer::staff_space (me);
 783       Real thickness = Beam::get_thickness (me) / ss;
 784       Real slt = Staff_symbol_referencer::line_thickness (me) / ss;
 785       Real sit = (thickness - slt) / 2;
 786       Real inter = 0.5;
 787       Real hang = 1.0 - (thickness - slt) / 2;
 788
 789       *dy = sign (*dy) * (fabs (*dy)
 790                           >?
 791                           (sit <? inter <? hang));
 792     }
 793 }
 794
 795 /*
 796   Compute  a first approximation to the beam slope.
 797 */
 798 MAKE_SCHEME_CALLBACK (Beam, least_squares, 1);
 799 SCM
 800 Beam::least_squares (SCM smob)
 801 {
 802   Grob *me = unsmob_grob (smob);
 803
 804   int count = visible_stem_count (me);
 805   Interval pos (0, 0);
 806
 807   if (count < 1)
 808     {
 809       me->set_property ("positions", ly_interval2scm (pos));
 810       return SCM_UNSPECIFIED;
 811     }
 812
 813   Array<Real> x_posns;
 814   Link_array<Grob> stems
 815     = extract_grob_array (me, ly_symbol2scm ("stems"));
 816   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
 817   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
 818
 819   Real my_y = me->relative_coordinate (commony, Y_AXIS);
 820
 821   Grob *fvs = first_visible_stem (me);
 822   Grob *lvs = last_visible_stem (me);
 823
 824   Interval ideal (Stem::get_stem_info (fvs).ideal_y_
 825                   + fvs->relative_coordinate (commony, Y_AXIS) -my_y,
 826                   Stem::get_stem_info (lvs).ideal_y_
 827                   + lvs->relative_coordinate (commony, Y_AXIS) - my_y);
 828
 829   Real x0 = first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
 830   for (int i = 0; i < stems.size (); i++)
 831     {
 832       Grob *s = stems[i];
 833
 834       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
 835       x_posns.push (x);
 836     }
 837   Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS) - x0;
 838
 839   Real y = 0;
 840   Real slope = 0;
 841   Real dy = 0;
 842
 843   if (!ideal.delta ())
 844     {
 845       Interval chord (Stem::chord_start_y (first_visible_stem (me)),
 846                       Stem::chord_start_y (last_visible_stem (me)));
 847
 848       /* Simple beams (2 stems) on middle line should be allowed to be
 849          slightly sloped.
 850
 851          However, if both stems reach middle line,
 852          ideal[LEFT] == ideal[RIGHT] and ideal.delta () == 0.
 853
 854          For that case, we apply artificial slope */
 855       if (!ideal[LEFT] && chord.delta () && count == 2)
 856         {
 857           /* FIXME. -> UP */
 858           Direction d = (Direction) (sign (chord.delta ()) * UP);
 859           pos[d] = get_thickness (me) / 2;
 860           pos[-d] = -pos[d];
 861         }
 862       else
 863         {
 864           pos = ideal;
 865         }
 866
 867       /*
 868         For broken beams this doesn't work well. In this case, the
 869         slope esp. of the first part of a broken beam should predict
 870         where the second part goes.
 871       */
 872       me->set_property ("least-squares-dy",
 873                         scm_make_real (pos[RIGHT] - pos[LEFT]));
 874     }
 875   else
 876     {
 877       Array<Offset> ideals;
 878       for (int i = 0; i < stems.size (); i++)
 879         {
 880           Grob *s = stems[i];
 881           if (Stem::is_invisible (s))
 882             continue;
 883           ideals.push (Offset (x_posns[i],
 884                                Stem::get_stem_info (s).ideal_y_
 885                                + s->relative_coordinate (commony, Y_AXIS)
 886                                - my_y));
 887         }
 888
 889       minimise_least_squares (&slope, &y, ideals);
 890
 891       dy = slope * dx;
 892
 893       set_minimum_dy (me, &dy);
 894       me->set_property ("least-squares-dy", scm_make_real (dy));
 895       pos = Interval (y, (y + dy));
 896     }
 897
 898   /*
 899     "position" is relative to the staff.
 900   */
 901   scale_drul (&pos, 1/ Staff_symbol_referencer::staff_space (me));
 902
 903   me->set_property ("positions", ly_interval2scm (pos));
 904
 905   return SCM_UNSPECIFIED;
 906 }
 907
 908 /*
 909   We can't combine with previous function, since check concave and
 910   slope damping comes first.
 911
 912   TODO: we should use the concaveness to control the amount of damping
 913   applied.
 914 */
 915 MAKE_SCHEME_CALLBACK (Beam, shift_region_to_valid, 1);
 916 SCM
 917 Beam::shift_region_to_valid (SCM grob)
 918 {
 919   Grob *me = unsmob_grob (grob);
 920   /*
 921     Code dup.
 922   */
 923   Array<Real> x_posns;
 924   Link_array<Grob> stems
 925     = extract_grob_array (me, ly_symbol2scm ("stems"));
 926   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
 927   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
 928
 929   Grob *fvs = first_visible_stem (me);
 930
 931   if (!fvs)
 932     return SCM_UNSPECIFIED;
 933
 934   Real x0 = fvs->relative_coordinate (commonx, X_AXIS);
 935   for (int i = 0; i < stems.size (); i++)
 936     {
 937       Grob *s = stems[i];
 938
 939       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
 940       x_posns.push (x);
 941     }
 942
 943   Grob *lvs = last_visible_stem (me);
 944   if (!lvs)
 945     return SCM_UNSPECIFIED;
 946
 947   Real dx = lvs->relative_coordinate (commonx, X_AXIS) - x0;
 948
 949   Drul_array<Real> pos = ly_scm2interval (me->get_property ("positions"));
 950
 951   scale_drul (&pos, Staff_symbol_referencer::staff_space (me));
 952
 953   Real dy = pos[RIGHT] - pos[LEFT];
 954   Real y = pos[LEFT];
 955   Real slope = dy / dx;
 956
 957   /*
 958     Shift the positions so that we have a chance of finding good
 959     quants (i.e. no short stem failures.)
 960   */
 961   Interval feasible_left_point;
 962   feasible_left_point.set_full ();
 963   for (int i = 0; i < stems.size (); i++)
 964     {
 965       Grob *s = stems[i];
 966       if (Stem::is_invisible (s))
 967         continue;
 968
 969       Direction d = Stem::get_direction (s);
 970
 971       Real left_y
 972         = Stem::get_stem_info (s).shortest_y_
 973         - slope * x_posns [i];
 974
 975       /*
 976         left_y is now relative to the stem S. We want relative to
 977         ourselves, so translate:
 978       */
 979       left_y
 980         += + s->relative_coordinate (commony, Y_AXIS)
 981         - me->relative_coordinate (commony, Y_AXIS);
 982
 983       Interval flp;
 984       flp.set_full ();
 985       flp[-d] = left_y;
 986
 987       feasible_left_point.intersect (flp);
 988     }
 989
 990   if (feasible_left_point.is_empty ())
 991     warning (_ ("no viable initial configuration found: may not find good beam slope"));
 992   else if (!feasible_left_point.contains (y))
 993     {
 994       if (isinf (feasible_left_point[DOWN]))
 995         y = feasible_left_point[UP] - REGION_SIZE;
 996       else if (isinf (feasible_left_point[UP]))
 997         y = feasible_left_point[DOWN]+ REGION_SIZE;
 998       else
 999         y = feasible_left_point.center ();
1000     }
1001
1002   pos = Drul_array<Real> (y, (y + dy));
1003   scale_drul (&pos, 1/ Staff_symbol_referencer::staff_space (me));
1004
1005   me->set_property ("positions", ly_interval2scm (pos));
1006   return SCM_UNSPECIFIED;
1007 }
1008
1009 /* This neat trick is by Werner Lemberg,
1010    damped = tanh (slope)
1011    corresponds with some tables in [Wanske] CHECKME */
1012 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
1013 SCM
1014 Beam::slope_damping (SCM smob)
1015 {
1016   Grob *me = unsmob_grob (smob);
1017
1018   if (visible_stem_count (me) <= 1)
1019     return SCM_UNSPECIFIED;
1020
1021   SCM s = me->get_property ("damping");
1022   Real damping = scm_to_double (s);
1023
1024   if (damping)
1025     {
1026       Drul_array<Real> pos = ly_scm2interval (me->get_property ("positions"));
1027       scale_drul (&pos, Staff_symbol_referencer::staff_space (me));
1028
1029       Real dy = pos[RIGHT] - pos[LEFT];
1030
1031       Grob *fvs = first_visible_stem (me);
1032       Grob *lvs = last_visible_stem (me);
1033
1034       Grob *commonx = fvs->common_refpoint (lvs, X_AXIS);
1035
1036       Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS)
1037         - first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
1038
1039       Real slope = dy && dx ? dy / dx : 0;
1040
1041       Real concaveness = robust_scm2double (me->get_property ("concaveness"), 0.0);
1042
1043       slope = 0.6 * tanh (slope) / (damping + concaveness);
1044
1045       Real damped_dy = slope * dx;
1046
1047       set_minimum_dy (me, &damped_dy);
1048
1049       pos[LEFT] += (dy - damped_dy) / 2;
1050       pos[RIGHT] -= (dy - damped_dy) / 2;
1051
1052       scale_drul (&pos, 1 / Staff_symbol_referencer::staff_space (me));
1053
1054       me->set_property ("positions", ly_interval2scm (pos));
1055     }
1056   return SCM_UNSPECIFIED;
1057 }
1058
1059 /*
1060   Report slice containing the numbers that are both in (car BEAMING)
1061   and (cdr BEAMING)
1062 */
1063 Slice
1064 where_are_the_whole_beams (SCM beaming)
1065 {
1066   Slice l;
1067
1068   for (SCM s = scm_car (beaming); scm_is_pair (s); s = scm_cdr (s))
1069     {
1070       if (scm_c_memq (scm_car (s), scm_cdr (beaming)) != SCM_BOOL_F)
1071
1072         l.add_point (scm_to_int (scm_car (s)));
1073     }
1074
1075   return l;
1076 }
1077
1078 /* Return the Y position of the stem-end, given the Y-left, Y-right
1079    in POS for stem S.  This Y position is relative to S. */
1080 Real
1081 Beam::calc_stem_y (Grob *me, Grob *s, Grob ** common,
1082                    Real xl, Real xr,
1083                    Drul_array<Real> pos, bool french)
1084 {
1085   Real beam_translation = get_beam_translation (me);
1086
1087   Real r = s->relative_coordinate (common[X_AXIS], X_AXIS) - xl;
1088   Real dy = pos[RIGHT] - pos[LEFT];
1089   Real dx = xr - xl;
1090   Real stem_y_beam0 = (dy && dx
1091                        ? r / dx
1092                        * dy
1093                        : 0) + pos[LEFT];
1094
1095   Direction my_dir = get_grob_direction (s);
1096   SCM beaming = s->get_property ("beaming");
1097
1098   Real stem_y = stem_y_beam0;
1099   if (french)
1100     {
1101       Slice bm = where_are_the_whole_beams (beaming);
1102       if (!bm.is_empty ())
1103         stem_y += beam_translation * bm[-my_dir];
1104     }
1105   else
1106     {
1107       Slice bm = Stem::beam_multiplicity (s);
1108       if (!bm.is_empty ())
1109         stem_y += bm[my_dir] * beam_translation;
1110     }
1111
1112   Real id = me->relative_coordinate (common[Y_AXIS], Y_AXIS)
1113     - s->relative_coordinate (common[Y_AXIS], Y_AXIS);
1114
1115   return stem_y + id;
1116 }
1117
1118 /*
1119   Hmm.  At this time, beam position and slope are determined.  Maybe,
1120   stem directions and length should set to relative to the chord's
1121   position of the beam.  */
1122 void
1123 Beam::set_stem_lengths (Grob *me)
1124 {
1125   Link_array<Grob> stems
1126     = extract_grob_array (me, ly_symbol2scm ("stems"));
1127
1128   if (!stems.size ())
1129     return;
1130
1131   Grob *common[2];
1132   for (int a = 2; a--;)
1133     common[a] = common_refpoint_of_array (stems, me, Axis (a));
1134
1135   Drul_array<Real> pos = ly_scm2realdrul (me->get_property ("positions"));
1136   Real staff_space = Staff_symbol_referencer::staff_space (me);
1137   scale_drul (&pos, staff_space);
1138
1139   bool gap = false;
1140   Real thick = 0.0;
1141   if (scm_is_number (me->get_property ("gap-count"))
1142       &&scm_to_int (me->get_property ("gap-count")))
1143     {
1144       gap = true;
1145       thick = get_thickness (me);
1146     }
1147
1148   // ugh -> use commonx
1149   Grob *fvs = first_visible_stem (me);
1150   Grob *lvs = last_visible_stem (me);
1151
1152   Real xl = fvs ? fvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1153   Real xr = lvs ? lvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1154
1155   for (int i = 0; i < stems.size (); i++)
1156     {
1157       Grob *s = stems[i];
1158       if (Stem::is_invisible (s))
1159         continue;
1160
1161       bool french = to_boolean (s->get_property ("french-beaming"));
1162       Real stem_y = calc_stem_y (me, s, common,
1163                                  xl, xr,
1164                                  pos, french && s != lvs && s!= fvs);
1165
1166       /*
1167         Make the stems go up to the end of the beam. This doesn't matter
1168         for normal beams, but for tremolo beams it looks silly otherwise.
1169       */
1170       if (gap)
1171         stem_y += thick * 0.5 * get_grob_direction (s);
1172
1173       Stem::set_stemend (s, 2* stem_y / staff_space);
1174     }
1175 }
1176
1177 void
1178 Beam::set_beaming (Grob *me, Beaming_info_list *beaming)
1179 {
1180   Link_array<Grob> stems
1181     = extract_grob_array (me, ly_symbol2scm ("stems"));
1182
1183   Direction d = LEFT;
1184   for (int i = 0; i < stems.size (); i++)
1185     {
1186       /*
1187         Don't overwrite user settings.
1188       */
1189
1190       do
1191         {
1192           /* Don't set beaming for outside of outer stems */
1193           if ((d == LEFT && i == 0)
1194               || (d == RIGHT && i == stems.size () -1))
1195             continue;
1196
1197           Grob *st = stems[i];
1198           SCM beaming_prop = st->get_property ("beaming");
1199           if (beaming_prop == SCM_EOL
1200               || index_get_cell (beaming_prop, d) == SCM_EOL)
1201             {
1202               int b = beaming->infos_.elem (i).beams_i_drul_[d];
1203               if (i > 0
1204                   && i < stems.size () -1
1205                   && Stem::is_invisible (st))
1206                 b = b <? beaming->infos_.elem (i).beams_i_drul_[-d];
1207
1208               Stem::set_beaming (st, b, d);
1209             }
1210         }
1211       while (flip (&d) != LEFT);
1212     }
1213 }
1214
1215 int
1216 Beam::forced_stem_count (Grob *me)
1217 {
1218   Link_array<Grob> stems
1219     = extract_grob_array (me, ly_symbol2scm ("stems"));
1220   int f = 0;
1221   for (int i = 0; i < stems.size (); i++)
1222     {
1223       Grob *s = stems[i];
1224
1225       if (Stem::is_invisible (s))
1226         continue;
1227
1228       /* I can imagine counting those boundaries as a half forced stem,
1229          but let's count them full for now. */
1230       if (abs (Stem::chord_start_y (s)) > 0.1
1231           && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1232         f++;
1233     }
1234   return f;
1235 }
1236
1237
1238 int
1239 Beam::visible_stem_count (Grob *me)
1240 {
1241   Link_array<Grob> stems
1242     = extract_grob_array (me, ly_symbol2scm ("stems"));
1243   int c = 0;
1244   for (int i = stems.size (); i--;)
1245     {
1246       if (!Stem::is_invisible (stems[i]))
1247         c++;
1248     }
1249   return c;
1250 }
1251
1252 Grob *
1253 Beam::first_visible_stem (Grob *me)
1254 {
1255   Link_array<Grob> stems
1256     = extract_grob_array (me, ly_symbol2scm ("stems"));
1257
1258   for (int i = 0; i < stems.size (); i++)
1259     {
1260       if (!Stem::is_invisible (stems[i]))
1261         return stems[i];
1262     }
1263   return 0;
1264 }
1265
1266 Grob *
1267 Beam::last_visible_stem (Grob *me)
1268 {
1269   Link_array<Grob> stems
1270     = extract_grob_array (me, ly_symbol2scm ("stems"));
1271   for (int i = stems.size (); i--;)
1272     {
1273       if (!Stem::is_invisible (stems[i]))
1274         return stems[i];
1275     }
1276   return 0;
1277 }
1278
1279 /*
1280   [TODO]
1281
1282   handle rest under beam (do_post: beams are calculated now)
1283   what about combination of collisions and rest under beam.
1284
1285   Should lookup
1286
1287   rest -> stem -> beam -> interpolate_y_position ()
1288 */
1289 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1290 SCM
1291 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1292 {
1293   Grob *rest = unsmob_grob (element_smob);
1294   Axis a = (Axis) scm_to_int (axis);
1295
1296   if (scm_is_number (rest->get_property ("staff-position")))
1297     return scm_int2num (0);
1298
1299   assert (a == Y_AXIS);
1300
1301   Grob *st = unsmob_grob (rest->get_property ("stem"));
1302   Grob *stem = st;
1303   if (!stem)
1304     return scm_make_real (0.0);
1305   Grob *beam = unsmob_grob (stem->get_property ("beam"));
1306   if (!beam
1307       || !Beam::has_interface (beam)
1308       || !Beam::visible_stem_count (beam))
1309     return scm_make_real (0.0);
1310
1311   Drul_array<Real> pos (0, 0);
1312   SCM s = beam->get_property ("positions");
1313   if (scm_is_pair (s) && scm_is_number (scm_car (s)))
1314     pos = ly_scm2interval (s);
1315   Real staff_space = Staff_symbol_referencer::staff_space (rest);
1316
1317   scale_drul (&pos, staff_space);
1318
1319   Real dy = pos[RIGHT] - pos[LEFT];
1320
1321   // ugh -> use commonx
1322   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1323   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1324   Real slope = dy && dx ? dy / dx : 0;
1325
1326   Direction d = Stem::get_direction (stem);
1327   Real stem_y = pos[LEFT] + (stem->relative_coordinate (0, X_AXIS) - x0) * slope;
1328
1329   Real beam_translation = get_beam_translation (beam);
1330   Real beam_thickness = Beam::get_thickness (beam);
1331
1332   /*
1333     TODO: this is not strictly correct for 16th knee beams.
1334   */
1335   int beam_count
1336     = Stem::beam_multiplicity (stem).length () + 1;
1337
1338   Real height_of_my_beams = beam_thickness / 2
1339     + (beam_count - 1) * beam_translation;
1340   Real beam_y = stem_y - d * height_of_my_beams;
1341
1342   Grob *common_y = rest->common_refpoint (beam, Y_AXIS);
1343
1344   Real rest_dim = rest->extent (common_y, Y_AXIS)[d];
1345   Real minimum_distance
1346     = + staff_space * (robust_scm2double (stem->get_property ("stemlet-length"), 0.0)
1347                        + robust_scm2double (rest->get_property ("minimum-distance"), 0.0));
1348
1349   Real shift = d * (((beam_y - d * minimum_distance) - rest_dim) * d <? 0.0);
1350
1351   shift /= staff_space;
1352   Real rad = Staff_symbol_referencer::line_count (rest) * staff_space / 2;
1353
1354   /* Always move discretely by half spaces */
1355   shift = ceil (fabs (shift * 2.0)) / 2.0 * sign (shift);
1356
1357   /* Inside staff, move by whole spaces*/
1358   if ((rest->extent (common_y, Y_AXIS)[d] + staff_space * shift) * d
1359       < rad
1360       || (rest->extent (common_y, Y_AXIS)[-d] + staff_space * shift) * -d
1361       < rad)
1362     shift = ceil (fabs (shift)) *sign (shift);
1363
1364   return scm_make_real (staff_space * shift);
1365 }
1366
1367 bool
1368 Beam::is_knee (Grob *me)
1369 {
1370   SCM k = me->get_property ("knee");
1371   if (scm_is_bool (k))
1372     return ly_scm2bool (k);
1373
1374   bool knee = false;
1375   int d = 0;
1376   for (SCM s = me->get_property ("stems"); scm_is_pair (s); s = scm_cdr (s))
1377     {
1378       Direction dir = get_grob_direction (unsmob_grob (scm_car (s)));
1379       if (d && d != dir)
1380         {
1381           knee = true;
1382           break;
1383         }
1384       d = dir;
1385     }
1386
1387   me->set_property ("knee", ly_bool2scm (knee));
1388
1389   return knee;
1390 }
1391
1392 int
1393 Beam::get_direction_beam_count (Grob *me, Direction d)
1394 {
1395   Link_array<Grob> stems
1396     = extract_grob_array (me, ly_symbol2scm ("stems"));
1397   int bc = 0;
1398
1399   for (int i = stems.size (); i--;)
1400     {
1401       /*
1402         Should we take invisible stems into account?
1403       */
1404       if (Stem::get_direction (stems[i]) == d)
1405         bc = bc >? (Stem::beam_multiplicity (stems[i]).length () + 1);
1406     }
1407
1408   return bc;
1409 }
1410
1411 ADD_INTERFACE (Beam, "beam-interface",
1412                "A beam. \n\n"
1413                "The @code{thickness} property is the weight of beams, and is measured "
1414                "in  staffspace",
1415                "knee positioning-done position-callbacks "
1416                "concaveness dir-function quant-score auto-knee-gap gap "
1417                "gap-count chord-tremolo beamed-stem-shorten shorten least-squares-dy "
1418                "damping inspect-quants flag-width-function neutral-direction positions space-function "
1419                "thickness");
1420