+MAKE_SCHEME_CALLBACK (Beam, brew_molecule, 1);
+SCM
+Beam::brew_molecule (SCM grob)
+{
+ Grob *me = unsmob_grob (grob);
+ position_beam (me);
+
+ Link_array<Grob> stems=
+ Pointer_group_interface__extract_grobs (me, (Grob*)0, "stems");
+ Grob* xcommon = common_refpoint_of_array (stems, me, X_AXIS);
+
+ Real x0, dx;
+ if (visible_stem_count (me))
+ {
+ // ugh -> use commonx
+ x0 = first_visible_stem (me)->relative_coordinate (xcommon, X_AXIS);
+ dx = last_visible_stem (me)->relative_coordinate (xcommon, X_AXIS) - x0;
+ }
+ else
+ {
+ x0 = stems[0]->relative_coordinate (xcommon, X_AXIS);
+ dx = stems.top ()->relative_coordinate (xcommon, X_AXIS) - x0;
+ }
+
+ SCM posns = me->get_grob_property ("positions");
+ Drul_array<Real> pos;
+ if (!is_number_pair (posns))
+ {
+ programming_error ("No beam posns");
+ pos = Interval (0,0);
+ }
+ else
+ pos= ly_scm2realdrul (posns);
+
+ scale_drul ( &pos, Staff_symbol_referencer::staff_space (me));
+
+ Real dy = pos[RIGHT] - pos[LEFT];
+ Real dydx = (dy && dx) ? dy/dx : 0;
+
+ Real thick = get_thickness (me);
+ Real bdy = get_beam_translation (me);
+
+ SCM last_beaming = SCM_EOL;
+ Real last_xposn = -1;
+ Real last_stem_width = -1 ;
+
+ Real gap_length =robust_scm2double ( me->get_grob_property ("gap"), 0.0);
+
+ Molecule the_beam;
+ Real lt = me->get_paper ()->get_realvar (ly_symbol2scm ("linethickness"));
+
+ for (int i = 0; i<= stems.size(); i++)
+ {
+ Grob * st = (i < stems.size()) ? stems[i] : 0;
+
+ SCM this_beaming = st ? st->get_grob_property ("beaming") : SCM_EOL;
+ Real xposn = st ? st->relative_coordinate (xcommon, X_AXIS) : 0.0;
+ Real stem_width = st ? robust_scm2double (st->get_grob_property ("thickness"), 1.0) *lt : 0 ;
+ Direction stem_dir = st ? to_dir (st->get_grob_property ("direction")) : CENTER;
+ /*
+ We do the space left of ST, with lfliebertjes pointing to the
+ right from the left stem, and rfliebertjes pointing left from
+ right stem.
+ */
+ SCM left = (i>0) ? gh_cdr (last_beaming) : SCM_EOL;
+ SCM right = st ? gh_car (this_beaming) : SCM_EOL;
+
+ Array<int> full_beams;
+ Array<int> lfliebertjes;
+ Array<int> rfliebertjes;
+
+ for (SCM s = left;
+ gh_pair_p (s); s =gh_cdr (s))
+ {
+ int b = gh_scm2int (gh_car (s));
+ if (scm_memq (gh_car(s), right) != SCM_BOOL_F)
+ {
+ full_beams.push (b);
+ }
+ else
+ {
+ lfliebertjes.push (b);
+ }
+ }
+ for (SCM s = right;
+ gh_pair_p (s); s =gh_cdr (s))
+ {
+ int b = gh_scm2int (gh_car (s));
+ if (scm_memq (gh_car(s), left) == SCM_BOOL_F)
+ {
+ rfliebertjes.push (b);
+ }
+ }
+
+ /*
+ how much to stick out for beams across linebreaks
+ */
+ Real break_overshoot = 3.0;
+ Real w = (i > 0 && st) ? xposn - last_xposn : break_overshoot;
+
+ Real stem_offset =0.0;
+ if (i > 0)
+ {
+ w += last_stem_width / 2;
+ stem_offset = -last_stem_width / 2;
+ }
+
+ if (st)
+ w += stem_width/ 2 ;
+
+
+ Real blot = me->get_paper ()->get_realvar (ly_symbol2scm ("blotdiameter"));
+ Molecule whole = Lookup::beam (dydx, w, thick, blot);
+ Molecule gapped;
+
+ int gap_count = 0;
+ if (gh_number_p (me->get_grob_property ("gap-count")))
+ {
+ gap_count = gh_scm2int (me->get_grob_property ("gap-count"));
+ gapped = Lookup::beam (dydx, w - 2 * gap_length, thick, blot);
+
+ full_beams.sort (default_compare);
+ if (stem_dir == UP)
+ full_beams.reverse ();
+ }
+
+ int k = 0;
+ for (int j = full_beams.size (); j--;)
+ {
+ Molecule b (whole);
+
+ if (k++ < gap_count)
+ {
+ b = gapped;
+ b.translate_axis (gap_length, X_AXIS);
+ }
+ b.translate_axis (last_xposn - x0 + stem_offset, X_AXIS);
+ b.translate_axis (dydx * (last_xposn - x0) + bdy * full_beams[j], Y_AXIS);
+
+ the_beam.add_molecule (b);
+ }
+
+
+
+ if (lfliebertjes.size() || rfliebertjes.size())
+ {
+ Real nw_f;
+
+ if (st)
+ {
+ int t = Stem::duration_log (st);
+
+ SCM proc = me->get_grob_property ("flag-width-function");
+ SCM result = gh_call1 (proc, scm_int2num (t));
+ nw_f = gh_scm2double (result);
+ }
+ else
+ nw_f = break_overshoot;
+
+ /* Half beam should be one note-width,
+ but let's make sure two half-beams never touch */
+ Real w = (i>0 && st) ? (xposn - last_xposn) : break_overshoot;
+ w = w/2 <? nw_f;
+
+ Molecule half = Lookup::beam (dydx, w, thick, blot);
+ for (int j = lfliebertjes.size(); j--;)
+ {
+ Molecule b (half);
+ b.translate_axis (last_xposn - x0, X_AXIS);
+ b.translate_axis (dydx * (last_xposn-x0) + bdy * lfliebertjes[j], Y_AXIS);
+ the_beam.add_molecule (b);
+ }
+ for (int j = rfliebertjes.size(); j--;)
+ {
+ Molecule b (half);
+ b.translate_axis (xposn - x0 - w , X_AXIS);
+ b.translate_axis (dydx * (xposn-x0 -w) + bdy * rfliebertjes[j], Y_AXIS);
+ the_beam.add_molecule (b);
+ }
+ }
+
+
+ last_xposn = xposn;
+ last_stem_width = stem_width;
+ last_beaming = this_beaming;
+ }
+
+ the_beam.translate_axis (x0 - me->relative_coordinate (xcommon, X_AXIS), X_AXIS);
+ the_beam.translate_axis (pos[LEFT], Y_AXIS);
+
+#if (DEBUG_QUANTING)
+ SCM quant_score = me->get_grob_property ("quant-score");
+ if (debug_beam_quanting_flag
+ && gh_string_p (quant_score))
+ {
+
+ /*
+ This code prints the demerits for each beam. Perhaps this
+ should be switchable for those who want to twiddle with the
+ parameters.
+ */
+ String str;
+ SCM properties = Font_interface::font_alist_chain (me);
+
+ Molecule tm = *unsmob_molecule (Text_item::interpret_markup
+ (me->get_paper ()->self_scm (), properties, quant_score));
+ the_beam.add_at_edge (Y_AXIS, UP, tm, 5.0, 0);
+ }
+#endif
+
+
+
+ return the_beam.smobbed_copy();
+}
+
+
+
+