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_pair_p (name) || !gh_string_p (gh_cdr (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   else
 122     name  = gh_cdr (name);
 123
 124   SCM mag = ly_assoc_chain (ly_symbol2scm ("font-magnification"), chain);
 125
 126   Real rmag = gh_pair_p (mag) && gh_number_p (gh_cdr (mag))
 127     ? gh_scm2double (gh_cdr (mag)) : 1.0;
 128
 129   Font_metric *fm = me->get_paper ()->find_font (name, rmag);
 130   return fm;
 131 }
 132
 133 /*
 134 SCM routines for looking up fonts.
 135
 136 wtk-fugue2, SCM:
 137
 138 real    0m31.862s
 139 user    0m29.110s
 140 sys     0m0.260s
 141
 142 wtk-fugue2, C++:
 143
 144 real    0m26.964s
 145 user    0m24.850s
 146 sys     0m0.280s
 147
 148
 149 so a 14% speedup.
 150
 151 */
 152
 153 static SCM shape_sym, family_sym, series_sym, rel_str0_sym, design_str0_sym, wild_sym;
 154
 155
 156 static void
 157 init_syms ()
 158 {
 159   shape_sym  = scm_permanent_object (ly_symbol2scm ("font-shape"));
 160   family_sym = scm_permanent_object (ly_symbol2scm ("font-family"));
 161   series_sym = scm_permanent_object (ly_symbol2scm ("font-series"));
 162   rel_str0_sym = scm_permanent_object (ly_symbol2scm ("font-relative-size"));
 163   design_str0_sym = scm_permanent_object (ly_symbol2scm ("font-design-size"));
 164   wild_sym = scm_permanent_object (ly_symbol2scm ("*"));
 165 }
 166
 167 ADD_SCM_INIT_FUNC(fi_init_syms, init_syms);
 168
 169 bool
 170 Font_interface::wild_compare (SCM field_val, SCM val)
 171 {
 172   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 173 }
 174
 175
 176 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
 177 SCM
 178 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
 179 {
 180   SCM shape = SCM_BOOL_F;
 181   SCM family = SCM_BOOL_F;
 182   SCM series = SCM_BOOL_F;
 183
 184
 185   SCM point_str0 = ly_assoc_chain (design_str0_sym, alist_chain);
 186   SCM rel_str0 = SCM_BOOL_F;
 187
 188   shape = ly_assoc_chain (shape_sym, alist_chain);
 189   family = ly_assoc_chain (family_sym, alist_chain);
 190   series = ly_assoc_chain (series_sym, alist_chain);
 191
 192   if (gh_pair_p (shape))
 193     shape = ly_cdr (shape);
 194   if (gh_pair_p (family))
 195     family = ly_cdr (family);
 196   if (gh_pair_p (series))
 197     series = ly_cdr (series);
 198
 199
 200   if (gh_pair_p (point_str0))
 201     point_str0 = ly_cdr (point_str0);
 202   else
 203     {
 204       rel_str0 = ly_assoc_chain (rel_str0_sym, alist_chain);
 205       if (gh_pair_p (rel_str0))
 206         rel_str0 = ly_cdr (rel_str0);
 207     }
 208
 209   for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
 210     {
 211       SCM qlist = ly_caar (s);
 212
 213       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
 214         continue;
 215       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
 216         continue;
 217       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 218         continue;
 219
 220       if (point_str0 == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_str0))
 221         continue;
 222
 223       SCM qname = ly_cdar (s);
 224       return qname;
 225     }
 226
 227   warning (_ ("couldn't find any font satisfying "));
 228   scm_write (scm_list_n (point_str0, shape, series , family, rel_str0,
 229                          SCM_UNDEFINED), scm_current_error_port ());
 230   scm_flush (scm_current_error_port ());
 231
 232   return scm_makfrom0str ("cmr10");
 233
 234 }
 235
 236
 237
 238 ADD_INTERFACE (Font_interface, "font-interface",
 239   "Any symbol that is typeset through fixed sets of glyphs (ie. fonts)",
 240   "font-magnification font-style font font-series font-shape font-family font-name font-design-size font-relative-size");