lily/book-paper-def.cc

   1 /*
   2   book-paper-def.cc --  implement Book_paper_def
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7
   8 */
   9
  10 #include "ly-module.hh"
  11 #include "paper-def.hh"
  12 #include "dimensions.hh"
  13 #include "book-paper-def.hh"
  14 #include "ly-smobs.icc"
  15 #include "font-metric.hh"
  16 #include "virtual-font-metric.hh"
  17 #include "scaled-font-metric.hh"
  18
  19 IMPLEMENT_SMOBS (Book_paper_def);
  20 IMPLEMENT_DEFAULT_EQUAL_P (Book_paper_def);
  21
  22 Book_paper_def::Book_paper_def ()
  23 {
  24   output_scale_ = 1.0;
  25   scaled_fonts_ = SCM_EOL;
  26   scope_ = SCM_EOL;
  27   smobify_self ();
  28   scaled_fonts_ = scm_c_make_hash_table (11);
  29   scope_ = ly_make_anonymous_module (false);
  30 }
  31
  32 Book_paper_def::Book_paper_def (Book_paper_def const & src)
  33 {
  34   output_scale_ = src.output_scale_;
  35   scope_ = SCM_EOL;
  36   scaled_fonts_ = SCM_EOL;
  37   smobify_self ();
  38   scope_= ly_make_anonymous_module (false);
  39   if (is_module (src.scope_))
  40     ly_import_module (scope_, src.scope_);
  41
  42   scaled_fonts_ = scm_c_make_hash_table (11); // copying is not done with live defs. hopefully.
  43 }
  44
  45 Book_paper_def::~Book_paper_def ()
  46 {
  47 }
  48
  49 SCM
  50 Book_paper_def::mark_smob (SCM m)
  51 {
  52   Book_paper_def *mo = (Book_paper_def*) SCM_CELL_WORD_1 (m);
  53
  54   scm_gc_mark (mo->scope_);
  55   return mo->scaled_fonts_;
  56 }
  57
  58 int
  59 Book_paper_def::print_smob (SCM s, SCM p, scm_print_state*)
  60 {
  61   (void) s;
  62   scm_puts ("#<Book_paper>", p);
  63   return 1;
  64 }
  65
  66 Font_metric*
  67 Book_paper_def::find_scaled_font (Font_metric *f, Real m, SCM input_enc_name)
  68 {
  69   Real lookup_mag = m;
  70   if (!dynamic_cast<Virtual_font_metric*> (f))
  71     lookup_mag /= output_scale_;
  72
  73   SCM sizes = scm_hashq_ref (scaled_fonts_, f->self_scm (), SCM_BOOL_F);
  74   if (sizes != SCM_BOOL_F)
  75     {
  76       SCM met = scm_assoc (scm_make_real (lookup_mag), sizes);
  77       if (ly_c_pair_p (met))
  78         return unsmob_metrics (ly_cdr (met));
  79     }
  80   else
  81     sizes = SCM_EOL;
  82
  83   /* Hmm. We're chaining font - metrics.  Should consider whether to
  84      merge virtual-font and scaled_font.  */
  85   SCM val = SCM_EOL;
  86   if (Virtual_font_metric * vf = dynamic_cast<Virtual_font_metric*> (f))
  87     {
  88       /*
  89         For fontify_atom (), the magnification and name must be known
  90         at the same time. That's impossible for
  91
  92           Scaled (Virtual_font (Font1,Font2))
  93
  94         so we replace by
  95
  96           Virtual_font (Scaled (Font1), Scaled (Font2))
  97
  98       */
  99
 100       SCM lst = SCM_EOL;
 101       SCM *t = &lst;
 102       for (SCM s = vf->get_font_list (); ly_c_pair_p (s); s = ly_cdr (s))
 103         {
 104           Font_metric *scaled = find_scaled_font (unsmob_metrics (ly_car (s)),
 105                                                   m, input_enc_name);
 106           *t = scm_cons (scaled->self_scm (), SCM_EOL);
 107           t = SCM_CDRLOC (*t);
 108         }
 109
 110       vf = new Virtual_font_metric (lst);
 111       val = vf->self_scm ();
 112     }
 113   else
 114     {
 115       if (!ly_c_symbol_p (input_enc_name))
 116         {
 117 #if 0
 118           /* FIXME.*/
 119           SCM var = ly_module_lookup (scope_, ly_symbol2scm ("inputencoding"));
 120           input_enc_name = scm_variable_ref (var);
 121
 122 #endif
 123           input_enc_name = ly_symbol2scm ("latin1");
 124         }
 125
 126       val = Modified_font_metric::make_scaled_font_metric (input_enc_name,
 127                                                            f, lookup_mag);
 128     }
 129
 130   sizes = scm_acons (scm_make_real (lookup_mag), val, sizes);
 131   scm_gc_unprotect_object (val);
 132   scm_hashq_set_x (scaled_fonts_, f->self_scm (), sizes);
 133   return unsmob_metrics (val);
 134 }
 135
 136 Paper_def *
 137 Book_paper_def::scale_paper (Paper_def *pd) const
 138 {
 139   SCM proc = ly_scheme_function ("scale-paper");
 140   SCM new_pap = scm_call_2 (proc, pd->self_scm (), self_scm ());
 141
 142   scm_gc_protect_object (new_pap);
 143
 144   Paper_def *p = unsmob_paper (new_pap);
 145
 146   p->bookpaper_ = (Book_paper_def*) this;
 147   return p;
 148 }
 149
 150 LY_DEFINE (ly_make_bookpaper, "ly:make-bookpaper",
 151            1, 0, 0,
 152            (SCM size),
 153            "Make a paperbook, for staff space SIZE, which is in INTERNAL_UNIT.")
 154 {
 155   Book_paper_def *bp = new Book_paper_def ;
 156
 157   SCM_ASSERT_TYPE (ly_c_number_p (size), size,
 158                    SCM_ARG1, __FUNCTION__, "number");
 159
 160   bp->output_scale_ = (ly_scm2double (size)) MM;
 161
 162   return scm_gc_unprotect_object (bp->self_scm ());
 163 }
 164
 165 LY_DEFINE (ly_bookpaper_fonts, "ly:bookpaper-fonts",
 166            1, 0, 0,
 167            (SCM bp),
 168            "Return fonts scaled up BP")
 169 {
 170   Book_paper_def *b = unsmob_book_paper_def (bp);
 171
 172   SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "bookpaper");
 173
 174   SCM func = ly_scheme_function ("hash-table->alist");
 175
 176   SCM ell = SCM_EOL;
 177   for (SCM s = scm_call_1 (func, b->scaled_fonts_); ly_c_pair_p (s);
 178        s = ly_cdr (s))
 179     {
 180       SCM entry = ly_car (s);
 181       for (SCM t = ly_cdr (entry); ly_c_pair_p (t); t  = ly_cdr (t))
 182         {
 183           Font_metric *fm = unsmob_metrics (ly_cdar (t));
 184
 185           if (dynamic_cast<Modified_font_metric*> (fm))
 186             ell = scm_cons (fm->self_scm (), ell);
 187         }
 188     }
 189   return ell;
 190 }
 191
 192
 193 LY_DEFINE (ly_bookpaper_outputscale, "ly:bookpaper-outputscale",
 194           1, 0, 0,
 195           (SCM bp),
 196           "Get outputscale for BP.")
 197 {
 198   Book_paper_def *b = unsmob_book_paper_def (bp);
 199   SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "bookpaper");
 200   return scm_make_real (b->output_scale_);
 201 }
 202
 203
 204 SCM
 205 Book_paper_def::lookup_variable (SCM sym) const
 206 {
 207   SCM var = ly_module_lookup (scope_, sym);
 208
 209   return scm_variable_ref (var);
 210 }
 211
 212 SCM
 213 Book_paper_def::c_variable (String s) const
 214 {
 215   return lookup_variable (ly_symbol2scm (s.to_str0 ()));
 216 }
 217
 218
 219 LY_DEFINE (ly_book_paper_def_scope, "ly:bookpaper-def-scope",
 220            1, 0,0, (SCM def),
 221            "Get the variable scope inside @var{def}.")
 222 {
 223   Book_paper_def *op = unsmob_book_paper_def (def);
 224   SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition");
 225   return op->scope_;
 226 }