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::beam_l (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->paper_l ()->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->paper_l ()->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_str (gh_scm2int (me->get_grob_property ("best-idx")));
 412           str += ":";
 413         }
 414       str += to_str (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.ch_C ()), 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       SCM force = s->remove_grob_property ("dir-forced");
 488       if (!gh_boolean_p (force) || !gh_scm2bool (force))
 489         Directional_element_interface::set (s, d);
 490     }
 491 }
 492
 493 /* Simplistic auto-knees; only consider vertical gap between two
 494    adjacent chords.
 495
 496   `Forced' stem directions are ignored.  If you don't want auto-knees,
 497   don't set, or unset auto-knee-gap. */
 498 void
 499 Beam::consider_auto_knees (Grob *me, Direction d)
 500 {
 501   SCM scm = me->get_grob_property ("auto-knee-gap");
 502
 503   if (gh_number_p (scm))
 504     {
 505       bool knee_b = false;
 506       Real knee_y = 0;
 507       Real staff_space = Staff_symbol_referencer::staff_space (me);
 508       Real gap = gh_scm2double (scm) / staff_space;
 509
 510       Link_array<Grob> stems=
 511         Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 512
 513       Grob *common = common_refpoint_of_array (stems, me,  Y_AXIS);
 514
 515       int l = 0;
 516       for (int i=1; i < stems.size (); i++)
 517         {
 518           if (!Stem::invisible_b (stems[i-1]))
 519             l = i - 1;
 520           if (Stem::invisible_b (stems[l]))
 521             continue;
 522           if (Stem::invisible_b (stems[i]))
 523             continue;
 524
 525           Real left = Stem::extremal_heads (stems[l])[d]
 526             ->relative_coordinate (common, Y_AXIS);
 527           Real right = Stem::extremal_heads (stems[i])[-d]
 528             ->relative_coordinate (common, Y_AXIS);
 529
 530           Real dy = right - left;
 531
 532           if (abs (dy) >= gap)
 533             {
 534               knee_y = (right + left) / 2;
 535               knee_b = true;
 536               break;
 537             }
 538         }
 539
 540       if (knee_b)
 541         {
 542           for (int i=0; i < stems.size (); i++)
 543             {
 544               Grob *s = stems[i];
 545               if (Stem::invisible_b (s) ||
 546                   s->get_grob_property ("dir-forced") == SCM_BOOL_T)
 547                 continue;
 548               Real y = Stem::extremal_heads (stems[i])[d]
 549                 ->relative_coordinate (common, Y_AXIS);
 550
 551               Directional_element_interface::set (s, y < knee_y ? UP : DOWN);
 552               s->set_grob_property ("dir-forced", SCM_BOOL_T);
 553             }
 554         }
 555     }
 556 }
 557
 558 /* Set stem's shorten property if unset.
 559
 560  TODO:
 561    take some y-position (chord/beam/nearest?) into account
 562    scmify forced-fraction
 563
 564    TODO:
 565
 566    why is shorten stored in beam, and not directly in stem?
 567
 568 */
 569 void
 570 Beam::set_stem_shorten (Grob *m)
 571 {
 572   Spanner*me = dynamic_cast<Spanner*> (m);
 573
 574   Real forced_fraction = forced_stem_count (me) / visible_stem_count (me);
 575
 576   int beam_count = get_beam_count (me);
 577
 578   SCM shorten = me->get_grob_property ("beamed-stem-shorten");
 579   if (shorten == SCM_EOL)
 580     return;
 581
 582   int sz = scm_ilength (shorten);
 583
 584   Real staff_space = Staff_symbol_referencer::staff_space (me);
 585   SCM shorten_elt = scm_list_ref (shorten,
 586                                   gh_int2scm (beam_count <? (sz - 1)));
 587   Real shorten_f = gh_scm2double (shorten_elt) * staff_space;
 588
 589   /* your similar cute comment here */
 590   shorten_f *= forced_fraction;
 591
 592   if (shorten_f)
 593     me->set_grob_property ("shorten", gh_double2scm (shorten_f));
 594 }
 595
 596 /*  Call list of y-dy-callbacks, that handle setting of
 597     grob-properties
 598
 599 */
 600 MAKE_SCHEME_CALLBACK (Beam, after_line_breaking, 1);
 601 SCM
 602 Beam::after_line_breaking (SCM smob)
 603 {
 604   Grob *me = unsmob_grob (smob);
 605
 606   /* Copy to mutable list. */
 607   SCM s = ly_deep_copy (me->get_grob_property ("positions"));
 608   me->set_grob_property ("positions", s);
 609
 610   if (ly_car (s) == SCM_BOOL_F)
 611     {
 612
 613       // one wonders if such genericity is necessary  --hwn.
 614       SCM callbacks = me->get_grob_property ("position-callbacks");
 615       for (SCM i = callbacks; gh_pair_p (i); i = ly_cdr (i))
 616         gh_call1 (ly_car (i), smob);
 617     }
 618
 619   set_stem_lengths (me);
 620   return SCM_UNSPECIFIED;
 621 }
 622
 623 MAKE_SCHEME_CALLBACK (Beam, least_squares, 1);
 624 SCM
 625 Beam::least_squares (SCM smob)
 626 {
 627   Grob *me = unsmob_grob (smob);
 628
 629   int count = visible_stem_count (me);
 630   Interval pos (0, 0);
 631
 632   if (count <= 1)
 633     {
 634       me->set_grob_property ("positions", ly_interval2scm (pos));
 635       return SCM_UNSPECIFIED;
 636     }
 637
 638
 639   Array<Real> x_posns ;
 640   Link_array<Grob> stems=
 641     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 642   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
 643   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
 644
 645   Real my_y = me->relative_coordinate (commony, Y_AXIS);
 646
 647   Grob *fvs  = first_visible_stem (me);
 648   Grob *lvs  = last_visible_stem (me);
 649
 650   Interval ideal (Stem::calc_stem_info (fvs).ideal_y_
 651                   + fvs->relative_coordinate (commony, Y_AXIS) -my_y,
 652                   Stem::calc_stem_info (lvs).ideal_y_
 653                   + lvs->relative_coordinate (commony, Y_AXIS) - my_y);
 654
 655   Real x0 = first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
 656   for (int i=0; i < stems.size (); i++)
 657     {
 658       Grob* s = stems[i];
 659
 660       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
 661       x_posns.push (x);
 662     }
 663   Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS) - x0;
 664
 665   Real y =0;
 666   Real dydx = 0;
 667   Real dy = 0;
 668
 669   if (!ideal.delta ())
 670     {
 671       Interval chord (Stem::chord_start_y (first_visible_stem (me)),
 672                       Stem::chord_start_y (last_visible_stem (me)));
 673
 674
 675       /*
 676         TODO -- use scoring for this.
 677
 678         complicated, because we take stem-info.ideal for determining
 679         beam slopes.
 680        */
 681       /* Make simple beam on middle line have small tilt */
 682       if (!ideal[LEFT] && chord.delta () && count == 2)
 683         {
 684
 685           /*
 686             FIXME. -> UP
 687           */
 688           Direction d = (Direction) (sign (chord.delta ()) * UP);
 689           pos[d] = gh_scm2double (me->get_grob_property ("thickness")) / 2;
 690           //                * dir;
 691           pos[-d] = - pos[d];
 692         }
 693       else
 694         {
 695           pos = ideal;
 696         }
 697
 698       y = pos[LEFT];
 699       dy = pos[RIGHT]- y;
 700       dydx = dy/dx;
 701     }
 702   else
 703     {
 704       Array<Offset> ideals;
 705       for (int i=0; i < stems.size (); i++)
 706         {
 707           Grob* s = stems[i];
 708           if (Stem::invisible_b (s))
 709             continue;
 710           ideals.push (Offset (x_posns[i],
 711                                Stem::calc_stem_info (s).ideal_y_
 712                                + s->relative_coordinate (commony, Y_AXIS)
 713                                - my_y));
 714         }
 715       minimise_least_squares (&dydx, &y, ideals);
 716
 717       dy = dydx * dx;
 718       me->set_grob_property ("least-squares-dy", gh_double2scm (dy));
 719       pos = Interval (y, (y+dy));
 720     }
 721
 722   me->set_grob_property ("positions", ly_interval2scm (pos));
 723
 724   return SCM_UNSPECIFIED;
 725 }
 726
 727
 728 /*
 729   We can't combine with previous function, since check concave and
 730   slope damping comes first.
 731  */
 732 MAKE_SCHEME_CALLBACK (Beam, shift_region_to_valid, 1);
 733 SCM
 734 Beam::shift_region_to_valid (SCM grob)
 735 {
 736   Grob *me = unsmob_grob (grob);
 737   /*
 738     Code dup.
 739    */
 740   Array<Real> x_posns ;
 741   Link_array<Grob> stems=
 742     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
 743   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
 744   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
 745
 746   Grob *fvs = first_visible_stem (me);
 747
 748   if (!fvs)
 749     return SCM_UNSPECIFIED;
 750
 751   Real x0 =fvs->relative_coordinate (commonx, X_AXIS);
 752   for (int i=0; i < stems.size (); i++)
 753     {
 754       Grob* s = stems[i];
 755
 756       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
 757       x_posns.push (x);
 758     }
 759
 760   Grob *lvs = last_visible_stem (me);
 761   if (!lvs)
 762     return SCM_UNSPECIFIED;
 763
 764   Real dx = lvs->relative_coordinate (commonx, X_AXIS) - x0;
 765
 766   Interval pos = ly_scm2interval ( me->get_grob_property ("positions"));
 767   Real dy = pos.delta();
 768   Real y = pos[LEFT];
 769   Real dydx =dy/dx;
 770
 771
 772   /*
 773     Shift the positions so that we have a chance of finding good
 774     quants (i.e. no short stem failures.)
 775    */
 776   Interval feasible_left_point;
 777   feasible_left_point.set_full ();
 778   for (int i=0; i < stems.size (); i++)
 779     {
 780       Grob* s = stems[i];
 781       if (Stem::invisible_b (s))
 782         continue;
 783
 784       Direction d = Stem::get_direction (s);
 785
 786       Real left_y =
 787         Stem::calc_stem_info (s).shortest_y_
 788         - dydx * x_posns [i];
 789
 790       /*
 791         left_y is now relative to the stem S. We want relative to
 792         ourselves, so translate:
 793        */
 794       left_y +=
 795         + s->relative_coordinate (commony, Y_AXIS)
 796         - me->relative_coordinate (commony, Y_AXIS);
 797
 798       Interval flp ;
 799       flp.set_full ();
 800       flp[-d] = left_y;
 801
 802       feasible_left_point.intersect (flp);
 803     }
 804
 805   if (feasible_left_point.empty_b())
 806     {
 807       warning (_("Not sure that we can find a nice beam slope (no viable initial configuration found)."));
 808     }
 809   else if (!feasible_left_point.elem_b(y))
 810     {
 811       if (isinf (feasible_left_point[DOWN]))
 812         y = feasible_left_point[UP] - REGION_SIZE;
 813       else if (isinf (feasible_left_point[UP]))
 814         y = feasible_left_point[DOWN]+ REGION_SIZE;
 815       else
 816         y = feasible_left_point.center ();
 817     }
 818   pos = Interval (y, (y+dy));
 819   me->set_grob_property ("positions", ly_interval2scm (pos));
 820   return SCM_UNSPECIFIED;
 821 }
 822
 823
 824 MAKE_SCHEME_CALLBACK (Beam, check_concave, 1);
 825 SCM
 826 Beam::check_concave (SCM smob)
 827 {
 828   Grob *me = unsmob_grob (smob);
 829
 830   Link_array<Grob> stems =
 831     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
 832
 833   for (int i = 0; i < stems.size ();)
 834     {
 835       if (Stem::invisible_b (stems[i]))
 836         stems.del (i);
 837       else
 838         i++;
 839     }
 840
 841   if (stems.size () < 3)
 842     return SCM_UNSPECIFIED;
 843
 844
 845   /* Concaveness #1: If distance of an inner notehead to line between
 846      two outer noteheads is bigger than CONCAVENESS-GAP (2.0ss),
 847      beam is concave (Heinz Stolba).
 848
 849      In the case of knees, the line connecting outer heads is often
 850      not related to the beam slope (it may even go in the other
 851      direction). Skip the check when the outer stems point in
 852      different directions. --hwn
 853
 854   */
 855   bool concaveness1 = false;
 856   SCM gap = me->get_grob_property ("concaveness-gap");
 857   if (gh_number_p (gap)
 858       && Stem::get_direction(stems.top ())
 859          == Stem::get_direction(stems[0]))
 860     {
 861       Real r1 = gh_scm2double (gap);
 862       Real dy = Stem::chord_start_y (stems.top ())
 863         - Stem::chord_start_y (stems[0]);
 864
 865
 866       Real slope = dy / (stems.size () - 1);
 867
 868       Real y0 = Stem::chord_start_y (stems[0]);
 869       for (int i = 1; i < stems.size () - 1; i++)
 870         {
 871           Real c = (Stem::chord_start_y (stems[i]) - y0) - i * slope;
 872           if (c > r1)
 873             {
 874               concaveness1 = true;
 875               break;
 876             }
 877         }
 878     }
 879
 880
 881   /* Concaveness #2: Sum distances of inner noteheads that fall
 882      outside the interval of the two outer noteheads.
 883
 884      We only do this for beams where first and last stem have the same
 885      direction. --hwn.
 886
 887
 888      Note that "convex" stems compensate for "concave" stems.
 889      (is that intentional?) --hwn.
 890   */
 891
 892   Real concaveness2 = 0;
 893   SCM thresh = me->get_grob_property ("concaveness-threshold");
 894   Real r2 = infinity_f;
 895   if (!concaveness1 && gh_number_p (thresh)
 896       && Stem::get_direction(stems.top ())
 897          == Stem::get_direction(stems[0]))
 898     {
 899       r2 = gh_scm2double (thresh);
 900
 901       Direction dir = Stem::get_direction(stems.top ());
 902       Real concave = 0;
 903       Interval iv (Stem::chord_start_y (stems[0]),
 904                    Stem::chord_start_y (stems.top ()));
 905
 906       if (iv[MAX] < iv[MIN])
 907         iv.swap ();
 908
 909       for (int i = 1; i < stems.size () - 1; i++)
 910         {
 911           Real f = Stem::chord_start_y (stems[i]);
 912           concave += ((f - iv[MAX] ) >? 0) +
 913             ((f - iv[MIN] ) <? 0);
 914         }
 915       concave *= dir;
 916       concaveness2 = concave / (stems.size () - 2);
 917
 918       /* ugh: this is the a kludge to get
 919          input/regression/beam-concave.ly to behave as
 920          baerenreiter. */
 921
 922       /*
 923         huh? we're dividing twice (which is not scalable) meaning that
 924         the longer the beam, the more unlikely it will be
 925         concave. Maybe you would even expect the other way around??
 926
 927         --hwn.
 928
 929        */
 930       concaveness2 /= (stems.size () - 2);
 931     }
 932
 933   /* TODO: some sort of damping iso -> plain horizontal */
 934   if (concaveness1 || concaveness2 > r2)
 935     {
 936       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 937       Real r = pos.linear_combination (0);
 938       me->set_grob_property ("positions", ly_interval2scm (Interval (r, r)));
 939       me->set_grob_property ("least-squares-dy", gh_double2scm (0));
 940     }
 941
 942   return SCM_UNSPECIFIED;
 943 }
 944
 945 /* This neat trick is by Werner Lemberg,
 946    damped = tanh (slope)
 947    corresponds with some tables in [Wanske] CHECKME */
 948 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
 949 SCM
 950 Beam::slope_damping (SCM smob)
 951 {
 952   Grob *me = unsmob_grob (smob);
 953
 954   if (visible_stem_count (me) <= 1)
 955     return SCM_UNSPECIFIED;
 956
 957   SCM s = me->get_grob_property ("damping");
 958   int damping = gh_scm2int (s);
 959
 960   if (damping)
 961     {
 962       Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
 963       Real dy = pos.delta ();
 964
 965       Grob *fvs  = first_visible_stem (me);
 966       Grob *lvs  = last_visible_stem (me);
 967
 968       Grob *commonx = fvs->common_refpoint (lvs, X_AXIS);
 969
 970
 971       Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS)
 972         - first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
 973       Real dydx = dy && dx ? dy/dx : 0;
 974       dydx = 0.6 * tanh (dydx) / damping;
 975
 976       Real damped_dy = dydx * dx;
 977       pos[LEFT] += (dy - damped_dy) / 2;
 978       pos[RIGHT] -= (dy - damped_dy) / 2;
 979
 980       me->set_grob_property ("positions", ly_interval2scm (pos));
 981     }
 982   return SCM_UNSPECIFIED;
 983 }
 984
 985 Slice
 986 where_are_the_whole_beams(SCM beaming)
 987 {
 988   Slice l;
 989
 990   for( SCM s = gh_car (beaming); gh_pair_p (s) ; s = gh_cdr (s))
 991     {
 992       if (scm_memq (gh_car (s), gh_cdr (beaming)) != SCM_BOOL_F)
 993
 994         l.add_point (gh_scm2int (gh_car (s)));
 995     }
 996
 997   return l;
 998 }
 999
1000 /*
1001   Calculate the Y position of the stem-end, given the Y-left, Y-right
1002   in POS for stem S. This Y position is relative to S.
1003  */
1004 Real
1005 Beam::calc_stem_y (Grob *me, Grob* s, Grob ** common,
1006                    Real xl, Real xr,
1007                    Interval pos, bool french)
1008 {
1009   Real beam_translation = get_beam_translation (me);
1010
1011
1012   Real r = s->relative_coordinate (common[X_AXIS], X_AXIS) - xl;
1013   Real dy = pos.delta ();
1014   Real dx = xr - xl;
1015   Real stem_y_beam0 = (dy && dx
1016                        ? r / dx
1017                        * dy
1018                        : 0) + pos[LEFT];
1019
1020   Direction my_dir = Directional_element_interface::get (s);
1021   SCM beaming = s->get_grob_property ("beaming");
1022
1023   Real stem_y = stem_y_beam0;
1024   if (french)
1025     {
1026       Slice bm = where_are_the_whole_beams (beaming);
1027       if (!bm.empty_b())
1028         stem_y += beam_translation * bm[-my_dir];
1029     }
1030   else
1031     {
1032       Slice bm = Stem::beam_multiplicity(s);
1033       if (!bm.empty_b())
1034         stem_y +=bm[my_dir] * beam_translation;
1035     }
1036
1037   Real id = me->relative_coordinate (common[Y_AXIS], Y_AXIS)
1038     - s->relative_coordinate (common[Y_AXIS], Y_AXIS);
1039
1040   return stem_y + id;
1041 }
1042
1043 /*
1044   Hmm.  At this time, beam position and slope are determined.  Maybe,
1045   stem directions and length should set to relative to the chord's
1046   position of the beam.  */
1047 void
1048 Beam::set_stem_lengths (Grob *me)
1049 {
1050   Link_array<Grob> stems=
1051     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
1052
1053   if (stems.size () <= 1)
1054     return;
1055
1056   Grob *common[2];
1057   for (int a = 2; a--;)
1058     common[a] = common_refpoint_of_array (stems, me, Axis(a));
1059
1060   Interval pos = ly_scm2interval (me->get_grob_property ("positions"));
1061   Real staff_space = Staff_symbol_referencer::staff_space (me);
1062
1063   bool french = to_boolean (me->get_grob_property ("french-beaming"));
1064
1065
1066   bool gap = false;
1067   Real thick =0.0;
1068   if (gh_number_p (me->get_grob_property ("gap"))
1069       &&gh_scm2double (me->get_grob_property ("gap")))
1070   {
1071     gap = true;
1072     thick = gh_scm2double (me->get_grob_property ("thickness"))
1073       * Staff_symbol_referencer::staff_space(me);
1074   }
1075
1076   // ugh -> use commonx
1077   Grob * fvs = first_visible_stem (me);
1078   Grob *lvs = last_visible_stem (me);
1079
1080   Real xl = fvs ? fvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1081   Real xr = lvs ? lvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1082
1083   for (int i=0; i < stems.size (); i++)
1084     {
1085       Grob* s = stems[i];
1086       if (Stem::invisible_b (s))
1087         continue;
1088
1089       Real stem_y = calc_stem_y (me, s, common,
1090                                  xl, xr,
1091                                  pos, french && i > 0&& (i < stems.size  () -1));
1092
1093       /*
1094         Make the stems go up to the end of the beam. This doesn't matter
1095         for normal beams, but for tremolo beams it looks silly otherwise.
1096        */
1097       if (gap)
1098         stem_y += thick * 0.5 * Directional_element_interface::get(s);
1099
1100       Stem::set_stemend (s, 2* stem_y / staff_space);
1101     }
1102 }
1103
1104 void
1105 Beam::set_beaming (Grob *me, Beaming_info_list *beaming)
1106 {
1107   Link_array<Grob> stems=
1108     Pointer_group_interface__extract_grobs (me, (Grob *)0, "stems");
1109
1110   Direction d = LEFT;
1111   for (int i=0; i  < stems.size (); i++)
1112     {
1113       /*
1114         Don't overwrite user settings.
1115        */
1116
1117       do
1118         {
1119           /* Don't set beaming for outside of outer stems */
1120           if ((d == LEFT && i == 0)
1121               ||(d == RIGHT && i == stems.size () -1))
1122             continue;
1123
1124
1125           SCM beaming_prop = stems[i]->get_grob_property ("beaming");
1126           if (beaming_prop == SCM_EOL ||
1127               index_get_cell (beaming_prop, d) == SCM_EOL)
1128             {
1129               int b = beaming->infos_.elem (i).beams_i_drul_[d];
1130               Stem::set_beaming (stems[i], b, d);
1131             }
1132         }
1133       while (flip (&d) != LEFT);
1134     }
1135 }
1136
1137 int
1138 Beam::forced_stem_count (Grob *me)
1139 {
1140   Link_array<Grob>stems =
1141     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1142   int f = 0;
1143   for (int i=0; i < stems.size (); i++)
1144     {
1145       Grob *s = stems[i];
1146
1147       if (Stem::invisible_b (s))
1148         continue;
1149
1150       if (((int)Stem::chord_start_y (s))
1151         && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1152         f++;
1153     }
1154   return f;
1155 }
1156
1157
1158
1159
1160 int
1161 Beam::visible_stem_count (Grob *me)
1162 {
1163   Link_array<Grob>stems =
1164     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1165   int c = 0;
1166   for (int i = stems.size (); i--;)
1167     {
1168       if (!Stem::invisible_b (stems[i]))
1169         c++;
1170     }
1171   return c;
1172 }
1173
1174 Grob*
1175 Beam::first_visible_stem (Grob *me)
1176 {
1177   Link_array<Grob>stems =
1178     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1179
1180   for (int i = 0; i < stems.size (); i++)
1181     {
1182       if (!Stem::invisible_b (stems[i]))
1183         return stems[i];
1184     }
1185   return 0;
1186 }
1187
1188 Grob*
1189 Beam::last_visible_stem (Grob *me)
1190 {
1191   Link_array<Grob>stems =
1192     Pointer_group_interface__extract_grobs (me, (Grob*) 0, "stems");
1193   for (int i = stems.size (); i--;)
1194     {
1195       if (!Stem::invisible_b (stems[i]))
1196         return stems[i];
1197     }
1198   return 0;
1199 }
1200
1201
1202 /*
1203   [TODO]
1204
1205   handle rest under beam (do_post: beams are calculated now)
1206   what about combination of collisions and rest under beam.
1207
1208   Should lookup
1209
1210     rest -> stem -> beam -> interpolate_y_position ()
1211 */
1212 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1213 SCM
1214 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1215 {
1216   Grob *rest = unsmob_grob (element_smob);
1217   Axis a = (Axis) gh_scm2int (axis);
1218
1219   assert (a == Y_AXIS);
1220
1221   Grob *st = unsmob_grob (rest->get_grob_property ("stem"));
1222   Grob *stem = st;
1223   if (!stem)
1224     return gh_double2scm (0.0);
1225   Grob *beam = unsmob_grob (stem->get_grob_property ("beam"));
1226   if (!beam
1227       || !Beam::has_interface (beam)
1228       || !Beam::visible_stem_count (beam))
1229     return gh_double2scm (0.0);
1230
1231   // make callback for rest from this.
1232   // todo: make sure this calced already.
1233
1234   //  Interval pos = ly_scm2interval (beam->get_grob_property ("positions"));
1235   Interval pos (0, 0);
1236   SCM s = beam->get_grob_property ("positions");
1237   if (gh_pair_p (s) && gh_number_p (ly_car (s)))
1238     pos = ly_scm2interval (s);
1239
1240   Real dy = pos.delta ();
1241   // ugh -> use commonx
1242   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1243   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1244   Real dydx = dy && dx ? dy/dx : 0;
1245
1246   Direction d = Stem::get_direction (stem);
1247   Real beamy = (stem->relative_coordinate (0, X_AXIS) - x0) * dydx + pos[LEFT];
1248
1249   Real staff_space = Staff_symbol_referencer::staff_space (rest);
1250
1251
1252   Real rest_dim = rest->extent (rest, Y_AXIS)[d]*2.0 / staff_space; // refp??
1253
1254   Real minimum_dist
1255     = gh_scm2double (rest->get_grob_property ("minimum-beam-collision-distance"));
1256   Real dist =
1257     minimum_dist +  -d  * (beamy - rest_dim) >? 0;
1258
1259   int stafflines = Staff_symbol_referencer::line_count (rest);
1260
1261   // move discretely by half spaces.
1262   int discrete_dist = int (ceil (dist));
1263
1264   // move by whole spaces inside the staff.
1265   if (discrete_dist < stafflines+1)
1266     discrete_dist = int (ceil (discrete_dist / 2.0)* 2.0);
1267
1268   return gh_double2scm (-d *  discrete_dist);
1269 }
1270
1271
1272
1273
1274 ADD_INTERFACE (Beam, "beam-interface",
1275   "A beam.
1276
1277 #'thickness= weight of beams, in staffspace
1278
1279
1280 We take the least squares line through the ideal-length stems, and
1281 then damp that using
1282
1283         damped = tanh (slope)
1284
1285 this gives an unquantized left and right position for the beam end.
1286 Then we take all combinations of quantings near these left and right
1287 positions, and give them a score (according to how close they are to
1288 the ideal slope, how close the result is to the ideal stems, etc.). We
1289 take the best scoring combination.
1290
1291 ",
1292   "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");
1293
1294