]> git.donarmstrong.com Git - lilypond.git/blob - lily/output-def-scheme.cc
* lily/output-def-scheme.cc (LY_DEFINE): take default argument.
[lilypond.git] / lily / output-def-scheme.cc
1 /*
2   output-def-scheme.cc -- implement Output_def bindings
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
7
8 */
9
10 #include "font-metric.hh"
11 #include "pango-font.hh"
12 #include "modified-font-metric.hh"
13 #include "output-def.hh"
14 #include "ly-module.hh"
15 #include "context-def.hh"
16
17 LY_DEFINE (ly_layout_lookup, "ly:output-def-lookup",
18            2, 1, 0, (SCM pap, SCM sym, SCM def),
19            "Lookup @var{sym} in @var{pap}. "
20            "Return the value or @var{def} (which defaults to  @code{'()}) if undefined.")
21 {
22   Output_def *op = unsmob_output_def (pap);
23   SCM_ASSERT_TYPE (op, pap, SCM_ARG1, __FUNCTION__, "Output_def");
24   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
25   
26   SCM answer = op->lookup_variable (sym);
27   if (answer == SCM_UNDEFINED)
28     {
29       if (def == SCM_UNDEFINED)
30         def = SCM_EOL;
31
32       answer = def;
33     }
34
35   return answer;
36 }
37
38 LY_DEFINE (ly_output_def_scope, "ly:output-def-scope",
39            1, 0, 0, (SCM def),
40            "Get the variable scope inside @var{def}.")
41 {
42   Output_def *op = unsmob_output_def (def);
43   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
44   return op->scope_;
45 }
46
47 LY_DEFINE (ly_output_def_parent, "ly:output-def-parent",
48            1, 0, 0, (SCM def),
49            "Get the parent output-def of @var{def}.")
50 {
51   Output_def *op = unsmob_output_def (def);
52   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
53   return op->parent_ ? op->parent_->self_scm () : SCM_EOL;
54 }
55
56 LY_DEFINE (ly_output_def_clone, "ly:output-def-clone",
57            1, 0, 0, (SCM def),
58            "Clone @var{def}.")
59 {
60   Output_def *op = unsmob_output_def (def);
61   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
62   SCM s = op->clone ()->self_scm ();
63   scm_gc_unprotect_object (s);
64   return s;
65 }
66
67 LY_DEFINE (ly_output_description, "ly:output-description",
68            1, 0, 0, (SCM output_def),
69            "Return the description of translators in @var{output-def}.")
70 {
71   Output_def *id = unsmob_output_def (output_def);
72   
73   SCM al = ly_module2alist (id->scope_);
74
75   SCM ell = SCM_EOL;
76   for (SCM s = al; scm_is_pair (s); s = scm_cdr (s))
77     {
78       Context_def * td = unsmob_context_def (scm_cdar (s));
79       SCM key = scm_caar (s);
80       if (td && key == td->get_context_name ())
81         ell = scm_cons (scm_cons (key, td->to_alist ()),  ell);
82     }
83   return ell;  
84 }
85
86 LY_DEFINE (ly_layout_def_p, "ly:layout-def?",
87            1, 0, 0, (SCM def),
88            "Is @var{def} a layout definition?")
89 {
90   return ly_bool2scm (unsmob_output_def (def));
91 }
92
93 LY_DEFINE (ly_paper_outputscale, "ly:paper-outputscale",
94           1, 0, 0, (SCM bp),
95           "Get outputscale for BP.")
96 {
97   Output_def *b = unsmob_output_def (bp);
98   SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper");
99   return scm_make_real (output_scale (b));
100 }
101
102 LY_DEFINE (ly_make_output_def, "ly:make-output-def",
103            0, 0, 0, (),
104            "Make a output def.")
105 {
106   Output_def *bp = new Output_def ;
107   return scm_gc_unprotect_object (bp->self_scm ());
108 }
109
110 LY_DEFINE (ly_paper_get_font, "ly:paper-get-font", 2, 0, 0,
111            (SCM paper_smob, SCM chain),
112
113            "Return a font metric satisfying the font-qualifiers "
114            "in the alist chain @var{chain}.\n"
115            "(An alist chain is a list of alists, "
116            "containing grob properties).\n")
117 {
118   Output_def *paper = unsmob_output_def (paper_smob);
119   SCM_ASSERT_TYPE (paper, paper_smob, SCM_ARG1,
120                    __FUNCTION__, "paper definition");
121   
122   Font_metric *fm = select_font (paper, chain);
123   return fm->self_scm ();
124 }
125
126 LY_DEFINE (ly_paper_get_number, "ly:paper-get-number", 2, 0, 0,
127            (SCM layout_smob, SCM name),
128            "Return the layout variable @var{name}.")
129 {
130   Output_def *layout = unsmob_output_def (layout_smob);
131   SCM_ASSERT_TYPE (layout, layout_smob, SCM_ARG1,
132                    __FUNCTION__, "layout definition");
133   return scm_make_real (layout->get_dimension (name));
134 }
135
136 LY_DEFINE (ly_paper_fonts, "ly:paper-fonts",
137            1, 0, 0,
138            (SCM bp),
139            "Return fonts from the @code{\\paper} block @var{bp}.")
140 {
141   Output_def *b = unsmob_output_def (bp);
142
143   
144   SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper");
145
146   SCM tab1 = b->lookup_variable (ly_symbol2scm ("scaled-fonts"));
147   SCM tab2 = b->lookup_variable (ly_symbol2scm ("pango-fonts"));
148
149   SCM alist1 = SCM_EOL;
150   if (scm_hash_table_p (tab1) == SCM_BOOL_T)
151     {
152       alist1 = scm_append (ly_alist_vals (ly_hash2alist (tab1)));
153       
154       alist1 = ly_alist_vals (alist1);
155     }
156
157   SCM alist2 = SCM_EOL;
158   if (scm_hash_table_p (tab2) == SCM_BOOL_T)
159     {
160       // strip original-fonts/pango-font-descriptions
161       alist2 = scm_append (ly_alist_vals (ly_hash2alist (tab2)));
162
163       // strip size factors
164       alist2 = ly_alist_vals (alist2); 
165     }
166
167   SCM alist = scm_append (scm_list_2 (alist1, alist2));
168   SCM font_list = SCM_EOL;
169   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
170     {
171       SCM entry = scm_car (s);
172       
173       Font_metric *fm = unsmob_metrics (entry);
174
175       if (dynamic_cast<Modified_font_metric*> (fm)
176           || dynamic_cast<Pango_font*> (fm))
177         font_list = scm_cons (fm->self_scm (), font_list);
178     }
179   
180   return font_list;
181 }