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
 291    TODO:
 292
 293    why is shorten stored in beam, and not directly in stem?
 294
 295 */
 296 void
 297 Beam::set_stem_shorten (Grob *m)
 298 {
 299   Spanner*me = dynamic_cast<Spanner*> (m);
 300
 301   Real forced_fraction = forced_stem_count (me) / visible_stem_count (me);
 302
 303   int multiplicity = get_multiplicity (me);
 304
 305   SCM shorten = me->get_grob_property ("beamed-stem-shorten");
 306   if (shorten == SCM_EOL)
 307     return;
 308
 309   int sz = scm_ilength (shorten);
 310
 311   Real staff_space = Staff_symbol_referencer::staff_space (me);
 312   SCM shorten_elt = scm_list_ref (shorten,
 313                                   gh_int2scm (multiplicity <? (sz - 1)));
 314   Real shorten_f = gh_scm2double (shorten_elt) * staff_space;
 315
 316   /* your similar cute comment here */
 317   shorten_f *= forced_fraction;
 318
 319   me->set_grob_property ("shorten", gh_double2scm (shorten_f));
 320 }
 321
 322 /*  Call list of y-dy-callbacks, that handle setting of
 323     grob-properties y, dy.
 324
 325     User may set grob-properties: y-position-hs and height-hs
 326  (to be fixed) that override the calculated y and dy.
 327
 328     Because y and dy cannot be calculated and quanted separately, we
 329     always calculate both, then check for user override. */
 330 MAKE_SCHEME_CALLBACK (Beam, after_line_breaking, 1);
 331 SCM
 332 Beam::after_line_breaking (SCM smob)
 333 {
 334   Grob *me = unsmob_grob (smob);
 335
 336   /* Copy to mutable list. */
 337   SCM s = ly_deep_copy (me->get_grob_property ("positions"));
 338   me->set_grob_property ("positions", s);
 339
 340   if (ly_car (s) != SCM_BOOL_F)
 341     return SCM_UNSPECIFIED;
 342
 343   SCM callbacks = me->get_grob_property ("position-callbacks");
 344   for (SCM i = callbacks; gh_pair_p (i); i = ly_cdr (i))
 345     gh_call1 (ly_car (i), smob);
 346
 347   return SCM_UNSPECIFIED;
 348 }
 349
 350 struct Quant_score
 351 {
 352   Real yl;
 353   Real yr;
 354   Real demerits;
 355 };
 356
 357
 358 /*
 359   TODO:
 360
 361    - Make all demerits customisable
 362
 363    - One sensible check per demerit (what's this --hwn)
 364
 365    - Add demerits for quants per se, as to forbid a specific quant
 366      entirely
 367
 368 */
 369 MAKE_SCHEME_CALLBACK (Beam, quanting, 1);
 370 SCM
 371 Beam::quanting (SCM smob)
 372 {
 373   Grob *me = unsmob_grob (smob);
 374
 375   SCM s = me->get_grob_property ("positions");
 376   Real yl = gh_scm2double (gh_car (s));
 377   Real yr = gh_scm2double (gh_cdr (s));
 378
 379   Real ss = Staff_symbol_referencer::staff_space (me);
 380   Real thickness = gh_scm2double (me->get_grob_property ("thickness")) / ss;
 381   Real slt = me->paper_l ()->get_var ("stafflinethickness") / ss;
 382
 383
 384   SCM sdy = me->get_grob_property ("least-squares-dy");
 385   Real dy_mus = gh_number_p (sdy) ? gh_scm2double (sdy) : 0.0;
 386
 387   Real straddle = 0.0;
 388   Real sit = (thickness - slt) / 2;
 389   Real inter = 0.5;
 390   Real hang = 1.0 - (thickness - slt) / 2;
 391   Real quants [] = {straddle, sit, inter, hang };
 392
 393   int num_quants = int (sizeof (quants)/sizeof (Real));
 394   Array<Real> quantsl;
 395   Array<Real> quantsr;
 396
 397   /*
 398     going to REGION_SIZE == 2, yields another 0.6 second with
 399     wtk1-fugue2.
 400
 401
 402     (result indexes between 70 and 575)  ? --hwn.
 403
 404   */
 405
 406   const int REGION_SIZE = 3;
 407   for (int i  = -REGION_SIZE ; i < REGION_SIZE; i++)
 408     for (int j = 0; j < num_quants; j++)
 409       {
 410         quantsl.push (i + quants[j] + int (yl));
 411         quantsr.push (i + quants[j] + int (yr));
 412       }
 413
 414   Array<Quant_score> qscores;
 415
 416   for (int l =0; l < quantsl.size (); l++)
 417     for (int r =0; r < quantsr.size (); r++)
 418       {
 419         Quant_score qs;
 420         qs.yl = quantsl[l];
 421         qs.yr = quantsr[r];
 422         qs.demerits = 0.0;
 423
 424         qscores.push (qs);
 425       }
 426
 427
 428   /*
 429     This is a longish function, but we don't separate this out into
 430     neat modular separate subfunctions, as the subfunctions would be
 431     called for many values of YL, YR. By precomputing various
 432     parameters outside of the loop, we can save a lot of time.
 433
 434   */
 435   for (int i = qscores.size (); i--;)
 436     if (qscores[i].demerits < 100)
 437       {
 438         qscores[i].demerits
 439           += score_slopes_dy (me, qscores[i].yl, qscores[i].yr,
 440                               dy_mus, yr- yl);
 441       }
 442
 443   Real rad = Staff_symbol_referencer::staff_radius (me);
 444   int multiplicity = get_multiplicity (me);
 445   Real interbeam = multiplicity < 4
 446     ? (2*ss + slt - thickness) / 2.0
 447      : (3*ss + slt - thickness) / 3.0;
 448
 449   for (int i = qscores.size (); i--;)
 450     if (qscores[i].demerits < 100)
 451       {
 452         qscores[i].demerits
 453           += score_forbidden_quants (me, qscores[i].yl, qscores[i].yr,
 454                                      rad, slt, thickness, interbeam,
 455                                      multiplicity);
 456       }
 457
 458
 459   /*
 460     Do stem lengths.  These depend on YL and YR linearly, so we can
 461     precompute for every stem 2 factors.
 462    */
 463   Link_array<Grob> stems=
 464     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 465   Array<Stem_info> stem_infos;
 466   Array<Real> lbase_lengths;
 467   Array<Real> rbase_lengths;
 468
 469   Array<int> directions;
 470   for (int i= 0; i < stems.size(); i++)
 471     {
 472       Grob*s = stems[i];
 473       stem_infos.push( Stem::calc_stem_info (s));
 474
 475       Real b = calc_stem_y (me, s, Interval (1,0));
 476       lbase_lengths.push (b);
 477
 478       b = calc_stem_y (me, s, Interval (0,1));
 479       rbase_lengths.push (b);
 480       directions.push( Directional_element_interface::get( s));
 481     }
 482
 483   for (int i = qscores.size (); i--;)
 484     if (qscores[i].demerits < 100)
 485       {
 486         qscores[i].demerits
 487           += score_stem_lengths (stems, stem_infos,
 488                                  lbase_lengths, rbase_lengths,
 489                                  directions,
 490                                  me, qscores[i].yl, qscores[i].yr);
 491       }
 492
 493
 494   Real best = 1e6;
 495   int best_idx = -1;
 496   for (int i = qscores.size (); i--;)
 497     {
 498       if (qscores[i].demerits < best)
 499         {
 500           best = qscores [i].demerits ;
 501           best_idx = i;
 502         }
 503     }
 504
 505
 506   me->set_grob_property ("positions",
 507                          gh_cons (gh_double2scm (qscores[best_idx].yl),
 508                                   gh_double2scm (qscores[best_idx].yr))
 509                          );
 510
 511   if (DEBUG_QUANTING)
 512   {
 513           // debug quanting
 514           me->set_grob_property ("quant-score",
 515                                  gh_double2scm (qscores[best_idx].demerits));
 516           me->set_grob_property ("best-idx", gh_int2scm (best_idx));
 517   }
 518
 519   return SCM_UNSPECIFIED;
 520 }
 521
 522 Real
 523 Beam::score_stem_lengths (Link_array<Grob>stems,
 524                           Array<Stem_info> stem_infos,
 525                           Array<Real> left_factor,
 526                           Array<Real> right_factor,
 527                           Array<int> directions,
 528                           Grob*me, Real yl, Real yr)
 529 {
 530   Real demerit_score = 0.0 ;
 531
 532   for (int i=0; i < stems.size (); i++)
 533     {
 534       Grob* s = stems[i];
 535       if (Stem::invisible_b (s))
 536         continue;
 537
 538       Real current_y =
 539         yl * left_factor[i] + right_factor[i]* yr;
 540
 541       Stem_info info = stem_infos[i];
 542       Direction d = Direction (directions[i]);
 543
 544       demerit_score += 500 * ( 0 >? (info.min_y - d * current_y));
 545       demerit_score += 500 * ( 0 >? (d * current_y  - info.max_y));
 546
 547       demerit_score += 5 * shrink_extra_weight (d * current_y  - info.ideal_y);
 548     }
 549
 550   demerit_score *= 2.0  /stems.size ();
 551
 552   return demerit_score;
 553 }
 554
 555 Real
 556 Beam::score_slopes_dy (Grob *me, Real yl, Real yr,
 557                        Real dy_mus, Real dy_damp)
 558 {
 559   Real dy = yr - yl;
 560
 561   Real dem = 0.0;
 562   if (sign (dy_damp) != sign (dy))
 563     {
 564       dem += 800;
 565     }
 566
 567    dem += 400* (0 >? (fabs (dy) - fabs (dy_mus)));
 568
 569
 570    dem += shrink_extra_weight (fabs (dy_damp) - fabs (dy))* 10;
 571    return dem;
 572 }
 573
 574 static Real
 575 my_modf (Real x)
 576 {
 577   return x - floor (x);
 578 }
 579
 580 Real
 581 Beam::score_forbidden_quants (Grob*me,
 582                               Real yl, Real yr,
 583                               Real rad,
 584                               Real slt,
 585                               Real thickness, Real interbeam,
 586                               int multiplicity)
 587 {
 588   Real dy = yr - yl;
 589
 590   Real dem = 0.0;
 591   if (fabs (yl) < rad && fabs ( my_modf (yl) - 0.5) < 1e-3)
 592     dem += 1000;
 593   if (fabs (yr) < rad && fabs ( my_modf (yr) - 0.5) < 1e-3)
 594     dem += 1000;
 595
 596   // todo: use multiplicity of outer stems.
 597   if (multiplicity >= 2)
 598     {
 599
 600       Real straddle = 0.0;
 601       Real sit = (thickness - slt) / 2;
 602       Real inter = 0.5;
 603       Real hang = 1.0 - (thickness - slt) / 2;
 604
 605       Direction dir = Directional_element_interface::get (me);
 606       if (fabs (yl - dir * interbeam) < rad
 607           && fabs (my_modf (yl) - inter) < 1e-3)
 608         dem += 15;
 609       if (fabs (yr - dir * interbeam) < rad
 610           && fabs (my_modf (yr) - inter) < 1e-3)
 611         dem += 15;
 612
 613       Real eps = 1e-3;
 614
 615       /*
 616         Can't we simply compute the distance between the nearest
 617         staffline and the secondary beam? That would get rid of the
 618         silly case analysis here (which is probably not when we have
 619         different beam-thicknesses.)
 620
 621         --hwn
 622        */
 623
 624       // hmm, without Interval/Drul_array, you get ~ 4x same code...
 625       if (fabs (yl - dir * interbeam) < rad + inter)
 626         {
 627           if (dir == UP && dy <= eps
 628               && fabs (my_modf (yl) - sit) < eps)
 629             dem += 15;
 630
 631           if (dir == DOWN && dy >= eps
 632               && fabs (my_modf (yl) - hang) < eps)
 633             dem += 15;
 634         }
 635
 636       if (fabs (yr - dir * interbeam) < rad + inter)
 637         {
 638           if (dir == UP && dy >= eps
 639               && fabs (my_modf (yr) - sit) < eps)
 640             dem += 15;
 641
 642           if (dir == DOWN && dy <= eps
 643               && fabs (my_modf (yr) - hang) < eps)
 644             dem += 15;
 645         }
 646
 647       if (multiplicity >= 3)
 648         {
 649           if (fabs (yl - 2 * dir * interbeam) < rad + inter)
 650             {
 651               if (dir == UP && dy <= eps
 652                   && fabs (my_modf (yl) - straddle) < eps)
 653                 dem += 15;
 654
 655               if (dir == DOWN && dy >= eps
 656                   && fabs (my_modf (yl) - straddle) < eps)
 657                 dem += 15;
 658         }
 659
 660           if (fabs (yr - 2 * dir * interbeam) < rad + inter)
 661             {
 662               if (dir == UP && dy >= eps
 663                   && fabs (my_modf (yr) - straddle) < eps)
 664                 dem += 15;
 665
 666               if (dir == DOWN && dy <= eps
 667                   && fabs (my_modf (yr) - straddle) < eps)
 668                 dem += 15;
 669             }
 670         }
 671     }
 672
 673   return dem;
 674 }
 675
 676
 677
 678 MAKE_SCHEME_CALLBACK (Beam, least_squares, 1);
 679 SCM
 680 Beam::least_squares (SCM smob)
 681 {
 682   Grob *me = unsmob_grob (smob);
 683
 684   int count = visible_stem_count (me);
 685   Interval pos (0, 0);
 686
 687   if (count <= 1)
 688     {
 689       me->set_grob_property ("positions", ly_interval2scm (pos));
 690       return SCM_UNSPECIFIED;
 691     }
 692
 693   Direction dir = Directional_element_interface::get (me);
 694
 695   Interval ideal (Stem::calc_stem_info (first_visible_stem (me)).ideal_y,
 696                   Stem::calc_stem_info (last_visible_stem (me)).ideal_y);
 697
 698   if (!ideal.delta ())
 699     {
 700       Interval chord (Stem::chord_start_f (first_visible_stem (me)),
 701                       Stem::chord_start_f (last_visible_stem (me)));
 702
 703
 704       /*
 705         TODO  : use scoring for this.
 706
 707         complicated, because we take stem-info.ideal for determining
 708         beam slopes.
 709
 710        */
 711       /* Make simple beam on middle line have small tilt */
 712       if (!ideal[LEFT] && chord.delta () && count == 2)
 713         {
 714           Direction d = (Direction) (sign (chord.delta ()) * dir);
 715           pos[d] = gh_scm2double (me->get_grob_property ("thickness")) / 2
 716             * dir;
 717           pos[-d] = - pos[d];
 718         }
 719       else
 720         {
 721           pos = ideal;
 722           pos[LEFT] *= dir ;
 723           pos[RIGHT] *= dir ;
 724         }
 725     }
 726   else
 727     {
 728       Array<Offset> ideals;
 729
 730       // ugh -> use commonx
 731       Real x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
 732       Link_array<Item> stems=
 733         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 734
 735       for (int i=0; i < stems.size (); i++)
 736         {
 737           Item* s = stems[i];
 738           if (Stem::invisible_b (s))
 739             continue;
 740           ideals.push (Offset (s->relative_coordinate (0, X_AXIS) - x0,
 741                                Stem::calc_stem_info (s).ideal_y));
 742         }
 743       Real y;
 744       Real dydx;
 745       minimise_least_squares (&dydx, &y, ideals);
 746
 747       Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
 748       Real dy = dydx * dx;
 749       me->set_grob_property ("least-squares-dy", gh_double2scm (dy * dir));
 750
 751       pos = Interval (y*dir, (y+dy) * dir);
 752     }
 753
 754   me->set_grob_property ("positions", ly_interval2scm (pos));
 755   return SCM_UNSPECIFIED;
 756 }
 757
 758 MAKE_SCHEME_CALLBACK (Beam, check_concave, 1);
 759 SCM
 760 Beam::check_concave (SCM smob)
 761 {
 762   Grob *me = unsmob_grob (smob);
 763
 764   Link_array<Item> stems =
 765     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
 766
 767   for (int i = 0; i < stems.size ();)
 768     {
 769       if (Stem::invisible_b (stems[i]))
 770         stems.del (i);
 771       else
 772         i++;
 773     }
 774
 775   if (stems.size () < 3)
 776     return SCM_UNSPECIFIED;
 777
 778   /* Concaveness try #2: Sum distances of inner noteheads that
 779      fall outside the interval of the two outer noteheads */
 780   Real concave = 0;
 781   Interval iv (Stem::chord_start_f (stems[0]),
 782                Stem::chord_start_f (stems.top ()));
 783
 784   if (iv[MAX] < iv[MIN])
 785     iv.swap ();
 786
 787   for (int i = 1; i < stems.size () - 1; i++)
 788     {
 789       Real c = 0;
 790       Real f = Stem::chord_start_f (stems[i]);
 791       if ((c = f - iv[MAX]) > 0)
 792         concave += c;
 793       else if ((c = f - iv[MIN]) < 0)
 794         concave += c;
 795     }
 796
 797   Direction dir = Directional_element_interface::get (me);
 798   concave *= dir;
 799
 800   Real concaveness = concave / (stems.size () - 2);
 801   /* ugh: this is the a kludge to get input/regression/beam-concave.ly
 802      to behave as baerenreiter. */
 803   concaveness /= (stems.size () - 2);
 804
 805   Real r = gh_scm2double (me->get_grob_property ("concaveness-threshold"));
 806
 807   /* TODO: some sort of damping iso -> plain horizontal */
 808   if (concaveness > r)
 809     {
 810       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 811       Real r = pos.linear_combination (0);
 812       me->set_grob_property ("positions", ly_interval2scm (Interval (r, r)));
 813       me->set_grob_property ("least-squares-dy", gh_double2scm (0));
 814     }
 815
 816   return SCM_UNSPECIFIED;
 817 }
 818
 819 /* This neat trick is by Werner Lemberg,
 820    damped = tanh (slope)
 821    corresponds with some tables in [Wanske] CHECKME */
 822 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
 823 SCM
 824 Beam::slope_damping (SCM smob)
 825 {
 826   Grob *me = unsmob_grob (smob);
 827
 828   if (visible_stem_count (me) <= 1)
 829     return SCM_UNSPECIFIED;
 830
 831   SCM s = me->get_grob_property ("damping");
 832   int damping = gh_scm2int (s);
 833
 834   if (damping)
 835     {
 836       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 837       Real dy = pos.delta ();
 838
 839       // ugh -> use commonx
 840       Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS)
 841         - first_visible_stem (me)->relative_coordinate (0, X_AXIS);
 842       Real dydx = dy && dx ? dy/dx : 0;
 843       dydx = 0.6 * tanh (dydx) / damping;
 844
 845       Real damped_dy = dydx * dx;
 846       pos[LEFT] += (dy - damped_dy) / 2;
 847       pos[RIGHT] -= (dy - damped_dy) / 2;
 848
 849       me->set_grob_property ("positions", ly_interval2scm (pos));
 850     }
 851     return SCM_UNSPECIFIED;
 852 }
 853
 854 MAKE_SCHEME_CALLBACK (Beam, end_after_line_breaking, 1);
 855 SCM
 856 Beam::end_after_line_breaking (SCM smob)
 857 {
 858   Grob *me = unsmob_grob (smob);
 859   set_stem_lengths (me);
 860
 861   return SCM_UNSPECIFIED;
 862 }
 863
 864 /*
 865   Calculate the Y position of the stem-end, given the Y-left, Y-right
 866   in POS, and for stem S.
 867  */
 868 Real
 869 Beam::calc_stem_y (Grob *me, Grob* s, Interval pos)
 870 {
 871   int beam_multiplicity = get_multiplicity (me);
 872   int stem_multiplicity = (Stem::flag_i (s) - 2) >? 0;
 873
 874   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
 875   Real interbeam = get_interbeam (me);
 876
 877   // ugh -> use commonx
 878   Real x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
 879   Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
 880   Real dy = pos.delta ();
 881   Real stem_y = (dy && dx
 882                  ? (s->relative_coordinate (0, X_AXIS) - x0) / dx
 883                  * dy
 884                  : 0) + pos[LEFT];
 885
 886   /* knee */
 887   Direction dir  = Directional_element_interface::get (me);
 888   Direction sdir = Directional_element_interface::get (s);
 889
 890   /* knee */
 891   if (dir!= sdir)
 892     {
 893       stem_y -= dir * (thick / 2 + (beam_multiplicity - 1) * interbeam);
 894
 895       // huh, why not for first visible?
 896
 897       Grob *last_visible = last_visible_stem (me);
 898       if (last_visible)
 899         {
 900           if ( Staff_symbol_referencer::staff_symbol_l (s)
 901                != Staff_symbol_referencer::staff_symbol_l (last_visible))
 902             stem_y += Directional_element_interface::get (me)
 903               * (beam_multiplicity - stem_multiplicity) * interbeam;
 904         }
 905       else
 906         programming_error ("No last visible stem");
 907     }
 908
 909   return stem_y;
 910 }
 911
 912 /*
 913   Hmm.  At this time, beam position and slope are determined.  Maybe,
 914   stem directions and length should set to relative to the chord's
 915   position of the beam.  */
 916 void
 917 Beam::set_stem_lengths (Grob *me)
 918 {
 919   Link_array<Item> stems=
 920     Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
 921
 922   if (stems.size () <= 1)
 923     return;
 924
 925   Grob *common = me->common_refpoint (stems[0], Y_AXIS);
 926   for (int i=1; i < stems.size (); i++)
 927     if (!Stem::invisible_b (stems[i]))
 928       common = common->common_refpoint (stems[i], Y_AXIS);
 929
 930   Direction dir = Directional_element_interface::get (me);
 931   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 932   Real staff_space = Staff_symbol_referencer::staff_space (me);
 933   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
 934   bool ps_testing = to_boolean (ly_symbol2scm ("ps-testing"));
 935   for (int i=0; i < stems.size (); i++)
 936     {
 937       Item* s = stems[i];
 938       if (Stem::invisible_b (s))
 939         continue;
 940
 941       Real stem_y = calc_stem_y (me, s, pos);
 942
 943       // doesn't play well with dvips
 944       if (ps_testing)
 945         if (Stem::get_direction (s) == dir)
 946           stem_y += Stem::get_direction (s) * thick / 2;
 947
 948       /* caution: stem measures in staff-positions */
 949       Real id = me->relative_coordinate (common, Y_AXIS)
 950         - stems[i]->relative_coordinate (common, Y_AXIS);
 951       Stem::set_stemend (s, (stem_y + id) / staff_space * 2);
 952     }
 953 }
 954
 955 void
 956 Beam::set_beaming (Grob *me, Beaming_info_list *beaming)
 957 {
 958   Link_array<Grob> stems=
 959     Pointer_group_interface__extract_grobs (me, (Grob *)0, "stems");
 960
 961   Direction d = LEFT;
 962   for (int i=0; i  < stems.size (); i++)
 963     {
 964       do
 965         {
 966           /* Don't overwrite user override (?) */
 967           if (Stem::beam_count (stems[i], d) == -1
 968               /* Don't set beaming for outside of outer stems */
 969               && ! (d == LEFT && i == 0)
 970               && ! (d == RIGHT && i == stems.size () -1))
 971             {
 972               int b = beaming->infos_.elem (i).beams_i_drul_[d];
 973               Stem::set_beaming (stems[i], b, d);
 974             }
 975         }
 976       while (flip (&d) != LEFT);
 977     }
 978 }
 979
 980
 981
 982 /*
 983   beams to go with one stem.
 984
 985   FIXME: clean me up.
 986   */
 987 Molecule
 988 Beam::stem_beams (Grob *me, Item *here, Item *next, Item *prev, Real dydx)
 989 {
 990   // ugh -> use commonx
 991   if ((next
 992        && ! (next->relative_coordinate (0, X_AXIS)
 993             > here->relative_coordinate (0, X_AXIS)))
 994       || (prev
 995           && ! (prev->relative_coordinate (0, X_AXIS)
 996                < here->relative_coordinate (0, X_AXIS))))
 997     programming_error ("Beams are not left-to-right");
 998
 999   Real thick = gh_scm2double (me->get_grob_property ("thickness"));
1000   Real bdy = get_interbeam (me);
1001
1002   Molecule leftbeams;
1003   Molecule rightbeams;
1004
1005   Real nw_f;
1006   if (!Stem::first_head (here))
1007     nw_f = 0;
1008   else {
1009     int t = Stem::type_i (here);
1010
1011     SCM proc = me->get_grob_property ("flag-width-function");
1012     SCM result = gh_call1 (proc, gh_int2scm (t));
1013     nw_f = gh_scm2double (result);
1014   }
1015
1016
1017   Direction dir = Directional_element_interface::get (me);
1018
1019   /* [Tremolo] beams on whole notes may not have direction set? */
1020  if (dir == CENTER)
1021     dir = Directional_element_interface::get (here);
1022
1023
1024   /* half beams extending to the left. */
1025   if (prev)
1026     {
1027       int lhalfs= lhalfs = Stem::beam_count (here, LEFT)
1028         - Stem::beam_count (prev, RIGHT);
1029       int lwholebeams= Stem::beam_count (here, LEFT)
1030         <? Stem::beam_count (prev, RIGHT);
1031
1032       /* Half beam should be one note-width,
1033          but let's make sure two half-beams never touch */
1034
1035       // FIXME: TODO (check) stem width / sloped beams
1036       Real w = here->relative_coordinate (0, X_AXIS)
1037         - prev->relative_coordinate (0, X_AXIS);
1038       Real stem_w = gh_scm2double (prev->get_grob_property ("thickness"))
1039         // URG
1040         * me->paper_l ()->get_var ("stafflinethickness");
1041
1042       w = w/2 <? nw_f;
1043       Molecule a;
1044       if (lhalfs)               // generates warnings if not
1045         a =  Lookup::beam (dydx, w + stem_w, thick);
1046       a.translate (Offset (-w, -w * dydx));
1047       a.translate_axis (-stem_w/2, X_AXIS);
1048       for (int j = 0; j  < lhalfs; j++)
1049         {
1050           Molecule b (a);
1051           b.translate_axis (-dir * bdy * (lwholebeams+j), Y_AXIS);
1052           leftbeams.add_molecule (b);
1053         }
1054     }
1055
1056   if (next)
1057     {
1058       int rhalfs  = Stem::beam_count (here, RIGHT)
1059         - Stem::beam_count (next, LEFT);
1060       int rwholebeams= Stem::beam_count (here, RIGHT)
1061         <? Stem::beam_count (next, LEFT);
1062
1063       Real w = next->relative_coordinate (0, X_AXIS)
1064         - here->relative_coordinate (0, X_AXIS);
1065
1066       Real stem_w = gh_scm2double (next->get_grob_property ("thickness"))
1067         // URG
1068         * me->paper_l ()->get_var ("stafflinethickness");
1069
1070       Molecule a = Lookup::beam (dydx, w + stem_w, thick);
1071       a.translate_axis (- stem_w/2, X_AXIS);
1072       int j = 0;
1073       Real gap_f = 0;
1074
1075       SCM gap = me->get_grob_property ("gap");
1076       if (gh_number_p (gap))
1077         {
1078           int gap_i = gh_scm2int ((gap));
1079           int nogap = rwholebeams - gap_i;
1080
1081           for (; j  < nogap; j++)
1082             {
1083               Molecule b (a);
1084               b.translate_axis (-dir  * bdy * j, Y_AXIS);
1085               rightbeams.add_molecule (b);
1086             }
1087           if (Stem::invisible_b (here))
1088             gap_f = nw_f;
1089           else
1090             gap_f = nw_f / 2;
1091           w -= 2 * gap_f;
1092           a = Lookup::beam (dydx, w + stem_w, thick);
1093         }
1094
1095       for (; j  < rwholebeams; j++)
1096         {
1097           Molecule b (a);
1098           Real tx = 0;
1099           if (Stem::invisible_b (here))
1100             // ugh, see chord-tremolo.ly
1101             tx = (-dir + 1) / 2 * nw_f * 1.5 + gap_f/4;
1102           else
1103             tx = gap_f;
1104           b.translate (Offset (tx, -dir * bdy * j));
1105           rightbeams.add_molecule (b);
1106         }
1107
1108       w = w/2 <? nw_f;
1109       if (rhalfs)
1110         a = Lookup::beam (dydx, w, thick);
1111
1112       for (; j  < rwholebeams + rhalfs; j++)
1113         {
1114           Molecule b (a);
1115           b.translate_axis (- dir * bdy * j, Y_AXIS);
1116           rightbeams.add_molecule (b);
1117         }
1118
1119     }
1120   leftbeams.add_molecule (rightbeams);
1121
1122   /* Does beam quanting think  of the asymetry of beams?
1123      Refpoint is on bottom of symbol. (FIXTHAT) --hwn. */
1124   return leftbeams;
1125 }
1126
1127
1128 MAKE_SCHEME_CALLBACK (Beam, brew_molecule, 1);
1129 SCM
1130 Beam::brew_molecule (SCM smob)
1131 {
1132   Grob *me =unsmob_grob (smob);
1133
1134   Molecule mol;
1135   if (!gh_pair_p (me->get_grob_property ("stems")))
1136     return SCM_EOL;
1137   Real x0, dx;
1138   Link_array<Item>stems =
1139     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1140   if (visible_stem_count (me))
1141     {
1142       // ugh -> use commonx
1143       x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
1144       dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
1145     }
1146   else
1147     {
1148       x0 = stems[0]->relative_coordinate (0, X_AXIS);
1149       dx = stems.top ()->relative_coordinate (0, X_AXIS) - x0;
1150     }
1151
1152   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
1153   Real dy = pos.delta ();
1154   Real dydx = dy && dx ? dy/dx : 0;
1155
1156   for (int i=0; i < stems.size (); i++)
1157     {
1158       Item *item = stems[i];
1159       Item *prev = (i > 0)? stems[i-1] : 0;
1160       Item *next = (i < stems.size ()-1) ? stems[i+1] :0;
1161
1162       Molecule sb = stem_beams (me, item, next, prev, dydx);
1163       Real x = item->relative_coordinate (0, X_AXIS) - x0;
1164       sb.translate (Offset (x, x * dydx + pos[LEFT]));
1165       mol.add_molecule (sb);
1166     }
1167
1168   mol.translate_axis (x0
1169                       - dynamic_cast<Spanner*> (me)
1170                       ->get_bound (LEFT)->relative_coordinate (0, X_AXIS),
1171                       X_AXIS);
1172
1173   if (DEBUG_QUANTING)
1174     {
1175       /*
1176         This code prints the demerits for each beam. Perhaps this
1177         should be switchable for those who want to twiddle with the
1178         parameters.
1179       */
1180       String str;
1181       if (1)
1182         {
1183           str += to_str (gh_scm2int (me->get_grob_property ("best-idx")));
1184           str += ":";
1185         }
1186       str += to_str (gh_scm2double (me->get_grob_property ("quant-score")),
1187                      "%.2f");
1188
1189       SCM properties = Font_interface::font_alist_chain (me);
1190
1191       Molecule tm = Text_item::text2molecule (me, gh_str02scm (str.ch_C ()), properties);
1192       mol.add_at_edge (Y_AXIS, UP, tm, 5.0);
1193     }
1194
1195   return mol.smobbed_copy ();
1196 }
1197
1198 int
1199 Beam::forced_stem_count (Grob *me)
1200 {
1201   Link_array<Item>stems =
1202     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1203   int f = 0;
1204   for (int i=0; i < stems.size (); i++)
1205     {
1206       Item *s = stems[i];
1207
1208       if (Stem::invisible_b (s))
1209         continue;
1210
1211       if (((int)Stem::chord_start_f (s))
1212         && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1213         f++;
1214     }
1215   return f;
1216 }
1217
1218
1219
1220
1221 int
1222 Beam::visible_stem_count (Grob *me)
1223 {
1224   Link_array<Item>stems =
1225     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1226   int c = 0;
1227   for (int i = stems.size (); i--;)
1228     {
1229       if (!Stem::invisible_b (stems[i]))
1230         c++;
1231     }
1232   return c;
1233 }
1234
1235 Item*
1236 Beam::first_visible_stem (Grob *me)
1237 {
1238   Link_array<Item>stems =
1239     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1240
1241   for (int i = 0; i < stems.size (); i++)
1242     {
1243       if (!Stem::invisible_b (stems[i]))
1244         return stems[i];
1245     }
1246   return 0;
1247 }
1248
1249 Item*
1250 Beam::last_visible_stem (Grob *me)
1251 {
1252   Link_array<Item>stems =
1253     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1254   for (int i = stems.size (); i--;)
1255     {
1256       if (!Stem::invisible_b (stems[i]))
1257         return stems[i];
1258     }
1259   return 0;
1260 }
1261
1262
1263 /*
1264   [TODO]
1265
1266   handle rest under beam (do_post: beams are calculated now)
1267   what about combination of collisions and rest under beam.
1268
1269   Should lookup
1270
1271     rest -> stem -> beam -> interpolate_y_position ()
1272 */
1273 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1274 SCM
1275 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1276 {
1277   Grob *rest = unsmob_grob (element_smob);
1278   Axis a = (Axis) gh_scm2int (axis);
1279
1280   assert (a == Y_AXIS);
1281
1282   Grob *st = unsmob_grob (rest->get_grob_property ("stem"));
1283   Grob *stem = st;
1284   if (!stem)
1285     return gh_double2scm (0.0);
1286   Grob *beam = unsmob_grob (stem->get_grob_property ("beam"));
1287   if (!beam
1288       || !Beam::has_interface (beam)
1289       || !Beam::visible_stem_count (beam))
1290     return gh_double2scm (0.0);
1291
1292   // make callback for rest from this.
1293   // todo: make sure this calced already.
1294
1295   //  Interval pos = ly_scm2interval (beam->get_grob_property ("positions"));
1296   Interval pos (0, 0);
1297   SCM s = beam->get_grob_property ("positions");
1298   if (gh_pair_p (s) && gh_number_p (ly_car (s)))
1299     pos = ly_scm2interval (s);
1300
1301   Real dy = pos.delta ();
1302   // ugh -> use commonx
1303   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1304   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1305   Real dydx = dy && dx ? dy/dx : 0;
1306
1307   Direction d = Stem::get_direction (stem);
1308   Real beamy = (stem->relative_coordinate (0, X_AXIS) - x0) * dydx + pos[LEFT];
1309
1310   Real staff_space = Staff_symbol_referencer::staff_space (rest);
1311
1312
1313   Real rest_dim = rest->extent (rest, Y_AXIS)[d]*2.0 / staff_space; // refp??
1314
1315   Real minimum_dist
1316     = gh_scm2double (rest->get_grob_property ("minimum-beam-collision-distance"));
1317   Real dist =
1318     minimum_dist +  -d  * (beamy - rest_dim) >? 0;
1319
1320   int stafflines = Staff_symbol_referencer::line_count (rest);
1321
1322   // move discretely by half spaces.
1323   int discrete_dist = int (ceil (dist));
1324
1325   // move by whole spaces inside the staff.
1326   if (discrete_dist < stafflines+1)
1327     discrete_dist = int (ceil (discrete_dist / 2.0)* 2.0);
1328
1329   return gh_double2scm (-d *  discrete_dist);
1330 }
1331
1332
1333 bool
1334 Beam::has_interface (Grob *me)
1335 {
1336   return me->has_interface (ly_symbol2scm ("beam-interface"));
1337 }
1338
1339
1340 ADD_INTERFACE (Beam, "beam-interface",
1341   "A beam.
1342
1343 #'thickness= weight of beams, in staffspace
1344
1345
1346 We take the least squares line through the ideal-length stems, and
1347 then damp that using
1348
1349         damped = tanh (slope)
1350
1351 this gives an unquantized left and right position for the beam end.
1352 Then we take all combinations of quantings near these left and right
1353 positions, and give them a score (according to how close they are to
1354 the ideal slope, how close the result is to the ideal stems, etc.). We
1355 take the best scoring combination.
1356
1357 ",
1358   "concaveness-threshold dir-function quant-score auto-knee-gap gap chord-tremolo beamed-stem-shorten shorten least-squares-dy direction damping flag-width-function neutral-direction positions thickness");
1359