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 = ly_cdr (scm_assoc (ly_symbol2scm ("font-defaults"),
  42                                     me->paper_l ()->style_sheet_));
  43
  44   SCM ch = scm_list_n (me->mutable_property_alist_,
  45                     me->immutable_property_alist_,
  46                     defaults,
  47                     SCM_UNDEFINED);
  48
  49   return ch;
  50 }
  51
  52 /*
  53   todo: split up this func, reuse in text_item?
  54  */
  55 Font_metric *
  56 Font_interface::get_default_font (Grob*me)
  57 {
  58   Font_metric * fm =  unsmob_metrics (me->get_grob_property ("font"));
  59   if (fm)
  60     return fm;
  61
  62   fm = get_font (me,  font_alist_chain (me));
  63   me->set_grob_property ("font", fm->self_scm ());
  64   return fm;
  65 }
  66
  67
  68 LY_DEFINE(ly_font_interface_get_default_font,
  69           "ly-get-default-font", 1 , 0, 0,
  70           (SCM grob), "Return the default font for grob @var{gr}.")
  71 {
  72   Grob * gr  = unsmob_grob (grob);
  73   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
  74
  75   return Font_interface::get_default_font (gr)->self_scm ();
  76 }
  77
  78 LY_DEFINE(ly_font_interface_get_font,"ly-get-font", 2, 0, 0,
  79           (SCM grob, SCM alist),
  80           "Return a font metric satisfying the font-qualifiers in @var{alist}.
  81
  82
  83 The font object represents the metric information of a font. Every font
  84 that is loaded into LilyPond can be accessed via Scheme.
  85
  86 LilyPond only needs to know the dimension of glyph to be able to process
  87 them. This information is stored in font metric files. LilyPond can read
  88 two types of font-metrics: @TeX{} Font Metric files (TFM files) and
  89 Adobe Font Metric files (AFM files).  LilyPond will always try to load
  90 AFM files first since they are more versatile.
  91
  92 ")
  93 {
  94   Grob * gr  = unsmob_grob (grob);
  95   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
  96
  97   Font_metric*fm=
  98     Font_interface::get_font (gr, gh_cons (alist,
  99                                            Font_interface::font_alist_chain (gr)));
 100
 101   return fm->self_scm();
 102 }
 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       SCM ss = me->paper_l ()->style_sheet_;
 114
 115       SCM proc = ly_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"),
 116                                     ss));
 117
 118       SCM fonts = ly_cdr (scm_assoc (ly_symbol2scm ("fonts"), ss));
 119
 120       assert (gh_procedure_p (proc));
 121       name = gh_call2 (proc, fonts, chain);
 122     }
 123
 124   SCM mag = me->get_grob_property ("font-magnification");
 125   Real rmag = gh_number_p (mag) ? gh_scm2double (mag) : 1.0;
 126
 127   Font_metric *fm = me->paper_l ()->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 sheet = me->paper_l ()->style_sheet_;
 137
 138   SCM style_alist = ly_cdr (scm_assoc (ly_symbol2scm ("style-alist"), sheet));
 139   SCM entry = scm_assoc (style, style_alist);
 140   if (gh_pair_p (entry))
 141     {
 142       chain = gh_cons (ly_cdr (entry), chain);
 143     }
 144   return chain;
 145 }
 146
 147 /*
 148 SCM routines:
 149
 150 Interpreting music...
 151 MIDI output to wtk1-fugue2.midi...
 152 Track ...
 153
 154 real    0m31.862s
 155 user    0m29.110s
 156 sys     0m0.260s
 157
 158 real    0m26.964s
 159 user    0m24.850s
 160 sys     0m0.280s
 161
 162
 163 so a 14% speedup.
 164
 165 */
 166
 167 static SCM shape_sym, family_sym, series_sym, rel_sz_sym, design_sz_sym, wild_sym;
 168
 169
 170 static void
 171 init_syms ()
 172 {
 173   shape_sym  = scm_permanent_object (ly_symbol2scm ("font-shape"));
 174   family_sym = scm_permanent_object (ly_symbol2scm ("font-family"));
 175   series_sym = scm_permanent_object (ly_symbol2scm ("font-series"));
 176   rel_sz_sym = scm_permanent_object (ly_symbol2scm ("font-relative-size"));
 177   design_sz_sym = scm_permanent_object (ly_symbol2scm ("font-design-size"));
 178   wild_sym = scm_permanent_object (ly_symbol2scm ("*"));
 179 }
 180
 181 ADD_SCM_INIT_FUNC(fi_init_syms, init_syms);
 182
 183 bool
 184 Font_interface::wild_compare (SCM field_val, SCM val)
 185 {
 186   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 187 }
 188
 189
 190 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
 191 SCM
 192 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
 193 {
 194   SCM shape = SCM_BOOL_F;
 195   SCM family = SCM_BOOL_F;
 196   SCM series = SCM_BOOL_F;
 197
 198
 199   SCM point_sz = ly_assoc_chain (design_sz_sym, alist_chain);
 200   SCM rel_sz = SCM_BOOL_F;
 201
 202   shape = ly_assoc_chain (shape_sym, alist_chain);
 203   family = ly_assoc_chain (family_sym, alist_chain);
 204   series = ly_assoc_chain (series_sym, alist_chain);
 205
 206   if (gh_pair_p (shape))
 207     shape = ly_cdr (shape);
 208   if (gh_pair_p (family))
 209     family = ly_cdr (family);
 210   if (gh_pair_p (series))
 211     series = ly_cdr (series);
 212
 213
 214   if (gh_pair_p (point_sz))
 215     point_sz = ly_cdr (point_sz);
 216   else
 217     {
 218       rel_sz = ly_assoc_chain (rel_sz_sym, alist_chain);
 219       if (gh_pair_p (rel_sz))
 220         rel_sz = ly_cdr (rel_sz);
 221     }
 222
 223   for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
 224     {
 225       SCM qlist = ly_caar (s);
 226
 227       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
 228         continue;
 229       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
 230         continue;
 231       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 232         continue;
 233
 234       if (point_sz == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_sz))
 235         continue;
 236
 237       SCM qname = ly_cdar (s);
 238       return qname;
 239     }
 240
 241   warning (_ ("couldn't find any font satisfying "));
 242   scm_write (scm_list_n (point_sz, shape, series , family, rel_sz, SCM_UNDEFINED), scm_current_error_port ());
 243   scm_flush (scm_current_error_port ());
 244
 245   return ly_str02scm ("cmr10");
 246
 247 }
 248
 249
 250
 251 ADD_INTERFACE (Font_interface, "font-interface",
 252   "Any symbol that is typeset through fixed sets of glyphs (ie. fonts)",
 253   "font-magnification font-style font font-series font-shape font-family font-name font-design-size font-relative-size");