/*
- stream-event.cc -- implement Stream_event
+ This file is part of LilyPond, the GNU music typesetter.
- source file of the GNU LilyPond music typesetter
+ Copyright (C) 2005--2015 Erik Sandberg <mandolaerik@gmail.com>
- (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
+ LilyPond is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ LilyPond is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
*/
#include "stream-event.hh"
-#include "ly-smobs.icc"
#include "context.hh"
#include "input.hh"
-#include "input-smob.hh"
-
-Stream_event::~Stream_event ()
-{
-}
-
-void
-Stream_event::init ()
-{
- self_scm_ = SCM_EOL;
- property_alist_ = SCM_EOL;
+#include "music.hh"
+#include "pitch.hh"
- smobify_self ();
-}
+/* TODO: Rename Stream_event -> Event */
Stream_event::Stream_event ()
+ : Prob (ly_symbol2scm ("Stream_event"), SCM_EOL)
{
- init ();
}
-Stream_event::Stream_event (SCM property_alist)
+Stream_event::Stream_event (SCM event_class, SCM immutable_props)
+ : Prob (ly_symbol2scm ("Stream_event"),
+ scm_acons (ly_symbol2scm ("class"), event_class, immutable_props))
{
- init ();
- property_alist_ = property_alist;
}
-/*
- Hm. Perhaps Stream_event should be a prob, with class_name as an
- immutable property?
- */
Stream_event::Stream_event (SCM class_name, Input *origin)
+ : Prob (ly_symbol2scm ("Stream_event"),
+ scm_list_1 (scm_cons (ly_symbol2scm ("class"), class_name)))
{
- init ();
- set_property ("class", class_name);
if (origin)
set_spot (origin);
}
-Stream_event::Stream_event (Stream_event *ev)
+SCM
+Stream_event::copy_mutable_properties () const
{
- init ();
- property_alist_ = scm_copy_tree (ev->property_alist_);
+ return ly_event_deep_copy (mutable_property_alist_);
}
Input *
Stream_event::origin () const
{
- Input *i = unsmob_input (get_property ("origin"));
+ Input *i = unsmob<Input> (get_property ("origin"));
return i ? i : &dummy_input_global;
}
-void Stream_event::set_spot (Input *i)
-{
- set_property ("origin", make_input (*i));
-}
-
-SCM
-Stream_event::mark_smob (SCM sm)
+void
+Stream_event::set_spot (Input *i)
{
- Stream_event *me = (Stream_event *) SCM_CELL_WORD_1 (sm);
- return me->property_alist_;
+ set_property ("origin", i->smobbed_copy ());
}
-int
-Stream_event::print_smob (SCM s, SCM port, scm_print_state *)
+bool
+Stream_event::internal_in_event_class (SCM class_name)
{
- scm_puts ("#<Stream_event ", port);
- scm_write (dump (s), port);
- scm_puts (" >", port);
- return 1;
+ SCM cl = get_property ("class");
+ return scm_is_true (scm_c_memq (class_name, cl));
}
-IMPLEMENT_SMOBS (Stream_event);
-IMPLEMENT_DEFAULT_EQUAL_P (Stream_event);
-IMPLEMENT_TYPE_P (Stream_event, "ly:stream-event?");
-
MAKE_SCHEME_CALLBACK (Stream_event, undump, 1);
MAKE_SCHEME_CALLBACK (Stream_event, dump, 1);
+void
+Stream_event::make_transposable ()
+{
+ /* This is in preparation for transposing stuff
+ that may be defined in the immutable part */
+
+ for (SCM s = immutable_property_alist_; scm_is_pair (s); s = scm_cdr (s))
+ {
+ SCM entry = scm_car (s);
+ SCM prop = scm_car (entry);
+ SCM val = scm_cdr (entry);
+
+ if ((unsmob<Pitch> (val)
+ || (scm_is_eq (prop, ly_symbol2scm ("element")) && unsmob<Music> (val))
+ || (scm_is_eq (prop, ly_symbol2scm ("elements")) && scm_is_pair (val))
+ || (scm_is_eq (prop, ly_symbol2scm ("pitch-alist")) && scm_is_pair (val)))
+ && scm_is_false (scm_assq (prop, mutable_property_alist_)))
+ mutable_property_alist_
+ = scm_acons (prop, music_deep_copy (val), mutable_property_alist_);
+ }
+}
+
SCM
Stream_event::dump (SCM self)
{
- Stream_event *ev = unsmob_stream_event (self);
+ Stream_event *ev = unsmob<Stream_event> (self);
// Reversed alists look prettier.
- return scm_reverse (ev->property_alist_);
+ return scm_cons (scm_reverse (ev->immutable_property_alist_),
+ scm_reverse (ev->mutable_property_alist_));
}
SCM
Stream_event::undump (SCM data)
{
Stream_event *obj = new Stream_event ();
- obj->property_alist_ = scm_reverse (data);
+ obj->immutable_property_alist_ = scm_reverse (scm_car (data));
+ obj->mutable_property_alist_ = scm_reverse (scm_cdr (data));
return obj->unprotect ();
}
-
-SCM
-Stream_event::internal_get_property (SCM sym) const
-{
- SCM s = scm_sloppy_assq (sym, property_alist_);
- if (s != SCM_BOOL_F)
- return scm_cdr (s);
- return SCM_EOL;
-}
-
-void
-Stream_event::internal_set_property (SCM prop, SCM val)
-{
- property_alist_ = scm_assq_set_x (property_alist_, prop, val);
-}