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