lily/beam.cc

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