lily/beam.cc

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