]> git.donarmstrong.com Git - lilypond.git/blob - lily/stencil-scheme.cc
Release: bump VERSION_DEVEL.
[lilypond.git] / lily / stencil-scheme.cc
1 /*
2   This file is part of LilyPond, the GNU music typesetter.
3
4   Copyright (C) 1997--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
5
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.
10
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.
15
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/>.
18 */
19
20 #include "font-metric.hh"
21 #include "libc-extension.hh"
22 #include "lookup.hh"
23 #include "stencil.hh"
24
25 /*
26   TODO: naming add/combine.
27 */
28
29 LY_DEFINE (ly_stencil_translate_axis, "ly:stencil-translate-axis",
30            3, 0, 0, (SCM stil, SCM amount, SCM axis),
31            "Return a copy of @var{stil} but translated by @var{amount}"
32            " in @var{axis} direction.")
33 {
34   Stencil *s = Stencil::unsmob (stil);
35   LY_ASSERT_SMOB (Stencil, stil, 1);
36   LY_ASSERT_TYPE (scm_is_number, amount, 2);
37
38   LY_ASSERT_TYPE (is_axis, axis, 3);
39
40   Real real_amount = scm_to_double (amount);
41
42   SCM new_s = s->smobbed_copy ();
43   scm_remember_upto_here_1 (stil);
44
45   Stencil *q = Stencil::unsmob (new_s);
46   q->translate_axis (real_amount, Axis (scm_to_int (axis)));
47   return new_s;
48 }
49
50 LY_DEFINE (ly_stencil_translate, "ly:stencil-translate",
51            2, 0, 0, (SCM stil, SCM offset),
52            "Return a @var{stil}, but translated by @var{offset}"
53            " (a pair of numbers).")
54 {
55   Stencil *s = Stencil::unsmob (stil);
56   LY_ASSERT_SMOB (Stencil, stil, 1);
57   LY_ASSERT_TYPE (is_number_pair, offset, 2);
58   Offset o = ly_scm2offset (offset);
59
60   SCM new_s = s->smobbed_copy ();
61   scm_remember_upto_here_1 (stil);
62
63   Stencil *q = Stencil::unsmob (new_s);
64   q->translate (o);
65   return new_s;
66 }
67
68 LY_DEFINE (ly_stencil_expr, "ly:stencil-expr",
69            1, 0, 0, (SCM stil),
70            "Return the expression of @var{stil}.")
71 {
72   Stencil *s = Stencil::unsmob (stil);
73   LY_ASSERT_SMOB (Stencil, stil, 1);
74   return s->expr ();
75 }
76
77 LY_DEFINE (ly_stencil_extent, "ly:stencil-extent",
78            2, 0, 0, (SCM stil, SCM axis),
79            "Return a pair of numbers signifying the extent of @var{stil} in"
80            " @var{axis} direction (@code{0} or @code{1} for x and"
81            " y@tie{}axis, respectively).")
82 {
83   Stencil *s = Stencil::unsmob (stil);
84   LY_ASSERT_SMOB (Stencil, stil, 1);
85   LY_ASSERT_TYPE (is_axis, axis, 2);
86
87   return ly_interval2scm (s->extent (Axis (scm_to_int (axis))));
88 }
89
90 LY_DEFINE (ly_stencil_empty_p, "ly:stencil-empty?",
91            1, 1, 0, (SCM stil, SCM axis),
92            "Return whether @var{stil} is empty.  If an optional"
93            " @var{axis} is supplied, the emptiness check is"
94            " restricted to that axis.")
95 {
96   Stencil *s = Stencil::unsmob (stil);
97   LY_ASSERT_SMOB (Stencil, stil, 1);
98   if (SCM_UNBNDP (axis))
99     return scm_from_bool (s->is_empty ());
100   LY_ASSERT_TYPE (is_axis, axis, 2);
101   return scm_from_bool (s->is_empty (Axis (scm_to_int (axis))));
102 }
103
104 LY_DEFINE (ly_stencil_combine_at_edge, "ly:stencil-combine-at-edge",
105            4, 1, 0, (SCM first, SCM axis, SCM direction,
106                      SCM second,
107                      SCM padding),
108            "Construct a stencil by putting @var{second} next to @var{first}."
109            "  @var{axis} can be 0 (x-axis) or@tie{}1 (y-axis)."
110            "  @var{direction} can be -1 (left or down) or@tie{}1 (right or"
111            " up).  The stencils are juxtaposed with @var{padding} as extra"
112            " space.  @var{first} and @var{second} may also be @code{'()} or"
113            " @code{#f}.")
114 {
115   Stencil *s1 = Stencil::unsmob (first);
116   Stencil *s2 = Stencil::unsmob (second);
117   Stencil result;
118
119   SCM_ASSERT_TYPE (s1 || first == SCM_BOOL_F || first == SCM_EOL,
120                    first, SCM_ARG1, __FUNCTION__, "Stencil, #f or ()");
121   SCM_ASSERT_TYPE (s2 || second == SCM_BOOL_F || second == SCM_EOL,
122                    second, SCM_ARG4, __FUNCTION__, "Stencil, #f or ()");
123   LY_ASSERT_TYPE (is_axis, axis, 2);
124   LY_ASSERT_TYPE (is_direction, direction, 3);
125
126   Real p = 0.0;
127   if (padding != SCM_UNDEFINED)
128     {
129       LY_ASSERT_TYPE (scm_is_number, padding, 5);
130       p = scm_to_double (padding);
131     }
132
133   if (s1)
134     result = *s1;
135
136   if (s2)
137     result.add_at_edge (Axis (scm_to_int (axis)),
138                         Direction (scm_to_int (direction)), *s2, p);
139
140   scm_remember_upto_here_2 (first, second);
141
142   return result.smobbed_copy ();
143 }
144
145 LY_DEFINE (ly_stencil_stack, "ly:stencil-stack",
146            4, 2, 0, (SCM first, SCM axis, SCM direction,
147                      SCM second,
148                      SCM padding,
149                      SCM mindist),
150            "Construct a stencil by stacking @var{second} next to @var{first}."
151            "  @var{axis} can be 0 (x-axis) or@tie{}1 (y-axis)."
152            "  @var{direction} can be -1 (left or down) or@tie{}1 (right or"
153            " up).  The stencils are juxtaposed with @var{padding} as extra"
154            " space.  @var{first} and @var{second} may also be @code{'()} or"
155            " @code{#f}.  As opposed to @code{ly:stencil-combine-at-edge},"
156            " metrics are suited for successively accumulating lines of"
157            " stencils.  Also, @var{second} stencil is drawn last.\n\n"
158            "If @var{mindist} is specified, reference points are placed"
159            " apart at least by this distance.  If either of the stencils"
160            " is spacing, @var{padding} and @var{mindist} do not apply.")
161 {
162   Stencil *s1 = Stencil::unsmob (first);
163   Stencil *s2 = Stencil::unsmob (second);
164   Stencil result;
165
166   SCM_ASSERT_TYPE (s1 || first == SCM_BOOL_F || first == SCM_EOL,
167                    first, SCM_ARG1, __FUNCTION__, "Stencil, #f or ()");
168   SCM_ASSERT_TYPE (s2 || second == SCM_BOOL_F || second == SCM_EOL,
169                    second, SCM_ARG4, __FUNCTION__, "Stencil, #f or ()");
170   LY_ASSERT_TYPE (is_axis, axis, 2);
171   LY_ASSERT_TYPE (is_direction, direction, 3);
172
173   Real p = 0.0;
174   if (padding != SCM_UNDEFINED)
175     {
176       LY_ASSERT_TYPE (scm_is_number, padding, 5);
177       p = scm_to_double (padding);
178     }
179   Real d = -infinity_f;
180   if (!SCM_UNBNDP (mindist))
181     {
182       LY_ASSERT_TYPE (scm_is_number, mindist, 6);
183       d = scm_to_double (mindist);
184     }
185
186   if (s1)
187     result = *s1;
188
189   if (s2)
190     result.stack (Axis (scm_to_int (axis)),
191                   Direction (scm_to_int (direction)), *s2, p, d);
192
193   scm_remember_upto_here_2 (first, second);
194
195   return result.smobbed_copy ();
196 }
197
198 LY_DEFINE (ly_stencil_add, "ly:stencil-add",
199            0, 0, 1, (SCM args),
200            "Combine stencils.  Takes any number of arguments.")
201 {
202 #define FUNC_NAME __FUNCTION__
203   SCM_VALIDATE_REST_ARGUMENT (args);
204
205   SCM expr = SCM_EOL;
206   SCM cs = ly_symbol2scm ("combine-stencil");
207
208   Box extent;
209   extent.set_empty ();
210
211   while (!SCM_NULLP (args))
212     {
213       Stencil *s = Stencil::unsmob (scm_car (args));
214       if (!s)
215         SCM_ASSERT_TYPE (s, scm_car (args), SCM_ARGn, __FUNCTION__, "Stencil");
216
217       extent.unite (s->extent_box ());
218       if (scm_is_pair (s->expr ()) && scm_is_eq (cs, s->expr ()))
219         {
220           expr = scm_reverse_x (scm_list_copy (scm_cdr (s->expr ())),
221                                 expr);
222         }
223       else
224         expr = scm_cons (s->expr (), expr);
225
226       args = scm_cdr (args);
227     }
228
229   expr = scm_cons (cs, scm_reverse_x (expr, SCM_EOL));
230   return Stencil (extent, expr).smobbed_copy ();
231 }
232
233 LY_DEFINE (ly_make_stencil, "ly:make-stencil",
234            1, 2, 0, (SCM expr, SCM xext, SCM yext),
235            "Stencils are device independent output expressions."
236            "  They carry two pieces of information:\n"
237            "\n"
238            "@enumerate\n"
239            "@item\n"
240            "A specification of how to print this object."
241            "  This specification is processed by the output backends,"
242            " for example @file{scm/output-ps.scm}.\n"
243            "\n"
244            "@item\n"
245            "The vertical and horizontal extents of the object, given as"
246            " pairs.  If an extent is unspecified (or if you use"
247            " @code{empty-interval} as its value), it is taken to be empty.\n"
248            "@end enumerate\n")
249 {
250   SCM_ASSERT_TYPE (!scm_is_pair (expr)
251                    || is_stencil_head (scm_car (expr)),
252                    expr, SCM_ARG1, __FUNCTION__, "registered stencil expression");
253
254   Interval x;
255   if (xext != SCM_UNDEFINED)
256     {
257       LY_ASSERT_TYPE (is_number_pair, xext, 2);
258       x = ly_scm2interval (xext);
259     }
260
261   Interval y;
262   if (yext != SCM_UNDEFINED)
263     {
264       LY_ASSERT_TYPE (is_number_pair, yext, 3);
265       y = ly_scm2interval (yext);
266     }
267
268   Box b (x, y);
269   Stencil s (b, expr);
270   return s.smobbed_copy ();
271 }
272
273 LY_DEFINE (ly_stencil_aligned_to, "ly:stencil-aligned-to",
274            3, 0, 0, (SCM stil, SCM axis, SCM dir),
275            "Align @var{stil} using its own extents.  @var{dir} is a number."
276            "  @w{@code{-1}} and @code{1} are left and right, respectively."
277            "  Other values are interpolated (so @code{0} means the center).")
278 {
279   LY_ASSERT_SMOB (Stencil, stil, 1);
280   LY_ASSERT_TYPE (is_axis, axis, 2);
281   LY_ASSERT_TYPE (scm_is_number, dir, 3);
282
283   Stencil target = *Stencil::unsmob (stil);
284
285   target.align_to ((Axis)scm_to_int (axis),
286                    scm_to_double (dir));
287   return target.smobbed_copy ();
288 }
289
290 LY_DEFINE (ly_stencil_fonts, "ly:stencil-fonts",
291            1, 0, 0, (SCM s),
292            "Analyze @var{s}, and return a list of fonts used"
293            " in@tie{}@var{s}.")
294 {
295   LY_ASSERT_SMOB (Stencil, s, 1);
296   Stencil *stil = Stencil::unsmob (s);
297   return find_expression_fonts (stil->expr ());
298 }
299
300 LY_DEFINE (ly_stencil_in_color, "ly:stencil-in-color",
301            4, 0, 0, (SCM stc, SCM r, SCM g, SCM b),
302            "Put @var{stc} in a different color.")
303 {
304   LY_ASSERT_SMOB (Stencil, stc, 1);
305   Stencil *stil = Stencil::unsmob (stc);
306   return Stencil (stil->extent_box (),
307                   scm_list_3 (ly_symbol2scm ("color"),
308                               scm_list_3 (r, g, b),
309                               stil->expr ())).smobbed_copy ();
310 }
311
312 struct Stencil_interpret_arguments
313 {
314   SCM func;
315   SCM arg1;
316 };
317
318 SCM stencil_interpret_in_scm (void *p, SCM expr)
319 {
320   Stencil_interpret_arguments *ap = (Stencil_interpret_arguments *) p;
321   return scm_call_2 (ap->func, ap->arg1, expr);
322 }
323
324 LY_DEFINE (ly_interpret_stencil_expression, "ly:interpret-stencil-expression",
325            4, 0, 0, (SCM expr, SCM func, SCM arg1, SCM offset),
326            "Parse @var{expr}, feed bits to @var{func} with first arg"
327            " @var{arg1} having offset @var{offset}.")
328 {
329   LY_ASSERT_TYPE (ly_is_procedure, func, 2);
330
331   Stencil_interpret_arguments a;
332   a.func = func;
333   a.arg1 = arg1;
334   Offset o = ly_scm2offset (offset);
335
336   interpret_stencil_expression (expr, stencil_interpret_in_scm, (void *) & a, o);
337
338   return SCM_UNSPECIFIED;
339 }
340
341 LY_DEFINE (ly_bracket, "ly:bracket",
342            4, 0, 0,
343            (SCM a, SCM iv, SCM t, SCM p),
344            "Make a bracket in direction@tie{}@var{a}.  The extent of the"
345            " bracket is given by @var{iv}.  The wings protrude by an amount"
346            " of@tie{}@var{p}, which may be negative.  The thickness is given"
347            " by@tie{}@var{t}.")
348 {
349   LY_ASSERT_TYPE (is_axis, a, 1);
350   LY_ASSERT_TYPE (is_number_pair, iv, 2);
351   LY_ASSERT_TYPE (scm_is_number, t, 3);
352   LY_ASSERT_TYPE (scm_is_number, p, 4);
353
354   return Lookup::bracket ((Axis)scm_to_int (a), ly_scm2interval (iv),
355                           scm_to_double (t),
356                           scm_to_double (p),
357                           0.95 * scm_to_double (t)).smobbed_copy ();
358 }
359
360 LY_DEFINE (ly_stencil_rotate, "ly:stencil-rotate",
361            4, 0, 0, (SCM stil, SCM angle, SCM x, SCM y),
362            "Return a stencil @var{stil} rotated @var{angle} degrees around"
363            " the relative offset (@var{x}, @var{y}).  E.g., an offset of"
364            " (-1, 1) will rotate the stencil around the left upper corner.")
365 {
366   Stencil *s = Stencil::unsmob (stil);
367   LY_ASSERT_SMOB (Stencil, stil, 1);
368   LY_ASSERT_TYPE (scm_is_number, angle, 2);
369   LY_ASSERT_TYPE (scm_is_number, x, 3);
370   LY_ASSERT_TYPE (scm_is_number, y, 4);
371   Real a = scm_to_double (angle);
372   Real x_off = scm_to_double (x);
373   Real y_off = scm_to_double (y);
374
375   SCM new_s = s->smobbed_copy ();
376   Stencil *q = Stencil::unsmob (new_s);
377   q->rotate_degrees (a, Offset (x_off, y_off));
378   return new_s;
379 }
380
381 LY_DEFINE (ly_stencil_rotate_absolute, "ly:stencil-rotate-absolute",
382            4, 0, 0, (SCM stil, SCM angle, SCM x, SCM y),
383            "Return a stencil @var{stil} rotated @var{angle} degrees around"
384            " point (@var{x}, @var{y}), given in absolute coordinates.")
385 {
386   Stencil *s = Stencil::unsmob (stil);
387   LY_ASSERT_SMOB (Stencil, stil, 1);
388   LY_ASSERT_TYPE (scm_is_number, angle, 2);
389   LY_ASSERT_TYPE (scm_is_number, x, 3);
390   LY_ASSERT_TYPE (scm_is_number, y, 4);
391   Real a = scm_to_double (angle);
392   Real x_off = scm_to_double (x);
393   Real y_off = scm_to_double (y);
394
395   SCM new_s = s->smobbed_copy ();
396   Stencil *q = Stencil::unsmob (new_s);
397   q->rotate_degrees_absolute (a, Offset (x_off, y_off));
398   return new_s;
399 }
400
401 LY_DEFINE (ly_round_filled_box, "ly:round-filled-box",
402            3, 0, 0,
403            (SCM xext, SCM yext, SCM blot),
404            "Make a @code{Stencil} object that prints a black box of"
405            " dimensions @var{xext}, @var{yext} and roundness @var{blot}.")
406 {
407   LY_ASSERT_TYPE (is_number_pair, xext, 1);
408   LY_ASSERT_TYPE (is_number_pair, yext, 2);
409   LY_ASSERT_TYPE (scm_is_number, blot, 3);
410
411   return Lookup::round_filled_box (Box (ly_scm2interval (xext), ly_scm2interval (yext)),
412                                    scm_to_double (blot)).smobbed_copy ();
413 }
414
415 LY_DEFINE (ly_round_filled_polygon, "ly:round-filled-polygon",
416            2, 0, 0,
417            (SCM points, SCM blot),
418            "Make a @code{Stencil} object that prints a black polygon with"
419            " corners at the points defined by @var{points} (list of coordinate"
420            " pairs) and roundness @var{blot}.")
421 {
422   SCM_ASSERT_TYPE (scm_ilength (points) > 0, points, SCM_ARG1, __FUNCTION__, "list of coordinate pairs");
423   LY_ASSERT_TYPE (scm_is_number, blot, 2);
424   vector<Offset> pts;
425   for (SCM p = points; scm_is_pair (p); p = scm_cdr (p))
426     {
427       SCM scm_pt = scm_car (p);
428       if (scm_is_pair (scm_pt))
429         {
430           pts.push_back (ly_scm2offset (scm_pt));
431         }
432       else
433         {
434           // TODO: Print out warning
435         }
436     }
437   return Lookup::round_filled_polygon (pts, scm_to_double (blot)).smobbed_copy ();
438 }
439
440 LY_DEFINE (ly_register_stencil_expression, "ly:register-stencil-expression",
441            1, 0, 0,
442            (SCM symbol),
443            "Add @var{symbol} as head of a stencil expression.")
444 {
445   LY_ASSERT_TYPE (ly_is_symbol, symbol, 1);
446   register_stencil_head (symbol);
447   return SCM_UNSPECIFIED;
448 }
449
450 LY_DEFINE (ly_all_stencil_expressions, "ly:all-stencil-expressions",
451            0, 0, 0,
452            (),
453            "Return all symbols recognized as stencil expressions.")
454 {
455   return all_stencil_heads ();
456 }
457
458 LY_DEFINE (ly_stencil_scale, "ly:stencil-scale",
459            3, 0, 0, (SCM stil, SCM x, SCM y),
460            "Scale @var{stil} using the horizontal and vertical scaling"
461            " factors @var{x} and @var{y}.")
462 {
463   Stencil *s = Stencil::unsmob (stil);
464   LY_ASSERT_SMOB (Stencil, stil, 1);
465   LY_ASSERT_TYPE (scm_is_number, x, 2);
466   LY_ASSERT_TYPE (scm_is_number, y, 3);
467
468   SCM new_s = s->smobbed_copy ();
469   Stencil *q = Stencil::unsmob (new_s);
470
471   q->scale (scm_to_double (x), scm_to_double (y));
472   return new_s;
473 }