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::text_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 MAKE_SCHEME_CALLBACK (Beam, check_concave, 1);
1061 SCM
1062 Beam::check_concave (SCM smob)
1063 {
1064   Grob *me = unsmob_grob (smob);
1065
1066   Link_array<Grob> stems =
1067     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1068
1069   Direction beam_dir = CENTER;
1070   for (int i = 0; i < stems.size ();)
1071     {
1072       if (Stem::is_invisible (stems[i]))
1073         stems.del (i);
1074       else
1075         {
1076           if (Direction sd = Stem::get_direction (stems[i]))
1077             {
1078               /*
1079                 Don't do knee beams.
1080                */
1081               if (beam_dir && sd && sd != beam_dir)
1082                 return SCM_UNSPECIFIED;
1083
1084               beam_dir = sd;
1085             }
1086           i++;
1087         }
1088     }
1089
1090   if (stems.size () < 3)
1091     return SCM_UNSPECIFIED;
1092
1093
1094   /* Concaveness #1: If distance of an inner notehead to line between
1095      two outer noteheads is bigger than CONCAVENESS-GAP (2.0ss),
1096      beam is concave (Heinz Stolba).
1097
1098      In the case of knees, the line connecting outer heads is often
1099      not related to the beam slope (it may even go in the other
1100      direction). Skip the check when the outer stems point in
1101      different directions. --hwn
1102
1103   */
1104   bool is_concave1 = false;
1105   SCM gap = me->get_property ("concaveness-gap");
1106   if (gh_number_p (gap))
1107     {
1108       Real r1 = gh_scm2double (gap);
1109       Real dy = Stem::chord_start_y (stems.top ())
1110         - Stem::chord_start_y (stems[0]);
1111
1112
1113       Real slope = dy / (stems.size () - 1);
1114
1115       Real y0 = Stem::chord_start_y (stems[0]);
1116       for (int i = 1; i < stems.size () - 1; i++)
1117         {
1118           Real c =
1119             beam_dir *((Stem::chord_start_y (stems[i]) - y0) - i * slope);
1120           if (c - r1 > 0)
1121             {
1122               is_concave1 = true;
1123               break;
1124             }
1125         }
1126     }
1127
1128
1129   /* Concaveness #2: Sum distances of inner noteheads that fall
1130      outside the interval of the two outer noteheads.
1131
1132      We only do this for beams where first and last stem have the same
1133      direction. --hwn.
1134
1135
1136      Note that "convex" stems compensate for "concave" stems.
1137      (is that intentional?) --hwn.
1138   */
1139
1140   Real concaveness2 = 0;
1141   SCM thresh = me->get_property ("concaveness-threshold");
1142   Real r2 = infinity_f;
1143   if (!is_concave1 && gh_number_p (thresh))
1144     {
1145       r2 = gh_scm2double (thresh);
1146
1147       Interval iv;
1148       iv.add_point (Stem::chord_start_y (stems[0]));
1149       iv.add_point (Stem::chord_start_y (stems.top ()));
1150
1151       for (int i = 1; i < stems.size () - 1; i++)
1152         {
1153           Real f = Stem::chord_start_y (stems[i]);
1154           concaveness2 += ( (f - iv[MAX] ) >? 0) +
1155             ( (f - iv[MIN] ) <? 0);
1156         }
1157
1158       concaveness2 *= beam_dir / (stems.size () - 2);
1159     }
1160
1161   /* TODO: some sort of damping iso -> plain horizontal */
1162   if (is_concave1 || concaveness2 > r2)
1163     {
1164       Drul_array<Real> pos = ly_scm2interval (me->get_property ("positions"));
1165       Real r = linear_combination (pos, 0);
1166
1167       r /= Staff_symbol_referencer::staff_space (me);
1168       me->set_property ("positions", ly_interval2scm (Drul_array<Real> (r, r)));
1169       me->set_property ("least-squares-dy", gh_double2scm (0));
1170     }
1171
1172   return SCM_UNSPECIFIED;
1173 }
1174
1175 /* This neat trick is by Werner Lemberg,
1176    damped = tanh (slope)
1177    corresponds with some tables in [Wanske] CHECKME */
1178 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
1179 SCM
1180 Beam::slope_damping (SCM smob)
1181 {
1182   Grob *me = unsmob_grob (smob);
1183
1184   if (visible_stem_count (me) <= 1)
1185     return SCM_UNSPECIFIED;
1186
1187   SCM s = me->get_property ("damping");
1188   int damping = gh_scm2int (s);
1189
1190   if (damping)
1191     {
1192       Drul_array<Real>  pos = ly_scm2interval (me->get_property ("positions"));
1193       scale_drul (&pos,  Staff_symbol_referencer::staff_space (me));
1194
1195       Real dy = pos[RIGHT] - pos[LEFT];
1196
1197       Grob *fvs  = first_visible_stem (me);
1198       Grob *lvs  = last_visible_stem (me);
1199
1200       Grob *commonx = fvs->common_refpoint (lvs, X_AXIS);
1201
1202
1203       Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS)
1204         - first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
1205       Real dydx = dy && dx ? dy/dx : 0;
1206       dydx = 0.6 * tanh (dydx) / damping;
1207
1208       Real damped_dy = dydx * dx;
1209       pos[LEFT] += (dy - damped_dy) / 2;
1210       pos[RIGHT] -= (dy - damped_dy) / 2;
1211
1212       scale_drul (&pos, 1/Staff_symbol_referencer::staff_space (me));
1213
1214       me->set_property ("positions", ly_interval2scm (pos));
1215     }
1216   return SCM_UNSPECIFIED;
1217 }
1218
1219 /*
1220   Report slice containing the numbers that are both in (car BEAMING)
1221   and (cdr BEAMING)
1222  */
1223 Slice
1224 where_are_the_whole_beams (SCM beaming)
1225 {
1226   Slice l;
1227
1228   for ( SCM s = gh_car (beaming); gh_pair_p (s) ; s = gh_cdr (s))
1229     {
1230       if (scm_memq (gh_car (s), gh_cdr (beaming)) != SCM_BOOL_F)
1231
1232         l.add_point (gh_scm2int (gh_car (s)));
1233     }
1234
1235   return l;
1236 }
1237
1238 /* Return the Y position of the stem-end, given the Y-left, Y-right
1239    in POS for stem S.  This Y position is relative to S. */
1240 Real
1241 Beam::calc_stem_y (Grob *me, Grob* s, Grob ** common,
1242                    Real xl, Real xr,
1243                    Drul_array<Real> pos, bool french)
1244 {
1245   Real beam_translation = get_beam_translation (me);
1246
1247
1248   Real r = s->relative_coordinate (common[X_AXIS], X_AXIS) - xl;
1249   Real dy = pos[RIGHT] - pos[LEFT];
1250   Real dx = xr - xl;
1251   Real stem_y_beam0 = (dy && dx
1252                        ? r / dx
1253                        * dy
1254                        : 0) + pos[LEFT];
1255
1256   Direction my_dir = get_grob_direction (s);
1257   SCM beaming = s->get_property ("beaming");
1258
1259   Real stem_y = stem_y_beam0;
1260   if (french)
1261     {
1262       Slice bm = where_are_the_whole_beams (beaming);
1263       if (!bm.is_empty ())
1264         stem_y += beam_translation * bm[-my_dir];
1265     }
1266   else
1267     {
1268       Slice bm = Stem::beam_multiplicity (s);
1269       if (!bm.is_empty ())
1270         stem_y +=bm[my_dir] * beam_translation;
1271     }
1272
1273   Real id = me->relative_coordinate (common[Y_AXIS], Y_AXIS)
1274     - s->relative_coordinate (common[Y_AXIS], Y_AXIS);
1275
1276   return stem_y + id;
1277 }
1278
1279 /*
1280   Hmm.  At this time, beam position and slope are determined.  Maybe,
1281   stem directions and length should set to relative to the chord's
1282   position of the beam.  */
1283 void
1284 Beam::set_stem_lengths (Grob *me)
1285 {
1286   Link_array<Grob> stems=
1287     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
1288
1289   if (!stems.size ())
1290     return;
1291
1292   Grob *common[2];
1293   for (int a = 2; a--;)
1294     common[a] = common_refpoint_of_array (stems, me, Axis (a));
1295
1296   Drul_array<Real> pos = ly_scm2realdrul (me->get_property ("positions"));
1297   Real staff_space = Staff_symbol_referencer::staff_space (me);
1298   scale_drul (&pos,  staff_space);
1299
1300   bool gap = false;
1301   Real thick =0.0;
1302   if (gh_number_p (me->get_property ("gap-count"))
1303       &&gh_scm2int (me->get_property ("gap-count")))
1304     {
1305       gap = true;
1306       thick = get_thickness (me);
1307     }
1308
1309   // ugh -> use commonx
1310   Grob * fvs = first_visible_stem (me);
1311   Grob *lvs = last_visible_stem (me);
1312
1313   Real xl = fvs ? fvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1314   Real xr = lvs ? lvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1315
1316   for (int i=0; i < stems.size (); i++)
1317     {
1318       Grob* s = stems[i];
1319       if (Stem::is_invisible (s))
1320         continue;
1321
1322       bool french = to_boolean (s->get_property ("french-beaming"));
1323       Real stem_y = calc_stem_y (me, s, common,
1324                                  xl, xr,
1325                                  pos, french && s != lvs && s!= fvs);
1326
1327       /*
1328         Make the stems go up to the end of the beam. This doesn't matter
1329         for normal beams, but for tremolo beams it looks silly otherwise.
1330        */
1331       if (gap)
1332         stem_y += thick * 0.5 * get_grob_direction (s);
1333
1334       Stem::set_stemend (s, 2* stem_y / staff_space);
1335     }
1336 }
1337
1338 void
1339 Beam::set_beaming (Grob *me, Beaming_info_list *beaming)
1340 {
1341   Link_array<Grob> stems=
1342     Pointer_group_interface__extract_grobs (me, (Grob *)0, "stems");
1343
1344   Direction d = LEFT;
1345   for (int i=0; i  < stems.size (); i++)
1346     {
1347       /*
1348         Don't overwrite user settings.
1349        */
1350
1351       do
1352         {
1353           /* Don't set beaming for outside of outer stems */
1354           if ( (d == LEFT && i == 0)
1355               || (d == RIGHT && i == stems.size () -1))
1356             continue;
1357
1358           Grob *st =  stems[i];
1359           SCM beaming_prop = st->get_property ("beaming");
1360           if (beaming_prop == SCM_EOL ||
1361               index_get_cell (beaming_prop, d) == SCM_EOL)
1362             {
1363               int b = beaming->infos_.elem (i).beams_i_drul_[d];
1364               if (i>0
1365                   && i < stems.size () -1
1366                   && Stem::is_invisible (st))
1367                 b = b <? beaming->infos_.elem (i).beams_i_drul_[-d];
1368
1369               Stem::set_beaming (st, b, d);
1370             }
1371         }
1372       while (flip (&d) != LEFT);
1373     }
1374 }
1375
1376 int
1377 Beam::forced_stem_count (Grob *me)
1378 {
1379   Link_array<Grob>stems =
1380     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1381   int f = 0;
1382   for (int i=0; i < stems.size (); i++)
1383     {
1384       Grob *s = stems[i];
1385
1386       if (Stem::is_invisible (s))
1387         continue;
1388
1389       /* I can imagine counting those boundaries as a half forced stem,
1390          but let's count them full for now. */
1391       if (abs (Stem::chord_start_y (s)) > 0.1
1392         && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1393         f++;
1394     }
1395   return f;
1396 }
1397
1398
1399
1400
1401 int
1402 Beam::visible_stem_count (Grob *me)
1403 {
1404   Link_array<Grob>stems =
1405     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1406   int c = 0;
1407   for (int i = stems.size (); i--;)
1408     {
1409       if (!Stem::is_invisible (stems[i]))
1410         c++;
1411     }
1412   return c;
1413 }
1414
1415 Grob*
1416 Beam::first_visible_stem (Grob *me)
1417 {
1418   Link_array<Grob>stems =
1419     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1420
1421   for (int i = 0; i < stems.size (); i++)
1422     {
1423       if (!Stem::is_invisible (stems[i]))
1424         return stems[i];
1425     }
1426   return 0;
1427 }
1428
1429 Grob*
1430 Beam::last_visible_stem (Grob *me)
1431 {
1432   Link_array<Grob>stems =
1433     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1434   for (int i = stems.size (); i--;)
1435     {
1436       if (!Stem::is_invisible (stems[i]))
1437         return stems[i];
1438     }
1439   return 0;
1440 }
1441
1442
1443 /*
1444   [TODO]
1445
1446   handle rest under beam (do_post: beams are calculated now)
1447   what about combination of collisions and rest under beam.
1448
1449   Should lookup
1450
1451     rest -> stem -> beam -> interpolate_y_position ()
1452 */
1453 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1454 SCM
1455 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1456 {
1457   Grob *rest = unsmob_grob (element_smob);
1458   Axis a = (Axis) gh_scm2int (axis);
1459
1460   if (gh_number_p (rest->get_property ("staff-position")))
1461     return gh_int2scm (0);
1462
1463   assert (a == Y_AXIS);
1464
1465   Grob *st = unsmob_grob (rest->get_property ("stem"));
1466   Grob *stem = st;
1467   if (!stem)
1468     return gh_double2scm (0.0);
1469   Grob *beam = unsmob_grob (stem->get_property ("beam"));
1470   if (!beam
1471       || !Beam::has_interface (beam)
1472       || !Beam::visible_stem_count (beam))
1473     return gh_double2scm (0.0);
1474
1475   Drul_array<Real> pos (0, 0);
1476   SCM s = beam->get_property ("positions");
1477   if (gh_pair_p (s) && gh_number_p (ly_car (s)))
1478     pos = ly_scm2interval (s);
1479   Real staff_space = Staff_symbol_referencer::staff_space (rest);
1480
1481   scale_drul (&pos, staff_space);
1482
1483
1484   Real dy = pos[RIGHT] - pos[LEFT];
1485
1486   // ugh -> use commonx
1487   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1488   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1489   Real dydx = dy && dx ? dy/dx : 0;
1490
1491   Direction d = Stem::get_direction (stem);
1492   Real stem_y = pos[LEFT] + (stem->relative_coordinate (0, X_AXIS) - x0) * dydx;
1493
1494   Real beam_translation = get_beam_translation (beam);
1495   Real beam_thickness = Beam::get_thickness (beam);
1496
1497   int beam_count = get_direction_beam_count (beam, d);
1498   Real height_of_my_beams = beam_thickness / 2
1499     + (beam_count - 1) * beam_translation;
1500   Real beam_y = stem_y - d * height_of_my_beams;
1501
1502   Grob *common_y = rest->common_refpoint (beam, Y_AXIS);
1503
1504   Real rest_dim = rest->extent (common_y, Y_AXIS)[d];
1505   Real minimum_distance =
1506     staff_space * robust_scm2double (rest->get_property ("minimum-distance"), 0.0);
1507
1508   Real shift = d * ( ((beam_y - d * minimum_distance) - rest_dim) * d  <? 0.0);
1509
1510   shift /= staff_space;
1511   Real rad = Staff_symbol_referencer::line_count (rest) * staff_space / 2;
1512
1513   /* Always move discretely by half spaces */
1514   shift = ceil (fabs (shift * 2.0)) / 2.0 * sign (shift);
1515
1516   /* Inside staff, move by whole spaces*/
1517   if ( (rest->extent (common_y, Y_AXIS)[d] + staff_space * shift) * d
1518       < rad
1519       || (rest->extent (common_y, Y_AXIS)[-d] + staff_space * shift) * -d
1520       < rad)
1521     shift = ceil (fabs (shift)) *sign (shift);
1522
1523   return gh_double2scm (staff_space * shift);
1524 }
1525
1526 bool
1527 Beam::is_knee (Grob* me)
1528 {
1529   SCM k = me->get_property ("knee");
1530   if (gh_boolean_p (k))
1531     return gh_scm2bool (k);
1532
1533   bool knee = false;
1534   int d = 0;
1535   for (SCM s = me->get_property ("stems"); gh_pair_p (s); s = ly_cdr (s))
1536     {
1537       Direction dir = get_grob_direction (unsmob_grob (ly_car (s)));
1538       if (d && d != dir)
1539         {
1540           knee = true;
1541           break;
1542         }
1543       d = dir;
1544     }
1545
1546   me->set_property ("knee", gh_bool2scm (knee));
1547
1548   return knee;
1549 }
1550
1551 int
1552 Beam::get_direction_beam_count (Grob *me, Direction d )
1553 {
1554   Link_array<Grob>stems =
1555     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1556   int bc = 0;
1557
1558   for (int i = stems.size (); i--;)
1559     {
1560       /*
1561         Should we take invisible stems into account?
1562        */
1563       if (Stem::get_direction (stems[i]) == d)
1564         bc = bc >? (Stem::beam_multiplicity (stems[i]).length () + 1);
1565     }
1566
1567   return bc;
1568 }
1569
1570
1571 ADD_INTERFACE (Beam, "beam-interface",
1572                "A beam. \n\n"
1573                "The @code{thickness} property is the weight of beams, and is measured "
1574                "in  staffspace"
1575                ,
1576                "knee positioning-done position-callbacks concaveness-gap "
1577                "concaveness-threshold dir-function quant-score auto-knee-gap gap "
1578                "gap-count chord-tremolo beamed-stem-shorten shorten least-squares-dy "
1579                "damping flag-width-function neutral-direction positions space-function "
1580                "thickness");
1581
1582