2 grob-scheme.cc -- Scheme entry points for the grob datatype
4 source file of the GNU LilyPond music typesetter
6 (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
7 Han-Wen Nienhuys <hanwen@xs4all.nl>
10 #include "warn.hh" // error ()
12 #include "output-def.hh"
14 #include "font-interface.hh"
15 #include "paper-score.hh"
16 #include "grob-array.hh"
18 LY_DEFINE (ly_grob_property_data
, "ly:grob-property-data",
19 2, 0, 0, (SCM grob
, SCM sym
),
20 "Return the value for property @var{sym} of @var{grob},"
21 " but do not process callbacks.")
23 Grob
*sc
= unsmob_grob (grob
);
25 LY_ASSERT_SMOB (Grob
, grob
, 1);
26 LY_ASSERT_TYPE (ly_is_symbol
, sym
, 2);
28 return sc
->get_property_data (sym
);
31 LY_DEFINE (ly_grob_set_property_x
, "ly:grob-set-property!",
32 3, 0, 0, (SCM grob
, SCM sym
, SCM val
),
33 "Set @var{sym} in grob @var{grob} to value @var{val}.")
35 Grob
*sc
= unsmob_grob (grob
);
37 LY_ASSERT_SMOB (Grob
, grob
, 1);
38 LY_ASSERT_TYPE (ly_is_symbol
, sym
, 2);
40 if (!ly_is_procedure (val
)
41 && !type_check_assignment (sym
, val
, ly_symbol2scm ("backend-type?")))
42 error ("typecheck failed");
44 sc
->set_property (sym
, val
);
45 return SCM_UNSPECIFIED
;
48 LY_DEFINE (ly_grob_property
, "ly:grob-property",
49 2, 1, 0, (SCM grob
, SCM sym
, SCM val
),
50 "Return the value for property @var{sym} of @var{grob}."
51 " If no value is found, return @var{val} or @code{'()}"
52 " if @var{val} is not specified.")
54 Grob
*sc
= unsmob_grob (grob
);
56 LY_ASSERT_SMOB (Grob
, grob
, 1);
57 LY_ASSERT_TYPE (ly_is_symbol
, sym
, 2);
58 if (val
== SCM_UNDEFINED
)
61 SCM retval
= sc
->internal_get_property (sym
);
62 if (retval
== SCM_EOL
)
69 LY_DEFINE (ly_grob_interfaces
, "ly:grob-interfaces",
71 "Return the interfaces list of grob @var{grob}.")
73 Grob
*sc
= unsmob_grob (grob
);
75 LY_ASSERT_SMOB (Grob
, grob
, 1);
77 return sc
->interfaces ();
80 LY_DEFINE (ly_grob_object
, "ly:grob-object",
81 2, 0, 0, (SCM grob
, SCM sym
),
82 "Return the value of a pointer in grob@tie{}@var{g} of property"
83 " @var{sym}. It returns @code{'()} (end-of-list) if @var{sym}"
84 " is undefined in@tie{}@var{g}.")
86 Grob
*sc
= unsmob_grob (grob
);
88 LY_ASSERT_SMOB (Grob
, grob
, 1);
89 LY_ASSERT_TYPE (ly_is_symbol
, sym
, 2);
91 return sc
->internal_get_object (sym
);
96 /* TODO: make difference between scaled and unscalead variable in
97 calling (i.e different funcs.) */
98 LY_DEFINE (ly_grob_layout
, "ly:grob-layout",
100 "Get @code{\\layout} definition from grob @var{grob}.")
102 Grob
*sc
= unsmob_grob (grob
);
104 LY_ASSERT_SMOB (Grob
, grob
, 1);
106 return sc
->layout ()->self_scm ();
109 LY_DEFINE (ly_grob_alist_chain
, "ly:grob-alist-chain",
110 1, 1, 0, (SCM grob
, SCM global
),
111 "Get an alist chain for grob @var{grob}, with @var{global} as"
112 " the global default. If unspecified, @code{font-defaults}"
113 " from the layout block is taken.")
115 Grob
*sc
= unsmob_grob (grob
);
117 LY_ASSERT_SMOB (Grob
, grob
, 1);
119 if (global
== SCM_UNDEFINED
)
121 global
= sc
->layout ()->lookup_variable (ly_symbol2scm ("font-defaults"));
122 if (global
== SCM_UNDEFINED
)
126 return sc
->get_property_alist_chain (global
);
129 LY_DEFINE (ly_grob_extent
, "ly:grob-extent",
130 3, 0, 0, (SCM grob
, SCM refp
, SCM axis
),
131 "Get the extent in @var{axis} direction of @var{grob} relative to"
132 " the grob @var{refp}.")
134 Grob
*sc
= unsmob_grob (grob
);
135 Grob
*ref
= unsmob_grob (refp
);
138 LY_ASSERT_SMOB (Grob
, grob
, 1);
139 LY_ASSERT_SMOB (Grob
, refp
, 2);
140 LY_ASSERT_TYPE (is_axis
, axis
, 3);
142 Axis a
= Axis (scm_to_int (axis
));
145 if (ref
->common_refpoint (sc
, a
) != ref
)
147 // ugh. should use other error message
148 SCM_ASSERT_TYPE (false, refp
, SCM_ARG2
, __FUNCTION__
, "common refpoint");
150 return ly_interval2scm (sc
->extent (ref
, a
));
153 LY_DEFINE (ly_grob_robust_relative_extent
, "ly:grob-robust-relative-extent",
154 3, 0, 0, (SCM grob
, SCM refp
, SCM axis
),
155 "Get the extent in @var{axis} direction of @var{grob} relative to"
156 " the grob @var{refp}, or @code{(0,0)} if empty.")
158 Grob
*sc
= unsmob_grob (grob
);
159 Grob
*ref
= unsmob_grob (refp
);
162 LY_ASSERT_SMOB (Grob
, grob
, 1);
163 LY_ASSERT_SMOB (Grob
, refp
, 2);
164 LY_ASSERT_TYPE (is_axis
, axis
, 3);
166 Axis a
= Axis (scm_to_int (axis
));
168 if (ref
->common_refpoint (sc
, a
) != ref
)
170 // ugh. should use other error message
171 SCM_ASSERT_TYPE (false, refp
, SCM_ARG2
, __FUNCTION__
, "common refpoint");
174 return ly_interval2scm (robust_relative_extent (sc
, ref
, a
));
177 LY_DEFINE (ly_grob_relative_coordinate
, "ly:grob-relative-coordinate",
178 3, 0, 0, (SCM grob
, SCM refp
, SCM axis
),
179 "Get the coordinate in @var{axis} direction of @var{grob} relative"
180 " to the grob @var{refp}.")
182 Grob
*sc
= unsmob_grob (grob
);
183 Grob
*ref
= unsmob_grob (refp
);
186 LY_ASSERT_SMOB (Grob
, grob
, 1);
187 LY_ASSERT_SMOB (Grob
, refp
, 2);
188 LY_ASSERT_TYPE (is_axis
, axis
, 3);
190 Axis a
= Axis (scm_to_int (axis
));
193 if (ref
->common_refpoint (sc
, a
) != ref
)
195 // ugh. should use other error message
196 SCM_ASSERT_TYPE (false, refp
, SCM_ARG2
, __FUNCTION__
, "common refpoint");
199 return scm_from_double (sc
->relative_coordinate (ref
, a
));
203 LY_DEFINE (ly_grob_parent
, "ly:grob-parent",
204 2, 0, 0, (SCM grob
, SCM axis
),
205 "Get the parent of @var{grob}. @var{axis} is 0 for the X-axis,"
206 " 1@tie{}for the Y-axis.")
208 Grob
*sc
= unsmob_grob (grob
);
210 LY_ASSERT_SMOB (Grob
, grob
, 1);
211 LY_ASSERT_TYPE (is_axis
, axis
, 2);
213 Grob
*par
= sc
->get_parent (Axis (scm_to_int (axis
)));
214 return par
? par
->self_scm () : SCM_EOL
;
217 LY_DEFINE (ly_grob_properties
, "ly:grob-properties",
219 "Get the mutable properties of @var{grob}.")
221 Grob
*g
= unsmob_grob (grob
);
223 LY_ASSERT_SMOB (Grob
, grob
, 1);
225 /* FIXME: uhg? copy/read only? */
226 return g
->mutable_property_alist_
;
229 LY_DEFINE (ly_grob_basic_properties
, "ly:grob-basic-properties",
231 "Get the immutable properties of @var{grob}.")
233 Grob
*g
= unsmob_grob (grob
);
235 LY_ASSERT_SMOB (Grob
, grob
, 1);
237 /* FIXME: uhg? copy/read only? */
238 return g
->immutable_property_alist_
;
241 LY_DEFINE (ly_grob_system
, "ly:grob-system",
243 "Return the system grob of @var{grob}.")
245 Grob
*me
= unsmob_grob (grob
);
247 LY_ASSERT_SMOB (Grob
, grob
, 1);
249 if (System
*g
= me
->get_system ())
250 return g
->self_scm ();
255 LY_DEFINE (ly_grob_original
, "ly:grob-original",
257 "Return the unbroken original grob of @var{grob}.")
259 Grob
*me
= unsmob_grob (grob
);
261 LY_ASSERT_SMOB (Grob
, grob
, 1);
262 return me
->original () ? me
->original ()->self_scm () : me
->self_scm ();
266 LY_DEFINE (ly_grob_suicide_x
, "ly:grob-suicide!",
270 Grob
*me
= unsmob_grob (grob
);
272 LY_ASSERT_SMOB (Grob
, grob
, 1);
275 return SCM_UNSPECIFIED
;
278 LY_DEFINE (ly_grob_translate_axis_x
, "ly:grob-translate-axis!",
279 3, 0, 0, (SCM grob
, SCM d
, SCM a
),
280 "Translate @var{g} on axis@tie{}@var{a} over"
281 " distance@tie{}@var{d}.")
283 Grob
*me
= unsmob_grob (grob
);
285 LY_ASSERT_SMOB (Grob
, grob
, 1);
286 LY_ASSERT_TYPE (scm_is_number
, d
, 2);
287 LY_ASSERT_TYPE (is_axis
, a
, 3);
289 me
->translate_axis (scm_to_double (d
), Axis (scm_to_int (a
)));
290 return SCM_UNSPECIFIED
;
293 LY_DEFINE (ly_grob_default_font
, "ly:grob-default-font",
295 "Return the default font for grob @var{gr}.")
297 Grob
*gr
= unsmob_grob (grob
);
299 LY_ASSERT_SMOB (Grob
, grob
, 1);
301 return Font_interface::get_default_font (gr
)->self_scm ();
306 TODO: consider swapping order, so we can do
308 (grob-common-refpoint a b c d e)
310 LY_DEFINE (ly_grob_common_refpoint
, "ly:grob-common-refpoint",
311 3, 0, 0, (SCM grob
, SCM other
, SCM axis
),
312 "Find the common refpoint of @var{grob} and @var{other}"
316 Grob
*gr
= unsmob_grob (grob
);
318 LY_ASSERT_SMOB (Grob
, grob
, 1);
319 LY_ASSERT_SMOB (Grob
, other
, 2);
321 Grob
*o
= unsmob_grob (other
);
323 LY_ASSERT_TYPE (is_axis
, axis
, 3);
325 Grob
*refp
= gr
->common_refpoint (o
, Axis (scm_to_int (axis
)));
326 return refp
? refp
->self_scm () : SCM_BOOL_F
;
329 LY_DEFINE (ly_grob_common_refpoint_of_array
, "ly:grob-common-refpoint-of-array",
330 3, 0, 0, (SCM grob
, SCM others
, SCM axis
),
331 "Find the common refpoint of @var{grob} and @var{others}"
332 " (a grob-array) for @var{axis}.")
334 Grob
*gr
= unsmob_grob (grob
);
336 LY_ASSERT_SMOB (Grob
, grob
, 1);
337 LY_ASSERT_SMOB (Grob_array
, others
, 2);
339 Grob_array
*ga
= unsmob_grob_array (others
);
340 LY_ASSERT_TYPE (is_axis
, axis
, 3);
342 Grob
*refp
= common_refpoint_of_array (ga
->array (), gr
, Axis (scm_to_int (axis
)));
343 return refp
? refp
->self_scm () : SCM_BOOL_F
;