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