lily/stem.cc

   1 /*
   2   stem.cc -- implement Stem
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1996--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7     Jan Nieuwenhuizen <janneke@gnu.org>
   8
   9   TODO: This is way too hairy
  10
  11   TODO: fix naming.
  12
  13   Stem-end, chord-start, etc. is all confusing naming.
  14 */
  15
  16 #include <math.h>               // rint
  17
  18 #include "lookup.hh"
  19 #include "directional-element-interface.hh"
  20 #include "note-head.hh"
  21 #include "stem.hh"
  22 #include "warn.hh"
  23 #include "paper-def.hh"
  24 #include "rhythmic-head.hh"
  25 #include "font-interface.hh"
  26 #include "molecule.hh"
  27 #include "paper-column.hh"
  28 #include "misc.hh"
  29 #include "beam.hh"
  30 #include "rest.hh"
  31 #include "group-interface.hh"
  32 #include "staff-symbol-referencer.hh"
  33 #include "spanner.hh"
  34 #include "side-position-interface.hh"
  35 #include "dot-column.hh"
  36 #include "stem-tremolo.hh"
  37
  38 void
  39 Stem::set_beaming (Grob*me, int beam_count,  Direction d)
  40 {
  41   SCM pair = me->get_grob_property ("beaming");
  42
  43   if (!gh_pair_p (pair))
  44     {
  45       pair = gh_cons (SCM_EOL, SCM_EOL);
  46       me->set_grob_property ("beaming", pair);
  47     }
  48
  49   SCM l = index_get_cell (pair, d);
  50   for( int i = 0; i<  beam_count; i++)
  51     {
  52       l = gh_cons (gh_int2scm (i), l);
  53     }
  54   index_set_cell (pair, d, l);
  55 }
  56
  57
  58 Interval
  59 Stem::head_positions (Grob*me)
  60 {
  61   if (!head_count (me))
  62     {
  63       Interval iv;
  64       return iv;
  65     }
  66
  67   Drul_array<Grob*> e (extremal_heads (me));
  68
  69   return Interval (Staff_symbol_referencer::get_position (e[DOWN]),
  70                    Staff_symbol_referencer::get_position (e[UP]));
  71 }
  72
  73
  74 Real
  75 Stem::chord_start_y (Grob*me)
  76 {
  77   return head_positions (me)[get_direction (me)]
  78     * Staff_symbol_referencer::staff_space (me)/2.0;
  79 }
  80
  81 Real
  82 Stem::stem_end_position (Grob*me)
  83 {
  84   SCM p =me->get_grob_property ("stem-end-position");
  85   Real pos;
  86   if (!gh_number_p (p))
  87     {
  88       pos = get_default_stem_end_position (me);
  89       me->set_grob_property ("stem-end-position", gh_double2scm (pos));
  90     }
  91   else
  92     pos = gh_scm2double (p);
  93
  94   return pos;
  95 }
  96
  97 Direction
  98 Stem::get_direction (Grob*me)
  99 {
 100   Direction d = get_grob_direction (me);
 101
 102   if (!d)
 103     {
 104        d = get_default_dir (me);
 105        // urg, AAARGH!
 106        set_grob_direction (me, d);
 107     }
 108   return d ;
 109 }
 110
 111
 112 void
 113 Stem::set_stemend (Grob*me, Real se)
 114 {
 115   // todo: margins
 116   Direction d= get_direction (me);
 117
 118   if (d && d * head_positions (me)[get_direction (me)] >= se*d)
 119     me->warning (_ ("Weird stem size; check for narrow beams"));
 120
 121   me->set_grob_property ("stem-end-position", gh_double2scm (se));
 122 }
 123
 124
 125 /*
 126   Note head that determines hshift for upstems
 127
 128   WARNING: triggers direction
 129 */
 130 Grob*
 131 Stem::support_head (Grob*me)
 132 {
 133   if (head_count (me) == 1)
 134     {
 135       /*
 136         UGH.
 137        */
 138
 139       return unsmob_grob (ly_car (me->get_grob_property ("note-heads")));
 140     }
 141   else
 142     return first_head (me);
 143 }
 144
 145
 146 int
 147 Stem::head_count (Grob*me)
 148 {
 149   return  Pointer_group_interface::count (me, "note-heads");
 150 }
 151
 152 /*
 153   The note head which forms one end of the stem.
 154
 155   WARNING: triggers direction
 156 */
 157 Grob*
 158 Stem::first_head (Grob*me)
 159 {
 160   Direction d = get_direction (me);
 161   if (!d)
 162     return 0;
 163   return extremal_heads (me)[-d];
 164 }
 165
 166 /*
 167   The note head opposite to the first head.
 168  */
 169 Grob*
 170 Stem::last_head (Grob*me)
 171 {
 172   Direction d = get_direction (me);
 173   if (!d)
 174     return 0;
 175   return extremal_heads (me)[d];
 176 }
 177
 178 /*
 179   START is part where stem reaches `last' head.
 180  */
 181 Drul_array<Grob*>
 182 Stem::extremal_heads (Grob*me)
 183 {
 184   const int inf = 1000000;
 185   Drul_array<int> extpos;
 186   extpos[DOWN] = inf;
 187   extpos[UP] = -inf;
 188
 189   Drul_array<Grob *> exthead;
 190   exthead[LEFT] = exthead[RIGHT] =0;
 191
 192   for (SCM s = me->get_grob_property ("note-heads"); gh_pair_p (s); s = ly_cdr (s))
 193     {
 194       Grob * n = unsmob_grob (ly_car (s));
 195
 196
 197       int p = int (Staff_symbol_referencer::get_position (n));
 198
 199       Direction d = LEFT;
 200       do {
 201       if (d* p > d* extpos[d])
 202         {
 203           exthead[d] = n;
 204           extpos[d] = p;
 205         }
 206       } while (flip (&d) != DOWN);
 207     }
 208
 209   return exthead;
 210 }
 211
 212 static int
 213 icmp (int const &a, int const &b)
 214 {
 215   return a-b;
 216 }
 217
 218 Array<int>
 219 Stem::note_head_positions (Grob *me)
 220 {
 221   Array<int> ps ;
 222   for (SCM s = me->get_grob_property ("note-heads"); gh_pair_p (s); s = ly_cdr (s))
 223     {
 224       Grob * n = unsmob_grob (ly_car (s));
 225       int p = int (Staff_symbol_referencer::get_position (n));
 226
 227       ps.push (p);
 228     }
 229
 230   ps.sort (icmp);
 231   return ps;
 232 }
 233
 234
 235 void
 236 Stem::add_head (Grob*me, Grob *n)
 237 {
 238   n->set_grob_property ("stem", me->self_scm ());
 239   n->add_dependency (me);
 240
 241   /*
 242     TODO: why not store Rest pointers?
 243   */
 244   if (Note_head::has_interface (n))
 245     {
 246       Pointer_group_interface::add_grob (me, ly_symbol2scm ("note-heads"), n);
 247     }
 248 }
 249
 250 bool
 251 Stem::invisible_b (Grob*me)
 252 {
 253   return ! (head_count (me)
 254             && gh_scm2int (me->get_grob_property ("duration-log")) >= 1);
 255 }
 256
 257 Direction
 258 Stem::get_default_dir (Grob*me)
 259 {
 260   int staff_center = 0;
 261   Interval hp = head_positions (me);
 262   if (hp.is_empty ())
 263     {
 264       return CENTER;
 265     }
 266
 267   int udistance = (int) (UP * hp[UP] - staff_center);
 268   int ddistance = (int) (DOWN* hp[DOWN] - staff_center);
 269
 270   if (sign (ddistance - udistance))
 271     return Direction (sign (ddistance -udistance));
 272
 273   return to_dir (me->get_grob_property ("neutral-direction"));
 274 }
 275
 276 Real
 277 Stem::get_default_stem_end_position (Grob*me)
 278 {
 279   Real ss = Staff_symbol_referencer::staff_space (me);
 280
 281   int durlog = duration_log (me);
 282
 283   SCM s;
 284   Array<Real> a;
 285
 286
 287   Real length = 7;              // WARNING: IN HALF SPACES
 288   SCM scm_len = me->get_grob_property ("length");
 289   if (gh_number_p (scm_len))
 290     {
 291       length = gh_scm2double (scm_len);
 292     }
 293   else
 294     {
 295       s = me->get_grob_property ("lengths");
 296       if (gh_pair_p (s))
 297         {
 298           length = 2* gh_scm2double (robust_list_ref (durlog -2, s));
 299         }
 300     }
 301
 302
 303
 304   /* URGURGURG
 305      'set-default-stemlen' sets direction too
 306    */
 307   Direction dir = get_direction (me);
 308   if (!dir)
 309     {
 310       dir = get_default_dir (me);
 311       set_grob_direction (me, dir);
 312     }
 313
 314
 315   /* stems in unnatural (forced) direction should be shortened,
 316     according to [Roush & Gourlay] */
 317   if (!chord_start_y (me)
 318       || (get_direction (me) != get_default_dir (me)))
 319     {
 320
 321
 322       SCM sshorten = me->get_grob_property ("stem-shorten");
 323       SCM scm_shorten = gh_pair_p (sshorten) ?
 324         robust_list_ref ((duration_log (me) - 2) >? 0, sshorten): SCM_EOL;
 325       Real shorten = 2* robust_scm2double (scm_shorten,0);
 326
 327
 328       /* On boundary: shorten only half */
 329       if (abs (head_positions (me)[get_direction (me)]) <= 1)
 330         shorten *= 0.5;
 331
 332       length -= shorten;
 333     }
 334
 335   /*
 336     Tremolo stuff:
 337   */
 338   Grob * trem = unsmob_grob (me->get_grob_property ("tremolo-flag"));
 339   if (trem &&  !unsmob_grob (me->get_grob_property ("beam")))
 340     {
 341       /*
 342         Crude hack: add extra space if tremolo flag is there.
 343
 344         We can't do this for the beam, since we get into a loop
 345         (Stem_tremolo::raw_molecule() looks at the beam.)
 346
 347          --hwn
 348       */
 349
 350       Real minlen =
 351         1.0 + 2 * Stem_tremolo::raw_molecule (trem).extent (Y_AXIS).length  () / ss;
 352
 353       if (durlog >= 3)
 354         {
 355           Interval flag_ext = flag (me).extent (Y_AXIS) ;
 356           if (!flag_ext.is_empty ())
 357             minlen += 2 * flag_ext.length () / ss ;
 358
 359           /*
 360             The clash is smaller for down stems (since the tremolo is
 361             angled up.)
 362            */
 363           if (dir == DOWN)
 364             minlen -= 1.0;
 365         }
 366
 367       length = length >? (minlen + 1.0);
 368     }
 369
 370   Interval hp = head_positions (me);
 371   Real st = hp[dir] + dir * length;
 372
 373   /*
 374     TODO: change name  to extend-stems to staff/center/'()
 375   */
 376   bool no_extend_b = to_boolean (me->get_grob_property ("no-stem-extend"));
 377   if (!no_extend_b && dir * st < 0) // junkme?
 378     st = 0.0;
 379
 380   /*
 381     Make a little room if we have a upflag and there is a dot.
 382     previous approach was to lengthen the stem. This is not
 383     good typesetting practice.
 384
 385   */
 386   if (!get_beam (me) && dir == UP
 387       && durlog > 2)
 388     {
 389       Grob * closest_to_flag = extremal_heads (me)[dir];
 390       Grob * dots = closest_to_flag
 391         ? Rhythmic_head::get_dots (closest_to_flag ) : 0;
 392
 393       if (dots)
 394         {
 395           Real dp = Staff_symbol_referencer::get_position (dots);
 396           Real flagy =  flag (me).extent (Y_AXIS)[-dir] * 2
 397             / ss;
 398
 399           /*
 400             Very gory: add myself to the X-support of the parent,
 401             which should be a dot-column.
 402            */
 403           if (dir * (st + flagy -  dp) < 0.5)
 404             {
 405               Grob *par = dots->get_parent (X_AXIS);
 406
 407               if (Dot_column::has_interface (par))
 408                 {
 409                   Side_position_interface::add_support (par, me);
 410
 411                   /*
 412                     TODO: apply some better logic here. The flag is
 413                     curved inwards, so this will typically be too
 414                     much.
 415                   */
 416                 }
 417             }
 418         }
 419     }
 420
 421
 422   return st;
 423 }
 424
 425
 426
 427 /*
 428
 429   the log of the duration (Number of hooks on the flag minus two)
 430  */
 431 int
 432 Stem::duration_log (Grob*me)
 433 {
 434   SCM s = me->get_grob_property ("duration-log");
 435   return (gh_number_p (s)) ? gh_scm2int (s) : 2;
 436 }
 437
 438 void
 439 Stem::position_noteheads (Grob*me)
 440 {
 441   if (!head_count (me))
 442     return;
 443
 444   Link_array<Grob> heads =
 445     Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-heads");
 446
 447   heads.sort (compare_position);
 448   Direction dir =get_direction (me);
 449
 450   if (dir < 0)
 451     heads.reverse ();
 452
 453
 454   Real thick = thickness (me);
 455
 456   Grob *hed = support_head (me);
 457   Real w = Note_head::head_extent (hed,X_AXIS)[dir];
 458   for (int i=0; i < heads.size (); i++)
 459     {
 460       heads[i]->translate_axis (w - Note_head::head_extent (heads[i],X_AXIS)[dir],
 461                                 X_AXIS);
 462     }
 463
 464   bool parity= true;
 465   Real lastpos = Real (Staff_symbol_referencer::get_position (heads[0]));
 466   for (int i=1; i < heads.size (); i ++)
 467     {
 468       Real p = Staff_symbol_referencer::get_position (heads[i]);
 469       Real dy =fabs (lastpos- p);
 470
 471       /*
 472        dy should always be 0.5, 0.0, 1.0, but provide safety margin
 473        for rounding errors.
 474       */
 475       if (dy < 1.1)
 476         {
 477           if (parity)
 478             {
 479               Real l = Note_head::head_extent (heads[i], X_AXIS).length ();
 480
 481               Direction d = get_direction (me);
 482               /*
 483                 Reversed head should be shifted l-thickness, but this
 484                 looks too crowded, so we only shift l-0.5*thickness.
 485
 486                 This leads to assymetry: Normal heads overlap the
 487                 stem 100% whereas reversed heads only overlaps the
 488                 stem 50%
 489
 490               */
 491
 492               Real reverse_overlap =0.5;
 493               heads[i]->translate_axis ((l-thick*reverse_overlap) * d, X_AXIS);
 494
 495               if (invisible_b(me))
 496                 heads[i]->translate_axis (-thick*(2 - reverse_overlap) * d , X_AXIS);
 497
 498
 499              /* TODO:
 500
 501               For some cases we should kern some more: when the
 502               distance between the next or prev note is too large, we'd
 503               get large white gaps, eg.
 504
 505                |
 506               X|
 507                |X  <- kern this.
 508                |
 509               X
 510
 511               */
 512             }
 513           parity = !parity;
 514         }
 515       else
 516         parity = true;
 517
 518       lastpos = int (p);
 519     }
 520 }
 521
 522 MAKE_SCHEME_CALLBACK (Stem,before_line_breaking,1);
 523 SCM
 524 Stem::before_line_breaking (SCM smob)
 525 {
 526   Grob*me = unsmob_grob (smob);
 527
 528
 529   /*
 530     Do the calculations for visible stems, but also for invisible stems
 531     with note heads (i.e. half notes.)
 532    */
 533   if (head_count (me))
 534     {
 535       stem_end_position (me);   // ugh. Trigger direction calc.
 536       position_noteheads (me);
 537     }
 538   else
 539     {
 540       me->set_grob_property ("molecule-callback", SCM_EOL);
 541     }
 542
 543   return SCM_UNSPECIFIED;
 544 }
 545
 546 /*
 547   ugh.
 548   When in a beam with tuplet brackets, brew_mol is called early,
 549   caching a wrong value.
 550  */
 551 MAKE_SCHEME_CALLBACK (Stem, height, 2);
 552 SCM
 553 Stem::height (SCM smob, SCM ax)
 554 {
 555   Axis a = (Axis)gh_scm2int (ax);
 556   Grob * me = unsmob_grob (smob);
 557   assert (a == Y_AXIS);
 558
 559   SCM mol = me->get_uncached_molecule ();
 560   Interval iv;
 561   if (mol != SCM_EOL)
 562     iv = unsmob_molecule (mol)->extent (a);
 563   if (Grob *b =get_beam (me))
 564     {
 565       Direction d = get_direction (me);
 566       iv[d] += d * Beam::get_thickness (b) /2.0 ;
 567     }
 568
 569   return ly_interval2scm (iv);
 570 }
 571
 572
 573 Molecule
 574 Stem::flag (Grob*me)
 575 {
 576   /* TODO: maybe property stroke-style should take different values,
 577      e.g. "" (i.e. no stroke), "single" and "double" (currently, it's
 578      '() or "grace").  */
 579   String flag_style;
 580
 581   SCM flag_style_scm = me->get_grob_property ("flag-style");
 582   if (gh_symbol_p (flag_style_scm))
 583     {
 584       flag_style = ly_symbol2string (flag_style_scm);
 585     }
 586
 587   if (flag_style == "no-flag")
 588     {
 589       return Molecule ();
 590     }
 591
 592   bool adjust = to_boolean (me->get_grob_property ("adjust-if-on-staffline"));
 593
 594   String staffline_offs;
 595   if (String::compare (flag_style, "mensural") == 0)
 596     /* Mensural notation: For notes on staff lines, use different
 597        flags than for notes between staff lines.  The idea is that
 598        flags are always vertically aligned with the staff lines,
 599        regardless if the note head is on a staff line or between two
 600        staff lines.  In other words, the inner end of a flag always
 601        touches a staff line.
 602     */
 603     {
 604       if (adjust)
 605         {
 606           /* Urrgh!  We have to detect wether this stem ends on a staff
 607              line or between two staff lines.  But we can not call
 608              stem_end_position(me) or get_default_stem_end_position(me),
 609              since this encounters the flag and hence results in an
 610              infinite recursion.  However, in pure mensural notation,
 611              there are no multiple note heads attached to a single stem,
 612              neither is there usually need for using the stem_shorten
 613              property (except for 32th and 64th notes, but that is not a
 614              problem since the stem length in this case is augmented by
 615              an integral multiple of staff_space).  Hence, it should be
 616              sufficient to just take the first note head, assume it's
 617              the only one, look if it's on a staff line, and select the
 618              flag's shape accordingly.  In the worst case, the shape
 619              looks slightly misplaced, but that will usually be the
 620              programmer's fault (e.g. when trying to attach multiple
 621              note heads to a single stem in mensural notation).
 622           */
 623
 624           /*
 625             perhaps the detection whether this correction is needed should
 626             happen in a different place  to avoid the recursion.
 627
 628             --hwn.
 629           */
 630           int p = (int)rint (Staff_symbol_referencer::get_position (first_head (me)));
 631           staffline_offs = Staff_symbol_referencer::on_staffline (me, p) ?
 632             "1" : "0";
 633         }
 634       else
 635         {
 636           staffline_offs = "2";
 637         }
 638     }
 639   else
 640     {
 641       staffline_offs = "";
 642     }
 643
 644   char dir = (get_direction (me) == UP) ? 'u' : 'd';
 645   String font_char =
 646     flag_style + to_string (dir) + staffline_offs + to_string (duration_log (me));
 647   Font_metric *fm = Font_interface::get_default_font (me);
 648   Molecule flag = fm->find_by_name ("flags-" + font_char);
 649   if (flag.is_empty ())
 650     {
 651       me->warning (_f ("flag `%s' not found", font_char));
 652     }
 653
 654   SCM stroke_style_scm = me->get_grob_property ("stroke-style");
 655   if (gh_string_p (stroke_style_scm))
 656     {
 657       String stroke_style = ly_scm2string (stroke_style_scm);
 658       if (!stroke_style.is_empty ())
 659         {
 660           String font_char = to_string (dir) + stroke_style;
 661           Molecule stroke = fm->find_by_name ("flags-" + font_char);
 662           if (stroke.is_empty ())
 663             {
 664               me->warning (_f ("flag stroke `%s' not found", font_char));
 665             }
 666           else
 667             {
 668               flag.add_molecule (stroke);
 669             }
 670         }
 671     }
 672
 673   return flag;
 674 }
 675
 676 MAKE_SCHEME_CALLBACK (Stem,dim_callback,2);
 677 SCM
 678 Stem::dim_callback (SCM e, SCM ax)
 679 {
 680   Axis a = (Axis) gh_scm2int (ax);
 681   assert (a == X_AXIS);
 682   Grob *me = unsmob_grob (e);
 683   Interval r (0, 0);
 684   if (unsmob_grob (me->get_grob_property ("beam")) || abs (duration_log (me)) <= 2)
 685     ;   // TODO!
 686   else
 687     {
 688       r = flag (me).extent (X_AXIS)
 689         + thickness (me)/2;
 690     }
 691   return ly_interval2scm (r);
 692 }
 693
 694 Real
 695 Stem::thickness (Grob* me)
 696 {
 697   return gh_scm2double (me->get_grob_property ("thickness"))
 698     * Staff_symbol_referencer::line_thickness (me);
 699 }
 700
 701 MAKE_SCHEME_CALLBACK (Stem,brew_molecule,1);
 702
 703 SCM
 704 Stem::brew_molecule (SCM smob)
 705 {
 706   Grob*me = unsmob_grob (smob);
 707   Molecule mol;
 708   Direction d = get_direction (me);
 709
 710   /*
 711     TODO: make the stem start a direction ?
 712
 713     This is required to avoid stems passing in tablature chords...
 714   */
 715   Grob *lh = to_boolean (me->get_grob_property ("avoid-note-head"))
 716     ? last_head (me) :  lh = first_head (me);
 717
 718   if (!lh)
 719     return SCM_EOL;
 720
 721   if (invisible_b (me))
 722     return SCM_EOL;
 723
 724   Real y1 = Staff_symbol_referencer::get_position (lh);
 725   Real y2 = stem_end_position (me);
 726
 727   Interval stem_y (y1 <? y2,y2 >? y1);
 728
 729
 730   // dy?
 731   Real dy = Staff_symbol_referencer::staff_space (me) * 0.5;
 732
 733   if (Grob *hed = support_head (me))
 734     {
 735       /*
 736         must not take ledgers into account.
 737        */
 738       Interval head_height = Note_head::head_extent (hed,Y_AXIS);
 739       Real y_attach = Note_head::stem_attachment_coordinate (hed, Y_AXIS);
 740
 741       y_attach = head_height.linear_combination (y_attach);
 742       stem_y[Direction (-d)] += d * y_attach/dy;
 743     }
 744
 745
 746   // URG
 747   Real stem_width = thickness (me);
 748   Real blot =
 749         me->get_paper ()->get_realvar (ly_symbol2scm ("blotdiameter"));
 750
 751   Box b = Box (Interval (-stem_width/2, stem_width/2),
 752                Interval (stem_y[DOWN]*dy, stem_y[UP]*dy));
 753
 754   Molecule ss = Lookup::round_filled_box (b, blot);
 755   mol.add_molecule (ss);
 756
 757   if (!get_beam (me) && abs (duration_log (me)) > 2)
 758     {
 759       Molecule fl = flag (me);
 760       fl.translate_axis (stem_y[d]*dy - d * blot/2, Y_AXIS);
 761       fl.translate_axis (stem_width/2, X_AXIS);
 762       mol.add_molecule (fl);
 763     }
 764
 765   return mol.smobbed_copy ();
 766 }
 767
 768 /*
 769   move the stem to right of the notehead if it is up.
 770  */
 771 MAKE_SCHEME_CALLBACK (Stem,off_callback,2);
 772 SCM
 773 Stem::off_callback (SCM element_smob, SCM)
 774 {
 775   Grob *me = unsmob_grob (element_smob);
 776
 777   Real r=0;
 778
 779   if (head_count (me) == 0)
 780     {
 781       return gh_double2scm (0.0);
 782     }
 783
 784   if (Grob * f = first_head (me))
 785     {
 786       Interval head_wid = Note_head::head_extent(f, X_AXIS);
 787
 788       Real attach =0.0;
 789
 790       if (invisible_b (me))
 791         {
 792           attach = 0.0;
 793         }
 794       else
 795         attach = Note_head::stem_attachment_coordinate(f, X_AXIS);
 796
 797       Direction d = get_direction (me);
 798
 799       Real real_attach = head_wid.linear_combination (d * attach);
 800
 801       r = real_attach;
 802
 803       /*
 804         If not centered: correct for stem thickness.
 805        */
 806       if (attach)
 807         {
 808           Real rule_thick
 809             = thickness (me);
 810
 811           r += - d * rule_thick * 0.5;
 812         }
 813     }
 814   return gh_double2scm (r);
 815 }
 816
 817
 818 Grob*
 819 Stem::get_beam (Grob*me)
 820 {
 821   SCM b=  me->get_grob_property ("beam");
 822   return unsmob_grob (b);
 823 }
 824
 825 Stem_info
 826 Stem::get_stem_info (Grob *me)
 827 {
 828   /* Return cached info if available */
 829   SCM scm_info = me->get_grob_property ("stem-info");
 830   if (!gh_pair_p (scm_info))
 831     {
 832       calc_stem_info (me);
 833       scm_info = me->get_grob_property ("stem-info");
 834     }
 835
 836   Stem_info si;
 837   si.dir_ = get_grob_direction (me);
 838   si.ideal_y_ = gh_scm2double (gh_car (scm_info));
 839   si.shortest_y_ = gh_scm2double (gh_cadr (scm_info));
 840   return si;
 841 }
 842
 843
 844 /*
 845   TODO: add extra space for tremolos!
 846  */
 847 void
 848 Stem::calc_stem_info (Grob *me)
 849 {
 850   Direction my_dir = get_grob_direction (me);
 851   Real staff_space = Staff_symbol_referencer::staff_space (me);
 852   Grob *beam = get_beam (me);
 853   Real beam_translation = Beam::get_beam_translation (beam);
 854   Real beam_thickness = Beam::get_thickness (beam);
 855   int beam_count = Beam::get_direction_beam_count (beam, my_dir);
 856
 857
 858   /* Simple standard stem length */
 859   SCM lengths = me->get_grob_property ("beamed-lengths");
 860   Real ideal_length =
 861     gh_scm2double (robust_list_ref (beam_count - 1,lengths))
 862
 863     * staff_space
 864     /* stem only extends to center of beam */
 865     - 0.5 * beam_thickness;
 866
 867   /* Condition: sane minimum free stem length (chord to beams) */
 868   lengths = me->get_grob_property ("beamed-minimum-free-lengths");
 869   Real ideal_minimum_free =
 870     gh_scm2double (robust_list_ref (beam_count - 1, lengths))
 871     * staff_space;
 872
 873
 874   /* UGH
 875      It seems that also for ideal minimum length, we must use
 876      the maximum beam count (for this direction):
 877
 878      \score{ \notes\relative c''{ [a8 a32] }}
 879
 880      must be horizontal. */
 881   Real height_of_my_beams = beam_thickness
 882     + (beam_count - 1) * beam_translation;
 883
 884   Real ideal_minimum_length = ideal_minimum_free
 885     + height_of_my_beams
 886     /* stem only extends to center of beam */
 887     - 0.5 * beam_thickness;
 888
 889   ideal_length = ideal_length >? ideal_minimum_length;
 890
 891
 892   /* Convert to Y position, calculate for dir == UP */
 893   Real note_start =
 894     /* staff positions */
 895     head_positions (me)[my_dir] * 0.5
 896     * my_dir * staff_space;
 897   Real ideal_y = note_start + ideal_length;
 898
 899
 900   /* Conditions for Y position */
 901
 902   /* Lowest beam of (UP) beam must never be lower than second staffline
 903
 904      Reference?
 905
 906      Although this (additional) rule is probably correct,
 907      I expect that highest beam (UP) should also never be lower
 908      than middle staffline, just as normal stems.
 909
 910      Reference?
 911
 912      Obviously not for grace beams.
 913
 914      Also, not for knees.  Seems to be a good thing. */
 915   bool no_extend_b = to_boolean (me->get_grob_property ("no-stem-extend"));
 916   bool knee_b = to_boolean (beam->get_grob_property ("knee"));
 917   if (!no_extend_b && !knee_b)
 918     {
 919       /* Highest beam of (UP) beam must never be lower than middle
 920          staffline */
 921       ideal_y = ideal_y >? 0;
 922       /* Lowest beam of (UP) beam must never be lower than second staffline */
 923       ideal_y = ideal_y >? (-staff_space
 924                             - beam_thickness + height_of_my_beams);
 925     }
 926
 927
 928   ideal_y -= robust_scm2double (beam->get_grob_property ("shorten"), 0);
 929
 930   Real minimum_free =
 931     gh_scm2double (robust_list_ref
 932                    (beam_count - 1,
 933                     me->get_grob_property
 934                     ("beamed-extreme-minimum-free-lengths")))
 935     * staff_space;
 936
 937   Real minimum_length = minimum_free
 938     + height_of_my_beams
 939     /* stem only extends to center of beam */
 940     - 0.5 * beam_thickness;
 941
 942   Real minimum_y = note_start + minimum_length;
 943
 944
 945   ideal_y *= my_dir;
 946   Real shortest_y = minimum_y * my_dir;
 947
 948   me->set_grob_property ("stem-info",
 949                          scm_list_n (gh_double2scm (ideal_y),
 950                                      gh_double2scm (shortest_y),
 951                                      SCM_UNDEFINED));
 952 }
 953
 954 Slice
 955 Stem::beam_multiplicity (Grob *stem)
 956 {
 957   SCM beaming= stem->get_grob_property ("beaming");
 958   Slice l = int_list_to_slice (gh_car (beaming));
 959   Slice r = int_list_to_slice (gh_cdr (beaming));
 960   l.unite (r);
 961
 962   return l;
 963 }
 964
 965
 966 /*
 967   these are too many props.
 968  */
 969 ADD_INTERFACE (Stem,"stem-interface",
 970                "A stem",
 971                "tremolo-flag french-beaming "
 972                "avoid-note-head adjust-if-on-staffline thickness "
 973                "stem-info beamed-lengths beamed-minimum-free-lengths "
 974                "beamed-extreme-minimum-free-lengths lengths beam stem-shorten "
 975                "duration-log beaming neutral-direction stem-end-position "
 976                "note-heads direction length flag-style "
 977                "no-stem-extend stroke-style");
 978
 979
 980
 981 /****************************************************************/
 982
 983 Stem_info::Stem_info()
 984 {
 985   ideal_y_ = shortest_y_ =0;
 986   dir_ = CENTER;
 987 }
 988
 989 void
 990 Stem_info::scale (Real x)
 991 {
 992   ideal_y_ *= x;
 993   shortest_y_ *= x;
 994 }