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