2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 1997--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 LilyPond is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 LilyPond is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
21 #include "font-metric.hh"
22 #include "libc-extension.hh"
27 TODO: naming add/combine.
30 LY_DEFINE (ly_stencil_translate_axis
, "ly:stencil-translate-axis",
31 3, 0, 0, (SCM stil
, SCM amount
, SCM axis
),
32 "Return a copy of @var{stil} but translated by @var{amount}"
33 " in @var{axis} direction.")
35 Stencil
*s
= unsmob_stencil (stil
);
36 LY_ASSERT_SMOB (Stencil
, stil
, 1);
37 LY_ASSERT_TYPE (scm_is_number
, amount
, 2);
38 LY_ASSERT_TYPE (is_axis
, axis
, 3);
40 Real real_amount
= scm_to_double (amount
);
42 SCM new_s
= s
->smobbed_copy ();
43 Stencil
*q
= unsmob_stencil (new_s
);
44 q
->translate_axis (real_amount
, Axis (scm_to_int (axis
)));
48 LY_DEFINE (ly_stencil_translate
, "ly:stencil-translate",
49 2, 0, 0, (SCM stil
, SCM offset
),
50 "Return a @var{stil}, but translated by @var{offset}"
51 " (a pair of numbers).")
53 Stencil
*s
= unsmob_stencil (stil
);
54 LY_ASSERT_SMOB (Stencil
, stil
, 1);
55 LY_ASSERT_TYPE (is_number_pair
, offset
, 2);
56 Offset o
= ly_scm2offset (offset
);
58 SCM new_s
= s
->smobbed_copy ();
59 Stencil
*q
= unsmob_stencil (new_s
);
64 LY_DEFINE (ly_stencil_expr
, "ly:stencil-expr",
66 "Return the expression of @var{stil}.")
68 Stencil
*s
= unsmob_stencil (stil
);
69 LY_ASSERT_SMOB (Stencil
, stil
, 1);
73 LY_DEFINE (ly_stencil_extent
, "ly:stencil-extent",
74 2, 0, 0, (SCM stil
, SCM axis
),
75 "Return a pair of numbers signifying the extent of @var{stil} in"
76 " @var{axis} direction (@code{0} or @code{1} for x and"
77 " y@tie{}axis, respectively).")
79 Stencil
*s
= unsmob_stencil (stil
);
80 LY_ASSERT_SMOB (Stencil
, stil
, 1);
81 LY_ASSERT_TYPE (is_axis
, axis
, 2);
83 return ly_interval2scm (s
->extent (Axis (scm_to_int (axis
))));
86 LY_DEFINE (ly_stencil_empty_p
, "ly:stencil-empty?",
88 "Return whether @var{stil} is empty.")
90 Stencil
*s
= unsmob_stencil (stil
);
91 LY_ASSERT_SMOB (Stencil
, stil
, 1);
92 return scm_from_bool (s
->is_empty ());
95 LY_DEFINE (ly_stencil_combine_at_edge
, "ly:stencil-combine-at-edge",
96 4, 2, 0, (SCM first
, SCM axis
, SCM direction
,
100 "Construct a stencil by putting @var{second} next to @var{first}."
101 " @var{axis} can be 0 (x-axis) or@tie{}1 (y-axis)."
102 " @var{direction} can be -1 (left or down) or@tie{}1 (right or"
103 " up). The stencils are juxtaposed with @var{padding} as extra"
104 " space. If this puts the reference points closer than"
105 " @var{minimum}, they are moved by the latter amount."
106 " @var{first} and @var{second} may also be @code{'()} or"
109 Stencil
*s1
= unsmob_stencil (first
);
110 Stencil
*s2
= unsmob_stencil (second
);
113 SCM_ASSERT_TYPE (s1
|| first
== SCM_BOOL_F
|| first
== SCM_EOL
,
114 first
, SCM_ARG1
, __FUNCTION__
, "Stencil, #f or ()");
115 SCM_ASSERT_TYPE (s2
|| second
== SCM_BOOL_F
|| second
== SCM_EOL
,
116 second
, SCM_ARG4
, __FUNCTION__
, "Stencil, #f or ()");
117 LY_ASSERT_TYPE (is_axis
, axis
, 2);
118 LY_ASSERT_TYPE (is_direction
, direction
, 3);
121 if (padding
!= SCM_UNDEFINED
)
123 LY_ASSERT_TYPE (scm_is_number
, padding
, 5);
124 p
= scm_to_double (padding
);
127 if (minimum
!= SCM_UNDEFINED
)
129 LY_ASSERT_TYPE (scm_is_number
, minimum
, 6);
130 m
= scm_to_double (minimum
);
137 result
.add_at_edge (Axis (scm_to_int (axis
)),
138 Direction (scm_to_int (direction
)), *s2
, p
);
140 return result
.smobbed_copy ();
143 LY_DEFINE (ly_stencil_add
, "ly:stencil-add",
145 "Combine stencils. Takes any number of arguments.")
147 #define FUNC_NAME __FUNCTION__
148 SCM_VALIDATE_REST_ARGUMENT (args
);
155 while (!SCM_NULLP (args
))
157 Stencil
*s
= unsmob_stencil (scm_car (args
));
159 SCM_ASSERT_TYPE (s
, scm_car (args
), SCM_ARGn
, __FUNCTION__
, "Stencil");
161 extent
.unite (s
->extent_box ());
162 *tail
= scm_cons (s
->expr (), SCM_EOL
);
163 tail
= SCM_CDRLOC (*tail
);
164 args
= scm_cdr (args
);
167 expr
= scm_cons (ly_symbol2scm ("combine-stencil"), expr
);
168 return Stencil (extent
, expr
).smobbed_copy ();
171 LY_DEFINE (ly_make_stencil
, "ly:make-stencil",
172 1, 2, 0, (SCM expr
, SCM xext
, SCM yext
),
173 "Stencils are device independent output expressions."
174 " They carry two pieces of information:\n"
178 "A specification of how to print this object."
179 " This specification is processed by the output backends,"
180 " for example @file{scm/output-ps.scm}.\n"
183 "The vertical and horizontal extents of the object, given as"
184 " pairs. If an extent is unspecified (or if you use"
185 " @code{(1000 . -1000)} as its value), it is taken to be empty.\n"
188 SCM_ASSERT_TYPE (!scm_is_pair (expr
)
189 || is_stencil_head (scm_car (expr
)),
190 expr
, SCM_ARG1
, __FUNCTION__
, "registered stencil expression");
194 if (xext
!= SCM_UNDEFINED
)
196 LY_ASSERT_TYPE (is_number_pair
, xext
, 2);
197 x
= ly_scm2interval (xext
);
201 if (yext
!= SCM_UNDEFINED
)
203 LY_ASSERT_TYPE (is_number_pair
, yext
, 3);
204 y
= ly_scm2interval (yext
);
209 return s
.smobbed_copy ();
212 LY_DEFINE (ly_stencil_aligned_to
, "ly:stencil-aligned-to",
213 3, 0, 0, (SCM stil
, SCM axis
, SCM dir
),
214 "Align @var{stil} using its own extents. @var{dir} is a number."
215 " @code{-1} and @code{1} are left and right, respectively."
216 " Other values are interpolated (so @code{0} means the center).")
218 LY_ASSERT_SMOB (Stencil
, stil
, 1);
219 LY_ASSERT_TYPE (is_axis
, axis
, 2);
220 LY_ASSERT_TYPE (scm_is_number
, dir
, 3);
222 Stencil target
= *unsmob_stencil (stil
);
224 target
.align_to ((Axis
)scm_to_int (axis
),
225 scm_to_double (dir
));
226 return target
.smobbed_copy ();
229 LY_DEFINE (ly_stencil_fonts
, "ly:stencil-fonts",
231 "Analyze @var{s}, and return a list of fonts used"
234 LY_ASSERT_SMOB (Stencil
, s
, 1);
235 Stencil
*stil
= unsmob_stencil (s
);
236 return find_expression_fonts (stil
->expr ());
239 LY_DEFINE (ly_stencil_in_color
, "ly:stencil-in-color",
240 4, 0, 0, (SCM stc
, SCM r
, SCM g
, SCM b
),
241 "Put @var{stc} in a different color.")
243 LY_ASSERT_SMOB (Stencil
, stc
, 1);
244 Stencil
*stil
= unsmob_stencil (stc
);
245 return Stencil (stil
->extent_box (),
246 scm_list_3 (ly_symbol2scm ("color"),
247 scm_list_3 (r
, g
, b
),
248 stil
->expr ())).smobbed_copy ();
251 struct Stencil_interpret_arguments
257 void stencil_interpret_in_scm (void *p
, SCM expr
)
259 Stencil_interpret_arguments
*ap
= (Stencil_interpret_arguments
*) p
;
260 scm_call_2 (ap
->func
, ap
->arg1
, expr
);
263 LY_DEFINE (ly_interpret_stencil_expression
, "ly:interpret-stencil-expression",
264 4, 0, 0, (SCM expr
, SCM func
, SCM arg1
, SCM offset
),
265 "Parse @var{expr}, feed bits to @var{func} with first arg"
266 " @var{arg1} having offset @var{offset}.")
268 LY_ASSERT_TYPE (ly_is_procedure
, func
, 2);
270 Stencil_interpret_arguments a
;
273 Offset o
= ly_scm2offset (offset
);
275 interpret_stencil_expression (expr
, stencil_interpret_in_scm
, (void *) & a
, o
);
277 return SCM_UNSPECIFIED
;
280 LY_DEFINE (ly_bracket
, "ly:bracket",
282 (SCM a
, SCM iv
, SCM t
, SCM p
),
283 "Make a bracket in direction@tie{}@var{a}. The extent of the"
284 " bracket is given by @var{iv}. The wings protrude by an amount"
285 " of@tie{}@var{p}, which may be negative. The thickness is given"
288 LY_ASSERT_TYPE (is_axis
, a
, 1);
289 LY_ASSERT_TYPE (is_number_pair
, iv
, 2);
290 LY_ASSERT_TYPE (scm_is_number
, t
, 3);
291 LY_ASSERT_TYPE (scm_is_number
, p
, 4);
293 return Lookup::bracket ((Axis
)scm_to_int (a
), ly_scm2interval (iv
),
296 0.95 * scm_to_double (t
)).smobbed_copy ();
299 LY_DEFINE (ly_stencil_rotate
, "ly:stencil-rotate",
300 4, 0, 0, (SCM stil
, SCM angle
, SCM x
, SCM y
),
301 "Return a stencil @var{stil} rotated @var{angle} degrees around"
302 " the relative offset (@var{x}, @var{y}). E.g. an offset of"
303 " (-1, 1) will rotate the stencil around the left upper corner.")
305 Stencil
*s
= unsmob_stencil (stil
);
306 LY_ASSERT_SMOB (Stencil
, stil
, 1);
307 LY_ASSERT_TYPE (scm_is_number
, angle
, 2);
308 LY_ASSERT_TYPE (scm_is_number
, x
, 3);
309 LY_ASSERT_TYPE (scm_is_number
, y
, 4);
310 Real a
= scm_to_double (angle
);
311 Real x_off
= scm_to_double (x
);
312 Real y_off
= scm_to_double (y
);
314 SCM new_s
= s
->smobbed_copy ();
315 Stencil
*q
= unsmob_stencil (new_s
);
316 q
->rotate_degrees (a
, Offset (x_off
, y_off
));
320 LY_DEFINE (ly_stencil_rotate_absolute
, "ly:stencil-rotate-absolute",
321 4, 0, 0, (SCM stil
, SCM angle
, SCM x
, SCM y
),
322 "Return a stencil @var{stil} rotated @var{angle} degrees around"
323 " point (@var{x}, @var{y}), given in absolute coordinates.")
325 Stencil
*s
= unsmob_stencil (stil
);
326 LY_ASSERT_SMOB (Stencil
, stil
, 1);
327 LY_ASSERT_TYPE (scm_is_number
, angle
, 2);
328 LY_ASSERT_TYPE (scm_is_number
, x
, 3);
329 LY_ASSERT_TYPE (scm_is_number
, y
, 4);
330 Real a
= scm_to_double (angle
);
331 Real x_off
= scm_to_double (x
);
332 Real y_off
= scm_to_double (y
);
334 SCM new_s
= s
->smobbed_copy ();
335 Stencil
*q
= unsmob_stencil (new_s
);
336 q
->rotate_degrees_absolute (a
, Offset (x_off
, y_off
));
340 LY_DEFINE (ly_round_filled_box
, "ly:round-filled-box",
342 (SCM xext
, SCM yext
, SCM blot
),
343 "Make a @code{Stencil} object that prints a black box of"
344 " dimensions @var{xext}, @var{yext} and roundness @var{blot}.")
346 LY_ASSERT_TYPE (is_number_pair
, xext
, 1);
347 LY_ASSERT_TYPE (is_number_pair
, yext
, 2);
348 LY_ASSERT_TYPE (scm_is_number
, blot
, 3);
350 return Lookup::round_filled_box (Box (ly_scm2interval (xext
), ly_scm2interval (yext
)),
351 scm_to_double (blot
)).smobbed_copy ();
354 LY_DEFINE (ly_round_filled_polygon
, "ly:round-filled-polygon",
356 (SCM points
, SCM blot
),
357 "Make a @code{Stencil} object that prints a black polygon with"
358 " corners at the points defined by @var{points} (list of coordinate"
359 " pairs) and roundness @var{blot}.")
361 SCM_ASSERT_TYPE (scm_ilength (points
) > 0, points
, SCM_ARG1
, __FUNCTION__
, "list of coordinate pairs");
362 LY_ASSERT_TYPE (scm_is_number
, blot
, 2);
364 for (SCM p
= points
; scm_is_pair (p
); p
= scm_cdr (p
))
366 SCM scm_pt
= scm_car (p
);
367 if (scm_is_pair (scm_pt
)) {
368 pts
.push_back (ly_scm2offset (scm_pt
));
370 // TODO: Print out warning
373 return Lookup::round_filled_polygon (pts
, scm_to_double (blot
)).smobbed_copy ();
376 LY_DEFINE (ly_register_stencil_expression
, "ly:register-stencil-expression",
379 "Add @var{symbol} as head of a stencil expression.")
381 LY_ASSERT_TYPE (ly_is_symbol
, symbol
, 1);
382 register_stencil_head (symbol
);
383 return SCM_UNSPECIFIED
;
386 LY_DEFINE (ly_all_stencil_expressions
, "ly:all-stencil-expressions",
389 "Return all symbols recognized as stencil expressions.")
391 return all_stencil_heads ();
394 LY_DEFINE (ly_stencil_scale
, "ly:stencil-scale",
395 3, 0, 0, (SCM stil
, SCM x
, SCM y
),
396 "Scale @var{stil} using the horizontal and vertical scaling"
397 " factors @var{x} and @var{y}.")
399 Stencil
*s
= unsmob_stencil (stil
);
400 LY_ASSERT_SMOB (Stencil
, stil
, 1);
401 LY_ASSERT_TYPE (scm_is_number
, x
, 2);
402 LY_ASSERT_TYPE (scm_is_number
, y
, 3);
404 SCM new_s
= s
->smobbed_copy ();
405 Stencil
*q
= unsmob_stencil (new_s
);
407 q
->scale (scm_to_double (x
), scm_to_double (y
));