lily/output-def-scheme.cc

   1 /*
   2   output-def-scheme.cc --  implement Output_def bindings
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7
   8 */
   9
  10 #include "font-metric.hh"
  11 #include "pango-font.hh"
  12 #include "modified-font-metric.hh"
  13 #include "output-def.hh"
  14 #include "ly-module.hh"
  15 #include "context-def.hh"
  16
  17 LY_DEFINE (ly_layout_lookup, "ly:output-def-lookup",
  18            2, 0, 0, (SCM pap, SCM sym),
  19            "Lookup @var{sym} in @var{pap}. "
  20            "Return the value or @code{'()} if undefined.")
  21 {
  22   Output_def *op = unsmob_output_def (pap);
  23   SCM_ASSERT_TYPE (op, pap, SCM_ARG1, __FUNCTION__, "Output_def");
  24   SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
  25
  26   return op->lookup_variable (sym);
  27 }
  28
  29 LY_DEFINE (ly_output_def_scope, "ly:output-def-scope",
  30            1, 0, 0, (SCM def),
  31            "Get the variable scope inside @var{def}.")
  32 {
  33   Output_def *op = unsmob_output_def (def);
  34   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
  35   return op->scope_;
  36 }
  37
  38 LY_DEFINE (ly_output_def_parent, "ly:output-def-parent",
  39            1, 0, 0, (SCM def),
  40            "Get the parent output-def of @var{def}.")
  41 {
  42   Output_def *op = unsmob_output_def (def);
  43   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
  44   return op->parent_ ? op->parent_->self_scm () : SCM_EOL;
  45 }
  46
  47 LY_DEFINE (ly_output_def_clone, "ly:output-def-clone",
  48            1, 0, 0, (SCM def),
  49            "Clone @var{def}.")
  50 {
  51   Output_def *op = unsmob_output_def (def);
  52   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
  53   SCM s = op->clone ()->self_scm ();
  54   scm_gc_unprotect_object (s);
  55   return s;
  56 }
  57
  58 LY_DEFINE (ly_output_description, "ly:output-description",
  59            1, 0, 0, (SCM output_def),
  60            "Return the description of translators in @var{output-def}.")
  61 {
  62   Output_def *id = unsmob_output_def (output_def);
  63
  64   SCM al = ly_module2alist (id->scope_);
  65
  66   SCM ell = SCM_EOL;
  67   for (SCM s = al; scm_is_pair (s); s = scm_cdr (s))
  68     {
  69       Context_def * td = unsmob_context_def (scm_cdar (s));
  70       SCM key = scm_caar (s);
  71       if (td && key == td->get_context_name ())
  72         ell = scm_cons (scm_cons (key, td->to_alist ()),  ell);
  73     }
  74   return ell;
  75 }
  76
  77 LY_DEFINE (ly_layout_def_p, "ly:layout-def?",
  78            1, 0, 0, (SCM def),
  79            "Is @var{def} a layout definition?")
  80 {
  81   return ly_bool2scm (unsmob_output_def (def));
  82 }
  83
  84 LY_DEFINE (ly_paper_outputscale, "ly:paper-outputscale",
  85           1, 0, 0, (SCM bp),
  86           "Get outputscale for BP.")
  87 {
  88   Output_def *b = unsmob_output_def (bp);
  89   SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper");
  90   return scm_make_real (output_scale (b));
  91 }
  92
  93 LY_DEFINE (ly_make_output_def, "ly:make-output-def",
  94            0, 0, 0, (),
  95            "Make a output def.")
  96 {
  97   Output_def *bp = new Output_def ;
  98   return scm_gc_unprotect_object (bp->self_scm ());
  99 }
 100
 101 LY_DEFINE (ly_paper_get_font, "ly:paper-get-font", 2, 0, 0,
 102            (SCM paper_smob, SCM chain),
 103
 104            "Return a font metric satisfying the font-qualifiers "
 105            "in the alist chain @var{chain}.\n"
 106            "(An alist chain is a list of alists, "
 107            "containing grob properties).\n")
 108 {
 109   Output_def *paper = unsmob_output_def (paper_smob);
 110   SCM_ASSERT_TYPE (paper, paper_smob, SCM_ARG1,
 111                    __FUNCTION__, "paper definition");
 112
 113   Font_metric *fm = select_font (paper, chain);
 114   return fm->self_scm ();
 115 }
 116
 117 LY_DEFINE (ly_paper_get_number, "ly:paper-get-number", 2, 0, 0,
 118            (SCM layout_smob, SCM name),
 119            "Return the layout variable @var{name}.")
 120 {
 121   Output_def *layout = unsmob_output_def (layout_smob);
 122   SCM_ASSERT_TYPE (layout, layout_smob, SCM_ARG1,
 123                    __FUNCTION__, "layout definition");
 124   return scm_make_real (layout->get_dimension (name));
 125 }
 126
 127 LY_DEFINE (ly_paper_fonts, "ly:paper-fonts",
 128            1, 0, 0,
 129            (SCM bp),
 130            "Return fonts from the @code{\\paper} block @var{bp}.")
 131 {
 132   Output_def *b = unsmob_output_def (bp);
 133
 134
 135   SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper");
 136
 137   SCM tab1 = b->lookup_variable (ly_symbol2scm ("scaled-fonts"));
 138   SCM tab2 = b->lookup_variable (ly_symbol2scm ("pango-fonts"));
 139
 140   SCM alist1 = SCM_EOL;
 141   if (scm_hash_table_p (tab1) == SCM_BOOL_T)
 142     {
 143       alist1 = scm_append (ly_alist_vals (ly_hash2alist (tab1)));
 144
 145       alist1 = ly_alist_vals (alist1);
 146     }
 147
 148   SCM alist2 = SCM_EOL;
 149   if (scm_hash_table_p (tab2) == SCM_BOOL_T)
 150     {
 151       // strip original-fonts/pango-font-descriptions
 152       alist2 = scm_append (ly_alist_vals (ly_hash2alist (tab2)));
 153
 154       // strip size factors
 155       alist2 = ly_alist_vals (alist2);
 156     }
 157
 158   SCM alist = scm_append (scm_list_2 (alist1, alist2));
 159   SCM font_list = SCM_EOL;
 160   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
 161     {
 162       SCM entry = scm_car (s);
 163
 164       Font_metric *fm = unsmob_metrics (entry);
 165
 166       if (dynamic_cast<Modified_font_metric*> (fm)
 167           || dynamic_cast<Pango_font*> (fm))
 168         font_list = scm_cons (fm->self_scm (), font_list);
 169     }
 170
 171   return font_list;
 172 }