lily/object-key-dumper.cc

   1 /*
   2   object-key-dumper.cc -- implement Object_key_dumper
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2004--2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #include "object-key-dumper.hh"
  10
  11 #include "moment.hh"
  12
  13 #include "ly-smobs.icc"
  14
  15 SCM
  16 Object_key_dumper::mark_smob (SCM smob)
  17 {
  18   Object_key_dumper *dumper = (Object_key_dumper *) SCM_CELL_WORD_1 (smob);
  19
  20   for (Key_to_key_map::const_iterator i (dumper->serialized_keys_.begin ());
  21        i != dumper->serialized_keys_.end ();
  22        i++)
  23     scm_gc_mark ((*i).first->self_scm ());
  24   return SCM_EOL;
  25 }
  26
  27 int
  28 Object_key_dumper::print_smob (SCM, SCM port, scm_print_state*)
  29 {
  30   scm_puts ("#<Object_key_dumper>", port);
  31   return 1;
  32 }
  33
  34 IMPLEMENT_DEFAULT_EQUAL_P (Object_key_dumper);
  35 IMPLEMENT_SMOBS (Object_key_dumper);
  36
  37 Object_key_dumper::Object_key_dumper ()
  38 {
  39   file_contents_ = SCM_EOL;
  40   next_available_ = 0;
  41   smobify_self ();
  42 }
  43
  44 SCM
  45 Object_key_dumper::key_serial (int k)
  46 {
  47   return scm_list_2 (ly_symbol2scm ("key"),
  48                      scm_from_int (k));
  49 }
  50
  51 SCM
  52 Object_key_dumper::serialize_key (Object_key const *key)
  53 {
  54   SCM skey = key->dump ();
  55   for (SCM s = skey; scm_is_pair (s); s = scm_cdr (s))
  56     {
  57       if (Object_key const *sub_key = unsmob_key (scm_car (s)))
  58         scm_set_car_x (s, dump_key (sub_key));
  59       else if (Moment *mom = unsmob_moment (scm_car (s)))
  60         {
  61           scm_set_car_x (s,
  62                          scm_list_2 (ly_symbol2scm ("unquote"),
  63                                      mom->as_scheme ()));
  64         }
  65     }
  66
  67   file_contents_ = scm_cons (scm_list_3 (ly_symbol2scm ("define-key"),
  68                                          scm_from_int (next_available_),
  69                                          skey),
  70                              file_contents_);
  71
  72   serialized_keys_[key] = key;
  73   key_serial_numbers_[key] = next_available_;
  74   SCM retval = key_serial (next_available_);
  75   next_available_++;
  76
  77   return retval;
  78 }
  79
  80 SCM
  81 Object_key_dumper::dump_key (Object_key const *key)
  82 {
  83   if (key_serial_numbers_.find (key) != key_serial_numbers_.end ())
  84     return key_serial (key_serial_numbers_[key]);
  85   else if (Object_key const *serialized = serialized_keys_[key])
  86     return key_serial (key_serial_numbers_[ serialized_keys_ [serialized] ]);
  87
  88   return serialize_key (key);
  89 }
  90
  91 SCM
  92 Object_key_dumper::get_file_contents () const
  93 {
  94   return scm_reverse (file_contents_);
  95 }
  96
  97 Object_key_dumper::~Object_key_dumper ()
  98 {
  99 }