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