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