2 font-interface.cc -- implement Font_interface
4 source file of the GNU LilyPond music typesetter
6 (c) 2000--2002 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 TODO revise font handling.
22 * relative sizes should relate to staff-space, eg. font-staff-space
25 * If a relative size is given, lily should magnify the closest
26 design size font to match that. (ie. fonts should have variable
29 (this requires that fonts are stored as (filename , designsize))
36 Font_interface::font_alist_chain (Grob *me)
39 Ugh: why the defaults?
41 SCM defaults = me->get_paper ()->lookup_variable (ly_symbol2scm ("font-defaults"));
43 SCM ch = me->get_property_alist_chain (defaults);
48 MAKE_SCHEME_CALLBACK(Font_interface, get_property_alist_chain, 1);
50 Font_interface::get_property_alist_chain (SCM grob)
52 Grob * g = unsmob_grob (grob);
53 SCM_ASSERT_TYPE(g, grob, SCM_ARG1, __FUNCTION__, "grob");
54 return font_alist_chain (g);
58 todo: split up this func, reuse in text_item?
61 Font_interface::get_default_font (Grob*me)
63 Font_metric * fm = unsmob_metrics (me->get_grob_property ("font"));
67 fm = get_font (me, font_alist_chain (me));
68 me->set_grob_property ("font", fm->self_scm ());
73 LY_DEFINE(ly_font_interface_get_default_font,
74 "ly:get-default-font", 1 , 0, 0,
75 (SCM grob), "Return the default font for grob @var{gr}.")
77 Grob * gr = unsmob_grob (grob);
78 SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
80 return Font_interface::get_default_font (gr)->self_scm ();
83 LY_DEFINE(ly_font_interface_get_font,"ly:get-font", 2, 0, 0,
84 (SCM grob, SCM chain),
85 "Return a font metric satisfying the font-qualifiers in the alist chain @var{chain}.\n"
87 "The font object represents the metric information of a font. Every font\n"
88 "that is loaded into LilyPond can be accessed via Scheme. \n"
90 "LilyPond only needs to know the dimension of glyph to be able to process\n"
91 "them. This information is stored in font metric files. LilyPond can read\n"
92 "two types of font-metrics: @TeX{} Font Metric files (TFM files) and\n"
93 "Adobe Font Metric files (AFM files). LilyPond will always try to load\n"
94 "AFM files first since they are more versatile.\n"
96 "An alist chain is a list of alists.\n")
98 Grob * gr = unsmob_grob (grob);
99 SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
101 Font_metric*fm = Font_interface::get_font (gr, chain);
102 return fm->self_scm();
107 Font_interface::get_font (Grob *me, SCM chain)
109 SCM name = me->get_grob_property ("font-name");
111 if (!gh_string_p (name))
113 Paper_def * p = me->get_paper ();
115 SCM proc = p->lookup_variable (ly_symbol2scm ("properties-to-font"));
116 SCM fonts = p->lookup_variable (ly_symbol2scm ("fonts"));
118 assert (gh_procedure_p (proc));
119 name = gh_call2 (proc, fonts, chain);
122 SCM mag = ly_assoc_chain (ly_symbol2scm ("font-magnification"), chain);
124 Real rmag = gh_pair_p (mag) && gh_number_p (gh_cdr (mag))
125 ? gh_scm2double (gh_cdr (mag)) : 1.0;
127 Font_metric *fm = me->get_paper ()->find_font (name, rmag);
132 Font_interface::add_style (Grob* me, SCM style, SCM chain)
134 assert (gh_symbol_p (style));
136 SCM style_alist = me->get_paper ()->lookup_variable (ly_symbol2scm ("style-alist"));
137 SCM entry = scm_assoc (style, style_alist);
138 if (gh_pair_p (entry))
140 chain = gh_cons (ly_cdr (entry), chain);
148 Interpreting music...
149 MIDI output to wtk1-fugue2.midi...
165 static SCM shape_sym, family_sym, series_sym, rel_str0_sym, design_str0_sym, wild_sym;
171 shape_sym = scm_permanent_object (ly_symbol2scm ("font-shape"));
172 family_sym = scm_permanent_object (ly_symbol2scm ("font-family"));
173 series_sym = scm_permanent_object (ly_symbol2scm ("font-series"));
174 rel_str0_sym = scm_permanent_object (ly_symbol2scm ("font-relative-size"));
175 design_str0_sym = scm_permanent_object (ly_symbol2scm ("font-design-size"));
176 wild_sym = scm_permanent_object (ly_symbol2scm ("*"));
179 ADD_SCM_INIT_FUNC(fi_init_syms, init_syms);
182 Font_interface::wild_compare (SCM field_val, SCM val)
184 return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
188 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
190 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
192 SCM shape = SCM_BOOL_F;
193 SCM family = SCM_BOOL_F;
194 SCM series = SCM_BOOL_F;
197 SCM point_str0 = ly_assoc_chain (design_str0_sym, alist_chain);
198 SCM rel_str0 = SCM_BOOL_F;
200 shape = ly_assoc_chain (shape_sym, alist_chain);
201 family = ly_assoc_chain (family_sym, alist_chain);
202 series = ly_assoc_chain (series_sym, alist_chain);
204 if (gh_pair_p (shape))
205 shape = ly_cdr (shape);
206 if (gh_pair_p (family))
207 family = ly_cdr (family);
208 if (gh_pair_p (series))
209 series = ly_cdr (series);
212 if (gh_pair_p (point_str0))
213 point_str0 = ly_cdr (point_str0);
216 rel_str0 = ly_assoc_chain (rel_str0_sym, alist_chain);
217 if (gh_pair_p (rel_str0))
218 rel_str0 = ly_cdr (rel_str0);
221 for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
223 SCM qlist = ly_caar (s);
225 if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
227 if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
229 if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
232 if (point_str0 == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_str0))
235 SCM qname = ly_cdar (s);
239 warning (_ ("couldn't find any font satisfying "));
240 scm_write (scm_list_n (point_str0, shape, series , family, rel_str0,
241 SCM_UNDEFINED), scm_current_error_port ());
242 scm_flush (scm_current_error_port ());
244 return scm_makfrom0str ("cmr10");
250 ADD_INTERFACE (Font_interface, "font-interface",
251 "Any symbol that is typeset through fixed sets of glyphs (ie. fonts)",
252 "font-magnification font-style font font-series font-shape font-family font-name font-design-size font-relative-size");