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