lily/beam.cc

   1 /*
   2   beam.cc -- implement Beam
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6    (c)  1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7     Jan Nieuwenhuizen <janneke@gnu.org>
   8
   9 */
  10
  11 /*
  12   [TODO]
  13
  14   * Fix TODO
  15
  16   * Junk stem_info.
  17
  18   * Remove #'direction from beam.  A beam has no direction per se.
  19     It may only set directions for stems.
  20
  21   * Rewrite stem_beams.
  22
  23   */
  24
  25
  26 #include <math.h> // tanh.
  27
  28 #include "molecule.hh"
  29 #include "directional-element-interface.hh"
  30 #include "beaming.hh"
  31 #include "beam.hh"
  32 #include "misc.hh"
  33 #include "least-squares.hh"
  34 #include "stem.hh"
  35 #include "paper-def.hh"
  36 #include "lookup.hh"
  37 #include "group-interface.hh"
  38 #include "staff-symbol-referencer.hh"
  39 #include "item.hh"
  40 #include "spanner.hh"
  41 #include "warn.hh"
  42 #include "text-item.hh"  // debug output.
  43 #include "font-interface.hh"  // debug output.
  44
  45
  46
  47 static Real
  48 shrink_extra_weight (Real x)
  49 {
  50   return fabs(x) * ((x < 0) ? 1.5 : 1.0);
  51 }
  52
  53
  54 void
  55 Beam::add_stem (Grob *me, Grob *s)
  56 {
  57   Pointer_group_interface::add_grob (me, ly_symbol2scm ("stems"), s);
  58
  59   s->add_dependency (me);
  60
  61   assert (!Stem::beam_l (s));
  62   s->set_grob_property ("beam", me->self_scm ());
  63
  64   add_bound_item (dynamic_cast<Spanner*> (me), dynamic_cast<Item*> (s));
  65 }
  66
  67 int
  68 Beam::get_multiplicity (Grob *me)
  69 {
  70   int m = 0;
  71   for (SCM s = me->get_grob_property ("stems"); gh_pair_p (s); s = ly_cdr (s))
  72     {
  73       Grob *sc = unsmob_grob (ly_car (s));
  74
  75       if (Stem::has_interface (sc))
  76         m = m >? Stem::beam_count (sc, LEFT) >? Stem::beam_count (sc, RIGHT);
  77     }
  78   return m;
  79 }
  80
  81 /* After pre-processing all directions should be set.
  82    Several post-processing routines (stem, slur, script) need stem/beam
  83    direction.
  84    Currenly, this means that beam has set all stem's directions.
  85    [Alternatively, stems could set its own directions, according to
  86    their beam, during 'final-pre-processing'.] */
  87 MAKE_SCHEME_CALLBACK (Beam, before_line_breaking, 1);
  88 SCM
  89 Beam::before_line_breaking (SCM smob)
  90 {
  91   Grob *me =  unsmob_grob (smob);
  92
  93   /* Beams with less than 2 two stems don't make much sense, but could happen
  94      when you do
  95
  96      [r8 c8 r8].
  97
  98     For a beam that  only has one stem, we try to do some disappearance magic:
  99     we revert the flag, and move on to The Eternal Engraving Fields. */
 100
 101   int count = visible_stem_count (me);
 102   if (count < 2)
 103     {
 104       me->warning (_ ("beam has less than two visible stems"));
 105
 106       SCM stems = me->get_grob_property ("stems");
 107       if (scm_ilength (stems) == 1)
 108         {
 109           me->warning (_ ("Beam has less than two stems. Removing beam."));
 110
 111           unsmob_grob (gh_car (stems))->remove_grob_property ("beam");
 112           me->suicide ();
 113
 114           return SCM_UNSPECIFIED;
 115         }
 116       else if (scm_ilength (stems) == 0)
 117         {
 118           me->suicide ();
 119           return SCM_UNSPECIFIED;
 120         }
 121     }
 122   if (count >= 1)
 123     {
 124       if (!Directional_element_interface::get (me))
 125         Directional_element_interface::set (me, get_default_dir (me));
 126
 127       consider_auto_knees (me);
 128       set_stem_directions (me);
 129       set_stem_shorten (me);
 130     }
 131   return SCM_EOL;
 132 }
 133
 134 Direction
 135 Beam::get_default_dir (Grob *me)
 136 {
 137   Drul_array<int> total;
 138   total[UP]  = total[DOWN] = 0;
 139   Drul_array<int> count;
 140   count[UP]  = count[DOWN] = 0;
 141   Direction d = DOWN;
 142
 143   Link_array<Item> stems=
 144         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 145
 146   for (int i=0; i <stems.size (); i++)
 147     do {
 148       Grob *s = stems[i];
 149       Direction sd = Directional_element_interface::get (s);
 150       int current = sd  ? (1 + d * sd)/2
 151         : Stem::get_center_distance (s, (Direction)-d);
 152
 153       if (current)
 154         {
 155           total[d] += current;
 156           count[d] ++;
 157         }
 158     } while (flip (&d) != DOWN);
 159
 160   SCM func = me->get_grob_property ("dir-function");
 161   SCM s = gh_call2 (func,
 162                     gh_cons (gh_int2scm (count[UP]),
 163                              gh_int2scm (count[DOWN])),
 164                     gh_cons (gh_int2scm (total[UP]),
 165                              gh_int2scm (total[DOWN])));
 166
 167   if (gh_number_p (s) && gh_scm2int (s))
 168     return to_dir (s);
 169
 170   /* If dir is not determined: get default */
 171   return to_dir (me->get_grob_property ("neutral-direction"));
 172 }
 173
 174
 175 /* Set all stems with non-forced direction to beam direction.
 176    Urg: non-forced should become `without/with unforced' direction,
 177    once stem gets cleaned-up. */
 178 void
 179 Beam::set_stem_directions (Grob *me)
 180 {
 181   Link_array<Item> stems
 182     =Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
 183   Direction d = Directional_element_interface::get (me);
 184
 185   for (int i=0; i <stems.size (); i++)
 186     {
 187       Grob *s = stems[i];
 188       SCM force = s->remove_grob_property ("dir-forced");
 189       if (!gh_boolean_p (force) || !gh_scm2bool (force))
 190         Directional_element_interface::set (s, d);
 191     }
 192 }
 193
 194 /* Simplistic auto-knees; only consider vertical gap between two
 195    adjacent chords.
 196
 197   `Forced' stem directions are ignored.  If you don't want auto-knees,
 198   don't set, or unset auto-knee-gap. */
 199 void
 200 Beam::consider_auto_knees (Grob *me)
 201 {
 202   SCM scm = me->get_grob_property ("auto-knee-gap");
 203
 204   if (gh_number_p (scm))
 205     {
 206       bool knee_b = false;
 207       Real knee_y = 0;
 208       Real staff_space = Staff_symbol_referencer::staff_space (me);
 209       Real gap = gh_scm2double (scm) / staff_space;
 210
 211       Direction d = Directional_element_interface::get (me);
 212       Link_array<Item> stems=
 213         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 214
 215       Grob *common = me->common_refpoint (stems[0], Y_AXIS);
 216       for (int i=1; i < stems.size (); i++)
 217         if (!Stem::invisible_b (stems[i]))
 218           common = common->common_refpoint (stems[i], Y_AXIS);
 219
 220       int l = 0;
 221       for (int i=1; i < stems.size (); i++)
 222         {
 223           if (!Stem::invisible_b (stems[i-1]))
 224             l = i - 1;
 225           if (Stem::invisible_b (stems[l]))
 226             continue;
 227           if (Stem::invisible_b (stems[i]))
 228             continue;
 229
 230           Real left = Stem::extremal_heads (stems[l])[d]
 231             ->relative_coordinate (common, Y_AXIS);
 232           Real right = Stem::extremal_heads (stems[i])[-d]
 233             ->relative_coordinate (common, Y_AXIS);
 234
 235           Real dy = right - left;
 236
 237           if (abs (dy) >= gap)
 238             {
 239               knee_y = (right + left) / 2;
 240               knee_b = true;
 241               break;
 242             }
 243         }
 244
 245       if (knee_b)
 246         {
 247           for (int i=0; i < stems.size (); i++)
 248             {
 249               if (Stem::invisible_b (stems[i]))
 250                 continue;
 251               Item *s = stems[i];
 252               Real y = Stem::extremal_heads (stems[i])[d]
 253                 ->relative_coordinate (common, Y_AXIS);
 254
 255               Directional_element_interface::set (s, y < knee_y ? UP : DOWN);
 256               s->set_grob_property ("dir-forced", SCM_BOOL_T);
 257             }
 258         }
 259     }
 260 }
 261
 262 /* Set stem's shorten property if unset.
 263    TODO:
 264    take some y-position (chord/beam/nearest?) into account
 265    scmify forced-fraction */
 266 void
 267 Beam::set_stem_shorten (Grob *m)
 268 {
 269   Spanner*me = dynamic_cast<Spanner*> (m);
 270
 271   Real forced_fraction = forced_stem_count (me) / visible_stem_count (me);
 272
 273   int multiplicity = get_multiplicity (me);
 274
 275   SCM shorten = me->get_grob_property ("beamed-stem-shorten");
 276   if (shorten == SCM_EOL)
 277     return;
 278
 279   int sz = scm_ilength (shorten);
 280
 281   Real staff_space = Staff_symbol_referencer::staff_space (me);
 282   SCM shorten_elt = scm_list_ref (shorten,
 283                                   gh_int2scm (multiplicity <? (sz - 1)));
 284   Real shorten_f = gh_scm2double (shorten_elt) * staff_space;
 285
 286   /* your similar cute comment here */
 287   shorten_f *= forced_fraction;
 288
 289   me->set_grob_property ("shorten", gh_double2scm (shorten_f));
 290 }
 291
 292 /*  Call list of y-dy-callbacks, that handle setting of
 293     grob-properties y, dy.
 294
 295     User may set grob-properties: y-position-hs and height-hs
 296     (to be fixed) that override the calculated y and dy.
 297
 298     Because y and dy cannot be calculated and quanted separately, we
 299     always calculate both, then check for user override. */
 300 MAKE_SCHEME_CALLBACK (Beam, after_line_breaking, 1);
 301 SCM
 302 Beam::after_line_breaking (SCM smob)
 303 {
 304   Grob *me = unsmob_grob (smob);
 305
 306   /* Copy to mutable list. */
 307   SCM s = ly_deep_copy (me->get_grob_property ("positions"));
 308   me->set_grob_property ("positions", s);
 309
 310   if (ly_car (s) != SCM_BOOL_F)
 311     return SCM_UNSPECIFIED;
 312
 313   SCM callbacks = me->get_grob_property ("position-callbacks");
 314   for (SCM i = callbacks; gh_pair_p (i); i = ly_cdr (i))
 315     gh_call1 (ly_car (i), smob);
 316
 317   return SCM_UNSPECIFIED;
 318 }
 319
 320 struct Quant_score
 321 {
 322   Real yl;
 323   Real yr;
 324   Real demerits;
 325 };
 326
 327
 328 MAKE_SCHEME_CALLBACK (Beam, new_quanting, 1);
 329 SCM
 330 Beam::new_quanting (SCM smob)
 331 {
 332   Grob *me = unsmob_grob (smob);
 333
 334   SCM s = me->get_grob_property ("positions");
 335   Real yl = gh_scm2double (gh_car(s));
 336   Real yr = gh_scm2double (gh_cdr(s));
 337
 338   Real ss = Staff_symbol_referencer::staff_space (me);
 339   Real thickness = gh_scm2double (me->get_grob_property ("thickness")) / ss;
 340   Real slt = me->paper_l()->get_var ("stafflinethickness") / ss;
 341
 342   Real straddle = 0.0;
 343   Real sit = (thickness - slt) / 2;
 344   Real inter = 0.5;
 345   Real hang = 1.0 - (thickness - slt) / 2;
 346   Real quants [] = {straddle, sit, inter, hang };
 347
 348   int num_quants = int(sizeof(quants)/sizeof (Real));
 349   Array<Real> quantsl;
 350   Array<Real> quantsr;
 351
 352   const int REGION_SIZE = 3;
 353   // -> result indexes between 70 and 575
 354   for (int i  = -REGION_SIZE ; i < REGION_SIZE; i++)
 355     for (int j = 0; j < num_quants; j++)
 356       {
 357         quantsl.push (i + quants[j] + int (yl));
 358         quantsr.push (i + quants[j] + int (yr));
 359       }
 360
 361   Array<Quant_score> qscores;
 362
 363   for(int l =0; l < quantsl.size(); l++)
 364     for(int r =0; r < quantsr.size(); r++)
 365       {
 366         Quant_score qs;
 367         qs.yl = quantsl[l];
 368         qs.yr = quantsr[r];
 369         qs.demerits = 0.0;
 370
 371         qscores.push (qs);
 372       }
 373
 374
 375   SCM score_funcs = me->get_grob_property("quant-score-functions");
 376   for (SCM s = score_funcs; gh_pair_p (s); s = gh_cdr (s))
 377     {
 378       SCM f = gh_car (s);
 379       for (int i = qscores.size(); i--;)
 380         {
 381           // best scores < 30;
 382           // if (qscores[i].demerits < 1000)
 383           if (qscores[i].demerits < 100)
 384             {
 385               SCM score = gh_call3 (f,
 386                                     me->self_scm(),
 387                                     gh_double2scm (qscores[i].yl),
 388                                     gh_double2scm (qscores[i].yr));
 389
 390               qscores[i].demerits += gh_scm2double (score);
 391             }
 392         }
 393     }
 394
 395   Real best = 1e6;
 396   int best_idx = -1;
 397   for (int i = qscores.size(); i--;)
 398     {
 399       if (qscores[i].demerits < best)
 400         {
 401           best = qscores [i].demerits ;
 402           best_idx = i;
 403         }
 404     }
 405
 406
 407   me->set_grob_property ("positions",
 408                          gh_cons (gh_double2scm (qscores[best_idx].yl),
 409                                   gh_double2scm (qscores[best_idx].yr))
 410                          );
 411   me->set_grob_property ("quant-score",
 412                          gh_double2scm (qscores[best_idx].demerits));
 413   me->set_grob_property ("best-idx", gh_int2scm (best_idx));
 414
 415   return SCM_UNSPECIFIED;
 416 }
 417
 418 MAKE_SCHEME_CALLBACK (Beam, score_slopes_dy, 3);
 419 SCM
 420 Beam::score_slopes_dy (SCM smob, SCM syl, SCM syr)
 421 {
 422   Grob*me = unsmob_grob(smob);
 423   Real yl = gh_scm2double (syl);
 424   Real yr = gh_scm2double (syr);
 425   Real dy = yr - yl;
 426
 427   SCM sdy = me->get_grob_property("least-squares-dy");
 428   SCM posns = me->get_grob_property ("positions");
 429
 430   Real dy_mus = gh_number_p (sdy) ? gh_scm2double (sdy) : 0.0;
 431   Real dy_damp = - gh_scm2double (gh_car(posns)) + gh_scm2double (gh_cdr (posns));
 432
 433   Real dem = 0.0;
 434   if (sign (dy_damp) != sign (dy))
 435     {
 436       dem += 800;
 437     }
 438
 439    dem += 400* (0 >? (fabs(dy) - fabs(dy_mus)));
 440
 441
 442    dem += shrink_extra_weight (fabs (dy_damp) - fabs(dy))* 10;
 443    return gh_double2scm  (dem);
 444 }
 445
 446 MAKE_SCHEME_CALLBACK (Beam, score_stem_lengths, 3);
 447 SCM
 448 Beam::score_stem_lengths (SCM smob, SCM syl, SCM syr)
 449 {
 450   Grob*me = unsmob_grob(smob);
 451   Real yl = gh_scm2double (syl);
 452   Real yr = gh_scm2double (syr);
 453
 454   Link_array<Item> stems=
 455     Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 456
 457   Real demerit_score = 0.0 ;
 458
 459   for (int i=0; i < stems.size (); i++)
 460     {
 461       Item* s = stems[i];
 462       if (Stem::invisible_b (s))
 463         continue;
 464
 465       Real current_y = calc_stem_y_f (me, s, Interval(yl,yr));
 466       Stem_info info = Stem::calc_stem_info (s);
 467       Direction d = Directional_element_interface::get (s);
 468
 469       demerit_score += 500 * ( 0 >? (info.miny_f_ - d*current_y));
 470       demerit_score += 500 * ( 0 >? (d * current_y  - info.maxy_f_));
 471
 472       demerit_score += 5 * shrink_extra_weight (d * current_y  - info.idealy_f_);
 473     }
 474
 475   demerit_score *= 2.0  /stems.size();
 476
 477   return gh_double2scm (demerit_score);
 478 }
 479
 480 static Real
 481 my_modf (Real x)
 482 {
 483   return x - floor(x);
 484 }
 485
 486
 487
 488 MAKE_SCHEME_CALLBACK (Beam, score_forbidden_quants, 3);
 489 SCM
 490 Beam::score_forbidden_quants (SCM smob, SCM syl, SCM syr)
 491 {
 492   Grob*me = unsmob_grob(smob);
 493   Real yl = gh_scm2double (syl);
 494   Real yr = gh_scm2double (syr);
 495   Real dy = yr - yl;
 496   Real rad = Staff_symbol_referencer::staff_radius (me);
 497   Real dem = 0.0;
 498   if (fabs (yl) < rad && fabs( my_modf(yl) - 0.5) < 1e-3)
 499     dem += 1000;
 500   if (fabs (yr) < rad && fabs( my_modf(yr) - 0.5) < 1e-3)
 501     dem += 1000;
 502
 503
 504   int multiplicity = get_multiplicity (me);
 505   // todo: use multiplicity of outer stems.
 506   if (multiplicity >= 2)
 507     {
 508       Real slt = me->paper_l()->get_var("stafflinethickness");
 509       Real ss = Staff_symbol_referencer::staff_space(me);
 510       Real thickness = gh_scm2double (me->get_grob_property ("thickness"))
 511         * ss;
 512
 513       Real beam_space= (2*ss + slt  - 3 *thickness) / 2.0;
 514       if (multiplicity >= 4)
 515         {
 516           beam_space = (3*ss + slt - 4 * thickness) /3.0;
 517         }
 518
 519       Real straddle = 0.0;
 520       Real sit = (thickness - slt) / 2;
 521       Real inter = 0.5;
 522       Real hang = 1.0 - (thickness - slt) / 2;
 523
 524       Direction dir = Directional_element_interface::get (me);
 525       if (fabs (yl - dir * (beam_space + thickness)) < rad
 526           && fabs (my_modf (yl) - inter) < 1e-3)
 527         dem += 15;
 528       if (fabs (yr - dir * (beam_space + thickness)) < rad
 529           && fabs (my_modf (yr) - inter) < 1e-3)
 530         dem += 15;
 531
 532       // hmm, without Interval/Drul_array, you get ~ 4x same code...
 533       if (fabs (yl - dir * (beam_space + thickness)) < rad + inter)
 534         {
 535           if (dir == UP && dy <= 1e-3
 536               && fabs (my_modf (yl) - sit) < 1e-3)
 537             dem += 15;
 538
 539           if (dir == DOWN && dy >= 1e-3
 540               && fabs (my_modf (yl) - hang) < 1e-3)
 541             dem += 15;
 542         }
 543
 544       if (fabs (yr - dir * (beam_space + thickness)) < rad + inter)
 545         {
 546           if (dir == UP && dy >= 1e-3
 547               && fabs (my_modf (yr) - sit) < 1e-3)
 548             dem += 15;
 549
 550           if (dir == DOWN && dy <= 1e-3
 551               && fabs (my_modf (yr) - hang) < 1e-3)
 552             dem += 15;
 553         }
 554
 555       if (multiplicity >= 3)
 556         {
 557           if (fabs (yl - 2 * dir * (beam_space + thickness)) < rad + inter)
 558             {
 559               if (dir == UP && dy <= 1e-3
 560                   && fabs (my_modf (yl) - straddle) < 1e-3)
 561                 dem += 15;
 562
 563               if (dir == DOWN && dy >= 1e-3
 564                   && fabs (my_modf (yl) - straddle) < 1e-3)
 565                 dem += 15;
 566         }
 567
 568           if (fabs (yr - 2 * dir * (beam_space + thickness)) < rad + inter)
 569             {
 570               if (dir == UP && dy >= 1e-3
 571                   && fabs (my_modf (yr) - straddle) < 1e-3)
 572                 dem += 15;
 573
 574               if (dir == DOWN && dy <= 1e-3
 575                   && fabs (my_modf (yr) - straddle) < 1e-3)
 576                 dem += 15;
 577             }
 578         }
 579     }
 580
 581   return gh_double2scm ( dem);
 582 }
 583
 584
 585
 586 MAKE_SCHEME_CALLBACK (Beam, least_squares, 1);
 587 SCM
 588 Beam::least_squares (SCM smob)
 589 {
 590   Grob *me = unsmob_grob (smob);
 591
 592   int count = visible_stem_count (me);
 593   Interval pos (0, 0);
 594
 595   if (count <= 1)
 596     {
 597       me->set_grob_property ("positions", ly_interval2scm (pos));
 598       return SCM_UNSPECIFIED;
 599     }
 600
 601   Direction dir = Directional_element_interface::get (me);
 602
 603   Interval ideal (Stem::calc_stem_info (first_visible_stem (me)).idealy_f_,
 604                   Stem::calc_stem_info (last_visible_stem (me)).idealy_f_);
 605
 606   if (!ideal.delta ())
 607     {
 608       Interval chord (Stem::chord_start_f (first_visible_stem (me)),
 609                       Stem::chord_start_f (last_visible_stem (me)));
 610
 611
 612       /*
 613         TODO  : use scoring for this.
 614
 615         complicated, because we take stem-info.ideal for determining
 616         beam slopes.
 617
 618        */
 619       /* Make simple beam on middle line have small tilt */
 620       if (!ideal[LEFT] && chord.delta () && count == 2)
 621         {
 622           Direction d = (Direction)(sign (chord.delta ()) * dir);
 623           pos[d] = gh_scm2double (me->get_grob_property ("thickness")) / 2
 624             * dir;
 625           pos[-d] = - pos[d];
 626         }
 627       else
 628         {
 629           pos = ideal;
 630           pos[LEFT] *= dir ;
 631           pos[RIGHT] *= dir ;
 632         }
 633     }
 634   else
 635     {
 636       Array<Offset> ideals;
 637
 638       // ugh -> use commonx
 639       Real x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
 640       Link_array<Item> stems=
 641         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 642
 643       for (int i=0; i < stems.size (); i++)
 644         {
 645           Item* s = stems[i];
 646           if (Stem::invisible_b (s))
 647             continue;
 648           ideals.push (Offset (s->relative_coordinate (0, X_AXIS) - x0,
 649                                Stem::calc_stem_info (s).idealy_f_));
 650         }
 651       Real y;
 652       Real dydx;
 653       minimise_least_squares (&dydx, &y, ideals);
 654
 655       Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
 656       Real dy = dydx * dx;
 657       me->set_grob_property ("least-squares-dy", gh_double2scm (dy * dir));
 658
 659       pos = Interval (y*dir, (y+dy) * dir);
 660     }
 661
 662   me->set_grob_property ("positions", ly_interval2scm (pos));
 663   return SCM_UNSPECIFIED;
 664 }
 665
 666 MAKE_SCHEME_CALLBACK (Beam, check_concave, 1);
 667 SCM
 668 Beam::check_concave (SCM smob)
 669 {
 670   Grob *me = unsmob_grob (smob);
 671
 672   Link_array<Item> stems =
 673     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
 674
 675   for (int i = 0; i < stems.size ();)
 676     {
 677       if (Stem::invisible_b (stems[i]))
 678         stems.del (i);
 679       else
 680         i++;
 681     }
 682
 683   if (stems.size () < 3)
 684     return SCM_UNSPECIFIED;
 685
 686   /* Concaveness try #2: Sum distances of inner noteheads that
 687      fall outside the interval of the two outer noteheads */
 688   Real concave = 0;
 689   Interval iv (Stem::chord_start_f (stems[0]),
 690                Stem::chord_start_f (stems.top ()));
 691
 692   if (iv[MAX] < iv[MIN])
 693     iv.swap ();
 694
 695   for (int i = 1; i < stems.size () - 1; i++)
 696     {
 697       Real c = 0;
 698       Real f = Stem::chord_start_f (stems[i]);
 699       if ((c = f - iv[MAX]) > 0)
 700         concave += c;
 701       else if ((c = f - iv[MIN]) < 0)
 702         concave += c;
 703     }
 704
 705   Direction dir = Directional_element_interface::get (me);
 706   concave *= dir;
 707
 708   Real concaveness = concave / (stems.size () - 2);
 709   /* ugh: this is the a kludge to get input/regression/beam-concave.ly
 710      to behave as baerenreiter. */
 711   concaveness /= (stems.size () - 2);
 712
 713   Real r = gh_scm2double (me->get_grob_property ("concaveness-threshold"));
 714
 715   /* TODO: some sort of damping iso -> plain horizontal */
 716   if (concaveness > r)
 717     {
 718       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 719       Real r = pos.linear_combination (0);
 720       me->set_grob_property ("positions", ly_interval2scm (Interval (r, r)));
 721       me->set_grob_property ("least-squares-dy", gh_double2scm (0));
 722     }
 723
 724   return SCM_UNSPECIFIED;
 725 }
 726
 727 /* This neat trick is by Werner Lemberg,
 728    damped = tanh (slope)
 729    corresponds with some tables in [Wanske] CHECKME */
 730 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
 731 SCM
 732 Beam::slope_damping (SCM smob)
 733 {
 734   Grob *me = unsmob_grob (smob);
 735
 736   if (visible_stem_count (me) <= 1)
 737     return SCM_UNSPECIFIED;
 738
 739   SCM s = me->get_grob_property ("damping");
 740   int damping = gh_scm2int (s);
 741
 742   if (damping)
 743     {
 744       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 745       Real dy = pos.delta ();
 746
 747       // ugh -> use commonx
 748       Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS)
 749         - first_visible_stem (me)->relative_coordinate (0, X_AXIS);
 750       Real dydx = dy && dx ? dy/dx : 0;
 751       dydx = 0.6 * tanh (dydx) / damping;
 752
 753       Real damped_dy = dydx * dx;
 754       pos[LEFT] += (dy - damped_dy) / 2;
 755       pos[RIGHT] -= (dy - damped_dy) / 2;
 756
 757       me->set_grob_property ("positions", ly_interval2scm (pos));
 758     }
 759     return SCM_UNSPECIFIED;
 760 }
 761
 762 /* Prevent interference from stafflines. */
 763 Interval
 764 Beam::quantise_interval (Grob *me, Interval pos, Direction quant_dir)
 765 {
 766   int multiplicity = get_multiplicity (me);
 767
 768   Real staff_space = Staff_symbol_referencer::staff_space (me);
 769   Real thick = me->paper_l ()->get_var ("stafflinethickness");
 770   Direction dir = Directional_element_interface::get (me);
 771   Real dy = pos.delta ();
 772
 773   Drul_array<Interval> bounds;
 774   Direction d = LEFT;
 775   do
 776     {
 777       SCM proc = d == LEFT
 778         ? me->get_grob_property ("left-position-quant-function")
 779         : me->get_grob_property ("right-position-quant-function");
 780
 781       SCM quants = scm_apply (proc,
 782                               me->self_scm (),
 783                               scm_list_n (gh_int2scm (multiplicity),
 784                                           gh_double2scm (dir),
 785                                           gh_double2scm (dy),
 786                                           gh_double2scm (thick / staff_space),
 787                                           /* HUH? */
 788                                           SCM_EOL,
 789                                           SCM_UNDEFINED));
 790
 791       Array<Real> a;
 792       for (SCM i = quants; gh_pair_p (i); i = ly_cdr (i))
 793         a.push (gh_scm2double (ly_car (i)));
 794
 795       if (a.size () <= 1)
 796         return pos;
 797
 798       bounds[d] = quantise_iv (a, pos[d]*dir/staff_space) * staff_space;
 799     }
 800   while (flip (&d) != LEFT);
 801
 802   Real ady = abs (dy);
 803
 804   // quant direction hints disabled for now
 805   int q = 0;//(int)quant_dir;
 806
 807   /* TODO: make smart choice, find best left/right quants pair.
 808
 809      Slope should never be steeper than least_squares (before damping)
 810      (save that value?)
 811      Slope should never be reduced to zero.
 812    */
 813   SCM s = me->get_grob_property ("least-squares-dy");
 814   Real lsdy = gh_number_p (s) ? gh_scm2double (s) : 0;
 815
 816   //  Interval qpos (0, 1000 * sign (dy));
 817   Interval qpos;
 818   Real epsilon = staff_space / 10;
 819   Direction ldir = LEFT;
 820   do
 821     {
 822       Direction rdir = LEFT;
 823       do
 824         {
 825           Interval i (bounds[LEFT][ldir]*dir, bounds[RIGHT][rdir]*dir);
 826           if ((!lsdy
 827                || (abs (i.delta ()) <= abs (lsdy) + epsilon
 828                    && sign (i.delta ()) == sign (lsdy)))
 829               && (abs (abs (i.delta ()) - ady)
 830                   <= abs (abs (qpos.delta ()) - ady))
 831               && sign (i.delta ()) == sign (pos.delta ())
 832               && (!q
 833                   || (i[LEFT]*q >= pos[LEFT]*q && i[RIGHT]*q
 834                       >= pos[RIGHT]*q)))
 835             qpos = i;
 836         }
 837       while (flip (&rdir) != LEFT);
 838     }
 839   while (flip (&ldir) != LEFT);
 840
 841   return qpos;
 842 }
 843
 844
 845 /* Quantise vertical position (left and right) of beam.
 846    Generalisation of [Ross]. */
 847 MAKE_SCHEME_CALLBACK (Beam, quantise_position, 1);
 848 SCM
 849 Beam::quantise_position (SCM smob)
 850 {
 851   Grob *me = unsmob_grob (smob);
 852
 853   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 854   Real y_shift = check_stem_length_f (me, pos);
 855   pos += y_shift;
 856   Real staff_space = Staff_symbol_referencer::staff_space (me);
 857
 858   Direction dir = Directional_element_interface::get (me);
 859   for (int i = 0; i < 10; i++)
 860     {
 861       Interval qpos = quantise_interval (me, pos, CENTER);
 862       // how to check for uninitised interval,  (inf, -inf)?
 863       if (qpos[LEFT] < 1000)
 864         {
 865           y_shift = check_stem_length_f (me, qpos);
 866           if (y_shift * dir < staff_space / 2)
 867             {
 868               pos = qpos;
 869               break;
 870             }
 871         }
 872       pos += ((i + 1) * ((i % 2) * -2 + 1)) *  dir * staff_space / 4;
 873     }
 874
 875
 876   me->set_grob_property ("positions", ly_interval2scm (pos));
 877   set_stem_lengths (me);
 878
 879 #if 0
 880   pos = ly_scm2interval (me->get_grob_property ("positions"));
 881
 882   y_shift = check_stem_length_f (me, pos);
 883
 884   Real half_space = Staff_symbol_referencer::staff_space (me) / 2;
 885   /* HMMM */
 886   if (y_shift > half_space / 4)
 887     {
 888       pos += y_shift;
 889       int quant_dir = 0;
 890       /* for significantly lengthened or shortened stems,
 891          request quanting the other way.
 892          HMMM */
 893       if (abs (y_shift) > half_space / 2)
 894         quant_dir = sign (y_shift) * Directional_element_interface::get (me);
 895       pos = quantise_interval (me, pos, (Direction)quant_dir);
 896     }
 897
 898   me->set_grob_property ("positions", ly_interval2scm (pos));
 899 #endif
 900
 901   return SCM_UNSPECIFIED;
 902 }
 903
 904 MAKE_SCHEME_CALLBACK (Beam, end_after_line_breaking, 1);
 905 SCM
 906 Beam::end_after_line_breaking (SCM smob)
 907 {
 908   Grob *me = unsmob_grob (smob);
 909   set_stem_lengths (me);
 910
 911   return SCM_UNSPECIFIED;
 912 }
 913
 914 /*
 915   Calculate the Y position of the stem-end, given the Y-left, Y-right
 916   in POS, and for stem S.
 917  */
 918 Real
 919 Beam::calc_stem_y_f (Grob *me, Item* s, Interval pos)
 920 {
 921   int beam_multiplicity = get_multiplicity (me);
 922   int stem_multiplicity = (Stem::flag_i (s) - 2) >? 0;
 923
 924   SCM space_proc = me->get_grob_property ("space-function");
 925   SCM space = gh_call1 (space_proc, gh_int2scm (beam_multiplicity));
 926
 927   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
 928   Real interbeam_f = gh_scm2double (space);
 929
 930   // ugh -> use commonx
 931   Real x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
 932   Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
 933   Real dy = pos.delta ();
 934   Real stem_y = (dy && dx
 935                  ? (s->relative_coordinate (0, X_AXIS) - x0) / dx
 936                  * dy
 937                  : 0) + pos[LEFT];
 938
 939   /* knee */
 940   Direction dir  = Directional_element_interface::get (me);
 941   Direction sdir = Directional_element_interface::get (s);
 942
 943   /* knee */
 944   if (dir!= sdir)
 945     {
 946       stem_y -= dir * (thick / 2 + (beam_multiplicity - 1) * interbeam_f);
 947
 948       // huh, why not for first visible?
 949       if (Staff_symbol_referencer::staff_symbol_l (s)
 950           != Staff_symbol_referencer::staff_symbol_l (last_visible_stem (me)))
 951         stem_y += Directional_element_interface::get (me)
 952           * (beam_multiplicity - stem_multiplicity) * interbeam_f;
 953     }
 954
 955   return stem_y;
 956 }
 957
 958 /* Make very sure that we don't have stems that are too short.
 959    Try our best not to have stems that are too long (think: knees).
 960
 961    Optionally (testing): try to lengthen more, to reach more ideal
 962    stem lengths */
 963 Real
 964 Beam::check_stem_length_f (Grob *me, Interval pos)
 965 {
 966   Real shorten = 0;
 967   Real lengthen = 0;
 968   Direction dir = Directional_element_interface::get (me);
 969
 970   Link_array<Item> stems=
 971     Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 972
 973   bool knee = false;
 974   int ideal_lengthen_count = 0;
 975   Real ideal_lengthen = 0;
 976   int ideal_shorten_count = 0;
 977   Real ideal_shorten = 0;
 978
 979   for (int i=0; i < stems.size (); i++)
 980     {
 981       Item* s = stems[i];
 982       if (Stem::invisible_b (s))
 983         continue;
 984
 985       knee |= dir != Directional_element_interface::get (s);
 986
 987       Real stem_y = calc_stem_y_f (me, s, pos);
 988
 989       stem_y *= dir;
 990       Stem_info info = Stem::calc_stem_info (s);
 991
 992       shorten = shorten <? info.maxy_f_ - stem_y;
 993       lengthen = lengthen >? info.miny_f_ - stem_y;
 994
 995       if (info.idealy_f_ - stem_y > 0)
 996         {
 997 #if 0
 998           ideal_lengthen += info.idealy_f_ - stem_y;
 999           ideal_lengthen_count++;
1000 #else
1001           ideal_lengthen = ideal_lengthen >? info.idealy_f_ - stem_y;
1002           ideal_lengthen_count = 1;
1003 #endif
1004         }
1005       else if (info.idealy_f_ - stem_y < 0)
1006         {
1007 #if 0
1008           ideal_shorten += info.idealy_f_ - stem_y;
1009           ideal_shorten_count++;
1010 #else
1011           ideal_shorten = ideal_shorten <? info.idealy_f_ - stem_y;
1012           ideal_shorten_count = 1;
1013 #endif
1014         }
1015     }
1016
1017   if (lengthen && shorten)
1018     me->warning (_ ("weird beam vertical offset"));
1019
1020   if (ideal_lengthen_count)
1021     lengthen = (ideal_lengthen / ideal_lengthen_count) >? lengthen;
1022   if (knee && ideal_shorten_count)
1023     shorten = (ideal_shorten / ideal_shorten_count) <? shorten;
1024
1025   if (lengthen && shorten)
1026     return dir * (lengthen + shorten);
1027
1028   return dir * (shorten ? shorten : lengthen);
1029 }
1030
1031 /*
1032   Hmm.  At this time, beam position and slope are determined.  Maybe,
1033   stem directions and length should set to relative to the chord's
1034   position of the beam.  */
1035 void
1036 Beam::set_stem_lengths (Grob *me)
1037 {
1038   Link_array<Item> stems=
1039     Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
1040
1041   if (stems.size () <= 1)
1042     return;
1043
1044   Grob *common = me->common_refpoint (stems[0], Y_AXIS);
1045   for (int i=1; i < stems.size (); i++)
1046     if (!Stem::invisible_b (stems[i]))
1047       common = common->common_refpoint (stems[i], Y_AXIS);
1048
1049   Direction dir = Directional_element_interface::get (me);
1050   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
1051   Real staff_space = Staff_symbol_referencer::staff_space (me);
1052   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
1053   bool ps_testing = to_boolean (ly_symbol2scm ("ps-testing"));
1054   for (int i=0; i < stems.size (); i++)
1055     {
1056       Item* s = stems[i];
1057       if (Stem::invisible_b (s))
1058         continue;
1059
1060       Real stem_y = calc_stem_y_f (me, s, pos);
1061
1062       // doesn't play well with dvips
1063       if (ps_testing)
1064         if (Stem::get_direction (s) == dir)
1065           stem_y += Stem::get_direction (s) * thick / 2;
1066
1067       /* caution: stem measures in staff-positions */
1068       Real id = me->relative_coordinate (common, Y_AXIS)
1069         - stems[i]->relative_coordinate (common, Y_AXIS);
1070       Stem::set_stemend (s, (stem_y + id) / staff_space * 2);
1071     }
1072 }
1073
1074 void
1075 Beam::set_beaming (Grob *me, Beaming_info_list *beaming)
1076 {
1077   Link_array<Grob> stems=
1078     Pointer_group_interface__extract_grobs (me, (Grob *)0, "stems");
1079
1080   Direction d = LEFT;
1081   for (int i=0; i  < stems.size (); i++)
1082     {
1083       do
1084         {
1085           /* Don't overwrite user override (?) */
1086           if (Stem::beam_count (stems[i], d) == -1
1087               /* Don't set beaming for outside of outer stems */
1088               && ! (d == LEFT && i == 0)
1089               && ! (d == RIGHT && i == stems.size () -1))
1090             {
1091               int b = beaming->infos_.elem (i).beams_i_drul_[d];
1092               Stem::set_beaming (stems[i], b, d);
1093             }
1094         }
1095       while (flip (&d) != LEFT);
1096     }
1097 }
1098
1099
1100
1101 /*
1102   beams to go with one stem.
1103
1104   FIXME: clean me up.
1105   */
1106 Molecule
1107 Beam::stem_beams (Grob *me, Item *here, Item *next, Item *prev, Real dydx)
1108 {
1109   // ugh -> use commonx
1110   if ((next
1111        && !(next->relative_coordinate (0, X_AXIS)
1112             > here->relative_coordinate (0, X_AXIS)))
1113       || (prev
1114           && !(prev->relative_coordinate (0, X_AXIS)
1115                < here->relative_coordinate (0, X_AXIS))))
1116     programming_error ("Beams are not left-to-right");
1117
1118   int multiplicity = get_multiplicity (me);
1119
1120   SCM space_proc = me->get_grob_property ("space-function");
1121   SCM space = gh_call1 (space_proc, gh_int2scm (multiplicity));
1122
1123   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
1124   Real interbeam_f = gh_scm2double (space);
1125
1126   Real bdy = interbeam_f;
1127
1128   Molecule leftbeams;
1129   Molecule rightbeams;
1130
1131   Real nw_f;
1132   if (!Stem::first_head (here))
1133     nw_f = 0;
1134   else {
1135     int t = Stem::type_i (here);
1136
1137     SCM proc = me->get_grob_property ("flag-width-function");
1138     SCM result = gh_call1 (proc, gh_int2scm (t));
1139     nw_f = gh_scm2double (result);
1140   }
1141
1142
1143   Direction dir = Directional_element_interface::get (me);
1144
1145   /* [Tremolo] beams on whole notes may not have direction set? */
1146  if (dir == CENTER)
1147     dir = Directional_element_interface::get (here);
1148
1149
1150   /* half beams extending to the left. */
1151   if (prev)
1152     {
1153       int lhalfs= lhalfs = Stem::beam_count (here, LEFT)
1154         - Stem::beam_count (prev, RIGHT);
1155       int lwholebeams= Stem::beam_count (here, LEFT)
1156         <? Stem::beam_count (prev, RIGHT);
1157
1158       /* Half beam should be one note-width,
1159          but let's make sure two half-beams never touch */
1160
1161       // FIXME: TODO (check) stem width / sloped beams
1162       Real w = here->relative_coordinate (0, X_AXIS)
1163         - prev->relative_coordinate (0, X_AXIS);
1164       Real stem_w = gh_scm2double (prev->get_grob_property ("thickness"))
1165         // URG
1166         * me->paper_l ()->get_var ("stafflinethickness");
1167
1168       w = w/2 <? nw_f;
1169       Molecule a;
1170       if (lhalfs)               // generates warnings if not
1171         a =  Lookup::beam (dydx, w + stem_w, thick);
1172       a.translate (Offset (-w, -w * dydx));
1173       a.translate_axis (-stem_w/2, X_AXIS);
1174       for (int j = 0; j  < lhalfs; j++)
1175         {
1176           Molecule b (a);
1177           b.translate_axis (-dir * bdy * (lwholebeams+j), Y_AXIS);
1178           leftbeams.add_molecule (b);
1179         }
1180     }
1181
1182   if (next)
1183     {
1184       int rhalfs  = Stem::beam_count (here, RIGHT)
1185         - Stem::beam_count (next, LEFT);
1186       int rwholebeams= Stem::beam_count (here, RIGHT)
1187         <? Stem::beam_count (next, LEFT);
1188
1189       Real w = next->relative_coordinate (0, X_AXIS)
1190         - here->relative_coordinate (0, X_AXIS);
1191
1192       Real stem_w = gh_scm2double (next->get_grob_property ("thickness"))
1193         // URG
1194         * me->paper_l ()->get_var ("stafflinethickness");
1195
1196       Molecule a = Lookup::beam (dydx, w + stem_w, thick);
1197       a.translate_axis (- stem_w/2, X_AXIS);
1198       int j = 0;
1199       Real gap_f = 0;
1200
1201       SCM gap = me->get_grob_property ("gap");
1202       if (gh_number_p (gap))
1203         {
1204           int gap_i = gh_scm2int ((gap));
1205           int nogap = rwholebeams - gap_i;
1206
1207           for (; j  < nogap; j++)
1208             {
1209               Molecule b (a);
1210               b.translate_axis (-dir  * bdy * j, Y_AXIS);
1211               rightbeams.add_molecule (b);
1212             }
1213           if (Stem::invisible_b (here))
1214             gap_f = nw_f;
1215           else
1216             gap_f = nw_f / 2;
1217           w -= 2 * gap_f;
1218           a = Lookup::beam (dydx, w + stem_w, thick);
1219         }
1220
1221       for (; j  < rwholebeams; j++)
1222         {
1223           Molecule b (a);
1224           Real tx = 0;
1225           if (Stem::invisible_b (here))
1226             // ugh, see chord-tremolo.ly
1227             tx = (-dir + 1) / 2 * nw_f * 1.5 + gap_f/4;
1228           else
1229             tx = gap_f;
1230           b.translate (Offset (tx, -dir * bdy * j));
1231           rightbeams.add_molecule (b);
1232         }
1233
1234       w = w/2 <? nw_f;
1235       if (rhalfs)
1236         a = Lookup::beam (dydx, w, thick);
1237
1238       for (; j  < rwholebeams + rhalfs; j++)
1239         {
1240           Molecule b (a);
1241           b.translate_axis (- dir * bdy * j, Y_AXIS);
1242           rightbeams.add_molecule (b);
1243         }
1244
1245     }
1246   leftbeams.add_molecule (rightbeams);
1247
1248   /* Does beam quanting think  of the asymetry of beams?
1249      Refpoint is on bottom of symbol. (FIXTHAT) --hwn. */
1250   return leftbeams;
1251 }
1252
1253
1254 MAKE_SCHEME_CALLBACK (Beam, brew_molecule, 1);
1255 SCM
1256 Beam::brew_molecule (SCM smob)
1257 {
1258   Grob *me =unsmob_grob (smob);
1259
1260   Molecule mol;
1261   if (!gh_pair_p (me->get_grob_property ("stems")))
1262     return SCM_EOL;
1263   Real x0, dx;
1264   Link_array<Item>stems =
1265     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1266   if (visible_stem_count (me))
1267     {
1268       // ugh -> use commonx
1269       x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
1270       dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
1271     }
1272   else
1273     {
1274       x0 = stems[0]->relative_coordinate (0, X_AXIS);
1275       dx = stems.top ()->relative_coordinate (0, X_AXIS) - x0;
1276     }
1277
1278   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
1279   Real dy = pos.delta ();
1280   Real dydx = dy && dx ? dy/dx : 0;
1281
1282   for (int i=0; i < stems.size (); i++)
1283     {
1284       Item *item = stems[i];
1285       Item *prev = (i > 0)? stems[i-1] : 0;
1286       Item *next = (i < stems.size ()-1) ? stems[i+1] :0;
1287
1288       Molecule sb = stem_beams (me, item, next, prev, dydx);
1289       Real x = item->relative_coordinate (0, X_AXIS) - x0;
1290       sb.translate (Offset (x, x * dydx + pos[LEFT]));
1291       mol.add_molecule (sb);
1292     }
1293
1294   mol.translate_axis (x0
1295                       - dynamic_cast<Spanner*> (me)
1296                       ->get_bound (LEFT)->relative_coordinate (0, X_AXIS),
1297                       X_AXIS);
1298
1299   if (0)
1300     {
1301       /*
1302         This code prints the demerits for each beam. Perhaps this
1303         should be switchable for those who want to twiddle with the
1304         parameters.
1305       */
1306       String str;
1307       if (1)
1308         {
1309           str += to_str (gh_scm2int  (me->get_grob_property ("best-idx")));
1310           str += ":";
1311         }
1312       str += to_str (gh_scm2double (me->get_grob_property ("quant-score")),
1313                      "%.2f");
1314
1315       SCM properties = Font_interface::font_alist_chain (me);
1316
1317       Molecule tm = Text_item::text2molecule (me, gh_str02scm (str.ch_C()), properties);
1318       mol.add_at_edge (Y_AXIS, UP, tm, 5.0);
1319     }
1320
1321   return mol.smobbed_copy ();
1322 }
1323
1324 int
1325 Beam::forced_stem_count (Grob *me)
1326 {
1327   Link_array<Item>stems =
1328     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1329   int f = 0;
1330   for (int i=0; i < stems.size (); i++)
1331     {
1332       Item *s = stems[i];
1333
1334       if (Stem::invisible_b (s))
1335         continue;
1336
1337       if (((int)Stem::chord_start_f (s))
1338         && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1339         f++;
1340     }
1341   return f;
1342 }
1343
1344
1345
1346
1347 /* TODO:
1348    use filter and standard list functions.
1349  */
1350 int
1351 Beam::visible_stem_count (Grob *me)
1352 {
1353   Link_array<Item>stems =
1354     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1355   int c = 0;
1356   for (int i = stems.size (); i--;)
1357     {
1358       if (!Stem::invisible_b (stems[i]))
1359         c++;
1360     }
1361   return c;
1362 }
1363
1364 Item*
1365 Beam::first_visible_stem (Grob *me)
1366 {
1367   Link_array<Item>stems =
1368     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1369
1370   for (int i = 0; i < stems.size (); i++)
1371     {
1372       if (!Stem::invisible_b (stems[i]))
1373         return stems[i];
1374     }
1375   return 0;
1376 }
1377
1378 Item*
1379 Beam::last_visible_stem (Grob *me)
1380 {
1381   Link_array<Item>stems =
1382     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1383   for (int i = stems.size (); i--;)
1384     {
1385       if (!Stem::invisible_b (stems[i]))
1386         return stems[i];
1387     }
1388   return 0;
1389 }
1390
1391
1392 /*
1393   [TODO]
1394   handle rest under beam (do_post: beams are calculated now)
1395   what about combination of collisions and rest under beam.
1396
1397   Should lookup
1398
1399     rest -> stem -> beam -> interpolate_y_position ()
1400 */
1401 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1402 SCM
1403 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1404 {
1405   Grob *rest = unsmob_grob (element_smob);
1406   Axis a = (Axis) gh_scm2int (axis);
1407
1408   assert (a == Y_AXIS);
1409
1410   Grob *st = unsmob_grob (rest->get_grob_property ("stem"));
1411   Grob *stem = st;
1412   if (!stem)
1413     return gh_double2scm (0.0);
1414   Grob *beam = unsmob_grob (stem->get_grob_property ("beam"));
1415   if (!beam
1416       || !Beam::has_interface (beam)
1417       || !Beam::visible_stem_count (beam))
1418     return gh_double2scm (0.0);
1419
1420   // make callback for rest from this.
1421   // todo: make sure this calced already.
1422
1423   //  Interval pos = ly_scm2interval (beam->get_grob_property ("positions"));
1424   Interval pos (0, 0);
1425   SCM s = beam->get_grob_property ("positions");
1426   if (gh_pair_p (s) && gh_number_p (ly_car (s)))
1427     pos = ly_scm2interval (s);
1428
1429   Real dy = pos.delta ();
1430   // ugh -> use commonx
1431   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1432   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1433   Real dydx = dy && dx ? dy/dx : 0;
1434
1435   Direction d = Stem::get_direction (stem);
1436   Real beamy = (stem->relative_coordinate (0, X_AXIS) - x0) * dydx + pos[LEFT];
1437
1438   Real staff_space =   Staff_symbol_referencer::staff_space (rest);
1439
1440
1441   Real rest_dim = rest->extent (rest, Y_AXIS)[d]*2.0 / staff_space; // refp??
1442
1443   Real minimum_dist
1444     = gh_scm2double (rest->get_grob_property ("minimum-beam-collision-distance"));
1445   Real dist =
1446     minimum_dist +  -d  * (beamy - rest_dim) >? 0;
1447
1448   int stafflines = Staff_symbol_referencer::line_count (rest);
1449
1450   // move discretely by half spaces.
1451   int discrete_dist = int (ceil (dist));
1452
1453   // move by whole spaces inside the staff.
1454   if (discrete_dist < stafflines+1)
1455     discrete_dist = int (ceil (discrete_dist / 2.0)* 2.0);
1456
1457   return gh_double2scm (-d *  discrete_dist);
1458 }
1459
1460
1461 bool
1462 Beam::has_interface (Grob *me)
1463 {
1464   return me->has_interface (ly_symbol2scm ("beam-interface"));
1465 }
1466