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