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   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
  73
  74   return Font_interface::get_default_font (gr)->self_scm ();
  75 }
  76
  77 SCM
  78 ly_font_interface_get_font (SCM grob, SCM alist)
  79 {
  80   Grob * gr  = unsmob_grob (grob);
  81   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob");
  82
  83   Font_metric*fm=
  84     Font_interface::get_font (gr, gh_cons (alist,
  85                                            Font_interface::font_alist_chain (gr)));
  86
  87   return fm->self_scm();
  88 }
  89
  90
  91
  92 Font_metric *
  93 Font_interface::get_font (Grob *me, SCM chain)
  94 {
  95   SCM name = me->get_grob_property ("font-name");
  96
  97   if (!gh_string_p (name))
  98     {
  99       SCM ss = me->paper_l ()->style_sheet_;
 100
 101       SCM proc = ly_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"),
 102                                     ss));
 103
 104       SCM fonts = ly_cdr (scm_assoc (ly_symbol2scm ("fonts"), ss));
 105
 106       assert (gh_procedure_p (proc));
 107       name = gh_call2 (proc, fonts, chain);
 108     }
 109
 110   SCM mag = me->get_grob_property ("font-magnification");
 111   Real rmag = gh_number_p (mag) ? gh_scm2double (mag) : 1.0;
 112
 113   Font_metric *fm = me->paper_l ()->find_font (name, rmag);
 114   return fm;
 115 }
 116
 117 SCM
 118 Font_interface::add_style (Grob* me, SCM style, SCM chain)
 119 {
 120   assert (gh_symbol_p (style));
 121
 122   SCM sheet = me->paper_l ()->style_sheet_;
 123
 124   SCM style_alist = ly_cdr (scm_assoc (ly_symbol2scm ("style-alist"), sheet));
 125   SCM entry = scm_assoc (style, style_alist);
 126   if (gh_pair_p (entry))
 127     {
 128       chain = gh_cons (ly_cdr (entry), chain);
 129     }
 130   return chain;
 131 }
 132
 133 /*
 134 SCM routines:
 135
 136 Interpreting music...
 137 MIDI output to wtk1-fugue2.midi...
 138 Track ...
 139
 140 real    0m31.862s
 141 user    0m29.110s
 142 sys     0m0.260s
 143
 144 real    0m26.964s
 145 user    0m24.850s
 146 sys     0m0.280s
 147
 148
 149 so a 14% speedup.
 150
 151 */
 152
 153 static SCM shape_sym, family_sym, series_sym, rel_sz_sym, design_sz_sym, wild_sym;
 154
 155
 156 static void
 157 init_syms ()
 158 {
 159   shape_sym  = scm_permanent_object (ly_symbol2scm ("font-shape"));
 160   family_sym = scm_permanent_object (ly_symbol2scm ("font-family"));
 161   series_sym = scm_permanent_object (ly_symbol2scm ("font-series"));
 162   rel_sz_sym = scm_permanent_object (ly_symbol2scm ("font-relative-size"));
 163   design_sz_sym = scm_permanent_object (ly_symbol2scm ("font-design-size"));
 164   wild_sym = scm_permanent_object (ly_symbol2scm ("*"));
 165
 166   scm_c_define_gsubr ("ly-get-default-font", 1 , 0, 0,
 167                       (Scheme_function_unknown) ly_font_interface_get_default_font);
 168   scm_c_define_gsubr ("ly-get-font", 2, 0, 0,
 169                       (Scheme_function_unknown) ly_font_interface_get_font);
 170 }
 171
 172
 173 bool
 174 Font_interface::wild_compare (SCM field_val, SCM val)
 175 {
 176   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 177 }
 178
 179 ADD_SCM_INIT_FUNC (Font_interface_syms,init_syms);
 180
 181
 182 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
 183 SCM
 184 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
 185 {
 186   SCM shape = SCM_BOOL_F;
 187   SCM family = SCM_BOOL_F;
 188   SCM series = SCM_BOOL_F;
 189
 190
 191   SCM point_sz = ly_assoc_chain (design_sz_sym, alist_chain);
 192   SCM rel_sz = SCM_BOOL_F;
 193
 194   shape = ly_assoc_chain (shape_sym, alist_chain);
 195   family = ly_assoc_chain (family_sym, alist_chain);
 196   series = ly_assoc_chain (series_sym, alist_chain);
 197
 198   if (gh_pair_p (shape))
 199     shape = ly_cdr (shape);
 200   if (gh_pair_p (family))
 201     family = ly_cdr (family);
 202   if (gh_pair_p (series))
 203     series = ly_cdr (series);
 204
 205
 206   if (gh_pair_p (point_sz))
 207     point_sz = ly_cdr (point_sz);
 208   else
 209     {
 210       rel_sz = ly_assoc_chain (rel_sz_sym, alist_chain);
 211       if (gh_pair_p (rel_sz))
 212         rel_sz = ly_cdr (rel_sz);
 213     }
 214
 215   for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
 216     {
 217       SCM qlist = ly_caar (s);
 218
 219       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
 220         continue;
 221       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
 222         continue;
 223       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 224         continue;
 225
 226       if (point_sz == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_sz))
 227         continue;
 228
 229       SCM qname = ly_cdar (s);
 230       return qname;
 231     }
 232
 233   warning (_ ("couldn't find any font satisfying "));
 234   scm_write (scm_list_n (point_sz, shape, series , family, rel_sz, SCM_UNDEFINED), scm_current_error_port ());
 235   scm_flush (scm_current_error_port ());
 236
 237   return ly_str02scm ("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");