-
-/****************************************************************/
-
-
-void
-interpret_stencil_expression (SCM expr,
- void (*func) (void*, SCM),
- void *func_arg,
- Offset o)
-{
- while (1)
- {
- if (!ly_c_pair_p (expr))
- return;
-
- SCM head =ly_car (expr);
- if (unsmob_input (head))
- {
- Input *ip = unsmob_input (head);
- (*func) (func_arg,
- scm_list_4 (ly_symbol2scm ("define-origin"),
- scm_makfrom0str (ip->file_string ()
- .to_str0 ()),
- scm_int2num (ip->line_number ()),
- scm_int2num (ip->column_number ())));
- expr = ly_cadr (expr);
- }
- else if (head == ly_symbol2scm ("no-origin"))
- {
- (*func) (func_arg, scm_list_1 (head));
- expr = ly_cadr (expr);
- }
- else if (head == ly_symbol2scm ("translate-stencil"))
- {
- o += ly_scm2offset (ly_cadr (expr));
- expr = ly_caddr (expr);
- }
- else if (head == ly_symbol2scm ("combine-stencil"))
- {
- for (SCM x = ly_cdr (expr); ly_c_pair_p (x); x = ly_cdr (x))
- interpret_stencil_expression (ly_car (x), func, func_arg, o);
- return;
- }
- else
- {
- (*func) (func_arg,
- scm_list_4 (ly_symbol2scm ("placebox"),
- scm_make_real (o[X_AXIS]),
- scm_make_real (o[Y_AXIS]),
- expr));
- return;
- }
- }
-}
-
-
-struct Font_list
-{
- SCM fonts_;
-};
-
-static void
-find_font_function (void *fs, SCM x)
-{
- Font_list *me = (Font_list*) fs;
-
- if (ly_car (x) == ly_symbol2scm ("placebox"))
- {
- SCM args = ly_cdr (x);
- SCM what = ly_caddr (args);
-
- if (ly_c_pair_p (what))
- {
- SCM head = ly_car (what);
- if (ly_symbol2scm ("text") == head)
- me->fonts_ = scm_cons (ly_cadr (what), me->fonts_);
- else if (head == ly_symbol2scm ("char"))
- me->fonts_ = scm_cons (ly_cadr (what), me->fonts_);
- }
- }
-}
-
-SCM
-find_expression_fonts (SCM expr)
-{
- Font_list fl;
-
- fl.fonts_ = SCM_EOL;
-
- interpret_stencil_expression (expr, &find_font_function,
- (void*) &fl, Offset (0,0));
-
- return fl.fonts_;
-}
-
-
-LY_DEFINE (ly_stencil_fonts, "ly:stencil-fonts",
- 1, 0, 0, (SCM s),
- " Analyse @var{s}, and return a list of fonts used in @var{s}.")
-{
- Stencil *stil = unsmob_stencil (s);
- SCM_ASSERT_TYPE (stil, s, SCM_ARG1, __FUNCTION__, "Stencil");
- return find_expression_fonts (stil->expr ());
-}
-
-struct Stencil_interpret_arguments
-{
- SCM func;
- SCM arg1;
-};
-
-void stencil_interpret_in_scm (void *p, SCM expr)