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