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 "molecule.hh"
  35 #include "directional-element-interface.hh"
  36 #include "beaming.hh"
  37 #include "beam.hh"
  38 #include "misc.hh"
  39 #include "least-squares.hh"
  40 #include "stem.hh"
  41 #include "paper-def.hh"
  42 #include "lookup.hh"
  43 #include "group-interface.hh"
  44 #include "staff-symbol-referencer.hh"
  45 #include "item.hh"
  46 #include "spanner.hh"
  47 #include "warn.hh"
  48
  49
  50 #define DEBUG_QUANTING 0
  51
  52
  53 #if DEBUG_QUANTING
  54 #include "text-item.hh"  // debug output.
  55 #include "font-interface.hh"  // debug output.
  56 #endif
  57
  58
  59 void
  60 Beam::add_stem (Grob *me, Grob *s)
  61 {
  62   Pointer_group_interface::add_grob (me, ly_symbol2scm ("stems"), s);
  63
  64   s->add_dependency (me);
  65
  66   assert (!Stem::beam_l (s));
  67   s->set_grob_property ("beam", me->self_scm ());
  68
  69   add_bound_item (dynamic_cast<Spanner*> (me), dynamic_cast<Item*> (s));
  70 }
  71
  72 Real
  73 Beam::get_beam_space (Grob *me)
  74 {
  75   SCM func = me->get_grob_property ("space-function");
  76   SCM s = gh_call2 (func, me->self_scm (), gh_int2scm (get_beam_count (me)));
  77   return gh_scm2double (s);
  78 }
  79
  80 /*
  81   Maximum beam_count.
  82  */
  83 int
  84 Beam::get_beam_count (Grob *me)
  85 {
  86   int m = 0;
  87   for (SCM s = me->get_grob_property ("stems"); gh_pair_p (s); s = ly_cdr (s))
  88     {
  89       Grob *sc = unsmob_grob (ly_car (s));
  90
  91       m = m >? (Stem::beam_multiplicity (sc).length () + 1);
  92     }
  93   return m;
  94 }
  95
  96 MAKE_SCHEME_CALLBACK (Beam, space_function, 2);
  97 SCM
  98 Beam::space_function (SCM smob, SCM beam_count)
  99 {
 100   Grob *me = unsmob_grob (smob);
 101
 102   Real staff_space = Staff_symbol_referencer::staff_space (me);
 103   Real line = me->paper_l ()->get_var ("linethickness");
 104   Real thickness = gh_scm2double (me->get_grob_property ("thickness"))
 105     * staff_space;
 106
 107   Real beam_space = gh_scm2int (beam_count) < 4
 108     ? (2*staff_space + line - thickness) / 2.0
 109     : (3*staff_space + line - thickness) / 3.0;
 110
 111   return gh_double2scm (beam_space);
 112 }
 113
 114
 115 /* After pre-processing all directions should be set.
 116    Several post-processing routines (stem, slur, script) need stem/beam
 117    direction.
 118    Currenly, this means that beam has set all stem's directions.
 119    [Alternatively, stems could set its own directions, according to
 120    their beam, during 'final-pre-processing'.] */
 121 MAKE_SCHEME_CALLBACK (Beam, before_line_breaking, 1);
 122 SCM
 123 Beam::before_line_breaking (SCM smob)
 124 {
 125   Grob *me =  unsmob_grob (smob);
 126
 127   /* Beams with less than 2 two stems don't make much sense, but could happen
 128      when you do
 129
 130      [r8 c8 r8].
 131
 132     For a beam that  only has one stem, we try to do some disappearance magic:
 133     we revert the flag, and move on to The Eternal Engraving Fields. */
 134
 135   int count = visible_stem_count (me);
 136   if (count < 2)
 137     {
 138       me->warning (_ ("beam has less than two visible stems"));
 139
 140       SCM stems = me->get_grob_property ("stems");
 141       if (scm_ilength (stems) == 1)
 142         {
 143           me->warning (_ ("Beam has less than two stems. Removing beam."));
 144
 145           unsmob_grob (gh_car (stems))->remove_grob_property ("beam");
 146           me->suicide ();
 147
 148           return SCM_UNSPECIFIED;
 149         }
 150       else if (scm_ilength (stems) == 0)
 151         {
 152           me->suicide ();
 153           return SCM_UNSPECIFIED;
 154         }
 155     }
 156   if (count >= 1)
 157     {
 158       Direction d = get_default_dir (me);
 159
 160       consider_auto_knees (me, d);
 161       set_stem_directions (me, d);
 162
 163       connect_beams (me);
 164
 165       set_stem_shorten (me);
 166     }
 167
 168   return SCM_EOL;
 169 }
 170
 171
 172
 173 void
 174 Beam::connect_beams (Grob *me)
 175 {
 176   Link_array<Grob> stems=
 177     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 178
 179   Slice last_int;
 180   last_int.set_empty();
 181   for (int i = 0; i< stems.size(); i++)
 182     {
 183       Grob *this_stem = stems[i];
 184       SCM this_beaming = this_stem->get_grob_property ("beaming");
 185
 186       Direction this_dir = Directional_element_interface::get(this_stem);
 187       if (i > 0)
 188         {
 189           int start_point = last_int [this_dir];
 190
 191           Direction d = LEFT;
 192           Slice new_slice ;
 193           do
 194             {
 195               if (d == RIGHT && i == stems.size()-1)
 196                 continue;
 197
 198               new_slice.set_empty();
 199               SCM s = index_get_cell (this_beaming, d);
 200               for (; gh_pair_p (s); s = gh_cdr (s))
 201                 {
 202                   int new_beam_pos =
 203                     start_point - this_dir * gh_scm2int (gh_car (s));
 204
 205                   new_slice.add_point (new_beam_pos);
 206                   gh_set_car_x (s, gh_int2scm (new_beam_pos));
 207                 }
 208             }
 209           while (flip (&d) != LEFT);
 210
 211           if (!new_slice.empty_b())
 212             last_int =  new_slice;
 213         }
 214       else
 215         {
 216           SCM s = gh_cdr (this_beaming);
 217           for (; gh_pair_p (s); s = gh_cdr (s))
 218             {
 219               int np = - this_dir * gh_scm2int (gh_car(s));
 220               gh_set_car_x (s, gh_int2scm (np));
 221               last_int.add_point (np);
 222             }
 223         }
 224     }
 225 }
 226
 227 MAKE_SCHEME_CALLBACK (Beam, brew_molecule, 1);
 228 SCM
 229 Beam::brew_molecule (SCM grob)
 230 {
 231   Grob *me = unsmob_grob (grob);
 232   Link_array<Grob> stems=
 233     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 234   Grob* xcommon = common_refpoint_of_array (stems, me, X_AXIS);
 235
 236   Real x0, dx;
 237   if (visible_stem_count (me))
 238     {
 239       // ugh -> use commonx
 240       x0 = first_visible_stem (me)->relative_coordinate (xcommon, X_AXIS);
 241       dx = last_visible_stem (me)->relative_coordinate (xcommon, X_AXIS) - x0;
 242     }
 243   else
 244     {
 245       x0 = stems[0]->relative_coordinate (xcommon, X_AXIS);
 246       dx = stems.top ()->relative_coordinate (xcommon, X_AXIS) - x0;
 247     }
 248
 249   SCM posns = me->get_grob_property ("positions");
 250   Interval pos;
 251   if (!ly_number_pair_p (posns))
 252     {
 253       programming_error ("No beam posns");
 254       pos = Interval (0,0);
 255     }
 256   else
 257     pos= ly_scm2interval (posns);
 258
 259   Real dy = pos.delta ();
 260   Real dydx = dy && dx ? dy/dx : 0;
 261
 262   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
 263   Real bdy = get_beam_space (me);
 264
 265   SCM last_beaming = SCM_EOL;;
 266   Real last_xposn = -1;
 267   Real last_width = -1 ;
 268
 269
 270   SCM gap = me->get_grob_property ("gap");
 271   Molecule the_beam;
 272   Real lt = me->paper_l ()->get_var ("linethickness");
 273   for (int i = 0; i< stems.size(); i++)
 274     {
 275       Grob * st =stems[i];
 276
 277       SCM this_beaming = st->get_grob_property ("beaming");
 278       Real xposn = st->relative_coordinate (xcommon, X_AXIS);
 279       Real stem_width = gh_scm2double (st->get_grob_property ("thickness")) *lt;
 280
 281       if (i > 0)
 282         {
 283           SCM left = gh_cdr (last_beaming);
 284           SCM right = gh_car (this_beaming);
 285
 286           Array<int> fullbeams;
 287           Array<int> lfliebertjes;
 288           Array<int> rfliebertjes;
 289
 290           for (SCM s = left;
 291                gh_pair_p (s); s =gh_cdr (s))
 292             {
 293               int b = gh_scm2int (gh_car (s));
 294               if (scm_memq (gh_car(s), right) != SCM_BOOL_F)
 295                 {
 296                   fullbeams.push (b);
 297                 }
 298               else
 299                 {
 300                   lfliebertjes.push (b);
 301                 }
 302             }
 303           for (SCM s = right;
 304                gh_pair_p (s); s =gh_cdr (s))
 305             {
 306               int b = gh_scm2int (gh_car (s));
 307               if (scm_memq (gh_car(s), left) == SCM_BOOL_F)
 308                 {
 309                   rfliebertjes.push (b);
 310                 }
 311             }
 312
 313
 314           Real w = xposn - last_xposn;
 315           Real stem_offset = 0.0;
 316           Real width_corr = 0.0;
 317           if (i == 1)
 318             {
 319               stem_offset -= last_width/2;
 320               width_corr += last_width/2;
 321             }
 322
 323           if (i == stems.size() -1)
 324             {
 325               width_corr += stem_width/2;
 326             }
 327
 328           if (gh_number_p (gap))
 329             {
 330               Real g = gh_scm2double (gap);
 331               stem_offset += g;
 332               width_corr -= 2*g;
 333             }
 334
 335           Molecule whole = Lookup::beam (dydx, w + width_corr, thick);
 336           for (int j = fullbeams.size(); j--;)
 337             {
 338               Molecule b (whole);
 339               b.translate_axis (last_xposn -  x0 + stem_offset, X_AXIS);
 340               b.translate_axis (dydx * (last_xposn - x0) + bdy * fullbeams[j], Y_AXIS);
 341               the_beam.add_molecule (b);
 342             }
 343
 344           if (lfliebertjes.size() || rfliebertjes.size())
 345             {
 346
 347               Real nw_f;
 348               if (!Stem::first_head (st))
 349                 nw_f = 0;
 350               else
 351                 {
 352                   int t = Stem::duration_log (st);
 353
 354                   SCM proc = me->get_grob_property ("flag-width-function");
 355                   SCM result = gh_call1 (proc, gh_int2scm (t));
 356                   nw_f = gh_scm2double (result);
 357                 }
 358
 359               /* Half beam should be one note-width,
 360                  but let's make sure two half-beams never touch */
 361
 362               Real w = xposn - last_xposn;
 363               w = w/2 <? nw_f;
 364
 365               Molecule half = Lookup::beam (dydx, w, thick);
 366               for (int j = lfliebertjes.size(); j--;)
 367                 {
 368                   Molecule b (half);
 369                   b.translate_axis (last_xposn -  x0, X_AXIS);
 370                   b.translate_axis (dydx * (last_xposn-x0) + bdy * lfliebertjes[j], Y_AXIS);
 371                   the_beam.add_molecule (b);
 372                 }
 373               for (int j = rfliebertjes.size(); j--;)
 374                 {
 375                   Molecule b (half);
 376                   b.translate_axis (xposn -  x0 - w , X_AXIS);
 377                   b.translate_axis (dydx * (xposn-x0 -w) + bdy * rfliebertjes[j], Y_AXIS);
 378                   the_beam.add_molecule (b);
 379                 }
 380             }
 381         }
 382
 383       last_xposn = xposn;
 384       last_width = stem_width;
 385       last_beaming = this_beaming;
 386     }
 387
 388   the_beam.translate_axis (x0 - me->relative_coordinate (xcommon, X_AXIS), X_AXIS);
 389   the_beam.translate_axis (pos[LEFT], Y_AXIS);
 390
 391 #if (DEBUG_QUANTING)
 392     {
 393       /*
 394         This code prints the demerits for each beam. Perhaps this
 395         should be switchable for those who want to twiddle with the
 396         parameters.
 397       */
 398       String str;
 399       if (1)
 400         {
 401           str += to_str (gh_scm2int (me->get_grob_property ("best-idx")));
 402           str += ":";
 403         }
 404       str += to_str (gh_scm2double (me->get_grob_property ("quant-score")),
 405                      "%.2f");
 406
 407       SCM properties = Font_interface::font_alist_chain (me);
 408
 409
 410       Molecule tm = Text_item::text2molecule (me, ly_str02scm (str.ch_C ()), properties);
 411       the_beam.add_at_edge (Y_AXIS, UP, tm, 5.0);
 412     }
 413 #endif
 414
 415
 416
 417   return the_beam.smobbed_copy();
 418 }
 419
 420
 421
 422
 423 Direction
 424 Beam::get_default_dir (Grob *me)
 425 {
 426   Drul_array<int> total;
 427   total[UP]  = total[DOWN] = 0;
 428   Drul_array<int> count;
 429   count[UP]  = count[DOWN] = 0;
 430   Direction d = DOWN;
 431
 432   Link_array<Item> stems=
 433         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 434
 435   for (int i=0; i <stems.size (); i++)
 436     do {
 437       Grob *s = stems[i];
 438       Direction sd = Directional_element_interface::get (s);
 439
 440       int center_distance = int(- d * Stem::head_positions (s) [-d]) >? 0;
 441       int current = sd  ? (1 + d * sd)/2 : center_distance;
 442
 443       if (current)
 444         {
 445           total[d] += current;
 446           count[d] ++;
 447         }
 448     } while (flip (&d) != DOWN);
 449
 450   SCM func = me->get_grob_property ("dir-function");
 451   SCM s = gh_call2 (func,
 452                     gh_cons (gh_int2scm (count[UP]),
 453                              gh_int2scm (count[DOWN])),
 454                     gh_cons (gh_int2scm (total[UP]),
 455                              gh_int2scm (total[DOWN])));
 456
 457   if (gh_number_p (s) && gh_scm2int (s))
 458     return to_dir (s);
 459
 460   /* If dir is not determined: get default */
 461   return to_dir (me->get_grob_property ("neutral-direction"));
 462 }
 463
 464
 465 /* Set all stems with non-forced direction to beam direction.
 466    Urg: non-forced should become `without/with unforced' direction,
 467    once stem gets cleaned-up. */
 468 void
 469 Beam::set_stem_directions (Grob *me, Direction d)
 470 {
 471   Link_array<Item> stems
 472     =Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
 473
 474   for (int i=0; i <stems.size (); i++)
 475     {
 476       Grob *s = stems[i];
 477       SCM force = s->remove_grob_property ("dir-forced");
 478       if (!gh_boolean_p (force) || !gh_scm2bool (force))
 479         Directional_element_interface::set (s, d);
 480     }
 481 }
 482
 483 /* Simplistic auto-knees; only consider vertical gap between two
 484    adjacent chords.
 485
 486   `Forced' stem directions are ignored.  If you don't want auto-knees,
 487   don't set, or unset auto-knee-gap. */
 488 void
 489 Beam::consider_auto_knees (Grob *me, Direction d)
 490 {
 491   SCM scm = me->get_grob_property ("auto-knee-gap");
 492
 493   if (gh_number_p (scm))
 494     {
 495       bool knee_b = false;
 496       Real knee_y = 0;
 497       Real staff_space = Staff_symbol_referencer::staff_space (me);
 498       Real gap = gh_scm2double (scm) / staff_space;
 499
 500       Link_array<Grob> stems=
 501         Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 502
 503       Grob *common = common_refpoint_of_array (stems, me,  Y_AXIS);
 504
 505       int l = 0;
 506       for (int i=1; i < stems.size (); i++)
 507         {
 508           if (!Stem::invisible_b (stems[i-1]))
 509             l = i - 1;
 510           if (Stem::invisible_b (stems[l]))
 511             continue;
 512           if (Stem::invisible_b (stems[i]))
 513             continue;
 514
 515           Real left = Stem::extremal_heads (stems[l])[d]
 516             ->relative_coordinate (common, Y_AXIS);
 517           Real right = Stem::extremal_heads (stems[i])[-d]
 518             ->relative_coordinate (common, Y_AXIS);
 519
 520           Real dy = right - left;
 521
 522           if (abs (dy) >= gap)
 523             {
 524               knee_y = (right + left) / 2;
 525               knee_b = true;
 526               break;
 527             }
 528         }
 529
 530       if (knee_b)
 531         {
 532           for (int i=0; i < stems.size (); i++)
 533             {
 534               Grob *s = stems[i];
 535               if (Stem::invisible_b (s) ||
 536                   s->get_grob_property ("dir-forced") == SCM_BOOL_T)
 537                 continue;
 538               Real y = Stem::extremal_heads (stems[i])[d]
 539                 ->relative_coordinate (common, Y_AXIS);
 540
 541               Directional_element_interface::set (s, y < knee_y ? UP : DOWN);
 542               s->set_grob_property ("dir-forced", SCM_BOOL_T);
 543             }
 544         }
 545     }
 546 }
 547
 548 /* Set stem's shorten property if unset.
 549
 550  TODO:
 551    take some y-position (chord/beam/nearest?) into account
 552    scmify forced-fraction
 553
 554    TODO:
 555
 556    why is shorten stored in beam, and not directly in stem?
 557
 558 */
 559 void
 560 Beam::set_stem_shorten (Grob *m)
 561 {
 562   Spanner*me = dynamic_cast<Spanner*> (m);
 563
 564   Real forced_fraction = forced_stem_count (me) / visible_stem_count (me);
 565
 566   int beam_count = get_beam_count (me);
 567
 568   SCM shorten = me->get_grob_property ("beamed-stem-shorten");
 569   if (shorten == SCM_EOL)
 570     return;
 571
 572   int sz = scm_ilength (shorten);
 573
 574   Real staff_space = Staff_symbol_referencer::staff_space (me);
 575   SCM shorten_elt = scm_list_ref (shorten,
 576                                   gh_int2scm (beam_count <? (sz - 1)));
 577   Real shorten_f = gh_scm2double (shorten_elt) * staff_space;
 578
 579   /* your similar cute comment here */
 580   shorten_f *= forced_fraction;
 581
 582   if (shorten_f)
 583     me->set_grob_property ("shorten", gh_double2scm (shorten_f));
 584 }
 585
 586 /*  Call list of y-dy-callbacks, that handle setting of
 587     grob-properties
 588
 589 */
 590 MAKE_SCHEME_CALLBACK (Beam, after_line_breaking, 1);
 591 SCM
 592 Beam::after_line_breaking (SCM smob)
 593 {
 594   Grob *me = unsmob_grob (smob);
 595
 596   /* Copy to mutable list. */
 597   SCM s = ly_deep_copy (me->get_grob_property ("positions"));
 598   me->set_grob_property ("positions", s);
 599
 600   if (ly_car (s) == SCM_BOOL_F)
 601     {
 602
 603       // one wonders if such genericity is necessary  --hwn.
 604       SCM callbacks = me->get_grob_property ("position-callbacks");
 605       for (SCM i = callbacks; gh_pair_p (i); i = ly_cdr (i))
 606         gh_call1 (ly_car (i), smob);
 607     }
 608
 609   set_stem_lengths (me);
 610   return SCM_UNSPECIFIED;
 611 }
 612
 613 MAKE_SCHEME_CALLBACK (Beam, least_squares, 1);
 614 SCM
 615 Beam::least_squares (SCM smob)
 616 {
 617   Grob *me = unsmob_grob (smob);
 618
 619   int count = visible_stem_count (me);
 620   Interval pos (0, 0);
 621
 622   if (count <= 1)
 623     {
 624       me->set_grob_property ("positions", ly_interval2scm (pos));
 625       return SCM_UNSPECIFIED;
 626     }
 627
 628
 629   Array<Real> x_posns ;
 630   Link_array<Grob> stems=
 631     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 632   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
 633   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
 634
 635   Real my_y = me->relative_coordinate (commony, Y_AXIS);
 636
 637   Grob *fvs  = first_visible_stem (me);
 638   Grob *lvs  = last_visible_stem (me);
 639
 640   Interval ideal (Stem::calc_stem_info (fvs).ideal_y_
 641                   + fvs->relative_coordinate (commony, Y_AXIS) -my_y,
 642                   Stem::calc_stem_info (lvs).ideal_y_
 643                   + lvs->relative_coordinate (commony, Y_AXIS) - my_y);
 644
 645   Real x0 = first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
 646   for (int i=0; i < stems.size (); i++)
 647     {
 648       Grob* s = stems[i];
 649
 650       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
 651       x_posns.push (x);
 652     }
 653   Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS) - x0;
 654
 655   Real y =0;
 656   Real dydx = 0;
 657   Real dy = 0;
 658
 659   if (!ideal.delta ())
 660     {
 661       Interval chord (Stem::chord_start_y (first_visible_stem (me)),
 662                       Stem::chord_start_y (last_visible_stem (me)));
 663
 664
 665       /*
 666         TODO -- use scoring for this.
 667
 668         complicated, because we take stem-info.ideal for determining
 669         beam slopes.
 670        */
 671       /* Make simple beam on middle line have small tilt */
 672       if (!ideal[LEFT] && chord.delta () && count == 2)
 673         {
 674
 675           /*
 676             FIXME. -> UP
 677           */
 678           Direction d = (Direction) (sign (chord.delta ()) * UP);
 679           pos[d] = gh_scm2double (me->get_grob_property ("thickness")) / 2;
 680           //                * dir;
 681           pos[-d] = - pos[d];
 682         }
 683       else
 684         {
 685           pos = ideal;
 686         }
 687
 688       y = pos[LEFT];
 689       dy = pos[RIGHT]- y;
 690       dydx = dy/dx;
 691     }
 692   else
 693     {
 694       Array<Offset> ideals;
 695       for (int i=0; i < stems.size (); i++)
 696         {
 697           Grob* s = stems[i];
 698           if (Stem::invisible_b (s))
 699             continue;
 700           ideals.push (Offset (x_posns[i],
 701                                Stem::calc_stem_info (s).ideal_y_
 702                                + s->relative_coordinate (commony, Y_AXIS)
 703                                - my_y));
 704         }
 705       minimise_least_squares (&dydx, &y, ideals);
 706
 707       dy = dydx * dx;
 708       me->set_grob_property ("least-squares-dy", gh_double2scm (dy));
 709       pos = Interval (y, (y+dy));
 710     }
 711
 712   me->set_grob_property ("positions", ly_interval2scm (pos));
 713
 714   return SCM_UNSPECIFIED;
 715 }
 716
 717
 718 /*
 719   We can't combine with previous function, since check concave and
 720   slope damping comes first.
 721  */
 722 MAKE_SCHEME_CALLBACK (Beam, shift_region_to_valid, 1);
 723 SCM
 724 Beam::shift_region_to_valid (SCM grob)
 725 {
 726   Grob *me = unsmob_grob (grob);
 727   /*
 728     Code dup.
 729    */
 730   Array<Real> x_posns ;
 731   Link_array<Grob> stems=
 732     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 733   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
 734   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
 735
 736   Grob *fvs = first_visible_stem (me);
 737
 738   if (!fvs)
 739     return SCM_UNSPECIFIED;
 740
 741   Real x0 =fvs->relative_coordinate (commonx, X_AXIS);
 742   for (int i=0; i < stems.size (); i++)
 743     {
 744       Grob* s = stems[i];
 745
 746       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
 747       x_posns.push (x);
 748     }
 749
 750   Grob *lvs = last_visible_stem (me);
 751   if (!lvs)
 752     return SCM_UNSPECIFIED;
 753
 754   Real dx = lvs->relative_coordinate (commonx, X_AXIS) - x0;
 755
 756   Interval pos = ly_scm2interval ( me->get_grob_property ("positions"));
 757   Real dy = pos.delta();
 758   Real y = pos[LEFT];
 759   Real dydx =dy/dx;
 760
 761
 762   /*
 763     Shift the positions so that we have a chance of finding good
 764     quants (i.e. no short stem failures.)
 765    */
 766   Interval feasible_left_point;
 767   feasible_left_point.set_full ();
 768   for (int i=0; i < stems.size (); i++)
 769     {
 770       Grob* s = stems[i];
 771       if (Stem::invisible_b (s))
 772         continue;
 773
 774       Direction d = Stem::get_direction (s);
 775
 776       Real left_y =
 777         Stem::calc_stem_info (s).shortest_y_
 778         - dydx * x_posns [i];
 779
 780       /*
 781         left_y is now relative to the stem S. We want relative to
 782         ourselves, so translate:
 783        */
 784       left_y +=
 785         + s->relative_coordinate (commony, Y_AXIS)
 786         - me->relative_coordinate (commony, Y_AXIS);
 787
 788       Interval flp ;
 789       flp.set_full ();
 790       flp[-d] = left_y;
 791
 792       feasible_left_point.intersect (flp);
 793     }
 794
 795   if (feasible_left_point.empty_b())
 796     {
 797       warning (_("Not sure that we can find a nice beam slope (no viable initial configuration found)."));
 798     }
 799   else if (!feasible_left_point.elem_b(y))
 800     {
 801       if (isinf (feasible_left_point[DOWN]))
 802         y = feasible_left_point[UP] - REGION_SIZE;
 803       else if (isinf (feasible_left_point[UP]))
 804         y = feasible_left_point[DOWN]+ REGION_SIZE;
 805       else
 806         y = feasible_left_point.center ();
 807     }
 808   pos = Interval (y, (y+dy));
 809   me->set_grob_property ("positions", ly_interval2scm (pos));
 810   return SCM_UNSPECIFIED;
 811 }
 812
 813
 814 MAKE_SCHEME_CALLBACK (Beam, check_concave, 1);
 815 SCM
 816 Beam::check_concave (SCM smob)
 817 {
 818   Grob *me = unsmob_grob (smob);
 819
 820   Link_array<Grob> stems =
 821     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
 822
 823   for (int i = 0; i < stems.size ();)
 824     {
 825       if (Stem::invisible_b (stems[i]))
 826         stems.del (i);
 827       else
 828         i++;
 829     }
 830
 831   if (stems.size () < 3)
 832     return SCM_UNSPECIFIED;
 833
 834
 835   /* Concaveness #1: If distance of an inner notehead to line between
 836      two outer noteheads is bigger than CONCAVENESS-GAP (2.0ss),
 837      beam is concave (Heinz Stolba).
 838
 839      In the case of knees, the line connecting outer heads is often
 840      not related to the beam slope (it may even go in the other
 841      direction). Skip the check when the outer stems point in
 842      different directions. --hwn
 843
 844   */
 845   bool concaveness1 = false;
 846   SCM gap = me->get_grob_property ("concaveness-gap");
 847   if (gh_number_p (gap)
 848       && Stem::get_direction(stems.top ())
 849          == Stem::get_direction(stems[0]))
 850     {
 851       Real r1 = gh_scm2double (gap);
 852       Real dy = Stem::chord_start_y (stems.top ())
 853         - Stem::chord_start_y (stems[0]);
 854
 855
 856       Real slope = dy / (stems.size () - 1);
 857
 858       Real y0 = Stem::chord_start_y (stems[0]);
 859       for (int i = 1; i < stems.size () - 1; i++)
 860         {
 861           Real c = (Stem::chord_start_y (stems[i]) - y0) - i * slope;
 862           if (c > r1)
 863             {
 864               concaveness1 = true;
 865               break;
 866             }
 867         }
 868     }
 869
 870
 871   /* Concaveness #2: Sum distances of inner noteheads that fall
 872      outside the interval of the two outer noteheads.
 873
 874      We only do this for beams where first and last stem have the same
 875      direction. --hwn.
 876
 877
 878      Note that "convex" stems compensate for "concave" stems.
 879      (is that intentional?) --hwn.
 880   */
 881
 882   Real concaveness2 = 0;
 883   SCM thresh = me->get_grob_property ("concaveness-threshold");
 884   Real r2 = infinity_f;
 885   if (!concaveness1 && gh_number_p (thresh)
 886       && Stem::get_direction(stems.top ())
 887          == Stem::get_direction(stems[0]))
 888     {
 889       r2 = gh_scm2double (thresh);
 890
 891       Direction dir = Stem::get_direction(stems.top ());
 892       Real concave = 0;
 893       Interval iv (Stem::chord_start_y (stems[0]),
 894                    Stem::chord_start_y (stems.top ()));
 895
 896       if (iv[MAX] < iv[MIN])
 897         iv.swap ();
 898
 899       for (int i = 1; i < stems.size () - 1; i++)
 900         {
 901           Real f = Stem::chord_start_y (stems[i]);
 902           concave += ((f - iv[MAX] ) >? 0) +
 903             ((f - iv[MIN] ) <? 0);
 904         }
 905       concave *= dir;
 906       concaveness2 = concave / (stems.size () - 2);
 907
 908       /* ugh: this is the a kludge to get
 909          input/regression/beam-concave.ly to behave as
 910          baerenreiter. */
 911
 912       /*
 913         huh? we're dividing twice (which is not scalable) meaning that
 914         the longer the beam, the more unlikely it will be
 915         concave. Maybe you would even expect the other way around??
 916
 917         --hwn.
 918
 919        */
 920       concaveness2 /= (stems.size () - 2);
 921     }
 922
 923   /* TODO: some sort of damping iso -> plain horizontal */
 924   if (concaveness1 || concaveness2 > r2)
 925     {
 926       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 927       Real r = pos.linear_combination (0);
 928       me->set_grob_property ("positions", ly_interval2scm (Interval (r, r)));
 929       me->set_grob_property ("least-squares-dy", gh_double2scm (0));
 930     }
 931
 932   return SCM_UNSPECIFIED;
 933 }
 934
 935 /* This neat trick is by Werner Lemberg,
 936    damped = tanh (slope)
 937    corresponds with some tables in [Wanske] CHECKME */
 938 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
 939 SCM
 940 Beam::slope_damping (SCM smob)
 941 {
 942   Grob *me = unsmob_grob (smob);
 943
 944   if (visible_stem_count (me) <= 1)
 945     return SCM_UNSPECIFIED;
 946
 947   SCM s = me->get_grob_property ("damping");
 948   int damping = gh_scm2int (s);
 949
 950   if (damping)
 951     {
 952       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 953       Real dy = pos.delta ();
 954
 955       Grob *fvs  = first_visible_stem (me);
 956       Grob *lvs  = last_visible_stem (me);
 957
 958       Grob *commonx = fvs->common_refpoint (lvs, X_AXIS);
 959
 960
 961       Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS)
 962         - first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
 963       Real dydx = dy && dx ? dy/dx : 0;
 964       dydx = 0.6 * tanh (dydx) / damping;
 965
 966       Real damped_dy = dydx * dx;
 967       pos[LEFT] += (dy - damped_dy) / 2;
 968       pos[RIGHT] -= (dy - damped_dy) / 2;
 969
 970       me->set_grob_property ("positions", ly_interval2scm (pos));
 971     }
 972   return SCM_UNSPECIFIED;
 973 }
 974
 975 Slice
 976 where_are_the_whole_beams(SCM beaming)
 977 {
 978   Slice l;
 979
 980   for( SCM s = gh_car (beaming); gh_pair_p (s) ; s = gh_cdr (s))
 981     {
 982       if (scm_memq (gh_car (s), gh_cdr (beaming)) != SCM_BOOL_F)
 983
 984         l.add_point (gh_scm2int (gh_car (s)));
 985     }
 986
 987   return l;
 988 }
 989
 990 /*
 991   Calculate the Y position of the stem-end, given the Y-left, Y-right
 992   in POS for stem S. This Y position is relative to S.
 993  */
 994 Real
 995 Beam::calc_stem_y (Grob *me, Grob* s, Grob ** common,
 996                    Real xl, Real xr,
 997                    Interval pos, bool french)
 998 {
 999   Real beam_space = get_beam_space (me);
1000
1001
1002   Real r = s->relative_coordinate (common[X_AXIS], X_AXIS) - xl;
1003   Real dy = pos.delta ();
1004   Real dx = xr - xl;
1005   Real stem_y_beam0 = (dy && dx
1006                        ? r / dx
1007                        * dy
1008                        : 0) + pos[LEFT];
1009
1010   Direction my_dir = Directional_element_interface::get (s);
1011   SCM beaming = s->get_grob_property ("beaming");
1012
1013   Real stem_y = stem_y_beam0;
1014   if (french)
1015     {
1016       Slice bm = where_are_the_whole_beams (beaming);
1017       if (!bm.empty_b())
1018         stem_y += beam_space * bm[-my_dir];
1019     }
1020   else
1021     {
1022       Slice bm = Stem::beam_multiplicity(s);
1023       if (!bm.empty_b())
1024         stem_y +=bm[my_dir] * beam_space;
1025     }
1026
1027   Real id = me->relative_coordinate (common[Y_AXIS], Y_AXIS)
1028     - s->relative_coordinate (common[Y_AXIS], Y_AXIS);
1029
1030   return stem_y + id;
1031 }
1032
1033 /*
1034   Hmm.  At this time, beam position and slope are determined.  Maybe,
1035   stem directions and length should set to relative to the chord's
1036   position of the beam.  */
1037 void
1038 Beam::set_stem_lengths (Grob *me)
1039 {
1040   Link_array<Grob> stems=
1041     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
1042
1043   if (stems.size () <= 1)
1044     return;
1045
1046   Grob *common[2];
1047   for (int a = 2; a--;)
1048     common[a] = common_refpoint_of_array (stems, me, Axis(a));
1049
1050   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
1051   Real staff_space = Staff_symbol_referencer::staff_space (me);
1052
1053   bool french = to_boolean (me->get_grob_property ("french-beaming"));
1054
1055
1056   // ugh -> use commonx
1057   Grob * fvs = first_visible_stem (me);
1058   Grob *lvs = last_visible_stem (me);
1059
1060   Real xl = fvs ? fvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1061   Real xr = fvs ? lvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1062
1063   for (int i=0; i < stems.size (); i++)
1064     {
1065       Grob* s = stems[i];
1066       if (Stem::invisible_b (s))
1067         continue;
1068
1069       Real stem_y = calc_stem_y (me, s, common,
1070                                  xl, xr,
1071                                  pos, french && i > 0&& (i < stems.size  () -1));
1072
1073       Stem::set_stemend (s, 2* stem_y / staff_space);
1074     }
1075 }
1076
1077 void
1078 Beam::set_beaming (Grob *me, Beaming_info_list *beaming)
1079 {
1080   Link_array<Grob> stems=
1081     Pointer_group_interface__extract_grobs (me, (Grob *)0, "stems");
1082
1083   Direction d = LEFT;
1084   for (int i=0; i  < stems.size (); i++)
1085     {
1086       /*
1087         Don't overwrite user settings.
1088        */
1089
1090       do
1091         {
1092           /* Don't set beaming for outside of outer stems */
1093           if ((d == LEFT && i == 0)
1094               ||(d == RIGHT && i == stems.size () -1))
1095             continue;
1096
1097
1098           SCM beaming_prop = stems[i]->get_grob_property ("beaming");
1099           if (beaming_prop == SCM_EOL ||
1100               index_get_cell (beaming_prop, d) == SCM_EOL)
1101             {
1102               int b = beaming->infos_.elem (i).beams_i_drul_[d];
1103               Stem::set_beaming (stems[i], b, d);
1104             }
1105         }
1106       while (flip (&d) != LEFT);
1107     }
1108 }
1109
1110 int
1111 Beam::forced_stem_count (Grob *me)
1112 {
1113   Link_array<Grob>stems =
1114     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1115   int f = 0;
1116   for (int i=0; i < stems.size (); i++)
1117     {
1118       Grob *s = stems[i];
1119
1120       if (Stem::invisible_b (s))
1121         continue;
1122
1123       if (((int)Stem::chord_start_y (s))
1124         && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1125         f++;
1126     }
1127   return f;
1128 }
1129
1130
1131
1132
1133 int
1134 Beam::visible_stem_count (Grob *me)
1135 {
1136   Link_array<Grob>stems =
1137     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1138   int c = 0;
1139   for (int i = stems.size (); i--;)
1140     {
1141       if (!Stem::invisible_b (stems[i]))
1142         c++;
1143     }
1144   return c;
1145 }
1146
1147 Grob*
1148 Beam::first_visible_stem (Grob *me)
1149 {
1150   Link_array<Grob>stems =
1151     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1152
1153   for (int i = 0; i < stems.size (); i++)
1154     {
1155       if (!Stem::invisible_b (stems[i]))
1156         return stems[i];
1157     }
1158   return 0;
1159 }
1160
1161 Grob*
1162 Beam::last_visible_stem (Grob *me)
1163 {
1164   Link_array<Grob>stems =
1165     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1166   for (int i = stems.size (); i--;)
1167     {
1168       if (!Stem::invisible_b (stems[i]))
1169         return stems[i];
1170     }
1171   return 0;
1172 }
1173
1174
1175 /*
1176   [TODO]
1177
1178   handle rest under beam (do_post: beams are calculated now)
1179   what about combination of collisions and rest under beam.
1180
1181   Should lookup
1182
1183     rest -> stem -> beam -> interpolate_y_position ()
1184 */
1185 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1186 SCM
1187 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1188 {
1189   Grob *rest = unsmob_grob (element_smob);
1190   Axis a = (Axis) gh_scm2int (axis);
1191
1192   assert (a == Y_AXIS);
1193
1194   Grob *st = unsmob_grob (rest->get_grob_property ("stem"));
1195   Grob *stem = st;
1196   if (!stem)
1197     return gh_double2scm (0.0);
1198   Grob *beam = unsmob_grob (stem->get_grob_property ("beam"));
1199   if (!beam
1200       || !Beam::has_interface (beam)
1201       || !Beam::visible_stem_count (beam))
1202     return gh_double2scm (0.0);
1203
1204   // make callback for rest from this.
1205   // todo: make sure this calced already.
1206
1207   //  Interval pos = ly_scm2interval (beam->get_grob_property ("positions"));
1208   Interval pos (0, 0);
1209   SCM s = beam->get_grob_property ("positions");
1210   if (gh_pair_p (s) && gh_number_p (ly_car (s)))
1211     pos = ly_scm2interval (s);
1212
1213   Real dy = pos.delta ();
1214   // ugh -> use commonx
1215   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1216   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1217   Real dydx = dy && dx ? dy/dx : 0;
1218
1219   Direction d = Stem::get_direction (stem);
1220   Real beamy = (stem->relative_coordinate (0, X_AXIS) - x0) * dydx + pos[LEFT];
1221
1222   Real staff_space = Staff_symbol_referencer::staff_space (rest);
1223
1224
1225   Real rest_dim = rest->extent (rest, Y_AXIS)[d]*2.0 / staff_space; // refp??
1226
1227   Real minimum_dist
1228     = gh_scm2double (rest->get_grob_property ("minimum-beam-collision-distance"));
1229   Real dist =
1230     minimum_dist +  -d  * (beamy - rest_dim) >? 0;
1231
1232   int stafflines = Staff_symbol_referencer::line_count (rest);
1233
1234   // move discretely by half spaces.
1235   int discrete_dist = int (ceil (dist));
1236
1237   // move by whole spaces inside the staff.
1238   if (discrete_dist < stafflines+1)
1239     discrete_dist = int (ceil (discrete_dist / 2.0)* 2.0);
1240
1241   return gh_double2scm (-d *  discrete_dist);
1242 }
1243
1244
1245
1246
1247 ADD_INTERFACE (Beam, "beam-interface",
1248   "A beam.
1249
1250 #'thickness= weight of beams, in staffspace
1251
1252
1253 We take the least squares line through the ideal-length stems, and
1254 then damp that using
1255
1256         damped = tanh (slope)
1257
1258 this gives an unquantized left and right position for the beam end.
1259 Then we take all combinations of quantings near these left and right
1260 positions, and give them a score (according to how close they are to
1261 the ideal slope, how close the result is to the ideal stems, etc.). We
1262 take the best scoring combination.
1263
1264 ",
1265   "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");
1266
1267