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