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