2 output-def-scheme.cc -- implement Output_def bindings
4 source file of the GNU LilyPond music typesetter
6 (c) 2005--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
9 #include "output-def.hh"
11 #include "pango-font.hh"
12 #include "modified-font-metric.hh"
13 #include "ly-module.hh"
14 #include "context-def.hh"
15 #include "lily-parser.hh"
17 LY_DEFINE (ly_output_def_lookup
, "ly:output-def-lookup",
18 2, 1, 0, (SCM def
, SCM sym
, SCM val
),
19 "Return the value of @var{sym} in output definition @var{def}"
20 " (e.g., @code{\\paper}). If no value is found, return"
21 " @var{val} or @code{'()} if @var{val} is undefined.")
23 LY_ASSERT_SMOB (Output_def
, def
, 1);
24 Output_def
*op
= unsmob_output_def (def
);
25 LY_ASSERT_TYPE (ly_is_symbol
, sym
, 2);
27 SCM answer
= op
->lookup_variable (sym
);
28 if (answer
== SCM_UNDEFINED
)
30 if (val
== SCM_UNDEFINED
)
39 LY_DEFINE (ly_output_def_scope
, "ly:output-def-scope",
41 "Return the variable scope inside @var{def}.")
43 LY_ASSERT_SMOB (Output_def
, def
, 1);
44 Output_def
*op
= unsmob_output_def (def
);
48 LY_DEFINE (ly_output_def_parent
, "ly:output-def-parent",
50 "Return the parent output definition of @var{def}.")
52 LY_ASSERT_SMOB (Output_def
, def
, 1);
53 Output_def
*op
= unsmob_output_def (def
);
54 return op
->parent_
? op
->parent_
->self_scm () : SCM_EOL
;
57 LY_DEFINE (ly_output_def_set_variable_x
, "ly:output-def-set-variable!",
58 3, 0, 0, (SCM def
, SCM sym
, SCM val
),
59 "Set an output definition @var{def} variable @var{sym} to @var{val}.")
61 LY_ASSERT_SMOB (Output_def
, def
, 1);
62 Output_def
*output_def
= unsmob_output_def (def
);
63 LY_ASSERT_TYPE (ly_is_symbol
, sym
, 2);
64 output_def
->set_variable (sym
, val
);
65 return SCM_UNSPECIFIED
;
68 LY_DEFINE (ly_output_def_clone
, "ly:output-def-clone",
70 "Clone output definition @var{def}.")
72 LY_ASSERT_SMOB (Output_def
, def
, 1);
73 Output_def
*op
= unsmob_output_def (def
);
75 Output_def
*clone
= op
->clone ();
76 return clone
->unprotect ();
79 LY_DEFINE (ly_output_description
, "ly:output-description",
80 1, 0, 0, (SCM output_def
),
81 "Return the description of translators in @var{output-def}.")
83 Output_def
*id
= unsmob_output_def (output_def
);
85 SCM al
= ly_module_2_alist (id
->scope_
);
87 for (SCM s
= al
; scm_is_pair (s
); s
= scm_cdr (s
))
89 Context_def
*td
= unsmob_context_def (scm_cdar (s
));
90 SCM key
= scm_caar (s
);
91 if (td
&& key
== td
->get_context_name ())
92 ell
= scm_cons (scm_cons (key
, td
->to_alist ()), ell
);
97 LY_DEFINE (ly_output_def_p
, "ly:output-def?",
99 "Is @var{def} an output definition?")
101 return ly_bool2scm (unsmob_output_def (def
));
104 LY_DEFINE (ly_paper_outputscale
, "ly:paper-outputscale",
106 "Return the output-scale for output definition @var{def}.")
108 LY_ASSERT_SMOB (Output_def
, def
, 1);
109 Output_def
*b
= unsmob_output_def (def
);
110 return scm_from_double (output_scale (b
));
113 LY_DEFINE (ly_make_output_def
, "ly:make-output-def",
115 "Make an output definition.")
117 Output_def
*bp
= new Output_def
;
118 return bp
->unprotect ();
121 LY_DEFINE (ly_paper_get_font
, "ly:paper-get-font",
122 2, 0, 0, (SCM def
, SCM chain
),
123 "Find a font metric in output definition @var{def} satisfying"
124 " the font-qualifiers in alist chain @var{chain}, and return"
125 " it. (An alist chain is a list of alists, containing grob"
128 LY_ASSERT_SMOB (Output_def
, def
, 1);
130 Output_def
*paper
= unsmob_output_def (def
);
131 Font_metric
*fm
= select_font (paper
, chain
);
132 return fm
->self_scm ();
135 LY_DEFINE (ly_paper_get_number
, "ly:paper-get-number",
136 2, 0, 0, (SCM def
, SCM sym
),
137 "Return the value of variable @var{sym} in output definition"
138 " @var{def} as a double.")
140 LY_ASSERT_SMOB (Output_def
, def
, 1);
141 Output_def
*layout
= unsmob_output_def (def
);
142 return scm_from_double (layout
->get_dimension (sym
));
145 LY_DEFINE (ly_paper_fonts
, "ly:paper-fonts",
147 "Return a list containing the fonts from output definition"
148 " @var{def} (e.g., @code{\\paper}).")
150 LY_ASSERT_SMOB (Output_def
, def
, 1);
151 Output_def
*b
= unsmob_output_def (def
);
153 SCM tab1
= b
->lookup_variable (ly_symbol2scm ("scaled-fonts"));
154 SCM tab2
= b
->lookup_variable (ly_symbol2scm ("pango-fonts"));
156 SCM alist1
= SCM_EOL
;
157 if (scm_hash_table_p (tab1
) == SCM_BOOL_T
)
159 alist1
= scm_append (ly_alist_vals (ly_hash2alist (tab1
)));
161 alist1
= ly_alist_vals (alist1
);
164 SCM alist2
= SCM_EOL
;
165 if (scm_hash_table_p (tab2
) == SCM_BOOL_T
)
167 // strip original-fonts/pango-font-descriptions
168 alist2
= scm_append (ly_alist_vals (ly_hash2alist (tab2
)));
170 // strip size factors
171 alist2
= ly_alist_vals (alist2
);
174 SCM alist
= scm_append (scm_list_2 (alist1
, alist2
));
175 SCM font_list
= SCM_EOL
;
176 for (SCM s
= alist
; scm_is_pair (s
); s
= scm_cdr (s
))
178 SCM entry
= scm_car (s
);
180 Font_metric
*fm
= unsmob_metrics (entry
);
182 if (dynamic_cast<Modified_font_metric
*> (fm
)
183 || dynamic_cast<Pango_font
*> (fm
))
184 font_list
= scm_cons (fm
->self_scm (), font_list
);