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     {
  24       scm_gc_mark ((*i).first->self_scm ());
  25     }
  26   return SCM_EOL;
  27 }
  28
  29 int
  30 Object_key_dumper::print_smob (SCM, SCM port, scm_print_state*)
  31 {
  32   scm_puts ("#<Object_key_dumper>", port);
  33   return 1;
  34 }
  35
  36 IMPLEMENT_DEFAULT_EQUAL_P (Object_key_dumper);
  37 IMPLEMENT_SMOBS (Object_key_dumper);
  38
  39 Object_key_dumper::Object_key_dumper ()
  40 {
  41   file_contents_ = SCM_EOL;
  42   next_available_ = 0;
  43   smobify_self ();
  44 }
  45
  46 SCM
  47 Object_key_dumper::key_serial (int k)
  48 {
  49   return scm_list_2 (ly_symbol2scm ("key"),
  50                      scm_from_int (k));
  51 }
  52
  53 SCM
  54 Object_key_dumper::serialize_key (Object_key const *key)
  55 {
  56   SCM skey = key->dump ();
  57   for (SCM s = skey; scm_is_pair (s); s = scm_cdr (s))
  58     {
  59       if (Object_key const *sub_key = unsmob_key (scm_car (s)))
  60         {
  61           scm_set_car_x (s, dump_key (sub_key));
  62         }
  63       else if (Moment *mom = unsmob_moment (scm_car (s)))
  64         {
  65           scm_set_car_x (s,
  66                          scm_list_2 (ly_symbol2scm ("unquote"),
  67                                      mom->as_scheme ()));
  68         }
  69     }
  70
  71   file_contents_ = scm_cons (scm_list_3 (ly_symbol2scm ("define-key"),
  72                                          scm_from_int (next_available_),
  73                                          skey),
  74                              file_contents_);
  75
  76   serialized_keys_[key] = key;
  77   key_serial_numbers_[key] = next_available_;
  78   SCM retval = key_serial (next_available_);
  79   next_available_++;
  80
  81   return retval;
  82 }
  83
  84 SCM
  85 Object_key_dumper::dump_key (Object_key const *key)
  86 {
  87   if (key_serial_numbers_.find (key) != key_serial_numbers_.end ())
  88     {
  89       return key_serial (key_serial_numbers_[key]);
  90     }
  91   else if (Object_key const *serialized = serialized_keys_[key])
  92     {
  93       return key_serial (key_serial_numbers_[ serialized_keys_ [serialized] ]);
  94     }
  95
  96   return serialize_key (key);
  97 }
  98
  99 SCM
 100 Object_key_dumper::get_file_contents () const
 101 {
 102   return scm_reverse (file_contents_);
 103 }
 104
 105 Object_key_dumper::~Object_key_dumper ()
 106 {
 107 }