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