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