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 SCM
  69 ly_font_interface_get_default_font (SCM grob)
  70 {
  71   Grob * gr  = unsmob_grob (grob);
  72
  73   if (!gr)
  74     {
  75       warning ("ly_font_interface_get_default_font (): invalid argument");
  76       return SCM_UNDEFINED;
  77     }
  78
  79   return Font_interface::get_default_font (gr)->self_scm ();
  80 }
  81
  82 SCM
  83 ly_font_interface_get_font (SCM grob, SCM alist)
  84 {
  85   Grob * gr  = unsmob_grob (grob);
  86   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
  87
  88   Font_metric*fm=
  89     Font_interface::get_font (gr, gh_cons (alist,
  90                                            Font_interface::font_alist_chain (gr)));
  91
  92   return fm->self_scm();
  93 }
  94
  95
  96
  97 Font_metric *
  98 Font_interface::get_font (Grob *me, SCM chain)
  99 {
 100   SCM name = me->get_grob_property ("font-name");
 101
 102   if (!gh_string_p (name))
 103     {
 104       SCM ss = me->paper_l ()->style_sheet_;
 105
 106       SCM proc = ly_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"),
 107                                     ss));
 108
 109       SCM fonts = ly_cdr (scm_assoc (ly_symbol2scm ("fonts"), ss));
 110
 111       assert (gh_procedure_p (proc));
 112       name = gh_call2 (proc, fonts, chain);
 113     }
 114
 115   SCM mag = me->get_grob_property ("font-magnification");
 116   Real rmag = gh_number_p (mag) ? gh_scm2double (mag) : 1.0;
 117
 118   Font_metric *fm = me->paper_l ()->find_font (name, rmag);
 119   return fm;
 120 }
 121
 122 SCM
 123 Font_interface::add_style (Grob* me, SCM style, SCM chain)
 124 {
 125   assert (gh_symbol_p (style));
 126
 127   SCM sheet = me->paper_l ()->style_sheet_;
 128
 129   SCM style_alist = ly_cdr (scm_assoc (ly_symbol2scm ("style-alist"), sheet));
 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_sz_sym, design_sz_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_sz_sym = scm_permanent_object (ly_symbol2scm ("font-relative-size"));
 168   design_sz_sym = scm_permanent_object (ly_symbol2scm ("font-design-size"));
 169   wild_sym = scm_permanent_object (ly_symbol2scm ("*"));
 170
 171   scm_c_define_gsubr ("ly-get-default-font", 1 , 0, 0,
 172                       (Scheme_function_unknown) ly_font_interface_get_default_font);
 173   scm_c_define_gsubr ("ly-get-font", 2, 0, 0,
 174                       (Scheme_function_unknown) ly_font_interface_get_font);
 175 }
 176
 177
 178 bool
 179 Font_interface::wild_compare (SCM field_val, SCM val)
 180 {
 181   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 182 }
 183
 184 ADD_SCM_INIT_FUNC (Font_interface_syms,init_syms);
 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_sz = ly_assoc_chain (design_sz_sym, alist_chain);
 197   SCM rel_sz = 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_sz))
 212     point_sz = ly_cdr (point_sz);
 213   else
 214     {
 215       rel_sz = ly_assoc_chain (rel_sz_sym, alist_chain);
 216       if (gh_pair_p (rel_sz))
 217         rel_sz = ly_cdr (rel_sz);
 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_sz == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_sz))
 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_sz, shape, series , family, rel_sz, SCM_UNDEFINED), scm_current_error_port ());
 240   scm_flush (scm_current_error_port ());
 241
 242   return ly_str02scm ("cmr10");
 243
 244 }