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