lily/font-select.cc

   1 #include "paper-def.hh"
   2 #include "font-interface.hh"
   3 #include "warn.hh"
   4
   5
   6 /*
   7   TODO revise font handling.
   8
   9
  10 * relative sizes should relate to staff-space, eg.  font-staff-space
  11 = 1.2 ^ relative-size
  12
  13 * If a relative size is given, lily should magnify the closest
  14 design size font to match that. (ie. fonts should have variable
  15 scaling)
  16
  17 (this requires that fonts are stored as (filename , designsize))
  18
  19
  20
  21  */
  22
  23
  24
  25
  26 LY_DEFINE(ly_paper_get_font,"ly:paper-get-font", 2, 0, 0,
  27           (SCM paper, SCM chain),
  28           "Return a font metric satisfying the font-qualifiers in the alist chain @var{chain}.\n"
  29 "\n"
  30 "The font object represents the metric information of a font. Every font\n"
  31 "that is loaded into LilyPond can be accessed via Scheme. \n"
  32 "\n"
  33 "LilyPond only needs to know the dimension of glyph to be able to process\n"
  34 "them. This information is stored in font metric files. LilyPond can read\n"
  35 "two types of font-metrics: @TeX{} Font Metric files (TFM files) and\n"
  36 "Adobe Font Metric files (AFM files).  LilyPond will always try to load\n"
  37 "AFM files first since they are more versatile.\n"
  38 "\n"
  39 "An alist chain is a list of alists, containing grob properties.\n")
  40 {
  41   Paper_def *pap = unsmob_paper (paper);
  42   SCM_ASSERT_TYPE(pap, paper, SCM_ARG1, __FUNCTION__, "paper definition");
  43
  44   Font_metric*fm = select_font (pap, chain);
  45   return fm->self_scm();
  46 }
  47
  48
  49 bool
  50 wild_compare (SCM field_val, SCM val)
  51 {
  52   return (val == SCM_BOOL_F || field_val == ly_symbol2scm ("*") || field_val == val);
  53 }
  54
  55 /*
  56   We can probably get more efficiency points if we preprocess FONTS
  57   to make lookup easier.
  58  */
  59 SCM
  60 properties_to_font_name (SCM fonts, SCM alist_chain)
  61 {
  62   SCM shape = SCM_BOOL_F;
  63   SCM family = SCM_BOOL_F;
  64   SCM series = SCM_BOOL_F;
  65
  66
  67   SCM point_sz = ly_assoc_chain (ly_symbol2scm ("font-design-size"), alist_chain);
  68   SCM rel_sz = SCM_BOOL_F;
  69
  70   shape = ly_assoc_chain (ly_symbol2scm ("font-shape"), alist_chain);
  71   family = ly_assoc_chain (ly_symbol2scm ("font-family"), alist_chain);
  72   series = ly_assoc_chain (ly_symbol2scm ("font-series"), alist_chain);
  73
  74   if (gh_pair_p (shape))
  75     shape = ly_cdr (shape);
  76   if (gh_pair_p (family))
  77     family = ly_cdr (family);
  78   if (gh_pair_p (series))
  79     series = ly_cdr (series);
  80
  81
  82   if (gh_pair_p (point_sz))
  83     point_sz = ly_cdr (point_sz);
  84   else
  85     {
  86       rel_sz = ly_assoc_chain (ly_symbol2scm ("font-relative-size"), alist_chain);
  87       if (gh_pair_p (rel_sz))
  88         rel_sz = ly_cdr (rel_sz);
  89     }
  90
  91   for (SCM s = fonts ; gh_pair_p (s); s = ly_cdr (s))
  92     {
  93       SCM qlist = ly_caar (s);
  94
  95       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (1)), series))
  96         continue;
  97       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (2)), shape))
  98         continue;
  99       if (!wild_compare (scm_list_ref (qlist, gh_int2scm (3)), family))
 100         continue;
 101
 102       if (point_sz == SCM_BOOL_F && !wild_compare (ly_car (qlist), rel_sz))
 103         continue;
 104
 105       SCM qname = ly_cdar (s);
 106       return qname;
 107     }
 108
 109   warning (_ ("couldn't find any font satisfying "));
 110   scm_write (scm_list_n (point_sz, shape, series , family, rel_sz,
 111                          SCM_UNDEFINED), scm_current_error_port ());
 112   scm_flush (scm_current_error_port ());
 113
 114   return scm_makfrom0str ("cmr10");
 115
 116 }
 117
 118
 119 Font_metric *
 120 select_font (Paper_def *paper, SCM chain)
 121 {
 122   SCM name = ly_assoc_chain (ly_symbol2scm  ("font-name"), chain);
 123
 124   if (!gh_pair_p (name) || !gh_string_p (gh_cdr (name)))
 125     {
 126       SCM fonts = paper->lookup_variable (ly_symbol2scm ("fonts"));
 127       name = properties_to_font_name (fonts, chain);
 128     }
 129   else
 130     name  = gh_cdr (name);
 131
 132   SCM mag = ly_assoc_chain (ly_symbol2scm ("font-magnification"), chain);
 133
 134   Real rmag = gh_pair_p (mag) && gh_number_p (gh_cdr (mag))
 135     ? gh_scm2double (gh_cdr (mag)) : 1.0;
 136
 137   Font_metric *fm = paper->find_font (name, rmag);
 138   return fm;
 139 }