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