lily/beam.cc

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