]> git.donarmstrong.com Git - lilypond.git/blob - lily/beam.cc
*** empty log message ***
[lilypond.git] / lily / beam.cc
1 /*
2   beam.cc -- implement Beam
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 1997--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
7   Jan Nieuwenhuizen <janneke@gnu.org>
8 */
9
10 /*
11   TODO:
12
13   - Determine auto knees based on positions if it's set by the user.
14
15   - the code is littered with * and / staff_space calls for
16   #'positions. Consider moving to real-world coordinates?
17
18   Problematic issue is user tweaks (user tweaks are in staff-coordinates.)
19
20   Notes:
21
22   - Stems run to the Y-center of the beam.
23
24   - beam_translation is the offset between Y centers of the beam.
25 */
26
27 #include "beam.hh"
28
29 #include "beaming.hh"
30 #include "directional-element-interface.hh"
31 #include "international.hh"
32 #include "interval-set.hh"
33 #include "item.hh"
34 #include "least-squares.hh"
35 #include "lookup.hh"
36 #include "misc.hh"
37 #include "output-def.hh"
38 #include "pointer-group-interface.hh"
39 #include "spanner.hh"
40 #include "staff-symbol-referencer.hh"
41 #include "stem.hh"
42 #include "warn.hh"
43
44 #if DEBUG_QUANTING
45 #include "text-interface.hh" // debug output.
46 #include "font-interface.hh" // debug output.
47 #endif
48
49 void
50 Beam::add_stem (Grob *me, Grob *s)
51 {
52   if (Stem::get_beam (s))
53     {
54       programming_error ("Stem already has beam");
55       return ;
56     }
57
58   Pointer_group_interface::add_grob (me, ly_symbol2scm ("stems"), s);
59   s->set_object ("beam", me->self_scm ());
60   add_bound_item (dynamic_cast<Spanner *> (me), dynamic_cast<Item *> (s));
61 }
62
63 Real
64 Beam::get_thickness (Grob *me)
65 {
66   return robust_scm2double (me->get_property ("thickness"), 0)
67     * Staff_symbol_referencer::staff_space (me);
68 }
69
70 /* Return the translation between 2 adjoining beams. */
71 Real
72 Beam::get_beam_translation (Grob *me)
73 {
74   int beam_count = get_beam_count (me);
75   Real staff_space = Staff_symbol_referencer::staff_space (me);
76   Real line = Staff_symbol_referencer::line_thickness (me);
77   Real thickness = get_thickness (me);
78   Real fract = robust_scm2double (me->get_property ("length-fraction"), 1.0);
79   
80   Real beam_translation = beam_count < 4
81     ? (2 * staff_space + line - thickness) / 2.0
82     : (3 * staff_space + line - thickness) / 3.0;
83
84   return fract * beam_translation;
85 }
86
87 /* Maximum beam_count. */
88 int
89 Beam::get_beam_count (Grob *me)
90 {
91   int m = 0;
92
93   extract_grob_set (me, "stems", stems);
94   for (vsize i = 0; i < stems.size (); i++)
95     {
96       Grob *stem = stems[i];
97       m = max (m, (Stem::beam_multiplicity (stem).length () + 1));
98     }
99   return m;
100 }
101
102
103 /* After pre-processing all directions should be set.
104    Several post-processing routines (stem, slur, script) need stem/beam
105    direction.
106    Currenly, this means that beam has set all stem's directions.
107    [Alternatively, stems could set its own directions, according to
108    their beam, during 'final-pre-processing'.] */
109 MAKE_SCHEME_CALLBACK (Beam, calc_direction, 1);
110 SCM
111 Beam::calc_direction (SCM smob)
112 {
113   Grob *me = unsmob_grob (smob);
114
115   /* Beams with less than 2 two stems don't make much sense, but could happen
116      when you do
117
118      [r8 c8 r8].
119
120      For a beam that  only has one stem, we try to do some disappearance magic:
121      we revert the flag, and move on to The Eternal Engraving Fields. */
122
123   Direction d = CENTER;
124
125   int count = visible_stem_count (me);
126   if (count < 2)
127     {
128       extract_grob_set (me, "stems", stems);
129       if (stems.size () == 1)
130         {
131           me->warning (_ ("removing beam with less than two stems"));
132
133           stems[0]->set_object ("beam", SCM_EOL);
134           me->suicide ();
135
136           return SCM_UNSPECIFIED;
137         }
138       else if (stems.size () == 0)
139         {
140           me->suicide ();
141           return SCM_UNSPECIFIED;
142         }
143       else 
144         {
145           Grob *stem = first_visible_stem (me);
146
147           /*
148             ugh: stems[0] case happens for chord tremolo.
149           */
150           d = to_dir ((stem ? stem : stems[0])->get_property ("default-direction"));
151         }
152     }
153
154   if (count >= 1)
155     {
156       if (!d)
157         d = get_default_dir (me);
158       
159       consider_auto_knees (me);
160     }
161
162   if (d)
163     {
164       set_stem_directions (me, d);
165     }
166   
167   return scm_from_int (d);
168 }
169
170
171
172 /* We want a maximal number of shared beams, but if there is choice, we
173  * take the one that is closest to the end of the stem. This is for
174  * situations like
175  *
176  *        x
177  *       |
178  *       |
179  *   |===|
180  *   |=
181  *   |
182  *  x
183  */
184 int
185 position_with_maximal_common_beams (SCM left_beaming, SCM right_beaming,
186                                     Direction left_dir,
187                                     Direction right_dir)
188 {
189   Slice lslice = int_list_to_slice (scm_cdr (left_beaming));
190
191   int best_count = 0;
192   int best_start = 0;
193   for (int i = lslice[-left_dir];
194        (i - lslice[left_dir]) * left_dir <= 0; i += left_dir)
195     {
196       int count = 0;
197       for (SCM s = scm_car (right_beaming); scm_is_pair (s); s = scm_cdr (s))
198         {
199           int k = -right_dir * scm_to_int (scm_car (s)) + i;
200           if (scm_c_memq (scm_from_int (k), left_beaming) != SCM_BOOL_F)
201             count++;
202         }
203
204       if (count >= best_count)
205         {
206           best_count = count;
207           best_start = i;
208         }
209     }
210
211   return best_start;
212 }
213
214 MAKE_SCHEME_CALLBACK(Beam, calc_beaming, 1)
215 SCM
216 Beam::calc_beaming (SCM smob)
217 {
218   Grob *me = unsmob_grob (smob);
219   
220   extract_grob_set (me, "stems", stems);
221
222   Slice last_int;
223   last_int.set_empty ();
224   
225   SCM last_beaming = scm_cons (SCM_EOL, scm_list_1 (scm_from_int (0)));
226   Direction last_dir = CENTER;
227   for (vsize i = 0; i < stems.size (); i++)
228     {
229       Grob *this_stem = stems[i];
230       SCM this_beaming = this_stem->get_property ("beaming");
231
232       Direction this_dir = get_grob_direction (this_stem);
233       if (scm_is_pair (last_beaming) && scm_is_pair (this_beaming))
234         {
235           int start_point = position_with_maximal_common_beams
236             (last_beaming, this_beaming,
237              last_dir ? last_dir : this_dir,
238              this_dir);
239
240           Direction d = LEFT;
241           Slice new_slice;
242           do
243             {
244               new_slice.set_empty ();
245               SCM s = index_get_cell (this_beaming, d);
246               for (; scm_is_pair (s); s = scm_cdr (s))
247                 {
248                   int new_beam_pos
249                     = start_point - this_dir * scm_to_int (scm_car (s));
250
251                   new_slice.add_point (new_beam_pos);
252                   scm_set_car_x (s, scm_from_int (new_beam_pos));
253                 }
254             }
255           while (flip (&d) != LEFT);
256
257           if (!new_slice.is_empty ())
258             last_int = new_slice;
259         }
260       else
261         {
262           SCM s = scm_cdr (this_beaming);
263           for (; scm_is_pair (s); s = scm_cdr (s))
264             {
265               int np = -this_dir * scm_to_int (scm_car (s));
266               scm_set_car_x (s, scm_from_int (np));
267               last_int.add_point (np);
268             }
269         }
270       
271       if (scm_ilength (scm_cdr (this_beaming)) > 0)
272         {
273           last_beaming = this_beaming;
274           last_dir = this_dir;
275         }
276     }
277
278   return SCM_EOL;
279 }
280
281 /*
282   I really enjoy spaghetti, but spaghetti should be kept on a plate
283   with a little garlic and olive oil. This is too much.
284
285   rewrite-me
286 */
287 MAKE_SCHEME_CALLBACK (Beam, print, 1);
288 SCM
289 Beam::print (SCM grob)
290 {
291   Spanner *me = unsmob_spanner (grob);
292
293   extract_grob_set (me, "stems", stems);
294   Grob *xcommon = common_refpoint_of_array (stems, me, X_AXIS);
295
296   xcommon = me->get_bound (LEFT)->common_refpoint (xcommon, X_AXIS);
297   xcommon = me->get_bound (RIGHT)->common_refpoint (xcommon, X_AXIS);
298
299   Real x0, dx;
300   if (visible_stem_count (me))
301     {
302       // ugh -> use commonx
303       x0 = first_visible_stem (me)->relative_coordinate (xcommon, X_AXIS);
304       dx = last_visible_stem (me)->relative_coordinate (xcommon, X_AXIS) - x0;
305     }
306   else
307     {
308       x0 = stems[0]->relative_coordinate (xcommon, X_AXIS);
309       dx = stems.back ()->relative_coordinate (xcommon, X_AXIS) - x0;
310     }
311
312   SCM posns = me->get_property ("quantized-positions");
313   Drul_array<Real> pos;
314   if (!is_number_pair (posns))
315     {
316       programming_error ("no beam positions?");
317       pos = Interval (0, 0);
318     }
319   else
320     pos = ly_scm2realdrul (posns);
321
322   scale_drul (&pos, Staff_symbol_referencer::staff_space (me));
323
324   Real dy = pos[RIGHT] - pos[LEFT];
325   Real slope = (dy && dx) ? dy / dx : 0;
326
327   Real thick = get_thickness (me);
328   Real bdy = get_beam_translation (me);
329
330   SCM last_beaming = SCM_EOL;
331   Real last_xposn = -1;
332   Real last_stem_width = -1;
333
334   Real gap_length = robust_scm2double (me->get_property ("gap"), 0.0);
335
336   Stencil the_beam;
337   Real lt = me->layout ()->get_dimension (ly_symbol2scm ("linethickness"));
338
339   for (vsize i = 0; i <= stems.size (); i++)
340     {
341       Grob *stem = (i < stems.size ()) ? stems[i] : 0;
342
343       SCM this_beaming = stem ? stem->get_property ("beaming") : SCM_EOL;
344       Real xposn = stem ? stem->relative_coordinate (xcommon, X_AXIS) : 0.0;
345       Real stem_width = stem ? robust_scm2double (stem->get_property ("thickness"), 1.0) * lt : 0;
346       Direction stem_dir = stem ? to_dir (stem->get_property ("direction")) : CENTER;
347       /*
348         We do the space left of ST, with lfliebertjes pointing to the
349         right from the left stem, and rfliebertjes pointing left from
350         right stem.
351       */
352       SCM left = (i > 0) ? scm_cdr (last_beaming) : SCM_EOL;
353       SCM right = stem ? scm_car (this_beaming) : SCM_EOL;
354
355       std::vector<int> full_beams;
356       std::vector<int> lfliebertjes;
357       std::vector<int> rfliebertjes;
358
359       for (SCM s = left;
360            scm_is_pair (s); s = scm_cdr (s))
361         {
362           int b = scm_to_int (scm_car (s));
363           if (scm_c_memq (scm_car (s), right) != SCM_BOOL_F)
364             full_beams.push_back (b);
365           else
366             lfliebertjes.push_back (b);
367         }
368       for (SCM s = right;
369            scm_is_pair (s); s = scm_cdr (s))
370         {
371           int b = scm_to_int (scm_car (s));
372           if (scm_c_memq (scm_car (s), left) == SCM_BOOL_F)
373             rfliebertjes.push_back (b);
374         }
375
376       Drul_array<Real> break_overshoot
377         = robust_scm2drul (me->get_property ("break-overshoot"),
378                            Drul_array<Real> (-0.5, 0.0));
379
380       Real w = (i > 0 && stem)
381         ? (xposn - last_xposn)
382         : break_overshoot[ (i == 0) ? LEFT : RIGHT];
383
384       Real stem_offset = 0.0;
385       if (i > 0)
386         {
387           w += last_stem_width / 2;
388           stem_offset = -last_stem_width / 2;
389         }
390
391       if (stem)
392         w += stem_width / 2;
393
394       Real blot = me->layout ()->get_dimension (ly_symbol2scm ("blotdiameter"));
395       Stencil whole = Lookup::beam (slope, w, thick, blot);
396       Stencil gapped;
397
398       int gap_count = 0;
399       if (scm_is_number (me->get_property ("gap-count")))
400         {
401           gap_count = scm_to_int (me->get_property ("gap-count"));
402           gapped = Lookup::beam (slope, w - 2 * gap_length, thick, blot);
403
404           vector_sort (full_beams, default_compare);
405           if (stem_dir == UP)
406             full_beams.reverse ();
407         }
408
409       int k = 0;
410       for (vsize j = full_beams.size (); j--;)
411         {
412           Stencil b (whole);
413
414           if (k++ < gap_count)
415             {
416               b = gapped;
417               b.translate_axis (gap_length, X_AXIS);
418             }
419           b.translate_axis (last_xposn - x0 + stem_offset, X_AXIS);
420           b.translate_axis (slope * (last_xposn - x0) + bdy * full_beams[j], Y_AXIS);
421
422           the_beam.add_stencil (b);
423         }
424
425       if (lfliebertjes.size () || rfliebertjes.size ())
426         {
427           Real nw_f;
428
429           if (stem)
430             {
431               int t = Stem::duration_log (stem);
432               // ugh. hardcoded.
433               if (t == 1)
434                 nw_f = 1.98;
435               else
436                 nw_f = 1.32;
437             }
438           else
439             nw_f = break_overshoot[RIGHT] / 2;
440
441           /* Half beam should be one note-width,
442              but let's make sure two half-beams never touch */
443           Real lw = nw_f;
444           Real rw = nw_f;
445           if (i > 0)
446             rw = min (nw_f, ((xposn - last_xposn) / 2));
447           else
448             {
449               if (me->get_bound (LEFT)->break_status_dir ())
450                 rw = xposn - me->get_bound (LEFT)->extent (xcommon, X_AXIS)[RIGHT]
451                   + break_overshoot[LEFT];
452               else
453                 rw = 1.0;       // ugh.
454             }
455           
456           if (stem)
457             lw = min (nw_f, ((xposn - last_xposn) / 2));
458           else
459             {
460               lw = me->get_bound (RIGHT)->relative_coordinate (xcommon, X_AXIS)
461                 - last_xposn
462                 + break_overshoot[RIGHT];
463             }
464           rw += stem_width / 2;
465           lw += last_stem_width / 2;
466
467           Stencil rhalf = Lookup::beam (slope, rw, thick, blot);
468           Stencil lhalf = Lookup::beam (slope, lw, thick, blot);
469           for (vsize j = lfliebertjes.size (); j--;)
470             {
471               Stencil b (lhalf);
472               b.translate_axis (last_xposn - x0 - last_stem_width /2,
473                                 X_AXIS);
474               b.translate_axis (slope * (last_xposn - x0)
475                                 + bdy * lfliebertjes[j],
476                                 Y_AXIS);
477               the_beam.add_stencil (b);
478             }
479           for (vsize j = rfliebertjes.size (); j--;)
480             {
481               Stencil b (rhalf);
482               b.translate_axis (xposn - x0 - rw + stem_width / 2, X_AXIS);
483               b.translate_axis (slope * (xposn - x0 - rw)
484                                 + bdy * rfliebertjes[j], Y_AXIS);
485               the_beam.add_stencil (b);
486             }
487         }
488
489       last_xposn = xposn;
490       last_stem_width = stem_width;
491       last_beaming = this_beaming;
492     }
493
494   the_beam.translate_axis (x0 - me->relative_coordinate (xcommon, X_AXIS),
495                            X_AXIS);
496   the_beam.translate_axis (pos[LEFT], Y_AXIS);
497
498 #if (DEBUG_QUANTING)
499   SCM quant_score = me->get_property ("quant-score");
500   SCM debug = me->layout ()->lookup_variable (ly_symbol2scm ("debug-beam-quanting"));
501   if (to_boolean (debug) && scm_is_string (quant_score))
502     {
503
504       /*
505         This code prints the demerits for each beam. Perhaps this
506         should be switchable for those who want to twiddle with the
507         parameters.
508       */
509       std::string str;
510       SCM properties = Font_interface::text_font_alist_chain (me);
511
512       Direction stem_dir = stems.size () ? to_dir (stems[0]->get_property ("direction")) : UP;
513
514       Stencil score = *unsmob_stencil (Text_interface::interpret_markup
515                                     (me->layout ()->self_scm (), properties, quant_score));
516
517       if (!score.is_empty ())
518         the_beam.add_at_edge (Y_AXIS, stem_dir, score, 1.0, 0);
519     }
520 #endif
521
522   return the_beam.smobbed_copy ();
523 }
524
525 Direction
526 Beam::get_default_dir (Grob *me)
527 {
528   Drul_array<int> total;
529   total[UP] = total[DOWN] = 0;
530   Drul_array<int> count;
531   count[UP] = count[DOWN] = 0;
532
533   extract_grob_set (me, "stems", stems);
534
535   for (vsize i = 0; i < stems.size (); i++)
536     {
537       Grob *s = stems[i];
538       Direction stem_dir = CENTER;
539       SCM stem_dir_scm = s->get_property_data (ly_symbol2scm ("direction"));
540       if (is_direction (stem_dir_scm))
541         stem_dir = to_dir (stem_dir_scm);
542       else
543         stem_dir = to_dir (s->get_property ("default-direction"));
544
545       if (!stem_dir)
546         stem_dir = to_dir (s->get_property ("neutral-direction"));
547
548       if (stem_dir)
549         {
550           count[stem_dir] ++;
551           total[stem_dir] += max (int (- stem_dir * Stem::head_positions (s) [-stem_dir]), 0);
552         }
553     }
554
555   Direction dir = CENTER;
556   Direction d = CENTER;
557   if ((d = (Direction) sign (count[UP] - count[DOWN])))
558     dir = d;
559   else if (count[UP]
560            && count[DOWN]
561            && (d = (Direction)  sign (total[UP] / count[UP] - total[DOWN]/count[DOWN])))
562     dir = d;
563   else if ((d = (Direction)  sign (total[UP] - total[DOWN])))
564     dir = d;
565   else
566     dir = to_dir (me->get_property ("neutral-direction"));
567   
568   return dir;
569 }
570
571 /* Set all stems with non-forced direction to beam direction.
572    Urg: non-forced should become `without/with unforced' direction,
573    once stem gets cleaned-up. */
574 void
575 Beam::set_stem_directions (Grob *me, Direction d)
576 {
577   extract_grob_set (me, "stems", stems);
578
579   for (vsize i = 0; i < stems.size (); i++)
580     {
581       Grob *s = stems[i];
582
583       SCM forcedir = s->get_property_data (ly_symbol2scm ("direction"));
584       if (!to_dir (forcedir))
585         set_grob_direction (s, d);
586     }
587 }
588
589 /*
590   Only try horizontal beams for knees.  No reliable detection of
591   anything else is possible here, since we don't know funky-beaming
592   settings, or X-distances (slopes!)  People that want sloped
593   knee-beams, should set the directions manually.
594
595
596   TODO:
597
598   this routine should take into account the stemlength scoring
599   of a possible knee/nonknee beam.
600 */
601 void
602 Beam::consider_auto_knees (Grob *me)
603 {
604   SCM scm = me->get_property ("auto-knee-gap");
605   if (!scm_is_number (scm))
606     return;
607
608   Interval_set gaps;
609
610   gaps.set_full ();
611
612   extract_grob_set (me, "stems", stems);
613
614   Grob *common = common_refpoint_of_array (stems, me, Y_AXIS);
615   Real staff_space = Staff_symbol_referencer::staff_space (me);
616
617   std::vector<Interval> head_extents_array;
618   for (vsize i = 0; i < stems.size (); i++)
619     {
620       Grob *stem = stems[i];
621       if (Stem::is_invisible (stem))
622         continue;
623
624       Interval head_extents = Stem::head_positions (stem);
625       if (!head_extents.is_empty ())
626         {
627           head_extents[LEFT] += -1;
628           head_extents[RIGHT] += 1;
629           head_extents *= staff_space * 0.5;
630
631           /*
632             We could subtract beam Y position, but this routine only
633             sets stem directions, a constant shift does not have an
634             influence.
635           */
636           head_extents += stem->relative_coordinate (common, Y_AXIS);
637
638           if (to_dir (stem->get_property_data (ly_symbol2scm ("direction"))))
639             {
640               Direction stemdir = to_dir (stem->get_property ("direction"));
641               head_extents[-stemdir] = -stemdir * infinity_f;
642             }
643         }
644       head_extents_array.push_back (head_extents);
645
646       gaps.remove_interval (head_extents);
647     }
648
649   Interval max_gap;
650   Real max_gap_len = 0.0;
651
652   for (vsize i = gaps.allowed_regions_.size () -1; i != VPOS ;i--)
653     {
654       Interval gap = gaps.allowed_regions_[i];
655
656       /*
657         the outer gaps are not knees.
658       */
659       if (isinf (gap[LEFT]) || isinf (gap[RIGHT]))
660         continue;
661
662       if (gap.length () >= max_gap_len)
663         {
664           max_gap_len = gap.length ();
665           max_gap = gap;
666         }
667     }
668
669   Real beam_translation = get_beam_translation (me);
670   Real beam_thickness = Beam::get_thickness (me);
671   int beam_count = Beam::get_beam_count (me);
672   Real height_of_beams = beam_thickness / 2
673     + (beam_count - 1) * beam_translation;
674   Real threshold = scm_to_double (scm) + height_of_beams;
675
676   if (max_gap_len > threshold)
677     {
678       int j = 0;
679       for (vsize i = 0; i < stems.size (); i++)
680         {
681           Grob *stem = stems[i];
682           if (Stem::is_invisible (stem))
683             continue;
684
685           Interval head_extents = head_extents_array[j++];
686
687           Direction d = (head_extents.center () < max_gap.center ())
688             ? UP : DOWN;
689
690           stem->set_property ("direction", scm_from_int (d));
691
692           head_extents.intersect (max_gap);
693           assert (head_extents.is_empty () || head_extents.length () < 1e-6);
694         }
695     }
696 }
697
698 /* Set stem's shorten property if unset.
699
700 TODO:
701 take some y-position (chord/beam/nearest?) into account
702 scmify forced-fraction
703
704 This is done in beam because the shorten has to be uniform over the
705 entire beam.
706 */
707
708
709
710 void
711 set_minimum_dy (Grob *me, Real *dy)
712 {
713   if (*dy)
714     {
715       /*
716         If dy is smaller than the smallest quant, we
717         get absurd direction-sign penalties.
718       */
719
720       Real ss = Staff_symbol_referencer::staff_space (me);
721       Real thickness = Beam::get_thickness (me) / ss;
722       Real slt = Staff_symbol_referencer::line_thickness (me) / ss;
723       Real sit = (thickness - slt) / 2;
724       Real inter = 0.5;
725       Real hang = 1.0 - (thickness - slt) / 2;
726
727       *dy = sign (*dy) * max (fabs (*dy),
728                               min (min (sit, inter), hang));
729     }
730 }
731
732   
733
734 MAKE_SCHEME_CALLBACK(Beam, calc_stem_shorten, 1)
735 SCM
736 Beam::calc_stem_shorten (SCM smob)
737 {
738   Grob *me = unsmob_grob (smob);
739   
740   /*
741     shortening looks silly for x staff beams
742   */
743   if (is_knee (me))
744     return scm_from_int (0);
745
746   Real forced_fraction = 1.0 * forced_stem_count (me)
747     / visible_stem_count (me);
748
749   int beam_count = get_beam_count (me);
750
751   SCM shorten_list = me->get_property ("beamed-stem-shorten");
752   if (shorten_list == SCM_EOL)
753     return scm_from_int (0);
754
755   Real staff_space = Staff_symbol_referencer::staff_space (me);
756
757   SCM shorten_elt
758     = robust_list_ref (beam_count -1, shorten_list);
759   Real shorten = scm_to_double (shorten_elt) * staff_space;
760
761   shorten *= forced_fraction;
762
763   
764   if (shorten)
765     return scm_from_double (shorten);
766
767   return scm_from_double (0.0);
768 }
769
770
771
772 /*
773   Compute a first approximation to the beam slope.
774 */
775 MAKE_SCHEME_CALLBACK (Beam, calc_least_squares_positions, 2);
776 SCM
777 Beam::calc_least_squares_positions (SCM smob, SCM posns)
778 {
779   (void) posns;
780   
781   Grob *me = unsmob_grob (smob);
782
783   int count = visible_stem_count (me);
784   Interval pos (0,0);
785   if (count < 1)
786     return ly_interval2scm (pos);
787   
788   std::vector<Real> x_posns;
789   extract_grob_set (me, "stems", stems);
790   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
791   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
792
793   Real my_y = me->relative_coordinate (commony, Y_AXIS);
794
795   Grob *fvs = first_visible_stem (me);
796   Grob *lvs = last_visible_stem (me);
797
798   Interval ideal (Stem::get_stem_info (fvs).ideal_y_
799                   + fvs->relative_coordinate (commony, Y_AXIS) -my_y,
800                   Stem::get_stem_info (lvs).ideal_y_
801                   + lvs->relative_coordinate (commony, Y_AXIS) - my_y);
802
803   Real x0 = first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
804   for (vsize i = 0; i < stems.size (); i++)
805     {
806       Grob *s = stems[i];
807
808       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
809       x_posns.push_back (x);
810     }
811   Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS) - x0;
812
813   Real y = 0;
814   Real slope = 0;
815   Real dy = 0;
816   Real ldy = 0.0;
817   if (!ideal.delta ())
818     {
819       Interval chord (Stem::chord_start_y (first_visible_stem (me)),
820                       Stem::chord_start_y (last_visible_stem (me)));
821
822       /* Simple beams (2 stems) on middle line should be allowed to be
823          slightly sloped.
824
825          However, if both stems reach middle line,
826          ideal[LEFT] == ideal[RIGHT] and ideal.delta () == 0.
827
828          For that case, we apply artificial slope */
829       if (!ideal[LEFT] && chord.delta () && count == 2)
830         {
831           /* FIXME. -> UP */
832           Direction d = (Direction) (sign (chord.delta ()) * UP);
833           pos[d] = get_thickness (me) / 2;
834           pos[-d] = -pos[d];
835         }
836       else
837         pos = ideal;
838
839       /*
840         For broken beams this doesn't work well. In this case, the
841         slope esp. of the first part of a broken beam should predict
842         where the second part goes.
843       */
844       ldy = pos[RIGHT] - pos[LEFT];
845     }
846   else
847     {
848       std::vector<Offset> ideals;
849       for (vsize i = 0; i < stems.size (); i++)
850         {
851           Grob *s = stems[i];
852           if (Stem::is_invisible (s))
853             continue;
854           ideals.push_back (Offset (x_posns[i],
855                                Stem::get_stem_info (s).ideal_y_
856                                + s->relative_coordinate (commony, Y_AXIS)
857                                - my_y));
858         }
859
860       minimise_least_squares (&slope, &y, ideals);
861
862       dy = slope * dx;
863
864       set_minimum_dy (me, &dy);
865
866       ldy = dy;
867       pos = Interval (y, (y + dy));
868     }
869
870   /*
871     "position" is relative to the staff.
872   */
873   scale_drul (&pos, 1 / Staff_symbol_referencer::staff_space (me));
874
875   me->set_property ("least-squares-dy",  scm_from_double (ldy));
876   return ly_interval2scm (pos);
877 }
878
879 /*
880   We can't combine with previous function, since check concave and
881   slope damping comes first.
882
883   TODO: we should use the concaveness to control the amount of damping
884   applied.
885 */
886 MAKE_SCHEME_CALLBACK (Beam, shift_region_to_valid, 2);
887 SCM
888 Beam::shift_region_to_valid (SCM grob, SCM posns)
889 {
890   Grob *me = unsmob_grob (grob);
891   /*
892     Code dup.
893   */
894   std::vector<Real> x_posns;
895   extract_grob_set (me, "stems", stems);
896   Grob *commonx = common_refpoint_of_array (stems, me, X_AXIS);
897   Grob *commony = common_refpoint_of_array (stems, me, Y_AXIS);
898
899   Grob *fvs = first_visible_stem (me);
900
901   if (!fvs)
902     return posns;
903
904   Real x0 = fvs->relative_coordinate (commonx, X_AXIS);
905   for (vsize i = 0; i < stems.size (); i++)
906     {
907       Grob *s = stems[i];
908
909       Real x = s->relative_coordinate (commonx, X_AXIS) - x0;
910       x_posns.push_back (x);
911     }
912
913   Grob *lvs = last_visible_stem (me);
914   if (!lvs)
915     return posns;
916
917   Real dx = lvs->relative_coordinate (commonx, X_AXIS) - x0;
918
919   Drul_array<Real> pos = ly_scm2interval (posns);
920   
921
922   scale_drul (&pos, Staff_symbol_referencer::staff_space (me));
923
924   Real dy = pos[RIGHT] - pos[LEFT];
925   Real y = pos[LEFT];
926   Real slope = dx ? (dy / dx) : 0.0;
927
928   /*
929     Shift the positions so that we have a chance of finding good
930     quants (i.e. no short stem failures.)
931   */
932   Interval feasible_left_point;
933   feasible_left_point.set_full ();
934   for (vsize i = 0; i < stems.size (); i++)
935     {
936       Grob *s = stems[i];
937       if (Stem::is_invisible (s))
938         continue;
939
940       Direction d = get_grob_direction (s);
941
942       Real left_y
943         = Stem::get_stem_info (s).shortest_y_
944         - slope * x_posns [i];
945
946       /*
947         left_y is now relative to the stem S. We want relative to
948         ourselves, so translate:
949       */
950       left_y
951         += + s->relative_coordinate (commony, Y_AXIS)
952         - me->relative_coordinate (commony, Y_AXIS);
953
954       Interval flp;
955       flp.set_full ();
956       flp[-d] = left_y;
957
958       feasible_left_point.intersect (flp);
959     }
960
961   if (feasible_left_point.is_empty ())
962     warning (_ ("no viable initial configuration found: may not find good beam slope"));
963   else if (!feasible_left_point.contains (y))
964     {
965       const int REGION_SIZE = 2; // UGH UGH
966       if (isinf (feasible_left_point[DOWN]))
967         y = feasible_left_point[UP] - REGION_SIZE;
968       else if (isinf (feasible_left_point[UP]))
969         y = feasible_left_point[DOWN]+ REGION_SIZE;
970       else
971         y = feasible_left_point.center ();
972     }
973
974   pos = Drul_array<Real> (y, (y + dy));
975   scale_drul (&pos, 1 / Staff_symbol_referencer::staff_space (me));
976
977   return ly_interval2scm (pos);
978 }
979
980 /* This neat trick is by Werner Lemberg,
981    damped = tanh (slope)
982    corresponds with some tables in [Wanske] CHECKME */
983 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 2);
984 SCM
985 Beam::slope_damping (SCM smob, SCM posns)
986 {
987   Grob *me = unsmob_grob (smob);
988   Drul_array<Real> pos = ly_scm2interval (posns);
989
990   if (visible_stem_count (me) <= 1)
991     return posns;
992
993   
994   SCM s = me->get_property ("damping");
995   Real damping = scm_to_double (s);
996   Real concaveness = robust_scm2double (me->get_property ("concaveness"), 0.0);
997   if (concaveness >= 10000)
998     {
999       pos[LEFT] = pos[RIGHT];
1000       me->set_property ("least-squares-dy", scm_from_double (0));
1001       damping = 0;
1002     }
1003   
1004   if (damping)
1005     {
1006       scale_drul (&pos, Staff_symbol_referencer::staff_space (me));
1007
1008       Real dy = pos[RIGHT] - pos[LEFT];
1009
1010       Grob *fvs = first_visible_stem (me);
1011       Grob *lvs = last_visible_stem (me);
1012
1013       Grob *commonx = fvs->common_refpoint (lvs, X_AXIS);
1014
1015       Real dx = last_visible_stem (me)->relative_coordinate (commonx, X_AXIS)
1016         - first_visible_stem (me)->relative_coordinate (commonx, X_AXIS);
1017
1018       Real slope = dy && dx ? dy / dx : 0;
1019
1020       slope = 0.6 * tanh (slope) / (damping + concaveness);
1021
1022       Real damped_dy = slope * dx;
1023
1024       set_minimum_dy (me, &damped_dy);
1025
1026       pos[LEFT] += (dy - damped_dy) / 2;
1027       pos[RIGHT] -= (dy - damped_dy) / 2;
1028
1029       scale_drul (&pos, 1 / Staff_symbol_referencer::staff_space (me));
1030     }
1031
1032   return ly_interval2scm (pos);
1033 }
1034
1035 /*
1036   Report slice containing the numbers that are both in (car BEAMING)
1037   and (cdr BEAMING)
1038 */
1039 Slice
1040 where_are_the_whole_beams (SCM beaming)
1041 {
1042   Slice l;
1043
1044   for (SCM s = scm_car (beaming); scm_is_pair (s); s = scm_cdr (s))
1045     {
1046       if (scm_c_memq (scm_car (s), scm_cdr (beaming)) != SCM_BOOL_F)
1047
1048         l.add_point (scm_to_int (scm_car (s)));
1049     }
1050
1051   return l;
1052 }
1053
1054 /* Return the Y position of the stem-end, given the Y-left, Y-right
1055    in POS for stem S.  This Y position is relative to S. */
1056 Real
1057 Beam::calc_stem_y (Grob *me, Grob *s, Grob ** common,
1058                    Real xl, Real xr,
1059                    Drul_array<Real> pos, bool french)
1060 {
1061   Real beam_translation = get_beam_translation (me);
1062
1063   Real r = s->relative_coordinate (common[X_AXIS], X_AXIS) - xl;
1064   Real dy = pos[RIGHT] - pos[LEFT];
1065   Real dx = xr - xl;
1066   Real stem_y_beam0 = (dy && dx
1067                        ? r / dx
1068                        * dy
1069                        : 0) + pos[LEFT];
1070
1071   Direction my_dir = get_grob_direction (s);
1072   SCM beaming = s->get_property ("beaming");
1073
1074   Real stem_y = stem_y_beam0;
1075   if (french)
1076     {
1077       Slice bm = where_are_the_whole_beams (beaming);
1078       if (!bm.is_empty ())
1079         stem_y += beam_translation * bm[-my_dir];
1080     }
1081   else
1082     {
1083       Slice bm = Stem::beam_multiplicity (s);
1084       if (!bm.is_empty ())
1085         stem_y += bm[my_dir] * beam_translation;
1086     }
1087
1088   Real id = me->relative_coordinate (common[Y_AXIS], Y_AXIS)
1089     - s->relative_coordinate (common[Y_AXIS], Y_AXIS);
1090
1091   return stem_y + id;
1092 }
1093
1094 /*
1095   Hmm.  At this time, beam position and slope are determined.  Maybe,
1096   stem directions and length should set to relative to the chord's
1097   position of the beam.  */
1098 MAKE_SCHEME_CALLBACK(Beam, set_stem_lengths, 1); 
1099 SCM
1100 Beam::set_stem_lengths (SCM smob)
1101 {
1102   Grob *me = unsmob_grob (smob);
1103
1104   /* trigger callback. */
1105   (void) me->get_property ("direction");
1106
1107   SCM posns = me->get_property ("positions");
1108   
1109   extract_grob_set (me, "stems", stems);
1110   if (!stems.size ())
1111     return posns;
1112
1113   Grob *common[2];
1114   for (int a = 2; a--;)
1115     common[a] = common_refpoint_of_array (stems, me, Axis (a));
1116
1117   Drul_array<Real> pos = ly_scm2realdrul (posns);
1118   Real staff_space = Staff_symbol_referencer::staff_space (me);
1119   scale_drul (&pos, staff_space);
1120
1121   bool gap = false;
1122   Real thick = 0.0;
1123   if (scm_is_number (me->get_property ("gap-count"))
1124       && scm_to_int (me->get_property ("gap-count")))
1125     {
1126       gap = true;
1127       thick = get_thickness (me);
1128     }
1129
1130   Grob *fvs = first_visible_stem (me);
1131   Grob *lvs = last_visible_stem (me);
1132
1133   Real xl = fvs ? fvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1134   Real xr = lvs ? lvs->relative_coordinate (common[X_AXIS], X_AXIS) : 0.0;
1135
1136   for (vsize i = 0; i < stems.size (); i++)
1137     {
1138       Grob *s = stems[i];
1139       if (Stem::is_invisible (s))
1140         continue;
1141
1142       bool french = to_boolean (s->get_property ("french-beaming"));
1143       Real stem_y = calc_stem_y (me, s, common,
1144                                  xl, xr,
1145                                  pos, french && s != lvs && s!= fvs);
1146
1147       /*
1148         Make the stems go up to the end of the beam. This doesn't matter
1149         for normal beams, but for tremolo beams it looks silly otherwise.
1150       */
1151       if (gap)
1152         stem_y += thick * 0.5 * get_grob_direction (s);
1153
1154       Stem::set_stemend (s, 2 * stem_y / staff_space);
1155     }
1156
1157   return posns;
1158 }
1159
1160 void
1161 Beam::set_beaming (Grob *me, Beaming_info_list const *beaming)
1162 {
1163   extract_grob_set (me, "stems", stems);
1164
1165   Direction d = LEFT;
1166   for (vsize i = 0; i < stems.size (); i++)
1167     {
1168       /*
1169         Don't overwrite user settings.
1170       */
1171       do
1172         {
1173           Grob *stem = stems[i];
1174           SCM beaming_prop = stem->get_property ("beaming");
1175           if (beaming_prop == SCM_EOL
1176               || index_get_cell (beaming_prop, d) == SCM_EOL)
1177             {
1178               int b = beaming->infos_.elem (i).beams_i_drul_[d];
1179               if (i > 0
1180                   && i < stems.size () -1
1181                   && Stem::is_invisible (stem))
1182                 b = min (b, beaming->infos_.elem (i).beams_i_drul_[-d]);
1183
1184               Stem::set_beaming (stem, b, d);
1185             }
1186         }
1187       while (flip (&d) != LEFT);
1188     }
1189 }
1190
1191 int
1192 Beam::forced_stem_count (Grob *me)
1193 {
1194   extract_grob_set (me, "stems", stems);
1195
1196   int f = 0;
1197   for (vsize i = 0; i < stems.size (); i++)
1198     {
1199       Grob *s = stems[i];
1200
1201       if (Stem::is_invisible (s))
1202         continue;
1203
1204       /* I can imagine counting those boundaries as a half forced stem,
1205          but let's count them full for now. */
1206       Direction defdir = to_dir (s->get_property ("default-direction"));
1207       
1208       if (abs (Stem::chord_start_y (s)) > 0.1
1209           && defdir
1210           && get_grob_direction (s) != defdir)
1211         f++;
1212     }
1213   return f;
1214 }
1215
1216 int
1217 Beam::visible_stem_count (Grob *me)
1218 {
1219   extract_grob_set (me, "stems", stems);
1220   int c = 0;
1221   for (vsize i = stems.size (); i--;)
1222     {
1223       if (!Stem::is_invisible (stems[i]))
1224         c++;
1225     }
1226   return c;
1227 }
1228
1229 Grob *
1230 Beam::first_visible_stem (Grob *me)
1231 {
1232   extract_grob_set (me, "stems", stems);
1233
1234   for (vsize i = 0; i < stems.size (); i++)
1235     {
1236       if (!Stem::is_invisible (stems[i]))
1237         return stems[i];
1238     }
1239   return 0;
1240 }
1241
1242 Grob *
1243 Beam::last_visible_stem (Grob *me)
1244 {
1245   extract_grob_set (me, "stems", stems);
1246
1247   for (vsize i = stems.size (); i--;)
1248     {
1249       if (!Stem::is_invisible (stems[i]))
1250         return stems[i];
1251     }
1252   return 0;
1253 }
1254
1255 /*
1256   [TODO]
1257
1258   handle rest under beam (do_post: beams are calculated now)
1259   what about combination of collisions and rest under beam.
1260
1261   Should lookup
1262
1263   rest -> stem -> beam -> interpolate_y_position ()
1264 */
1265 MAKE_SCHEME_CALLBACK (Beam, rest_collision_callback, 2);
1266 SCM
1267 Beam::rest_collision_callback (SCM smob, SCM prev_offset)
1268 {
1269   Grob *rest = unsmob_grob (smob);
1270   if (scm_is_number (rest->get_property ("staff-position")))
1271     return scm_from_int (0);
1272
1273   Real offset = robust_scm2double (prev_offset, 0.0);
1274   
1275   Grob *st = unsmob_grob (rest->get_object ("stem"));
1276   Grob *stem = st;
1277   if (!stem)
1278     return scm_from_double (0.0);
1279   Grob *beam = unsmob_grob (stem->get_object ("beam"));
1280   if (!beam
1281       || !Beam::has_interface (beam)
1282       || !Beam::visible_stem_count (beam))
1283     return scm_from_double (0.0);
1284
1285   Drul_array<Real> pos (0, 0);
1286   SCM s = beam->get_property ("positions");
1287   if (scm_is_pair (s) && scm_is_number (scm_car (s)))
1288     pos = ly_scm2interval (s);
1289   else
1290     programming_error ("positions property should always be pair of numbers.");
1291
1292   Real staff_space = Staff_symbol_referencer::staff_space (rest);
1293
1294   scale_drul (&pos, staff_space);
1295
1296   Real dy = pos[RIGHT] - pos[LEFT];
1297
1298   Drul_array<Grob*> visible_stems (first_visible_stem (beam),
1299                                    last_visible_stem (beam));
1300   extract_grob_set (beam, "stems", stems);
1301   
1302   Grob *common = common_refpoint_of_array (stems, beam, X_AXIS);
1303   
1304   Real x0 = visible_stems[LEFT]->relative_coordinate (common, X_AXIS);
1305   Real dx = visible_stems[RIGHT]->relative_coordinate (common, X_AXIS) - x0;
1306   Real slope = dy && dx ? dy / dx : 0;
1307
1308   Direction d = get_grob_direction (stem);
1309   Real stem_y = pos[LEFT]
1310     + (stem->relative_coordinate (common, X_AXIS) - x0) * slope;
1311
1312   Real beam_translation = get_beam_translation (beam);
1313   Real beam_thickness = Beam::get_thickness (beam);
1314
1315   /*
1316     TODO: this is not strictly correct for 16th knee beams.
1317   */
1318   int beam_count
1319     = Stem::beam_multiplicity (stem).length () + 1;
1320
1321   Real height_of_my_beams = beam_thickness / 2
1322     + (beam_count - 1) * beam_translation;
1323   Real beam_y = stem_y - d * height_of_my_beams;
1324
1325   Grob *common_y = rest->common_refpoint (beam, Y_AXIS);
1326   Interval rest_extent = rest->extent (common_y, Y_AXIS);
1327   rest_extent.translate (offset);
1328   
1329   Real rest_dim = rest_extent[d];
1330   Real minimum_distance
1331     = staff_space * (robust_scm2double (stem->get_property ("stemlet-length"), 0.0)
1332                      + robust_scm2double (rest->get_property ("minimum-distance"), 0.0));
1333
1334   Real shift = d * min (((beam_y - d * minimum_distance) - rest_dim) * d, 0.0);
1335
1336   shift /= staff_space;
1337   Real rad = Staff_symbol_referencer::line_count (rest) * staff_space / 2;
1338
1339   /* Always move discretely by half spaces */
1340   shift = ceil (fabs (shift * 2.0)) / 2.0 * sign (shift);
1341
1342   /* Inside staff, move by whole spaces*/
1343   if ((rest_extent[d] + staff_space * shift) * d
1344       < rad
1345       || (rest_extent[-d] + staff_space * shift) * -d
1346       < rad)
1347     shift = ceil (fabs (shift)) * sign (shift);
1348
1349   return scm_from_double (staff_space * shift);
1350 }
1351
1352 bool
1353 Beam::is_knee (Grob *me)
1354 {
1355   SCM k = me->get_property ("knee");
1356   if (scm_is_bool (k))
1357     return ly_scm2bool (k);
1358
1359   bool knee = false;
1360   int d = 0;
1361   extract_grob_set (me, "stems", stems);
1362   for (vsize i = stems.size (); i--;)
1363     {
1364       Direction dir = get_grob_direction (stems[i]);
1365       if (d && d != dir)
1366         {
1367           knee = true;
1368           break;
1369         }
1370       d = dir;
1371     }
1372
1373   me->set_property ("knee", ly_bool2scm (knee));
1374
1375   return knee;
1376 }
1377
1378 int
1379 Beam::get_direction_beam_count (Grob *me, Direction d)
1380 {
1381   extract_grob_set (me, "stems", stems);
1382   int bc = 0;
1383
1384   for (vsize i = stems.size (); i--;)
1385     {
1386       /*
1387         Should we take invisible stems into account?
1388       */
1389       if (get_grob_direction (stems[i]) == d)
1390         bc = max (bc, (Stem::beam_multiplicity (stems[i]).length () + 1));
1391     }
1392
1393   return bc;
1394 }
1395
1396 ADD_INTERFACE (Beam,
1397                "beam-interface",
1398
1399                "A beam. \n\n"
1400                "The @code{thickness} property is the weight of beams, "
1401                "measured in staffspace.  The @code{direction} "
1402                "property is not user-serviceable. Use "
1403                "the @code{direction} property of @code{Stem} instead. "
1404
1405                ,
1406                
1407                /* properties */
1408                "auto-knee-gap "
1409                "beamed-stem-shorten "
1410                "beaming "
1411                "break-overshoot "
1412                "chord-tremolo "
1413                "concaveness "
1414                "damping "
1415                "details "
1416                "direction " 
1417                "gap "
1418                "gap-count "
1419                "inspect-quants "
1420                "knee "
1421                "length-fraction "
1422                "least-squares-dy "
1423                "neutral-direction "
1424                "positions "
1425                "quant-score "
1426                "quantized-positions "
1427                "shorten "
1428                "stems "
1429                "thickness "
1430                );