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--2003 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 = ly_assoc_chain (ly_symbol2scm  ("font-name"), chain);
 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 = ly_assoc_chain (ly_symbol2scm ("font-magnification"), chain);
 123
 124   Real rmag = gh_pair_p (mag) && gh_number_p (gh_cdr (mag))
 125     ? gh_scm2double (gh_cdr (mag)) : 1.0;
 126
 127   Font_metric *fm = me->get_paper ()->find_font (name, rmag);
 128   return fm;
 129 }
 130
 131 SCM
 132 Font_interface::add_style (Grob* me, SCM style, SCM chain)
 133 {
 134   assert (gh_symbol_p (style));
 135
 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))
 139     {
 140       chain = gh_cons (ly_cdr (entry), chain);
 141     }
 142   return chain;
 143 }
 144
 145 /*
 146 SCM routines:
 147
 148 Interpreting music...
 149 MIDI output to wtk1-fugue2.midi...
 150 Track ...
 151
 152 real    0m31.862s
 153 user    0m29.110s
 154 sys     0m0.260s
 155
 156 real    0m26.964s
 157 user    0m24.850s
 158 sys     0m0.280s
 159
 160
 161 so a 14% speedup.
 162
 163 */
 164
 165 static SCM shape_sym, family_sym, series_sym, rel_str0_sym, design_str0_sym, wild_sym;
 166
 167
 168 static void
 169 init_syms ()
 170 {
 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 ("*"));
 177 }
 178
 179 ADD_SCM_INIT_FUNC(fi_init_syms, init_syms);
 180
 181 bool
 182 Font_interface::wild_compare (SCM field_val, SCM val)
 183 {
 184   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 185 }
 186
 187
 188 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
 189 SCM
 190 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
 191 {
 192   SCM shape = SCM_BOOL_F;
 193   SCM family = SCM_BOOL_F;
 194   SCM series = SCM_BOOL_F;
 195
 196
 197   SCM point_str0 = ly_assoc_chain (design_str0_sym, alist_chain);
 198   SCM rel_str0 = SCM_BOOL_F;
 199
 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);
 203
 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);
 210
 211
 212   if (gh_pair_p (point_str0))
 213     point_str0 = ly_cdr (point_str0);
 214   else
 215     {
 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);
 219     }
 220
 221   for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
 222     {
 223       SCM qlist = ly_caar (s);
 224
 225       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
 226         continue;
 227       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
 228         continue;
 229       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 230         continue;
 231
 232       if (point_str0 == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_str0))
 233         continue;
 234
 235       SCM qname = ly_cdar (s);
 236       return qname;
 237     }
 238
 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 ());
 243
 244   return scm_makfrom0str ("cmr10");
 245
 246 }
 247
 248
 249
 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");