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