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 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 "score-element.hh"
  14 #include "paper-def.hh"
  15
  16
  17 SCM
  18 Font_interface::font_alist_chain (Score_element *me)
  19 {
  20   SCM defaults = gh_cdr (scm_assoc (ly_symbol2scm ("font-defaults"),
  21                                     me->paper_l ()->style_sheet_ ));
  22
  23   SCM ch = gh_list (me->mutable_property_alist_,
  24                     me->immutable_property_alist_,
  25                     defaults,
  26                     SCM_UNDEFINED);
  27
  28   return ch;
  29 }
  30
  31 /*
  32   todo: split up this func, reuse in text_item?
  33  */
  34 Font_metric *
  35 Font_interface::get_default_font (Score_element*me)
  36 {
  37   Font_metric * fm =  unsmob_metrics (me->get_elt_property ("font"));
  38   if (fm)
  39     return fm;
  40
  41   fm = get_font (me,  font_alist_chain (me));
  42   me->set_elt_property ("font", fm->self_scm ());
  43   return fm;
  44 }
  45
  46 Font_metric *
  47 Font_interface::get_font (Score_element *me, SCM chain)
  48 {
  49
  50   SCM ss = me->paper_l ()->style_sheet_;
  51
  52   SCM proc = gh_cdr (scm_assoc (ly_symbol2scm ("properties-to-font"),
  53                                 ss));
  54
  55   SCM fonts = gh_cdr (scm_assoc (ly_symbol2scm ("fonts"), ss));
  56
  57   assert (gh_procedure_p (proc));
  58   SCM font_name = gh_call2 (proc, fonts, chain);
  59
  60   Font_metric *fm = me->paper_l ()->find_font (font_name, 1.0);
  61
  62   return fm;
  63 }
  64
  65 SCM
  66 Font_interface::add_style (Score_element* me, SCM style, SCM chain)
  67 {
  68   assert (gh_symbol_p (style));
  69
  70   SCM sheet = me->paper_l ()->style_sheet_;
  71
  72   SCM style_alist = gh_cdr (scm_assoc (ly_symbol2scm ("style-alist"), sheet));
  73   SCM entry = scm_assoc (style, style_alist);
  74   if (gh_pair_p (entry))
  75     {
  76       chain = gh_cons (gh_cdr (entry), chain);
  77     }
  78   return chain;
  79 }