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_make_gsubr ("ly-get-default-font", 1 , 0, 0, (Scheme_function_unknown) ly_font_interface_get_default_font);
 148 }
 149
 150
 151 bool
 152 Font_interface::wild_compare (SCM field_val, SCM val)
 153 {
 154   return (val == SCM_BOOL_F || field_val == wild_sym || field_val == val);
 155 }
 156
 157 ADD_SCM_INIT_FUNC (Font_interface_syms,init_syms);
 158
 159
 160 MAKE_SCHEME_CALLBACK (Font_interface,properties_to_font_name,2);
 161 SCM
 162 Font_interface::properties_to_font_name (SCM fonts, SCM alist_chain)
 163 {
 164   SCM name = ly_assoc_chain (name_sym, alist_chain);
 165
 166   SCM shape = SCM_BOOL_F;
 167   SCM family = SCM_BOOL_F;
 168   SCM series = SCM_BOOL_F;
 169
 170
 171   SCM point_sz = ly_assoc_chain (design_sz_sym, alist_chain);
 172   SCM rel_sz = SCM_BOOL_F;
 173
 174   if (!gh_pair_p (name))
 175     {
 176        shape = ly_assoc_chain (shape_sym, alist_chain);
 177        family = ly_assoc_chain (family_sym, alist_chain);
 178        series = ly_assoc_chain (series_sym, alist_chain);
 179
 180        if (gh_pair_p (shape))
 181          shape = gh_cdr (shape);
 182        if (gh_pair_p (family))
 183          family = gh_cdr (family);
 184        if (gh_pair_p (series))
 185          series = gh_cdr (series);
 186     }
 187   else
 188     name = gh_cdr (name);
 189
 190
 191   if (gh_pair_p (point_sz))
 192     point_sz = gh_cdr (point_sz);
 193   else
 194     {
 195       rel_sz = ly_assoc_chain (rel_sz_sym, alist_chain);
 196       if (gh_pair_p (rel_sz))
 197         rel_sz = gh_cdr (rel_sz);
 198     }
 199
 200   for (SCM s = fonts ; gh_pair_p (s); s = gh_cdr (s))
 201     {
 202       SCM qlist = gh_caar (s);
 203
 204       if (name != SCM_BOOL_F)
 205         {
 206           if (!wild_compare (scm_list_ref (qlist, gh_int2scm (4)), name))
 207             continue;
 208         }
 209       else
 210         {
 211           if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
 212             continue;
 213           if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
 214             continue;
 215           if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 216             continue;
 217         }
 218
 219       if (point_sz != SCM_BOOL_F)
 220         {
 221           // This if statement will always be true since name must
 222           // be SCM_BOOL_F here, right?  /MB
 223           if (!wild_compare (scm_list_ref (qlist, gh_int2scm (4)), name))
 224             continue;
 225         }
 226       else
 227         {
 228           if (!wild_compare (gh_car (qlist), rel_sz))
 229             continue;
 230         }
 231
 232
 233       SCM qname = gh_cdar (s);
 234       return qname;
 235     }
 236
 237   warning (_ ("couldn't find any font satisfying "));
 238   scm_write (gh_list (name, point_sz, shape, series , family, rel_sz, SCM_UNDEFINED), scm_current_error_port ());
 239   scm_flush (scm_current_error_port ());
 240
 241   return ly_str02scm ("cmr10");
 242
 243 }