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