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