lily/font-interface.cc

   1 /*
   2   font-interface.cc --  implement Font_interface
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2000--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include "all-font-metrics.hh"
  11 #include "font-metric.hh"
  12 #include "font-interface.hh"
  13 #include "grob.hh"
  14 #include "paper-def.hh"
  15 #include "warn.hh"
  16
  17
  18 /*
  19   TODO revise font handling.
  20
  21
  22 * relative sizes should relate to staff-space, eg.  font-staff-space
  23 = 1.2 ^ relative-size
  24
  25 * If a relative size is given, lily should magnify the closest
  26 design size font to match that. (ie. fonts should have variable
  27 scaling)
  28
  29 (this requires that fonts are stored as (filename , designsize))
  30
  31
  32
  33  */
  34
  35 SCM
  36 Font_interface::font_alist_chain (Grob *me)
  37 {
  38   /*
  39     Ugh: why the defaults?
  40    */
  41   SCM defaults = me->get_paper ()->lookup_variable (ly_symbol2scm ("font-defaults"));
  42
  43   SCM ch = me->get_property_alist_chain (defaults);
  44   return ch;
  45 }
  46
  47
  48 MAKE_SCHEME_CALLBACK(Font_interface, get_property_alist_chain, 1);
  49 SCM
  50 Font_interface::get_property_alist_chain (SCM grob)
  51 {
  52   Grob * g = unsmob_grob (grob);
  53   SCM_ASSERT_TYPE(g, grob, SCM_ARG1, __FUNCTION__, "grob");
  54   return  font_alist_chain (g);
  55 }
  56
  57 /*
  58   todo: split up this func, reuse in text_item?
  59  */
  60 Font_metric *
  61 Font_interface::get_default_font (Grob*me)
  62 {
  63   Font_metric * fm =  unsmob_metrics (me->get_grob_property ("font"));
  64   if (fm)
  65     return fm;
  66
  67   fm = get_font (me,  font_alist_chain (me));
  68   me->set_grob_property ("font", fm->self_scm ());
  69   return fm;
  70 }
  71
  72
  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}.")
  76 {
  77   Grob * gr  = unsmob_grob (grob);
  78   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
  79
  80   return Font_interface::get_default_font (gr)->self_scm ();
  81 }
  82
  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"
  86 "\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"
  89 "\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"
  95 "\n"
  96 "An alist chain is a list of alists.\n")
  97 {
  98   Grob * gr  = unsmob_grob (grob);
  99   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
 100
 101   Font_metric*fm = Font_interface::get_font (gr, chain);
 102   return fm->self_scm();
 103 }
 104
 105
 106 Font_metric *
 107 Font_interface::get_font (Grob *me, SCM chain)
 108 {
 109   SCM name = me->get_grob_property ("font-name");
 110
 111   if (!gh_string_p (name))
 112     {
 113       Paper_def * p =  me->get_paper ();
 114
 115       SCM proc = p->lookup_variable (ly_symbol2scm ("properties-to-font"));
 116       SCM fonts = p->lookup_variable (ly_symbol2scm ("fonts"));
 117
 118       assert (gh_procedure_p (proc));
 119       name = gh_call2 (proc, fonts, chain);
 120     }
 121
 122   SCM mag = me->get_grob_property ("font-magnification");
 123   Real rmag = gh_number_p (mag) ? gh_scm2double (mag) : 1.0;
 124
 125   Font_metric *fm = me->get_paper ()->find_font (name, rmag);
 126   return fm;
 127 }
 128
 129 SCM
 130 Font_interface::add_style (Grob* me, SCM style, SCM chain)
 131 {
 132   assert (gh_symbol_p (style));
 133
 134   SCM style_alist = me->get_paper ()->lookup_variable (ly_symbol2scm ("style-alist"));
 135   SCM entry = scm_assoc (style, style_alist);
 136   if (gh_pair_p (entry))
 137     {
 138       chain = gh_cons (ly_cdr (entry), chain);
 139     }
 140   return chain;
 141 }
 142
 143 /*
 144 SCM routines:
 145
 146 Interpreting music...
 147 MIDI output to wtk1-fugue2.midi...
 148 Track ...
 149
 150 real    0m31.862s
 151 user    0m29.110s
 152 sys     0m0.260s
 153
 154 real    0m26.964s
 155 user    0m24.850s
 156 sys     0m0.280s
 157
 158
 159 so a 14% speedup.
 160
 161 */
 162
 163 static SCM shape_sym, family_sym, series_sym, rel_str0_sym, design_str0_sym, wild_sym;
 164
 165
 166 static void
 167 init_syms ()
 168 {
 169   shape_sym  = scm_permanent_object (ly_symbol2scm ("font-shape"));
 170   family_sym = scm_permanent_object (ly_symbol2scm ("font-family"));
 171   series_sym = scm_permanent_object (ly_symbol2scm ("font-series"));
 172   rel_str0_sym = scm_permanent_object (ly_symbol2scm ("font-relative-size"));
 173   design_str0_sym = scm_permanent_object (ly_symbol2scm ("font-design-size"));
 174   wild_sym = scm_permanent_object (ly_symbol2scm ("*"));
 175 }
 176
 177 ADD_SCM_INIT_FUNC(fi_init_syms, init_syms);
 178
 179 bool
 180 Font_interface::wild_compare (SCM field_val, SCM val)
 181 {
 182   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 183 }
 184
 185
 186 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
 187 SCM
 188 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
 189 {
 190   SCM shape = SCM_BOOL_F;
 191   SCM family = SCM_BOOL_F;
 192   SCM series = SCM_BOOL_F;
 193
 194
 195   SCM point_str0 = ly_assoc_chain (design_str0_sym, alist_chain);
 196   SCM rel_str0 = SCM_BOOL_F;
 197
 198   shape = ly_assoc_chain (shape_sym, alist_chain);
 199   family = ly_assoc_chain (family_sym, alist_chain);
 200   series = ly_assoc_chain (series_sym, alist_chain);
 201
 202   if (gh_pair_p (shape))
 203     shape = ly_cdr (shape);
 204   if (gh_pair_p (family))
 205     family = ly_cdr (family);
 206   if (gh_pair_p (series))
 207     series = ly_cdr (series);
 208
 209
 210   if (gh_pair_p (point_str0))
 211     point_str0 = ly_cdr (point_str0);
 212   else
 213     {
 214       rel_str0 = ly_assoc_chain (rel_str0_sym, alist_chain);
 215       if (gh_pair_p (rel_str0))
 216         rel_str0 = ly_cdr (rel_str0);
 217     }
 218
 219   for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
 220     {
 221       SCM qlist = ly_caar (s);
 222
 223       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
 224         continue;
 225       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
 226         continue;
 227       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 228         continue;
 229
 230       if (point_str0 == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_str0))
 231         continue;
 232
 233       SCM qname = ly_cdar (s);
 234       return qname;
 235     }
 236
 237   warning (_ ("couldn't find any font satisfying "));
 238   scm_write (scm_list_n (point_str0, shape, series , family, rel_str0,
 239                          SCM_UNDEFINED), scm_current_error_port ());
 240   scm_flush (scm_current_error_port ());
 241
 242   return scm_makfrom0str ("cmr10");
 243
 244 }
 245
 246
 247
 248 ADD_INTERFACE (Font_interface, "font-interface",
 249   "Any symbol that is typeset through fixed sets of glyphs (ie. fonts)",
 250   "font-magnification font-style font font-series font-shape font-family font-name font-design-size font-relative-size");