]> git.donarmstrong.com Git - lilypond.git/blob - lily/beam.cc
patch::: 1.5.38.jcn2
[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--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
7     Jan Nieuwenhuizen <janneke@gnu.org>
8
9 */
10
11 /*
12   [TODO]
13
14   -* shorter! (now +- 1000 lines)
15   
16   -* less hairy code
17
18   -* Remove #'direction from beam. The beam has no direction per se.
19   It may only set directions for stems.
20   */
21
22
23 #include <math.h> // tanh.
24
25 #include "molecule.hh" 
26 #include "directional-element-interface.hh"
27 #include "beaming.hh"
28 #include "beam.hh"
29 #include "misc.hh"
30 #include "least-squares.hh"
31 #include "stem.hh"
32 #include "paper-def.hh"
33 #include "lookup.hh"
34 #include "group-interface.hh"
35 #include "staff-symbol-referencer.hh"
36 #include "item.hh"
37 #include "spanner.hh"
38 #include "warn.hh"
39
40 void
41 Beam::add_stem (Grob*me, Grob*s)
42 {
43   Pointer_group_interface::add_grob (me, ly_symbol2scm ("stems"), s);
44   
45   s->add_dependency (me);
46
47   assert (!Stem::beam_l (s));
48   s->set_grob_property ("beam", me->self_scm ());
49
50   add_bound_item (dynamic_cast<Spanner*> (me), dynamic_cast<Item*> (s));
51 }
52
53 int
54 Beam::get_multiplicity (Grob*me) 
55 {
56   int m = 0;
57   for (SCM s = me->get_grob_property ("stems"); gh_pair_p (s); s = ly_cdr (s))
58     {
59       Grob * sc = unsmob_grob (ly_car (s));
60
61       if (Stem::has_interface (sc))
62         m = m >? Stem::beam_count (sc,LEFT) >? Stem::beam_count (sc,RIGHT);
63     }
64   return m;
65 }
66
67 /*
68   After pre-processing all directions should be set.
69   Several post-processing routines (stem, slur, script) need stem/beam
70   direction.
71   Currenly, this means that beam has set all stem's directions.
72   [Alternatively, stems could set its own directions, according to
73    their beam, during 'final-pre-processing'.]
74  */
75 MAKE_SCHEME_CALLBACK (Beam,before_line_breaking,1);
76 SCM
77 Beam::before_line_breaking (SCM smob)
78 {
79   Grob * me =  unsmob_grob (smob);
80
81   /*
82     Beams with less than 2 two stems don't make much sense, but could happen
83     when you do
84
85     [r8 c8 r8].
86     
87     For a beam that  only has one stem, we try to do some disappearance magic:
88     we revert the flag, and move on to The Eternal Engraving Fields.*/
89   
90   
91   if (visible_stem_count (me) < 2)
92     {
93       me->warning (_ ("beam has less than two visible stems"));
94
95       SCM stems = me->get_grob_property ("stems");
96       if (scm_ilength (stems) == 1)
97         {
98           me->warning (_("Beam has less than two stems. Removing beam."));
99
100           unsmob_grob (gh_car (stems))->remove_grob_property ("beam");
101           me->suicide ();
102
103           return SCM_UNSPECIFIED;
104         }
105       else if (scm_ilength (stems) == 0)
106         {
107           me->suicide ();
108           return SCM_UNSPECIFIED;         
109         }
110     }
111   if (visible_stem_count (me) >= 1)
112     {
113       if (!Directional_element_interface::get (me))
114         Directional_element_interface::set (me, get_default_dir (me));
115       
116       consider_auto_knees (me);
117       set_stem_directions (me);
118       set_stem_shorten (me);
119     }
120   return SCM_EOL;
121 }
122
123 Direction
124 Beam::get_default_dir (Grob*me) 
125 {
126   Drul_array<int> total;
127   total[UP]  = total[DOWN] = 0;
128   Drul_array<int> count; 
129   count[UP]  = count[DOWN] = 0;
130   Direction d = DOWN;
131
132   Link_array<Item> stems=
133         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
134
135   for (int i=0; i <stems.size (); i++)
136     do {
137       Grob *s = stems[i];
138       Direction sd = Directional_element_interface::get (s);
139       int current = sd  ? (1 + d * sd)/2
140         : Stem::get_center_distance (s, (Direction)-d);
141
142       if (current)
143         {
144           total[d] += current;
145           count[d] ++;
146         }
147
148     } while (flip (&d) != DOWN);
149   
150   SCM func = me->get_grob_property ("dir-function");
151   SCM s = gh_call2 (func,
152                     gh_cons (gh_int2scm (count[UP]),
153                              gh_int2scm (count[DOWN])),
154                     gh_cons (gh_int2scm (total[UP]),
155                              gh_int2scm (total[DOWN])));
156
157   if (gh_number_p (s) && gh_scm2int (s))
158     return to_dir (s);
159   
160   /*
161     If dir is not determined: get default
162   */
163   return to_dir (me->get_grob_property ("neutral-direction"));
164 }
165
166
167 /*
168   Set all stems with non-forced direction to beam direction.
169   Urg: non-forced should become `without/with unforced' direction,
170        once stem gets cleaned-up.
171  */
172 void
173 Beam::set_stem_directions (Grob*me)
174 {
175   Link_array<Item> stems
176     =Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
177   Direction d = Directional_element_interface::get (me);
178   
179   for (int i=0; i <stems.size (); i++)
180     {
181       Grob *s = stems[i];
182       SCM force = s->remove_grob_property ("dir-forced");
183       if (!gh_boolean_p (force) || !gh_scm2bool (force))
184         Directional_element_interface ::set (s,d);
185     }
186
187
188 /*
189   Simplistic auto-knees; only consider vertical gap between two
190   adjacent chords.
191
192   `Forced' stem directions are ignored.  If you don't want auto-knees,
193   don't set, or unset auto-knee-gap.
194  */
195 void
196 Beam::consider_auto_knees (Grob *me)
197 {
198   SCM scm = me->get_grob_property ("auto-knee-gap");
199
200   if (gh_number_p (scm))
201     {
202       bool knee_b = false;
203       Real knee_y = 0;
204       Real staff_space = Staff_symbol_referencer::staff_space (me);
205       Real gap = gh_scm2double (scm) / staff_space;
206
207       Direction d = Directional_element_interface::get (me);
208       Link_array<Item> stems=
209         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
210       
211       Grob *common = me->common_refpoint (stems[0], Y_AXIS);
212       for (int i=1; i < stems.size (); i++)
213         if (!Stem::invisible_b (stems[i]))
214           common = common->common_refpoint (stems[i], Y_AXIS);
215
216       int l = 0;
217       for (int i=1; i < stems.size (); i++)
218         {
219           if (!Stem::invisible_b (stems[i-1]))
220             l = i - 1;
221           if (Stem::invisible_b (stems[l]))
222             continue;
223           if (Stem::invisible_b (stems[i]))
224             continue;
225           
226           Real left = Stem::extremal_heads (stems[l])[d]
227             ->relative_coordinate (common, Y_AXIS);
228           Real right = Stem::extremal_heads (stems[i])[-d]
229             ->relative_coordinate (common, Y_AXIS);
230
231           Real dy = right - left;
232
233           if (abs (dy) >= gap)
234             {
235               knee_y = (right + left) / 2;
236               knee_b = true;
237               break;
238             }
239         }
240       
241       if (knee_b)
242         {
243           for (int i=0; i < stems.size (); i++)
244             {
245               if (Stem::invisible_b (stems[i]))
246                 continue;
247               Item *s = stems[i];         
248               Real y = Stem::extremal_heads (stems[i])[d]
249                 ->relative_coordinate (common, Y_AXIS);
250
251               Directional_element_interface::set (s, y < knee_y ? UP : DOWN);
252               s->set_grob_property ("dir-forced", SCM_BOOL_T);
253             }
254         }
255     }
256 }
257
258 /*
259  Set stem's shorten property if unset.
260  TODO:
261     take some y-position (chord/beam/nearest?) into account
262     scmify forced-fraction
263  */
264 void
265 Beam::set_stem_shorten (Grob*m)
266 {
267   Spanner*me = dynamic_cast<Spanner*> (m);
268
269   Real forced_fraction = forced_stem_count (me) / visible_stem_count (me);
270
271   int multiplicity = get_multiplicity (me);
272
273   SCM shorten = me->get_grob_property ("beamed-stem-shorten");
274   if (shorten == SCM_EOL)
275     return;
276
277   int sz = scm_ilength (shorten);
278   
279   Real staff_space = Staff_symbol_referencer::staff_space (me);
280   SCM shorten_elt = scm_list_ref (shorten, gh_int2scm (multiplicity <? (sz - 1)));
281   Real shorten_f = gh_scm2double (shorten_elt) * staff_space;
282
283   /* your similar cute comment here */
284   shorten_f *= forced_fraction;
285   
286   me->set_grob_property ("shorten", gh_double2scm (shorten_f));
287 }
288
289 /*
290   Call list of y-dy-callbacks, that handle setting of
291   grob-properties y, dy.
292
293   User may set grob-properties: y-position-hs and height-hs
294  (to be fixed) that override the calculated y and dy.
295
296   Because y and dy cannot be calculated and quanted separately, we
297   always calculate both, then check for user override.
298  */
299 MAKE_SCHEME_CALLBACK (Beam, after_line_breaking, 1);
300 SCM
301 Beam::after_line_breaking (SCM smob)
302 {
303   Grob * me =  unsmob_grob (smob);
304   
305   me->set_grob_property ("y", gh_double2scm (0));
306   me->set_grob_property ("dy", gh_double2scm (0));
307
308   /* Hmm, callbacks should be called by, a eh, callback mechanism
309     somewhere (?), I guess, not by looping here. */
310   
311   SCM list = me->get_grob_property ("y-dy-callbacks");
312   for (SCM i = list; gh_pair_p (i); i = ly_cdr (i))
313     gh_call1 (ly_car (i), smob);
314
315   // UGH. Y is not in staff position unit?
316   // Ik dacht datwe daar juist van weg wilden?
317   
318   // Hmm, nu hebben we 3 dimensies, want inmiddels zijn we daar
319   // weer terug, maar dan / 2
320   // (staff-space iso staff-position)
321   
322   set_stem_lengths (me);
323
324   return SCM_UNSPECIFIED;
325 }
326
327
328 MAKE_SCHEME_CALLBACK (Beam, least_squares, 1);
329 SCM
330 Beam::least_squares (SCM smob)
331 {
332  Grob *me = unsmob_grob (smob);
333
334  if (visible_stem_count (me) <= 1)
335    return SCM_UNSPECIFIED;
336
337   Real y = 0;
338   Real dy = 0;
339
340   /* Stem_info, and thus y,dy in this function are corrected for beam-dir */
341   Real first_ideal = Stem::calc_stem_info (first_visible_stem (me)).idealy_f_;
342   if (first_ideal == Stem::calc_stem_info (last_visible_stem (me)).idealy_f_)
343     {
344       y = first_ideal;
345       dy = 0;
346     }
347   else
348     {
349       Array<Offset> ideals;
350
351       // ugh -> use commonx
352       Real x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
353       Link_array<Item> stems=
354         Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
355
356       for (int i=0; i < stems.size (); i++)
357         {
358           Item* s = stems[i];
359           if (Stem::invisible_b (s))
360             continue;
361           ideals.push (Offset (s->relative_coordinate (0, X_AXIS) - x0, 
362                                Stem::calc_stem_info (s).idealy_f_));
363         }
364       Real dydx;
365       minimise_least_squares (&dydx, &y, ideals);
366
367       Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
368       dy = dydx * dx;
369     }
370
371   /* Store true, not dir-corrected values */
372   Direction dir = Directional_element_interface::get (me);
373   me->set_grob_property ("y", gh_double2scm (y * dir));
374   me->set_grob_property ("dy", gh_double2scm (dy * dir));
375   return SCM_UNSPECIFIED;
376 }
377
378 #include <stdio.h>
379 MAKE_SCHEME_CALLBACK (Beam, check_concave, 1);
380 SCM
381 Beam::check_concave (SCM smob)
382 {
383   Grob *me = unsmob_grob (smob);
384
385   Link_array<Item> stems = 
386     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
387
388   for (int i = 0; i < stems.size ();)
389     {
390       if (Stem::invisible_b (stems[i]))
391         stems.del (i);
392       else
393         i++;
394     }
395   
396   if (stems.size () < 3)
397     return SCM_UNSPECIFIED;
398
399   /* TODO: find-out what makes beam concave (#1, #2, #3, #4 or
400      something else) */
401   SCM s = me->get_grob_property ("concaveness-no-slope");
402
403   Real concave = 0;
404   if (!to_boolean (s))
405     {
406       /* Concaveness try #1: Sum distances of inner noteheads to line
407          between two outer noteheads.  */
408
409       s = me->get_grob_property ("concave-if-bigger-than-two");
410       
411       Real dy = Stem::chord_start_f (stems.top ())
412         - Stem::chord_start_f (stems[0]);
413       Real slope = dy / (stems.size () - 1);
414       
415       Real y0 = Stem::chord_start_f (stems[0]);
416       for (int i = 1; i < stems.size () - 1; i++)
417         {
418           Real c = (Stem::chord_start_f (stems[i]) - y0) - i * slope;
419
420           /* try #4: (Han-Wen): neem maximum afstand lijn - tot
421              extreme notehead (in geval van akkoorden). Als die
422              afstand >= 2.0 ss was, dan moest hij recht (of blijkbaar:
423              vrijwel recht, zie m 17, 18). Dat was nl. wat stolba zei:
424              als afstand lijn-noot >= 2.0 dan recht. */
425           
426           if (to_boolean (s) && c >= 2.0)
427             {
428               concave = 1000 * Directional_element_interface::get (me);
429               break;
430             }
431           
432           concave += c;
433         }
434
435     }
436   else
437     {
438       /* Concaveness try #2: Sum distances of inner noteheads that
439          fall outside the interval of the two outer noteheads */
440          
441       Interval iv = Interval (Stem::chord_start_f (stems[0]),
442                               Stem::chord_start_f (stems.top ()));
443
444       if (iv[MAX] < iv[MIN])
445         //      iv.swap ();
446         iv = Interval (iv[MAX], iv[MIN]);
447       
448       for (int i = 1; i < stems.size () - 1; i++)
449         {
450           Real c = 0;
451           Real f = Stem::chord_start_f (stems[i]);
452           if ((c = f - iv[MAX]) > 0)
453             concave += c;
454           else if ((c = f - iv[MIN]) < 0)
455             concave += c;
456         }
457     }
458   
459   concave *= Directional_element_interface::get (me);
460       
461   Real concaveness = concave / (stems.size () - 2);
462
463   /* ugh: this is the a kludge to get input/regression/beam-concave.ly
464      to behave as baerenreiter.
465
466     try #3 (add-on to #2): */
467   s = me->get_grob_property ("concaveness-square");
468   if (to_boolean (s))
469     concaveness /= (stems.size () - 2);
470   
471   s = me->get_grob_property ("concaveness");
472   Real r = gh_scm2double (s);
473
474   /* TODO: some sort of damping iso -> plain horizontal */
475   if (concaveness > r)
476     {
477       Direction dir = Directional_element_interface::get (me);
478       Real y = gh_scm2double (me->get_grob_property ("y")) * dir;
479       Real dy = gh_scm2double (me->get_grob_property ("dy")) * dir;
480   
481       Real adjusted_y = y + dy / 2;
482       /* Store true, not dir-corrected values */
483       me->set_grob_property ("y", gh_double2scm (adjusted_y * dir));
484       me->set_grob_property ("dy", gh_double2scm (0)); 
485     }
486
487   s = me->get_grob_property ("debug-concave");
488   if (to_boolean (s))
489     {
490 #if 0
491       Item *text = new Item (me->get_property ("TextScript"));
492       text->set_grob_property ("text",
493                                ly_str02scm (to_str (concaveness).ch_C ())),
494       Side_position_interface::add_support (text, stem[0]);
495 #else
496       printf ("concaveness: %.2f\n", concaveness);
497 #endif
498     }
499   
500   return SCM_UNSPECIFIED;
501 }
502
503 /*
504   This neat trick is by Werner Lemberg,
505   damped = tanh (slope)
506   corresponds with some tables in [Wanske]
507 */
508 MAKE_SCHEME_CALLBACK (Beam, slope_damping, 1);
509 SCM
510 Beam::slope_damping (SCM smob)
511 {
512   Grob *me = unsmob_grob (smob);
513
514   if (visible_stem_count (me) <= 1)
515     return SCM_UNSPECIFIED;
516
517   SCM s = me->get_grob_property ("damping"); 
518   int damping = gh_scm2int (s);
519
520   if (damping)
521     {
522       /* y,dy in this function are corrected for beam-dir */
523       Direction dir = Directional_element_interface::get (me);
524       Real y = gh_scm2double (me->get_grob_property ("y")) * dir;
525       Real dy = gh_scm2double (me->get_grob_property ("dy")) * dir;
526       
527       // ugh -> use commonx
528       Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS)
529         - first_visible_stem (me)->relative_coordinate (0, X_AXIS);
530       Real dydx = dy && dx ? dy/dx : 0;
531       dydx = 0.6 * tanh (dydx) / damping;
532
533       Real damped_dy = dydx * dx;
534       Real adjusted_y = y + (dy - damped_dy) / 2;
535       /* Store true, not dir-corrected values */
536       me->set_grob_property ("y", gh_double2scm (adjusted_y * dir));
537       me->set_grob_property ("dy", gh_double2scm (damped_dy * dir));
538     }
539     return SCM_UNSPECIFIED;
540 }
541
542 /*
543   Quantise dy (height) of beam.
544   Generalisation of [Ross].
545   */
546 MAKE_SCHEME_CALLBACK (Beam, quantise_dy, 1);
547 SCM
548 Beam::quantise_dy (SCM smob)
549 {
550   Grob *me = unsmob_grob (smob);
551
552   if (visible_stem_count (me) <= 1)
553     return SCM_UNSPECIFIED;
554
555   Array<Real> a;
556   SCM proc = me->get_grob_property ("height-quants");
557   SCM quants = gh_call2 (proc, me->self_scm (),
558                          gh_double2scm (me->paper_l ()->get_var ("stafflinethickness")
559                                         / 1.0));
560   
561   for (SCM s = quants; gh_pair_p (s); s = ly_cdr (s))
562     a.push (gh_scm2double (ly_car (s)));
563   
564   if (a.size () > 1)
565     {
566       /* y,dy in this function are corrected for beam-dir */
567       Direction dir = Directional_element_interface::get (me);
568       Real y = gh_scm2double (me->get_grob_property ("y")) * dir;
569       Real dy = gh_scm2double (me->get_grob_property ("dy")) * dir;
570
571       Real staff_space = Staff_symbol_referencer::staff_space (me);
572       
573       Interval iv = quantise_iv (a, abs (dy)/staff_space) * staff_space;
574       Real q = (abs (dy) - iv[SMALLER] <= iv[BIGGER] - abs (dy))
575         ? iv[SMALLER]
576         : iv[BIGGER];
577
578       if (to_boolean (me->get_grob_property ("quantise-dy-never-steeper"))
579           && iv[SMALLER] != 0)
580         q = iv[SMALLER];
581           
582       Real quantised_dy = q * sign (dy);
583       Real adjusted_y = y + (dy - quantised_dy) * 0.5;
584       /* Store true, not dir-corrected values */
585       me->set_grob_property ("y", gh_double2scm (adjusted_y * dir));
586       me->set_grob_property ("dy", gh_double2scm (quantised_dy * dir));
587     }
588   return SCM_UNSPECIFIED;
589 }
590
591 /* It's tricky to have the user override y,dy directly, so we use this
592    translation func.  Also, if our staff_space != 1 (smaller staff, eg),
593    user will expect staff-position to be discrete values. */
594 MAKE_SCHEME_CALLBACK (Beam, user_override, 1);
595 SCM
596 Beam::user_override (SCM smob)
597 {
598   Grob *me = unsmob_grob (smob);
599   Real staff_space = Staff_symbol_referencer::staff_space (me);
600
601   SCM s = me->get_grob_property ("staff-position");
602   if (gh_number_p (s))
603     {
604       Real y = gh_scm2double (s) * staff_space * 0.5;
605       me->set_grob_property ("y", gh_double2scm (y));
606     }
607
608   /* Name suggestions? Tilt, slope, vertical-* ? */
609   s = me->get_grob_property ("height");
610   if (gh_number_p (s))
611     {
612       Real dy = gh_scm2double (s) * staff_space * 0.5;
613       me->set_grob_property ("dy", gh_double2scm (dy));
614     }
615   
616   return SCM_UNSPECIFIED;
617 }
618
619 /*
620   Ugh, this must be last, after user_override
621   Assumes directionised y/dy.
622  */
623 MAKE_SCHEME_CALLBACK (Beam, do_quantise_y, 1);
624 SCM
625 Beam::do_quantise_y (SCM smob)
626 {
627   Grob *me = unsmob_grob (smob);
628
629   /*
630     If the user set y-position, we shouldn't do quanting.
631    */
632   if (gh_number_p (me->get_grob_property ("y-position-hs")))
633     return SCM_UNSPECIFIED;
634
635   Real y = gh_scm2double (me->get_grob_property ("y"));
636   Real dy = gh_scm2double (me->get_grob_property ("dy"));
637       
638   /* we can modify y, so we should quantise y */
639   Real half_space = Staff_symbol_referencer::staff_space (me) / 2;
640   Real y_shift = check_stem_length_f (me, y, dy);
641   y += y_shift;
642   y = quantise_y_f (me, y, dy, 0);
643
644   /*
645     Hmm, this is a bit keyhole operation: we're passing `this' as a
646     parameter, and member vars as SCM properties.  We should decide on
647     SCM/C/C++ boundary */
648   me->set_grob_property ("y", gh_double2scm (y));
649   set_stem_lengths (me);
650   y = gh_scm2double (me->get_grob_property ("y"));
651   
652   y_shift = check_stem_length_f (me, y, dy);
653
654   if (y_shift > half_space / 4)
655     {
656       y += y_shift;
657
658       /*
659         for significantly lengthened or shortened stems,
660         request quanting the other way.
661       */
662       int quant_dir = 0;
663       if (abs (y_shift) > half_space / 2)
664         quant_dir = sign (y_shift) * Directional_element_interface::get (me);
665       y = quantise_y_f (me, y, dy, quant_dir);
666     }
667   
668   me->set_grob_property ("y", gh_double2scm (y));
669   // me->set_grob_property ("dy", gh_double2scm (dy));
670   return SCM_UNSPECIFIED;
671 }
672
673
674 Real
675 Beam::calc_stem_y_f (Grob*me,Item* s, Real y, Real dy) 
676 {
677   int beam_multiplicity = get_multiplicity (me);
678   int stem_multiplicity = (Stem::flag_i (s) - 2) >? 0;
679
680   SCM space_proc = me->get_grob_property ("space-function");
681   SCM space = gh_call1 (space_proc, gh_int2scm (beam_multiplicity));
682
683   Real thick = gh_scm2double (me->get_grob_property ("thickness")) ;
684   Real interbeam_f = gh_scm2double (space) ;
685
686   // ugh -> use commonx
687   Real x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
688   Real dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
689   Real stem_y = (dy && dx ? (s->relative_coordinate (0, X_AXIS) - x0) / dx * dy : 0) + y;
690
691   /* knee */
692    Direction dir  = Directional_element_interface::get (me);
693    Direction sdir = Directional_element_interface::get (s);
694    
695     /* knee */
696    if (dir!= sdir)
697       {
698        stem_y -= dir 
699         * (thick / 2 + (beam_multiplicity - 1) * interbeam_f);
700
701
702       
703       // huh, why not for first visible?
704        if (Staff_symbol_referencer::staff_symbol_l (s)
705            != Staff_symbol_referencer::staff_symbol_l (last_visible_stem (me)))
706          stem_y += Directional_element_interface::get (me)
707            * (beam_multiplicity - stem_multiplicity) * interbeam_f;
708       }
709
710   return stem_y;
711 }
712
713 /* Make very sure that we don't have stems that are too short.
714    Try our best not to have stems that are too long (think: knees).
715    
716    Optionally (testing): try to lengthen more, to reach more ideal
717    stem lengths */
718 Real
719 Beam::check_stem_length_f (Grob*me,Real y, Real dy) 
720 {
721   Real shorten = 0;
722   Real lengthen = 0;
723   Direction dir = Directional_element_interface::get (me);
724
725   Link_array<Item> stems=
726     Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
727
728   int ideal_lengthen_count = 0;
729   Real ideal_lengthen = 0;
730   
731   for (int i=0; i < stems.size (); i++)
732     {
733       Item* s = stems[i];
734       if (Stem::invisible_b (s))
735         continue;
736
737       Real stem_y = calc_stem_y_f (me, s, y, dy);
738         
739       stem_y *= dir;
740       Stem_info info = Stem::calc_stem_info (s);
741
742       // if (0 > info.maxy_f_ - stem_y)
743       shorten = shorten <? info.maxy_f_ - stem_y;
744       // if (0 < info.miny_f_ - stem_y)
745       lengthen = lengthen >? info.miny_f_ - stem_y;
746
747       if (info.idealy_f_ - stem_y > 0)
748         {
749           ideal_lengthen += (info.idealy_f_ - stem_y);
750           ideal_lengthen_count++;
751         }
752       // too long is not so bad as too short
753       else if (0) //info.idealy_f_ - stem_y < 0)
754         {
755           ideal_lengthen += info.idealy_f_ - stem_y;
756           ideal_lengthen_count++;
757         }
758     }
759
760   if (lengthen && shorten)
761     me->warning (_ ("weird beam vertical offset"));
762
763   if (to_boolean (me->get_grob_property ("ideal-lengthen"))
764       && ideal_lengthen_count)
765     lengthen = (ideal_lengthen / ideal_lengthen_count) >? lengthen;
766       
767   /* when all stems are too short, normal stems win */
768   return dir * ((shorten) ?  shorten : lengthen);
769 }
770
771 /*
772   Hmm.  At this time, beam position and slope are determined.  Maybe,
773   stem directions and length should set to relative to the chord's
774   position of the beam.  */
775 void
776 Beam::set_stem_lengths (Grob *me)
777 {
778   if (visible_stem_count (me) <= 1)
779     return;
780   
781   Real y = gh_scm2double (me->get_grob_property ("y"));
782   Real dy = gh_scm2double (me->get_grob_property ("dy"));
783
784   Real half_space = Staff_symbol_referencer::staff_space (me)/2;
785   Link_array<Item> stems=
786     Pointer_group_interface__extract_grobs (me, (Item*)0, "stems");
787
788   Grob *common = me->common_refpoint (stems[0], Y_AXIS);
789   for (int i=1; i < stems.size (); i++)
790     if (!Stem::invisible_b (stems[i]))
791       common = common->common_refpoint (stems[i], Y_AXIS);
792
793   for (int i=0; i < stems.size (); i++)
794     {
795       Item* s = stems[i];
796       if (Stem::invisible_b (s))
797         continue;
798
799       Real stem_y = calc_stem_y_f (me, s, y, dy);
800
801       // doesn't play well with dvips
802       if (scm_definedp (ly_symbol2scm ("ps-testing"), SCM_UNDEFINED)
803           == SCM_BOOL_T)
804         if (Stem::get_direction (s) == Directional_element_interface::get (me))
805           stem_y += Stem::get_direction (s)
806             * gh_scm2double (me->get_grob_property ("thickness")) / 2;
807       
808       /* caution: stem measures in staff-positions */
809       Real id = me->relative_coordinate (common, Y_AXIS)
810         - stems[i]->relative_coordinate (common, Y_AXIS);
811       Stem::set_stemend (s, (stem_y + id) / half_space);
812     }
813 }
814
815 /*
816   Prevent interference from stafflines and beams.
817
818   We only need to quantise the (left) y of the beam,
819   since dy is quantised too.
820   if extend_b then stems must *not* get shorter
821  */
822 Real
823 Beam::quantise_y_f (Grob*me,Real y, Real dy, int quant_dir)
824 {
825   int multiplicity = get_multiplicity (me);
826
827   Real staff_space = Staff_symbol_referencer::staff_space (me);
828   Real thick = me->paper_l ()->get_var ("stafflinethickness");
829
830
831   SCM proc = me->get_grob_property ("vertical-position-quant-function");
832   SCM quants = scm_apply (proc,
833                           me->self_scm (),
834                           scm_list_n (gh_int2scm (multiplicity),
835                                    gh_double2scm (dy/staff_space),
836                                    gh_double2scm (thick/staff_space),
837                                    SCM_EOL, SCM_UNDEFINED));
838   
839   Array<Real> a;
840
841   for (; gh_pair_p (quants); quants = ly_cdr (quants))
842     a.push (gh_scm2double (ly_car (quants)));
843
844   if (a.size () <= 1)
845     return y;
846
847   Real up_y = Directional_element_interface::get (me) * y;
848   Interval iv = quantise_iv (a, up_y/staff_space) * staff_space;
849
850   Real q = up_y - iv[SMALLER] <= iv[BIGGER] - up_y 
851     ? iv[SMALLER] : iv[BIGGER];
852   if (quant_dir)
853     q = iv[ (Direction)quant_dir];
854
855   return q * Directional_element_interface::get (me);
856 }
857
858 void
859 Beam::set_beaming (Grob*me,Beaming_info_list *beaming)
860 {
861   Link_array<Grob> stems=
862     Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
863   
864   Direction d = LEFT;
865   for (int i=0; i  < stems.size (); i++)
866     {
867       do
868         {
869           /* Don't overwrite user override (?) */
870           if (Stem::beam_count (stems[i], d) == -1
871               /* Don't set beaming for outside of outer stems */
872               && ! (d == LEFT && i == 0)
873               && ! (d == RIGHT && i == stems.size () -1))
874             {
875               int b = beaming->infos_.elem (i).beams_i_drul_[d];
876               Stem::set_beaming (stems[i], b, d);
877             }
878         }
879       while (flip (&d) != LEFT);
880     }
881 }
882
883
884
885 /*
886   beams to go with one stem.
887
888   FIXME: clean me up.
889   */
890 Molecule
891 Beam::stem_beams (Grob*me,Item *here, Item *next, Item *prev,
892                   Real /* dy */ , Real dydx
893                   ) 
894 {
895   // ugh -> use commonx
896   if ((next && ! (next->relative_coordinate (0, X_AXIS) > here->relative_coordinate (0, X_AXIS))) ||
897  (prev && ! (prev->relative_coordinate (0, X_AXIS) < here->relative_coordinate (0, X_AXIS))))
898       programming_error ("Beams are not left-to-right");
899
900   int multiplicity = get_multiplicity (me);
901
902   SCM space_proc = me->get_grob_property ("space-function");
903   SCM space = gh_call1 (space_proc, gh_int2scm (multiplicity));
904
905   Real thick = gh_scm2double (me->get_grob_property ("thickness")) ;
906   Real interbeam_f = gh_scm2double (space) ;
907     
908   Real bdy = interbeam_f;
909   
910 #if 0
911     // ugh -> use commonx
912   Real dx = visible_stem_count (me) ?
913     last_visible_stem (me)->relative_coordinate (0, X_AXIS) - first_visible_stem (me)->relative_coordinate (0, X_AXIS)
914     : 0.0;
915 #endif
916   
917   Molecule leftbeams;
918   Molecule rightbeams;
919
920   Real nw_f;
921   if (!Stem::first_head (here))
922     nw_f = 0;
923   else {
924     int t = Stem::type_i (here); 
925
926     SCM proc = me->get_grob_property ("flag-width-function");
927     SCM result = gh_call1 (proc, gh_int2scm (t));
928     nw_f = gh_scm2double (result);
929   }
930
931
932   Direction dir = Directional_element_interface::get (me);
933
934   /* [Tremolo] beams on whole notes may not have direction set? */
935  if (dir == CENTER)
936     dir = Directional_element_interface::get (here);
937
938
939   /* half beams extending to the left. */
940   if (prev)
941     {
942       int lhalfs= lhalfs = Stem::beam_count (here,LEFT) - Stem::beam_count (prev,RIGHT);
943       int lwholebeams= Stem::beam_count (here,LEFT) <? Stem::beam_count (prev,RIGHT) ;
944       /*
945        Half beam should be one note-width, 
946        but let's make sure two half-beams never touch
947        */
948
949       // FIXME: TODO (check) stem width / sloped beams
950       Real w = here->relative_coordinate (0, X_AXIS)
951         - prev->relative_coordinate (0, X_AXIS);
952       Real stem_w = gh_scm2double (prev->get_grob_property ("thickness"))
953         // URG
954         * me->paper_l ()->get_var ("stafflinethickness");
955
956       w = w/2 <? nw_f;
957       Molecule a;
958       if (lhalfs)               // generates warnings if not
959         a =  Lookup::beam (dydx, w + stem_w, thick);
960       a.translate (Offset (-w, -w * dydx));
961       a.translate_axis (-stem_w/2, X_AXIS);
962       for (int j = 0; j  < lhalfs; j++)
963         {
964           Molecule b (a);
965           b.translate_axis (-dir * bdy * (lwholebeams+j), Y_AXIS);
966           leftbeams.add_molecule (b);
967         }
968     }
969
970   if (next)
971     {
972       int rhalfs  = Stem::beam_count (here,RIGHT)
973         - Stem::beam_count (next,LEFT);
974       int rwholebeams= Stem::beam_count (here,RIGHT)
975         <? Stem::beam_count (next,LEFT) ;
976
977       Real w = next->relative_coordinate (0, X_AXIS)
978         - here->relative_coordinate (0, X_AXIS);
979
980       Real stem_w = gh_scm2double (next->get_grob_property ("thickness"))
981         // URG
982         * me->paper_l ()->get_var ("stafflinethickness");
983
984       Molecule a = Lookup::beam (dydx, w + stem_w, thick);
985       a.translate_axis (- stem_w/2, X_AXIS);
986       int j = 0;
987       Real gap_f = 0;
988       
989       SCM gap = me->get_grob_property ("gap");
990       if (gh_number_p (gap))
991         {
992           int gap_i = gh_scm2int ((gap));
993           int nogap = rwholebeams - gap_i;
994           
995           for (; j  < nogap; j++)
996             {
997               Molecule b (a);
998               b.translate_axis (-dir  * bdy * j, Y_AXIS);
999               rightbeams.add_molecule (b);
1000             }
1001           if (Stem::invisible_b (here))
1002             gap_f = nw_f;
1003           else
1004             gap_f = nw_f / 2;
1005           w -= 2 * gap_f;
1006           a = Lookup::beam (dydx, w + stem_w, thick);
1007         }
1008
1009       for (; j  < rwholebeams; j++)
1010         {
1011           Molecule b (a);
1012           Real tx = 0;
1013           if (Stem::invisible_b (here))
1014             // ugh, see chord-tremolo.ly
1015             tx = (-dir + 1) / 2 * nw_f * 1.5 + gap_f/4;
1016           else
1017             tx = gap_f;
1018           b.translate (Offset (tx, -dir * bdy * j));
1019           rightbeams.add_molecule (b);
1020         }
1021
1022       w = w/2 <? nw_f;
1023       if (rhalfs)
1024         a = Lookup::beam (dydx, w, thick);
1025
1026       for (; j  < rwholebeams + rhalfs; j++)
1027         {
1028           Molecule b (a);
1029           b.translate_axis (- dir * bdy * j, Y_AXIS);
1030           rightbeams.add_molecule (b);
1031         }
1032
1033     }
1034   leftbeams.add_molecule (rightbeams);
1035
1036   /*
1037     Does beam quanting think  of the asymetry of beams? 
1038     Refpoint is on bottom of symbol. (FIXTHAT) --hwn.
1039    */
1040   return leftbeams;
1041 }
1042
1043 MAKE_SCHEME_CALLBACK (Beam,brew_molecule,1);
1044 SCM
1045 Beam::brew_molecule (SCM smob)
1046 {
1047   Grob * me =unsmob_grob (smob);
1048
1049   Molecule mol;
1050   if (!gh_pair_p (me->get_grob_property ("stems")))
1051     return SCM_EOL;
1052   Real x0,dx;
1053   Link_array<Item>stems = 
1054     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");  
1055   if (visible_stem_count (me))
1056     {
1057   // ugh -> use commonx
1058       x0 = first_visible_stem (me)->relative_coordinate (0, X_AXIS);
1059       dx = last_visible_stem (me)->relative_coordinate (0, X_AXIS) - x0;
1060     }
1061   else
1062     {
1063       x0 = stems[0]->relative_coordinate (0, X_AXIS);
1064       dx = stems.top ()->relative_coordinate (0, X_AXIS) - x0;
1065     }
1066   
1067
1068
1069   /*
1070     TODO: the naming of the grob properties sucks.
1071    */
1072   SCM dy_s = me->get_grob_property ("dy");
1073   SCM y_s = me->get_grob_property ("y");
1074
1075   
1076   Real dy = gh_number_p (dy_s) ? gh_scm2double (dy_s) : 0.0;
1077   Real dydx = dy && dx ? dy/dx : 0;
1078   Real y = gh_number_p (y_s) ? gh_scm2double (y_s) : 0.0;
1079
1080
1081   for (int j=0; j <stems.size (); j++)
1082     {
1083       Item *i = stems[j];
1084       Item * prev = (j > 0)? stems[j-1] : 0;
1085       Item * next = (j < stems.size ()-1) ? stems[j+1] :0;
1086
1087       Molecule sb = stem_beams (me, i, next, prev, dy, dydx);
1088       Real x = i->relative_coordinate (0, X_AXIS)-x0;
1089       sb.translate (Offset (x, x * dydx + y));
1090       mol.add_molecule (sb);
1091     }
1092   mol.translate_axis (x0 
1093     - dynamic_cast<Spanner*> (me)->get_bound (LEFT)->relative_coordinate (0, X_AXIS), X_AXIS);
1094
1095   return mol.smobbed_copy ();
1096 }
1097
1098 int
1099 Beam::forced_stem_count (Grob*me) 
1100 {
1101   Link_array<Item>stems = 
1102     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1103   int f = 0;
1104   for (int i=0; i < stems.size (); i++)
1105     {
1106       Item *s = stems[i];
1107
1108       if (Stem::invisible_b (s))
1109         continue;
1110
1111       if (( (int)Stem::chord_start_f (s)) 
1112         && (Stem::get_direction (s) != Stem::get_default_dir (s)))
1113         f++;
1114     }
1115   return f;
1116 }
1117
1118
1119
1120
1121 /* TODO:
1122    use filter and standard list functions.
1123  */
1124 int
1125 Beam::visible_stem_count (Grob*me) 
1126 {
1127   Link_array<Item>stems = 
1128     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1129   int c = 0;
1130   for (int i = stems.size (); i--;)
1131     {
1132       if (!Stem::invisible_b (stems[i]))
1133         c++;
1134     }
1135   return c;
1136 }
1137
1138 Item*
1139 Beam::first_visible_stem (Grob*me) 
1140 {
1141   Link_array<Item>stems = 
1142     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1143   
1144   for (int i = 0; i < stems.size (); i++)
1145     {
1146       if (!Stem::invisible_b (stems[i]))
1147         return stems[i];
1148     }
1149   return 0;
1150 }
1151
1152 Item*
1153 Beam::last_visible_stem (Grob*me) 
1154 {
1155   Link_array<Item>stems = 
1156     Pointer_group_interface__extract_grobs (me, (Item*) 0, "stems");
1157   for (int i = stems.size (); i--;)
1158     {
1159       if (!Stem::invisible_b (stems[i]))
1160         return stems[i];
1161     }
1162   return 0;
1163 }
1164
1165
1166 /*
1167   [TODO]
1168   handle rest under beam (do_post: beams are calculated now)
1169   what about combination of collisions and rest under beam.
1170
1171   Should lookup
1172     
1173     rest -> stem -> beam -> interpolate_y_position ()
1174 */
1175 MAKE_SCHEME_CALLBACK (Beam,rest_collision_callback,2);
1176 SCM
1177 Beam::rest_collision_callback (SCM element_smob, SCM axis)
1178 {
1179   Grob *rest = unsmob_grob (element_smob);
1180   Axis a = (Axis) gh_scm2int (axis);
1181   
1182   assert (a == Y_AXIS);
1183
1184   Grob * st = unsmob_grob (rest->get_grob_property ("stem"));
1185   Grob * stem = st;
1186   if (!stem)
1187     return gh_double2scm (0.0);
1188   Grob * beam = unsmob_grob (stem->get_grob_property ("beam"));
1189   if (!beam || !Beam::has_interface (beam) || !Beam::visible_stem_count (beam))
1190     return gh_double2scm (0.0);
1191
1192   // make callback for rest from this.
1193   Real beam_dy = 0;
1194   Real beam_y = 0;
1195
1196
1197   // todo: make sure this calced already.
1198   SCM s = beam->get_grob_property ("dy");
1199   if (gh_number_p (s))
1200     beam_dy = gh_scm2double (s);
1201   
1202   s = beam->get_grob_property ("y");
1203   if (gh_number_p (s))
1204     beam_y = gh_scm2double (s);
1205   
1206   // ugh -> use commonx
1207   Real x0 = first_visible_stem (beam)->relative_coordinate (0, X_AXIS);
1208   Real dx = last_visible_stem (beam)->relative_coordinate (0, X_AXIS) - x0;
1209   Real dydx = beam_dy && dx ? beam_dy/dx : 0;
1210
1211   Direction d = Stem::get_direction (stem);
1212   Real beamy = (stem->relative_coordinate (0, X_AXIS) - x0) * dydx + beam_y;
1213
1214   Real staff_space =   Staff_symbol_referencer::staff_space (rest);
1215
1216   
1217   Real rest_dim = rest->extent (rest, Y_AXIS)[d]*2.0 / staff_space ; // refp??
1218
1219   Real minimum_dist
1220     = gh_scm2double (rest->get_grob_property ("minimum-beam-collision-distance"));
1221   Real dist =
1222     minimum_dist +  -d  * (beamy - rest_dim) >? 0;
1223
1224   int stafflines = Staff_symbol_referencer::line_count (rest);
1225
1226   // move discretely by half spaces.
1227   int discrete_dist = int (ceil (dist));
1228
1229   // move by whole spaces inside the staff.
1230   if (discrete_dist < stafflines+1)
1231     discrete_dist = int (ceil (discrete_dist / 2.0)* 2.0);
1232
1233   return gh_double2scm (-d *  discrete_dist);
1234 }
1235
1236
1237 bool
1238 Beam::has_interface (Grob*me)
1239 {
1240   return me->has_interface (ly_symbol2scm ("beam-interface"));
1241 }
1242