2 font-interface.cc -- implement Font_interface
4 source file of the GNU LilyPond music typesetter
6 (c) 2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "all-font-metrics.hh"
11 #include "font-metric.hh"
12 #include "font-interface.hh"
14 #include "paper-def.hh"
19 Font_interface::font_alist_chain (Grob
*me
)
21 SCM defaults
= gh_cdr (scm_assoc (ly_symbol2scm ("font-defaults"),
22 me
->paper_l ()->style_sheet_
));
24 SCM ch
= gh_list (me
->mutable_property_alist_
,
25 me
->immutable_property_alist_
,
33 todo: split up this func, reuse in text_item?
36 Font_interface::get_default_font (Grob
*me
)
38 Font_metric
* fm
= unsmob_metrics (me
->get_grob_property ("font"));
42 fm
= get_font (me
, font_alist_chain (me
));
43 me
->set_grob_property ("font", fm
->self_scm ());
48 Font_interface::get_font (Grob
*me
, SCM chain
)
51 SCM ss
= me
->paper_l ()->style_sheet_
;
53 SCM proc
= gh_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"),
56 SCM fonts
= gh_cdr (scm_assoc (ly_symbol2scm ("fonts"), ss
));
58 assert (gh_procedure_p (proc
));
59 SCM font_name
= gh_call2 (proc
, fonts
, chain
);
61 Font_metric
*fm
= me
->paper_l ()->find_font (font_name
, 1.0);
67 Font_interface::add_style (Grob
* me
, SCM style
, SCM chain
)
69 assert (gh_symbol_p (style
));
71 SCM sheet
= me
->paper_l ()->style_sheet_
;
73 SCM style_alist
= gh_cdr (scm_assoc (ly_symbol2scm ("style-alist"), sheet
));
74 SCM entry
= scm_assoc (style
, style_alist
);
75 if (gh_pair_p (entry
))
77 chain
= gh_cons (gh_cdr (entry
), chain
);
86 MIDI output to wtk1-fugue2.midi...
102 static SCM name_sym
, shape_sym
, family_sym
, series_sym
, rel_sz_sym
, pt_sz_sym
, wild_sym
;
108 name_sym
= scm_permanent_object (ly_symbol2scm ("font-name"));
109 shape_sym
= scm_permanent_object (ly_symbol2scm ("font-shape"));
110 family_sym
= scm_permanent_object (ly_symbol2scm ("font-family"));
111 series_sym
= scm_permanent_object (ly_symbol2scm ("font-series"));
112 rel_sz_sym
= scm_permanent_object (ly_symbol2scm ("font-relative-size"));
113 pt_sz_sym
= scm_permanent_object (ly_symbol2scm ("font-point-size"));
114 wild_sym
= scm_permanent_object (ly_symbol2scm ("*"));
118 Font_interface::wild_compare(SCM field_val
, SCM val
)
120 return (val
== SCM_BOOL_F
|| field_val
== wild_sym
|| field_val
== val
);
123 ADD_SCM_INIT_FUNC(Font_interface_syms
,init_syms
);
126 MAKE_SCHEME_CALLBACK(Font_interface
,properties_to_font_name
,2);
128 Font_interface::properties_to_font_name (SCM fonts
, SCM alist_chain
)
130 SCM name
= ly_assoc_chain (name_sym
, alist_chain
);
132 SCM shape
= SCM_BOOL_F
;
133 SCM family
= SCM_BOOL_F
;
134 SCM series
= SCM_BOOL_F
;
137 SCM point_sz
= ly_assoc_chain (pt_sz_sym
, alist_chain
);
138 SCM rel_sz
= SCM_BOOL_F
;
140 if (!gh_pair_p (name
))
142 shape
= ly_assoc_chain (shape_sym
, alist_chain
);
143 family
= ly_assoc_chain (family_sym
, alist_chain
);
144 series
= ly_assoc_chain (series_sym
, alist_chain
);
146 if (gh_pair_p (shape
))
147 shape
= gh_cdr (shape
);
148 if (gh_pair_p (family
))
149 family
= gh_cdr (family
);
150 if (gh_pair_p (series
))
151 series
= gh_cdr (series
);
154 name
= gh_cdr (name
);
157 if (gh_pair_p (point_sz
))
158 point_sz
= gh_cdr (point_sz
);
161 rel_sz
= ly_assoc_chain (rel_sz_sym
, alist_chain
);
162 if (gh_pair_p (rel_sz
))
163 rel_sz
= gh_cdr (rel_sz
);
166 for (SCM s
= fonts
; gh_pair_p (s
); s
= gh_cdr (s
))
168 SCM qlist
= gh_caar (s
);
170 if (name
!= SCM_BOOL_F
)
172 if (!wild_compare(scm_list_ref (qlist
, gh_int2scm (4)), name
))
177 if (!wild_compare(scm_list_ref (qlist
, gh_int2scm (1)), series
))
179 if (!wild_compare(scm_list_ref (qlist
, gh_int2scm (2)), shape
))
181 if (!wild_compare(scm_list_ref (qlist
, gh_int2scm (3)), family
))
185 if (point_sz
!= SCM_BOOL_F
)
187 // This if statement will always be true since name must
188 // be SCM_BOOL_F here, right? /MB
189 if (!wild_compare(scm_list_ref (qlist
, gh_int2scm (4)), name
))
194 if (!wild_compare(gh_car (qlist
), rel_sz
))
199 SCM qname
= gh_cdar (s
);
203 warning (_("couldn't find any font satisfying ") );
204 scm_write (gh_list (name
, point_sz
, shape
, series
, family
, rel_sz
, SCM_UNDEFINED
), scm_current_error_port ());
205 scm_flush(scm_current_error_port ());
207 return ly_str02scm ("cmr10");