Use scalar instead of embedded_scm for context mod overrides.
[lilypond/mpolesky.git] / lily / vaticana-ligature.cc
blob861e4352a8dff1ff62027fd1f63f6eb1fa18f2c0
1 /*
2 vaticana-ligature.cc -- implement Vaticana_ligature
4 source file of the GNU LilyPond music typesetter
6 (c) 2003--2009 Juergen Reuter <reuter@ipd.uka.de>
7 */
9 #include "vaticana-ligature.hh"
11 #include "bezier.hh"
12 #include "font-interface.hh"
13 #include "international.hh"
14 #include "item.hh"
15 #include "lookup.hh"
16 #include "note-head.hh"
17 #include "output-def.hh"
18 #include "staff-symbol-referencer.hh"
19 #include "warn.hh"
21 Stencil
22 vaticana_brew_cauda (Grob *me,
23 int pos,
24 int delta_pitch,
25 Real thickness,
26 Real blotdiameter)
28 bool on_staffline = Staff_symbol_referencer::on_line (me, pos);
29 int interspaces = Staff_symbol_referencer::line_count (me) - 1;
30 bool above_staff = pos > interspaces;
32 if (delta_pitch > -1)
34 me->programming_error ("flexa cauda: invalid delta_pitch; assuming -1");
35 delta_pitch = -1;
37 Real length;
38 if (on_staffline)
40 if (delta_pitch >= -1)
41 length = 1.30;
42 else if (delta_pitch >= -2)
43 length = 1.35;
44 else
45 length = 1.85;
47 else
49 if (delta_pitch >= -1)
50 if (above_staff)
51 length = 1.30;
52 else
53 length = 1.00;
54 else if (delta_pitch >= -2)
55 length = 1.35;
56 else if (delta_pitch >= -3)
57 length = 1.50;
58 else
59 length = 1.85;
61 Box cauda_box (Interval (0, thickness), Interval (-length, 0));
62 return Lookup::round_filled_box (cauda_box, blotdiameter);
66 * TODO: move this function to class Lookup?
68 Stencil
69 vaticana_brew_flexa (Grob *me,
70 bool solid,
71 Real line_thickness)
73 Real staff_space = Staff_symbol_referencer::staff_space (me);
74 Stencil stencil;
75 Real right_height = 0.6 * staff_space;
77 Real interval;
78 SCM flexa_height_scm = me->get_property ("flexa-height");
79 if (flexa_height_scm != SCM_EOL)
80 interval = scm_to_int (flexa_height_scm);
81 else
83 me->warning ("Vaticana_ligature: "
84 + _ ("flexa-height undefined; assuming 0"));
85 interval = 0.0;
88 if (interval >= 0.0)
89 me->warning (_ ("ascending vaticana style flexa"));
91 Real width = robust_scm2double (me->get_property ("flexa-width"), 2);
94 * Compensate curve thickness that appears to be smaller in steep
95 * section of bend.
97 Real left_height
98 = right_height
99 + min (0.12 * abs (interval), 0.3) * staff_space;
102 * Compensate optical illusion regarding vertical position of left
103 * and right endings due to curved shape.
105 Real ypos_correction = -0.1 * staff_space * sign (interval);
106 Real interval_correction = 0.2 * staff_space * sign (interval);
107 Real corrected_interval = interval * staff_space + interval_correction;
110 * middle curve of flexa shape
112 Bezier curve;
113 curve.control_[0] = Offset (0.00 * width, 0.0);
114 curve.control_[1] = Offset (0.33 * width, corrected_interval / 2.0);
115 curve.control_[2] = Offset (0.66 * width, corrected_interval / 2.0);
116 curve.control_[3] = Offset (1.00 * width, corrected_interval / 2.0);
118 Bezier top_curve = curve, bottom_curve = curve;
119 for (int i = 0; i < 4; i++)
121 Real curve_thickness = 0.33 * ((3 - i) * left_height + i * right_height);
122 top_curve.control_[i] += Offset (0, 0.5 * curve_thickness);
123 bottom_curve.control_[i] -= Offset (0, 0.5 * curve_thickness);
126 if (solid)
128 Stencil solid_head
129 = Lookup::bezier_sandwich (top_curve, bottom_curve, 0.0);
130 stencil.add_stencil (solid_head);
132 else // outline
134 Bezier inner_top_curve = top_curve;
135 inner_top_curve.translate (Offset (0.0, -line_thickness));
136 Stencil top_edge
137 = Lookup::bezier_sandwich (top_curve, inner_top_curve, 0.0);
138 stencil.add_stencil (top_edge);
140 Bezier inner_bottom_curve = bottom_curve;
141 inner_bottom_curve.translate (Offset (0.0, +line_thickness));
142 Stencil bottom_edge
143 = Lookup::bezier_sandwich (bottom_curve, inner_bottom_curve, 0.0);
144 stencil.add_stencil (bottom_edge);
147 * TODO: Use horizontal slope with proper slope value rather
148 * than filled box for left edge, since the filled box stands
149 * out from the flexa shape if the interval is big and the line
150 * thickness small. The difficulty here is to compute a proper
151 * slope value, as it should roughly be equal with the slope of
152 * the left end of the bezier curve.
154 Box left_edge_box (Interval (0, line_thickness),
155 Interval (-0.5 * left_height, +0.5 * left_height));
156 Stencil left_edge = Lookup::filled_box (left_edge_box);
157 stencil.add_stencil (left_edge);
159 Box right_edge_box (Interval (-line_thickness, 0),
160 Interval (-0.5 * right_height, +0.5 * right_height));
161 Stencil right_edge = Lookup::filled_box (right_edge_box);
162 right_edge.translate_axis (width, X_AXIS);
163 right_edge.translate_axis (corrected_interval / 2.0, Y_AXIS);
164 stencil.add_stencil (right_edge);
166 stencil.translate_axis (ypos_correction, Y_AXIS);
167 return stencil;
170 Stencil
171 vaticana_brew_join (Grob *me, int delta_pitch,
172 Real join_thickness, Real blotdiameter)
174 Real staff_space = Staff_symbol_referencer::staff_space (me);
175 if (!delta_pitch)
177 me->programming_error (_ ("Vaticana_ligature: "
178 "zero join (delta_pitch == 0)"));
179 return Lookup::blank (Box (Interval (0, 0), Interval (0, 0)));
181 Interval x_extent = Interval (0, join_thickness);
182 Interval y_extent = (delta_pitch > 0)
183 ? Interval (0, delta_pitch * 0.5 * staff_space) : // ascending join
184 Interval (delta_pitch * 0.5 * staff_space, 0); // descending join
185 Box join_box (x_extent, y_extent);
186 return Lookup::round_filled_box (join_box, blotdiameter);
189 Stencil
190 vaticana_brew_primitive (Grob *me)
192 SCM glyph_name_scm = me->get_property ("glyph-name");
193 if (glyph_name_scm == SCM_EOL)
195 me->programming_error ("Vaticana_ligature: "
196 "undefined glyph-name -> ignoring grob");
197 return Lookup::blank (Box (Interval (0, 0), Interval (0, 0)));
200 string glyph_name = ly_scm2string (glyph_name_scm);
202 Stencil out;
203 Real thickness = robust_scm2double (me->get_property ("thickness"), 1);
205 Real line_thickness
206 = thickness * me->layout ()->get_dimension (ly_symbol2scm ("line-thickness"));
208 Real blotdiameter
209 = (me->layout ()->get_dimension (ly_symbol2scm ("blot-diameter")));
211 int pos = Staff_symbol_referencer::get_rounded_position (me);
213 SCM delta_pitch_scm = me->get_property ("delta-position");
214 int delta_pitch;
215 if (delta_pitch_scm != SCM_EOL)
216 delta_pitch = scm_to_int (delta_pitch_scm);
217 else
218 delta_pitch = 0;
220 Real x_offset = robust_scm2double (me->get_property ("x-offset"), 0);
222 bool add_stem = to_boolean (me->get_property ("add-stem"));
223 bool add_cauda = to_boolean (me->get_property ("add-cauda"));
224 bool add_join = to_boolean (me->get_property ("add-join"));
226 if (glyph_name == "")
229 * This is an empty head. This typically applies for the right
230 * side of a curved flexa shape, which is already typeset by the
231 * associated left side head. The only possible thing left to
232 * do is to draw a vertical join to the next head. (Urgh: need
233 * flexa_width.)
235 Real staff_space = Staff_symbol_referencer::staff_space (me);
236 Real flexa_width = robust_scm2double (me->get_property ("flexa-width"), 2) * staff_space;
238 = Lookup::blank (Box (Interval (0, 0.5 * flexa_width), Interval (0, 0)));
240 else if (glyph_name == "flexa")
241 out = vaticana_brew_flexa (me, true, line_thickness);
242 else
245 = Font_interface::get_default_font (me)->
246 find_by_name ("noteheads.s" + glyph_name);
248 out.translate_axis (x_offset, X_AXIS);
249 Real head_width = out.extent (X_AXIS).length ();
251 if (add_cauda)
253 Stencil cauda
254 = vaticana_brew_cauda (me, pos, delta_pitch,
255 line_thickness, blotdiameter);
256 out.add_stencil (cauda);
259 if (add_stem)
261 Stencil stem
262 = vaticana_brew_cauda (me, pos, -1,
263 line_thickness, blotdiameter);
264 stem.translate_axis (head_width - line_thickness, X_AXIS);
265 out.add_stencil (stem);
268 if (add_join)
270 Stencil join
271 = vaticana_brew_join (me, delta_pitch, line_thickness, blotdiameter);
272 join.translate_axis (head_width - line_thickness, X_AXIS);
273 out.add_stencil (join);
276 return out;
279 MAKE_SCHEME_CALLBACK (Vaticana_ligature, brew_ligature_primitive, 1);
281 Vaticana_ligature::brew_ligature_primitive (SCM smob)
283 Grob *me = unsmob_grob (smob);
284 SCM primitive = vaticana_brew_primitive (me).smobbed_copy ();
285 return primitive;
288 MAKE_SCHEME_CALLBACK (Vaticana_ligature, print, 1);
290 Vaticana_ligature::print (SCM)
292 return SCM_EOL;
295 ADD_INTERFACE (Vaticana_ligature,
296 "A vaticana style Gregorian ligature.",
298 /* properties */
299 "glyph-name "
300 "flexa-height "
301 "flexa-width "
302 "thickness "
303 "add-cauda "
304 "add-stem "
305 "add-join "
306 "delta-position "
307 "x-offset "