]> git.donarmstrong.com Git - lilypond.git/blob - lily/grob-scheme.cc
restore regression tests for time-signature styles; issue 4176
[lilypond.git] / lily / grob-scheme.cc
1 /*
2   This file is part of LilyPond, the GNU music typesetter.
3
4   Copyright (C) 1998--2015 Jan Nieuwenhuizen <janneke@gnu.org>
5   Han-Wen Nienhuys <hanwen@xs4all.nl>
6
7   LilyPond is free software: you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation, either version 3 of the License, or
10   (at your option) any later version.
11
12   LilyPond is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16
17   You should have received a copy of the GNU General Public License
18   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
19 */
20
21 #include "font-interface.hh"
22 #include "grob-array.hh"
23 #include "item.hh"
24 #include "output-def.hh"
25 #include "paper-score.hh"
26 #include "simple-closure.hh"
27 #include "system.hh"
28 #include "unpure-pure-container.hh"
29 #include "warn.hh"              // error ()
30
31 LY_DEFINE (ly_grob_property_data, "ly:grob-property-data",
32            2, 0, 0, (SCM grob, SCM sym),
33            "Return the value for property @var{sym} of @var{grob},"
34            " but do not process callbacks.")
35 {
36   Grob *sc = Grob::unsmob (grob);
37
38   LY_ASSERT_SMOB (Grob, grob, 1);
39   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
40
41   return sc->get_property_data (sym);
42 }
43
44 LY_DEFINE (ly_grob_set_property_x, "ly:grob-set-property!",
45            3, 0, 0, (SCM grob, SCM sym, SCM val),
46            "Set @var{sym} in grob @var{grob} to value @var{val}.")
47 {
48   Grob *sc = Grob::unsmob (grob);
49
50   LY_ASSERT_SMOB (Grob, grob, 1);
51   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
52
53   if (!ly_is_procedure (val)
54       && !Simple_closure::is_smob (val)
55       && !type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")))
56     error ("typecheck failed");
57
58   sc->set_property (sym, val);
59   return SCM_UNSPECIFIED;
60 }
61
62 LY_DEFINE (ly_grob_set_nested_property_x, "ly:grob-set-nested-property!",
63            3, 0, 0, (SCM grob, SCM symlist, SCM val),
64            "Set nested property @var{symlist} in grob @var{grob} to value @var{val}.")
65 {
66   Grob *sc = Grob::unsmob (grob);
67
68   LY_ASSERT_SMOB (Grob, grob, 1);
69
70   bool type_ok = scm_is_pair (symlist);
71
72   if (type_ok)
73     for (SCM s = symlist; scm_is_pair (s) && type_ok; s = scm_cdr (s))
74       type_ok &= ly_is_symbol (scm_car (s));
75
76   SCM_ASSERT_TYPE (type_ok, symlist, SCM_ARG2, __FUNCTION__, "list of symbols");
77
78   if (scm_is_pair (scm_cdr (symlist)))
79     set_nested_property (sc, symlist, val);
80   else
81     ly_grob_set_property_x (grob, scm_car (symlist), val);
82   return SCM_UNSPECIFIED;
83 }
84
85 LY_DEFINE (ly_grob_pure_property, "ly:grob-pure-property",
86            4, 1, 0, (SCM grob, SCM sym, SCM beg, SCM end, SCM val),
87            "Return the pure value for property @var{sym} of @var{grob}."
88            "  If no value is found, return @var{val} or @code{'()}"
89            " if @var{val} is not specified.")
90 {
91   Grob *sc = Grob::unsmob (grob);
92
93   LY_ASSERT_SMOB (Grob, grob, 1);
94   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
95   LY_ASSERT_TYPE (scm_is_integer, beg, 3);
96   LY_ASSERT_TYPE (scm_is_integer, end, 4);
97   if (val == SCM_UNDEFINED)
98     val = SCM_EOL;
99
100   SCM retval = sc->internal_get_pure_property (sym, scm_to_int (beg), scm_to_int (end));
101   if (retval == SCM_EOL)
102     retval = val;
103
104   return retval;
105 }
106
107 LY_DEFINE (ly_grob_pure_height, "ly:grob-pure-height",
108            4, 1, 0, (SCM grob, SCM refp, SCM beg, SCM end, SCM val),
109            "Return the pure height of @var{grob} given refpoint @var{refp}."
110            "  If no value is found, return @var{val} or @code{'()}"
111            " if @var{val} is not specified.")
112 {
113   Grob *sc = Grob::unsmob (grob);
114   Grob *ref = Grob::unsmob (refp);
115
116   LY_ASSERT_SMOB (Grob, grob, 1);
117   LY_ASSERT_SMOB (Grob, refp, 2);
118   LY_ASSERT_TYPE (scm_is_integer, beg, 3);
119   LY_ASSERT_TYPE (scm_is_integer, end, 4);
120   if (val == SCM_UNDEFINED)
121     val = SCM_EOL;
122
123   Interval retval = sc->pure_height (ref, scm_to_int (beg), scm_to_int (end));
124
125   return ly_interval2scm (retval);
126 }
127
128 LY_DEFINE (ly_grob_property, "ly:grob-property",
129            2, 1, 0, (SCM grob, SCM sym, SCM val),
130            "Return the value for property @var{sym} of @var{grob}."
131            "  If no value is found, return @var{val} or @code{'()}"
132            " if @var{val} is not specified.")
133 {
134   Grob *sc = Grob::unsmob (grob);
135
136   LY_ASSERT_SMOB (Grob, grob, 1);
137   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
138   if (val == SCM_UNDEFINED)
139     val = SCM_EOL;
140
141   SCM retval = sc->get_property (sym);
142   if (retval == SCM_EOL)
143     retval = val;
144
145   return retval;
146 }
147
148 LY_DEFINE (ly_grob_interfaces, "ly:grob-interfaces",
149            1, 0, 0, (SCM grob),
150            "Return the interfaces list of grob @var{grob}.")
151 {
152   Grob *sc = Grob::unsmob (grob);
153
154   LY_ASSERT_SMOB (Grob, grob, 1);
155
156   return sc->interfaces ();
157 }
158
159 LY_DEFINE (ly_grob_object, "ly:grob-object",
160            2, 0, 0, (SCM grob, SCM sym),
161            "Return the value of a pointer in grob @var{grob} of property"
162            " @var{sym}.  It returns @code{'()} (end-of-list) if @var{sym}"
163            " is undefined in @var{grob}.")
164 {
165   Grob *sc = Grob::unsmob (grob);
166
167   LY_ASSERT_SMOB (Grob, grob, 1);
168   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
169
170   return sc->internal_get_object (sym);
171 }
172
173 LY_DEFINE (ly_grob_set_object_x, "ly:grob-set-object!",
174            3, 0, 0, (SCM grob, SCM sym, SCM val),
175            "Set @var{sym} in grob @var{grob} to value @var{val}.")
176 {
177   Grob *sc = Grob::unsmob (grob);
178
179   LY_ASSERT_SMOB (Grob, grob, 1);
180   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
181
182   sc->set_object (sym, val);
183   return SCM_UNSPECIFIED;
184 }
185
186 /* TODO: make difference between scaled and unscalead variable in
187    calling (i.e different funcs.) */
188 LY_DEFINE (ly_grob_layout, "ly:grob-layout",
189            1, 0, 0, (SCM grob),
190            "Get @code{\\layout} definition from grob @var{grob}.")
191 {
192   Grob *sc = Grob::unsmob (grob);
193
194   LY_ASSERT_SMOB (Grob, grob, 1);
195
196   return sc->layout ()->self_scm ();
197 }
198
199 LY_DEFINE (ly_grob_alist_chain, "ly:grob-alist-chain",
200            1, 1, 0, (SCM grob, SCM global),
201            "Get an alist chain for grob @var{grob}, with @var{global} as"
202            " the global default.  If unspecified, @code{font-defaults}"
203            " from the layout block is taken.")
204 {
205   Grob *sc = Grob::unsmob (grob);
206
207   LY_ASSERT_SMOB (Grob, grob, 1);
208
209   if (global == SCM_UNDEFINED)
210     {
211       global = sc->layout ()->lookup_variable (ly_symbol2scm ("font-defaults"));
212       if (global == SCM_UNDEFINED)
213         global = SCM_EOL;
214     }
215
216   return sc->get_property_alist_chain (global);
217 }
218
219 LY_DEFINE (ly_grob_extent, "ly:grob-extent",
220            3, 0, 0, (SCM grob, SCM refp, SCM axis),
221            "Get the extent in @var{axis} direction of @var{grob} relative to"
222            " the grob @var{refp}.")
223 {
224   Grob *sc = Grob::unsmob (grob);
225   Grob *ref = Grob::unsmob (refp);
226
227   LY_ASSERT_SMOB (Grob, grob, 1);
228   LY_ASSERT_SMOB (Grob, refp, 2);
229   LY_ASSERT_TYPE (is_axis, axis, 3);
230
231   Axis a = Axis (scm_to_int (axis));
232
233   if (ref->common_refpoint (sc, a) != ref)
234     {
235       // ugh. should use other error message
236       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
237     }
238   return ly_interval2scm (sc->extent (ref, a));
239 }
240
241 LY_DEFINE (ly_grob_robust_relative_extent, "ly:grob-robust-relative-extent",
242            3, 0, 0, (SCM grob, SCM refp, SCM axis),
243            "Get the extent in @var{axis} direction of @var{grob} relative to"
244            " the grob @var{refp}, or @code{(0,0)} if empty.")
245 {
246   Grob *sc = Grob::unsmob (grob);
247   Grob *ref = Grob::unsmob (refp);
248
249   LY_ASSERT_SMOB (Grob, grob, 1);
250   LY_ASSERT_SMOB (Grob, refp, 2);
251   LY_ASSERT_TYPE (is_axis, axis, 3);
252
253   Axis a = Axis (scm_to_int (axis));
254
255   if (ref->common_refpoint (sc, a) != ref)
256     {
257       // ugh. should use other error message
258       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
259     }
260
261   return ly_interval2scm (robust_relative_extent (sc, ref, a));
262 }
263
264 LY_DEFINE (ly_grob_relative_coordinate, "ly:grob-relative-coordinate",
265            3, 0, 0, (SCM grob, SCM refp, SCM axis),
266            "Get the coordinate in @var{axis} direction of @var{grob} relative"
267            " to the grob @var{refp}.")
268 {
269   Grob *sc = Grob::unsmob (grob);
270   Grob *ref = Grob::unsmob (refp);
271
272   LY_ASSERT_SMOB (Grob, grob, 1);
273   LY_ASSERT_SMOB (Grob, refp, 2);
274   LY_ASSERT_TYPE (is_axis, axis, 3);
275
276   Axis a = Axis (scm_to_int (axis));
277
278   if (ref->common_refpoint (sc, a) != ref)
279     {
280       // ugh. should use other error message
281       SCM_ASSERT_TYPE (false, refp, SCM_ARG2, __FUNCTION__, "common refpoint");
282     }
283
284   return scm_from_double (sc->relative_coordinate (ref, a));
285 }
286
287 LY_DEFINE (ly_grob_parent, "ly:grob-parent",
288            2, 0, 0, (SCM grob, SCM axis),
289            "Get the parent of @var{grob}.  @var{axis} is 0 for the X-axis,"
290            " 1@tie{}for the Y-axis.")
291 {
292   Grob *sc = Grob::unsmob (grob);
293
294   LY_ASSERT_SMOB (Grob, grob, 1);
295   LY_ASSERT_TYPE (is_axis, axis, 2);
296
297   Grob *par = sc->get_parent (Axis (scm_to_int (axis)));
298   return par ? par->self_scm () : SCM_EOL;
299 }
300
301 LY_DEFINE (ly_grob_set_parent_x, "ly:grob-set-parent!",
302            3, 0, 0, (SCM grob, SCM axis, SCM parent_grob),
303            "Set @var{parent-grob} the parent of grob @var{grob} in axis @var{axis}.")
304 {
305   Grob *gr = Grob::unsmob (grob);
306   Grob *parent = Grob::unsmob (parent_grob);
307
308   LY_ASSERT_SMOB (Grob, grob, 1);
309   LY_ASSERT_TYPE (is_axis, axis, 2);
310   LY_ASSERT_SMOB (Grob, parent_grob, 3);
311
312   Axis a = Axis (scm_to_int (axis));
313   gr->set_parent (parent, a);
314   return SCM_UNSPECIFIED;
315 }
316
317 LY_DEFINE (ly_grob_properties, "ly:grob-properties",
318            1, 0, 0, (SCM grob),
319            "Get the mutable properties of @var{grob}.")
320 {
321   Grob *g = Grob::unsmob (grob);
322
323   LY_ASSERT_SMOB (Grob, grob, 1);
324
325   /* FIXME: uhg? copy/read only? */
326   return g->mutable_property_alist_;
327 }
328
329 LY_DEFINE (ly_grob_basic_properties, "ly:grob-basic-properties",
330            1, 0, 0, (SCM grob),
331            "Get the immutable properties of @var{grob}.")
332 {
333   Grob *g = Grob::unsmob (grob);
334
335   LY_ASSERT_SMOB (Grob, grob, 1);
336
337   /* FIXME: uhg? copy/read only? */
338   return g->immutable_property_alist_;
339 }
340
341 LY_DEFINE (ly_grob_system, "ly:grob-system",
342            1, 0, 0, (SCM grob),
343            "Return the system grob of @var{grob}.")
344 {
345   Grob *me = Grob::unsmob (grob);
346
347   LY_ASSERT_SMOB (Grob, grob, 1);
348
349   if (System *g = me->get_system ())
350     return g->self_scm ();
351
352   return SCM_EOL;
353 }
354
355 LY_DEFINE (ly_grob_original, "ly:grob-original",
356            1, 0, 0, (SCM grob),
357            "Return the unbroken original grob of @var{grob}.")
358 {
359   Grob *me = Grob::unsmob (grob);
360
361   LY_ASSERT_SMOB (Grob, grob, 1);
362   return me->original () ? me->original ()->self_scm () : me->self_scm ();
363 }
364
365 LY_DEFINE (ly_grob_suicide_x, "ly:grob-suicide!",
366            1, 0, 0, (SCM grob),
367            "Kill @var{grob}.")
368 {
369   Grob *me = Grob::unsmob (grob);
370
371   LY_ASSERT_SMOB (Grob, grob, 1);
372
373   me->suicide ();
374   return SCM_UNSPECIFIED;
375 }
376
377 LY_DEFINE (ly_grob_translate_axis_x, "ly:grob-translate-axis!",
378            3, 0, 0, (SCM grob, SCM d, SCM a),
379            "Translate @var{grob} on axis@tie{}@var{a} over"
380            " distance@tie{}@var{d}.")
381 {
382   Grob *me = Grob::unsmob (grob);
383
384   LY_ASSERT_SMOB (Grob, grob, 1);
385   LY_ASSERT_TYPE (scm_is_number, d, 2);
386   LY_ASSERT_TYPE (is_axis, a, 3);
387
388   me->translate_axis (scm_to_double (d), Axis (scm_to_int (a)));
389   return SCM_UNSPECIFIED;
390 }
391
392 LY_DEFINE (ly_grob_default_font, "ly:grob-default-font",
393            1, 0, 0, (SCM grob),
394            "Return the default font for grob @var{grob}.")
395 {
396   Grob *gr = Grob::unsmob (grob);
397
398   LY_ASSERT_SMOB (Grob, grob, 1);
399
400   return Font_interface::get_default_font (gr)->self_scm ();
401 }
402
403 /*
404   TODO: consider swapping order, so we can do
405
406   (grob-common-refpoint a b c d e)
407  */
408 LY_DEFINE (ly_grob_common_refpoint, "ly:grob-common-refpoint",
409            3, 0, 0, (SCM grob, SCM other, SCM axis),
410            "Find the common refpoint of @var{grob} and @var{other}"
411            " for @var{axis}.")
412 {
413
414   Grob *gr = Grob::unsmob (grob);
415
416   LY_ASSERT_SMOB (Grob, grob, 1);
417   LY_ASSERT_SMOB (Grob, other, 2);
418
419   Grob *o = Grob::unsmob (other);
420
421   LY_ASSERT_TYPE (is_axis, axis, 3);
422
423   Grob *refp = gr->common_refpoint (o, Axis (scm_to_int (axis)));
424   return refp ? refp->self_scm () : SCM_BOOL_F;
425 }
426
427 LY_DEFINE (ly_grob_common_refpoint_of_array, "ly:grob-common-refpoint-of-array",
428            3, 0, 0, (SCM grob, SCM others, SCM axis),
429            "Find the common refpoint of @var{grob} and @var{others}"
430            " (a grob-array) for @var{axis}.")
431 {
432   Grob *gr = Grob::unsmob (grob);
433
434   LY_ASSERT_SMOB (Grob, grob, 1);
435   LY_ASSERT_SMOB (Grob_array, others, 2);
436
437   Grob_array *ga = Grob_array::unsmob (others);
438   LY_ASSERT_TYPE (is_axis, axis, 3);
439
440   Grob *refp = common_refpoint_of_array (ga->array (), gr, Axis (scm_to_int (axis)));
441   return refp ? refp->self_scm () : SCM_BOOL_F;
442 }
443
444 LY_DEFINE (ly_grob_chain_callback, "ly:grob-chain-callback",
445            3, 0, 0, (SCM grob, SCM proc, SCM sym),
446            "Find the callback that is stored as property"
447            " @var{sym} of grob @var{grob} and chain @var{proc}"
448            " to the head of this, meaning that it is called"
449            " using @var{grob} and the previous callback's result.")
450 {
451   Grob *gr = Grob::unsmob (grob);
452
453   LY_ASSERT_SMOB (Grob, grob, 1);
454   SCM_ASSERT_TYPE (ly_is_procedure (proc) || Unpure_pure_container::is_smob (proc), proc, SCM_ARG2, __FUNCTION__, "procedure or unpure pure container");
455   LY_ASSERT_TYPE (ly_is_symbol, sym, 3);
456
457   chain_callback (gr, proc, sym);
458   return SCM_UNSPECIFIED;
459 }
460
461 LY_DEFINE (ly_grob_vertical_less_p, "ly:grob-vertical<?",
462            2, 0, 0, (SCM a, SCM b),
463            "Does @var{a} lie above @var{b} on the page?")
464 {
465   LY_ASSERT_SMOB (Grob, a, 1);
466   LY_ASSERT_SMOB (Grob, b, 2);
467
468   Grob *ga = Grob::unsmob (a);
469   Grob *gb = Grob::unsmob (b);
470
471   return ly_bool2scm (Grob::vertical_less (ga, gb));
472 }
473
474 LY_DEFINE (ly_grob_get_vertical_axis_group_index, "ly:grob-get-vertical-axis-group-index",
475            1, 0, 0, (SCM grob),
476            "Get the index of the vertical axis group the grob @var{grob} belongs to;"
477            " return @code{-1} if none is found.")
478 {
479   Grob *gr = Grob::unsmob (grob);
480
481   LY_ASSERT_SMOB (Grob, grob, 1);
482
483   return scm_from_int (Grob::get_vertical_axis_group_index (gr));
484 }