+2006-05-05 Erik Sandberg <mandolaerik@gmail.com>
+ * lily/context.cc, lily/global-context.cc: Added 'unique' member,
+ used by music streams.
+
+ * lily/dispatcher.cc, lily/dispatcher-scheme.cc,
+ lily/stream-event.cc, lily/stream-event-scheme.cc,
+ lily/listener.cc, lily/scheme-listener.cc,
+ lily/scheme-listener-scheme.cc, lily/include/dispatcher.hh,
+ lily/include/stream-event.hh, lily/include/listener.hh,
+ lily/include/scheme-listener.hh, scm/define-event-classes.scm:
+ Created data structures for music streams.
+
2006-05-05 Han-Wen Nienhuys <hanwen@lilypond.org>
* scm/define-markup-commands.scm (note-by-number): remove debug display.
accepts_list_ = SCM_EOL;
context_list_ = SCM_EOL;
definition_ = SCM_EOL;
+ unique_ = -1;
smobify_self ();
Context *new_context
= cdef->instantiate (ops, key);
+ new_context->unique_ = get_global_context()->new_unique();
new_context->id_string_ = id;
add_context (new_context);
apply_property_operations (new_context, ops);
--- /dev/null
+/*
+ dispatcher.cc -- implement Scheme bindings for Dispatcher
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "dispatcher.hh"
+
+LY_DEFINE (ly_make_dispatcher, "ly:make-dispatcher",
+ 0, 0, 0, (),
+ "Returns a newly created dispatcher.")
+{
+ return (new Dispatcher ())->unprotect ();
+}
+
+LY_DEFINE (ly_register_dispatcher, "ly:connect-dispatchers",
+ 2, 0, 0, (SCM to, SCM from),
+ "Makes the dispatcher @var{to} listen to events from @var{from}." )
+{
+ Dispatcher *t = unsmob_dispatcher (to);
+ Dispatcher *f = unsmob_dispatcher (from);
+ SCM_ASSERT_TYPE (t, from, SCM_ARG1, __FUNCTION__, "dispatcher");
+ SCM_ASSERT_TYPE (f, to, SCM_ARG2, __FUNCTION__, "dispatcher");
+ t->register_as_listener (f);
+
+ return SCM_UNDEFINED;
+}
+
+LY_DEFINE (ly_add_listener, "ly:add-listener",
+ 2, 0, 1, (SCM list, SCM disp, SCM cl),
+ "Adds the listener @var{list} to the dispatcher @var{disp}.\n"
+ " Whenever @var{disp} hears an event of class @var{cl}, it will be forwarded to @var{list}.\n" )
+{
+ Listener *l = unsmob_listener (list);
+ Dispatcher *d = unsmob_dispatcher (disp);
+ SCM_ASSERT_TYPE (l, list, SCM_ARG1, __FUNCTION__, "listener");
+ SCM_ASSERT_TYPE (d, disp, SCM_ARG2, __FUNCTION__, "dispatcher");
+
+ for (int arg=SCM_ARG3; cl != SCM_EOL; cl = scm_cdr (cl), arg++)
+ {
+ SCM_ASSERT_TYPE (scm_symbol_p (cl), cl, arg, __FUNCTION__, "symbol");
+ d->add_listener (*l, scm_car (cl));
+ }
+
+ return SCM_UNDEFINED;
+}
+
+LY_DEFINE (ly_broadcast, "ly:broadcast",
+ 2, 0, 0, (SCM disp, SCM ev),
+ "Sends the stream event @var{ev} to the dispatcher\n"
+ "@var{disp}.")
+{
+ Dispatcher *d = unsmob_dispatcher (disp);
+ Stream_event *e = unsmob_stream_event (ev);
+ SCM_ASSERT_TYPE (d, disp, SCM_ARG1, __FUNCTION__, "dispatcher");
+ SCM_ASSERT_TYPE (e, ev, SCM_ARG2, __FUNCTION__, "stream event");
+ d->broadcast (e);
+ return SCM_UNDEFINED;
+}
--- /dev/null
+/*
+ dispatcher.cc -- implement Dispatcher
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "dispatcher.hh"
+#include "international.hh"
+#include "ly-smobs.icc"
+#include "stream-event.hh"
+#include "warn.hh"
+
+// ES todo: move to lily-guile.hh
+SCM appendable_list ();
+void appendable_list_append (SCM l, SCM elt);
+
+IMPLEMENT_SMOBS (Dispatcher);
+IMPLEMENT_TYPE_P (Dispatcher, "dispatcher");
+IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
+
+Dispatcher::~Dispatcher ()
+{
+}
+
+Dispatcher::Dispatcher ()
+{
+ self_scm_ = SCM_EOL;
+ listeners_ = SCM_EOL;
+ dispatchers_ = SCM_EOL;
+ listen_classes_ = SCM_EOL;
+ smobify_self ();
+ listeners_ = scm_c_make_hash_table (0);
+ priority_count_ = 0;
+}
+
+SCM
+Dispatcher::mark_smob (SCM sm)
+{
+ Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
+ scm_gc_mark (me->dispatchers_);
+ scm_gc_mark (me->listen_classes_);
+ return me->listeners_;
+}
+
+int
+Dispatcher::print_smob (SCM s, SCM p, scm_print_state*)
+{
+ Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
+ scm_puts ("#<Dispatcher ", p);
+ scm_write (scm_vector_to_list (me->listeners_), p);
+ scm_puts (">", p);
+ return 1;
+}
+
+/*
+Event dispatching:
+- Collect a list of listeners for each relevant class
+- Send the event to each of these listeners, in increasing priority order.
+ This is done by keeping a priority queue of listener lists,
+ and iteratively send the event to the lowest-priority listener.
+- An event is never sent twice to listeners with equal priority.
+*/
+IMPLEMENT_LISTENER (Dispatcher, dispatch);
+void
+Dispatcher::dispatch (SCM sev)
+{
+ Stream_event *ev = unsmob_stream_event (sev);
+ SCM class_symbol = ev->get_property ("class");
+ if (!scm_symbol_p (class_symbol))
+ {
+ warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
+ return;
+ }
+
+ SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
+ bool sent = false;
+ int num_classes = scm_ilength (class_list);
+
+ /*
+ For each event class there is a list of listeners, which is
+ ordered by priority. Our next task is to call these listeners, in
+ priority order. A priority queue stores the next element in each
+ listener list, and the lowest priority element is repeatedly
+ extracted and called.
+
+ The priority queue is implemented as a bubble-sorted C
+ array. Using the stack instead of native Scheme datastructures
+ avoids overheads for memory allocation. The queue is usually small
+ (around 2 elements), so the quadratic sorting time is not a
+ problem. (if this changes, it's easy to rewrite this routine using
+ a heap)
+
+ The first step is to collect all listener lists and to initially
+ insert them in the priority queue.
+ */
+ struct { int prio; SCM list; } lists[num_classes+1];
+ int i = 0;
+ for (SCM cl = class_list; scm_is_pair(cl); cl = scm_cdr (cl))
+ {
+ SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
+ if (!scm_is_pair(list))
+ num_classes--;
+ else
+ {
+ // bubblesort.
+ int prio = scm_to_int (scm_caar (list));
+ int j;
+ for (j = i; j > 0 && lists[j-1].prio > prio; j--)
+ lists[j] = lists[j-1];
+ lists[j].prio = prio;
+ lists[j].list = list;
+ i++;
+ }
+ }
+ lists[num_classes].prio = INT_MAX;
+
+ // Never send an event to two listeners with equal priority.
+ int last_priority = -1;
+ /*
+ Each iteration extracts the lowest-priority element, which is a
+ list of listeners. The first listener is called, and the tail of
+ the list is pushed back into the priority queue.
+ */
+ while (num_classes)
+ {
+ // Send the event, if we haven't already sent it to this target.
+ if (lists[0].prio != last_priority)
+ {
+ // process the listener
+ assert (lists[0].prio > last_priority);
+ last_priority = lists[0].prio;
+
+ Listener *l = unsmob_listener (scm_cdar (lists[0].list));
+ l->listen (ev->self_scm ());
+ sent = true;
+ }
+ // go to the next listener; bubble-sort the class list.
+ SCM next = scm_cdr (lists[0].list);
+ if (!scm_is_pair(next))
+ num_classes--;
+ int prio = (scm_is_pair(next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
+ for (i = 0; prio > lists[i+1].prio; i++)
+ lists[i] = lists[i+1];
+ lists[i].prio = prio;
+ lists[i].list = next;
+ }
+
+ if (!sent)
+ warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
+}
+
+void
+Dispatcher::broadcast (Stream_event *ev)
+{
+ dispatch (ev->self_scm ());
+}
+
+void
+Dispatcher::add_listener (Listener l, SCM ev_class)
+{
+ internal_add_listener (l, ev_class, ++priority_count_);
+}
+
+inline void
+Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
+{
+ SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
+ if (list == SCM_EOL)
+ {
+ /* Register with all dispatchers. */
+ for (SCM disp = dispatchers_; scm_is_pair(disp); disp = scm_cdr (disp))
+ {
+ int priority = scm_to_int (scm_cdar (disp));
+ Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
+ d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
+ }
+ listen_classes_ = scm_cons (ev_class, listen_classes_);
+ }
+ SCM entry = scm_cons (scm_int2num (priority), l.smobbed_copy ());
+ list = scm_merge_x (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
+ scm_hashq_set_x (listeners_, ev_class, list);
+}
+
+void
+Dispatcher::remove_listener (Listener l, SCM ev_class)
+{
+ SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
+
+ if (list == SCM_EOL)
+ {
+ programming_error ("remove_listener called with incorrect class.");
+ return;
+ }
+
+ // We just remove the listener once.
+ bool first = true;
+
+ SCM dummy = scm_cons (SCM_EOL, list);
+ SCM e = dummy;
+ while (scm_is_pair(scm_cdr (e)))
+ if (*unsmob_listener (scm_cdadr (e)) == l && first)
+ {
+ scm_set_cdr_x (e, scm_cddr(e));
+ first = false;
+ break;
+ }
+ else
+ e = scm_cdr (e);
+ list = scm_cdr (dummy);
+
+ if (first)
+ warning ("Attempting to remove nonexisting listener.");
+ else if (list == SCM_EOL)
+ {
+ /* Unregister with all dispatchers. */
+ for (SCM disp = dispatchers_; disp != SCM_EOL; disp = scm_cdr (disp))
+ {
+ Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
+ d->remove_listener (GET_LISTENER (dispatch), ev_class);
+ }
+ listen_classes_ = scm_delq_x (ev_class, listen_classes_);
+ }
+}
+
+/* Register as a listener to another dispatcher. */
+void
+Dispatcher::register_as_listener (Dispatcher *disp)
+{
+ int priority = ++disp->priority_count_;
+
+ // Don't register twice to the same dispatcher.
+ if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
+ {
+ warning ("Already listening to dispatcher, ignoring request");
+ return;
+ }
+
+ dispatchers_ = scm_acons (disp->self_scm (), scm_int2num (priority), dispatchers_);
+
+ Listener list = GET_LISTENER (dispatch);
+ for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
+ {
+ disp->internal_add_listener (list, scm_car (cl), priority);
+ }
+}
+
+/* Unregister as a listener to another dispatcher. */
+void
+Dispatcher::unregister_as_listener (Dispatcher *disp)
+{
+ dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
+
+ Listener list = GET_LISTENER (dispatch);
+ for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
+ {
+ disp->remove_listener (list, scm_car (cl));
+ }
+}
output_def_ = o;
final_mom_ = final;
definition_ = find_context_def (o, ly_symbol2scm ("Global"));
+ unique_count_ = 0;
+ unique_ = 0;
Context_def *globaldef = unsmob_context_def (definition_);
if (!globaldef)
else
return Context::get_default_interpreter ();
}
+
+int
+Global_context::new_unique ()
+{
+ return ++unique_count_;
+}
bool init_;
protected:
+ int unique_;
Context *daddy_context_;
SCM definition_;
Context_key_manager key_manager_;
string id_string () const { return id_string_; }
SCM children_contexts () const { return context_list_; }
SCM default_child_context_name () const;
+ int get_unique() { return unique_; }
Translator_group *implementation () const { return implementation_; }
Context *get_parent_context () const;
--- /dev/null
+/*
+ dispatcher.hh -- declare Dispatcher
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#ifndef DISPATCHER_HH
+#define DISPATCHER_HH
+
+#include "listener.hh"
+#include "stream-event.hh"
+
+class Dispatcher
+{
+ /* Hash table. Each event-class maps to a list of listeners. */
+ SCM listeners_;
+ /* alist of dispatchers that we listen to. Each entry is a
+ (dist . priority) pair. */
+ SCM dispatchers_;
+ SCM listen_classes_;
+ DECLARE_LISTENER (dispatch);
+ /* priority counter. Listeners with low priority receive events
+ first. */
+ int priority_count_;
+ void internal_add_listener (Listener, SCM event_class, int priority);
+public:
+ Dispatcher ();
+ void broadcast (Stream_event *ev);
+ void add_listener (Listener, SCM event_class);
+ void remove_listener (Listener, SCM event_class);
+ void register_as_listener (Dispatcher *dist);
+ void unregister_as_listener (Dispatcher *dist);
+protected:
+ DECLARE_SMOBS (Dispatcher,);
+};
+
+DECLARE_UNSMOB (Dispatcher, dispatcher);
+
+#endif // DISPATCHER_HH
{
PQueue<Moment> extra_mom_pq_;
Output_def *output_def_;
+ int unique_count_;
DECLARE_CLASSNAME(Global_context);
virtual Moment now_mom () const;
virtual Context *get_default_interpreter ();
+ int new_unique ();
Moment previous_moment () const;
protected:
Moment final_mom_;
class Context;
class Context_def;
class Context_specced_music;
+class Dispatcher;
class Engraver;
class Engraver;
class Engraver_group;
class Lilypond_context_key;
class Lilypond_grob_key;
class Line_group_engraver_group;
+class Listener;
class Lookup;
class Lyric_combine_music;
class Lyric_combine_music_iterator;
class Staff_group_bar_engraver;
class Staff_performer;
class Stencil;
+class Stream_event;
class Swallow_engraver;
class Swallow_performer;
class System;
--- /dev/null
+/*
+ listener.hh -- declare Listener
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#ifndef LISTENER_HH
+#define LISTENER_HH
+
+/*
+ Listeners
+
+ Listeners are used for stream event dispatching. If you want to
+ register a method as an event handler in a dispatcher, then you
+ must:
+
+ - declare the method using the DECLARE_LISTENER macro.
+ class Foo
+ {
+ DECLARE_LISTENER (method);
+ ...
+ };
+ This macro declares the method to take a SCM as parameter, and to
+ return void. It also declares some other stuff that shouldn't be
+ touched.
+
+ - implement the method using IMPLEMENT_LISTENER:
+ IMPLEMENT_LISTENER (Foo, method)
+ void method (SCM e)
+ {
+ write ("Foo hears an event!");
+ }
+
+ - Extract a listener using GET_LISTENER (Foo->method)
+ - Register the method to the dispatcher using Dispatcher::register
+
+ Example:
+
+ Foo *foo = (...);
+ Stream_distributor *d = (...);
+ Listener l = GET_LISTENER (foo->method);
+ d->register_listener (l, "EventClass");
+
+ Whenever d hears a stream-event ev of class "EventClass",
+ the implemented procedure is called.
+
+ Limitations:
+ - DECLARE_LISTENER currently only works inside smob classes.
+*/
+
+#include "smobs.hh"
+
+typedef struct {
+ void (*listen_callback) (void *, SCM);
+ void (*mark_callback) (void *);
+} Listener_function_table;
+
+class Listener {
+ void *target_;
+ Listener_function_table *type_;
+public:
+ Listener (const void *target, Listener_function_table *type);
+ Listener (Listener const &other);
+ void listen (SCM ev) const;
+
+ bool operator == (Listener const &other) const
+ { return target_ == other.target_ && type_ == other.type_; }
+
+ DECLARE_SIMPLE_SMOBS (Listener,);
+};
+DECLARE_UNSMOB (Listener, listener);
+
+#define IMPLEMENT_LISTENER(cl, method) \
+void \
+cl :: method ## _callback (void *self, SCM ev) \
+{ \
+ cl *s = (cl *)self; \
+ s->method (ev); \
+} \
+void \
+cl :: method ## _mark (void *self) \
+{ \
+ cl *s = (cl *)self; \
+ scm_gc_mark (s->self_scm ()); \
+} \
+Listener \
+cl :: method ## _listener () const \
+{ \
+ static Listener_function_table callbacks; \
+ callbacks.listen_callback = &cl::method ## _callback; \
+ callbacks.mark_callback = &cl::method ## _mark; \
+ return Listener (this, &callbacks); \
+}
+
+#define GET_LISTENER(proc) ( proc ## _listener ())
+
+#define DECLARE_LISTENER(name) \
+ inline void name (SCM); \
+ static void name ## _callback (void *self, SCM ev); \
+ static void name ## _mark (void *self); \
+ Listener name ## _listener () const
+
+#endif /* LISTENER_HH */
--- /dev/null
+/*
+ scheme-listener.hh -- Declare Scheme_listener
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#ifndef SCHEME_LISTENER_HH
+#define SCHEME_LISTENER_HH
+
+#include "listener.hh"
+#include "ly-smobs.icc"
+
+/*
+ Scheme_listener is only used internally by scheme-listener-scheme.cc
+*/
+
+class Scheme_listener
+{
+public:
+ Scheme_listener (SCM callback);
+ DECLARE_LISTENER (call);
+protected:
+ DECLARE_SMOBS (Scheme_listener,);
+private:
+ SCM callback_;
+};
+
+#endif /* SCHEME_LISTENER_HH */
--- /dev/null
+/*
+ stream-event.hh -- declare Stream_event
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#ifndef STREAM_EVENT_HH
+#define STREAM_EVENT_HH
+
+#include "lily-proto.hh"
+#include "smobs.hh"
+#include "prob.hh"
+
+class Stream_event
+{
+ void init ();
+ SCM property_alist_;
+ Input *origin_;
+
+public:
+ Stream_event ();
+ Input *origin () const;
+
+ DECLARE_SCHEME_CALLBACK (undump, (SCM));
+ DECLARE_SCHEME_CALLBACK (dump, (SCM));
+
+ // todo: make Input mandatory.
+ Stream_event (SCM property_alist);
+ Stream_event (Context *c, SCM class_name);
+ Stream_event (Context *c, Input *);
+ Stream_event (Stream_event *ev);
+
+ SCM internal_get_property (SCM) const;
+ void internal_set_property (SCM prop, SCM val);
+
+protected:
+ DECLARE_SMOBS (Stream_event,);
+};
+
+DECLARE_UNSMOB (Stream_event, stream_event);
+DECLARE_TYPE_P (Stream_event);
+
+#define SEND_EVENT_TO_CONTEXT(ctx, cl, ...) \
+ { \
+ Stream_event *_e_ = new Stream_event (ctx, ly_symbol2scm (cl)); \
+ __VA_ARGS__; \
+ ctx->event_source ()->distribute (_e_); \
+ scm_gc_unprotect_object (_e_->self_scm ()); \
+ }
+
+#define EVENT_PROPERTY(prop, val) \
+ (_e_->set_property (prop, val))
+
+#endif /* STREAM_EVENT_HH */
--- /dev/null
+/*
+ listener.cc -- implement Listener and Listener_target
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "listener.hh"
+#include "ly-smobs.icc"
+#include "warn.hh"
+
+/*
+Listener_target::~Listener_target ()
+{
+}
+*/
+
+Listener::Listener (const void *target, Listener_function_table *type)
+{
+ target_ = (void *)target;
+ type_ = type;
+}
+
+Listener::Listener (Listener const &other)
+{
+ target_ = other.target_;
+ type_ = other.type_;
+}
+
+void Listener::listen (SCM ev) const {
+ (type_->listen_callback) (target_, ev);
+}
+
+SCM
+Listener::mark_smob (SCM sm)
+{
+ Listener *me = (Listener *) SCM_CELL_WORD_1 (sm);
+ (me->type_->mark_callback) (me->target_);
+ return SCM_EOL;
+}
+
+int
+Listener::print_smob (SCM s, SCM p, scm_print_state*)
+{
+ scm_puts ("#<Listener>", p);
+ return 1;
+}
+
+SCM
+Listener::equal_p (SCM a, SCM b)
+{
+ Listener *l1 = unsmob_listener (a);
+ Listener *l2 = unsmob_listener (b);
+
+ return (*l1 == *l2) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+IMPLEMENT_SIMPLE_SMOBS (Listener);
+IMPLEMENT_TYPE_P (Listener, "listener");
--- /dev/null
+/*
+ scheme-listener-scheme.cc -- Connect listeners to Scheme through Scheme_listener
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "scheme-listener.hh"
+
+LY_DEFINE (ly_make_listener, "ly:make-listener",
+ 1, 0, 0, (SCM callback),
+ "Creates a listener. Any time the listener hears\n"
+ " an object, it will call @var{callback}\n"
+ " with that object.\n"
+ "\n"
+ " @var{callback} should take exactly one argument." )
+{
+ SCM_ASSERT_TYPE (scm_procedure_p (callback), callback, SCM_ARG1, __FUNCTION__, "procedure");
+ Scheme_listener *l = new Scheme_listener (callback);
+ SCM listener = GET_LISTENER (l->call).smobbed_copy ();
+ l->unprotect ();
+ return listener;
+}
--- /dev/null
+/*
+ scheme-listener.cc -- Implement Scheme_listener
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "scheme-listener.hh"
+
+IMPLEMENT_LISTENER (Scheme_listener, call)
+void
+Scheme_listener::call (SCM ev)
+{
+ scm_call_1 (callback_, ev);
+}
+
+IMPLEMENT_SMOBS (Scheme_listener);
+IMPLEMENT_DEFAULT_EQUAL_P (Scheme_listener);
+
+Scheme_listener::Scheme_listener (SCM c)
+{
+ callback_ = SCM_EOL;
+ self_scm_ = SCM_EOL;
+ smobify_self ();
+ callback_ = c;
+}
+
+SCM
+Scheme_listener::mark_smob (SCM obj)
+{
+ Scheme_listener *me = (Scheme_listener *) SCM_CELL_WORD_1 (obj);
+ return me->callback_;
+}
+
+int
+Scheme_listener::print_smob (SCM obj, SCM p, scm_print_state*)
+{
+ Scheme_listener *me = (Scheme_listener *) SCM_CELL_WORD_1 (obj);
+ scm_puts ("#<Scheme_listener ", p);
+ scm_write (me->callback_, p);
+ scm_puts (">", p);
+ return 1;
+}
+
+Scheme_listener::~Scheme_listener ()
+{
+}
--- /dev/null
+/*
+ stream-event.cc -- implement Scheme bindings for Stream_event
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "stream-event.hh"
+
+LY_DEFINE (ly_make_stream_event, "ly:make-stream-event",
+ 1, 0, 0, (SCM proplist),
+ "Creates a stream event, with the given property list.\n" )
+{
+ SCM_ASSERT_TYPE (scm_list_p (proplist), proplist, SCM_ARG1, __FUNCTION__, "association list");
+ Stream_event *e = new Stream_event (proplist);
+ return e->unprotect ();
+}
+
+LY_DEFINE (ly_stream_event_property, "ly:stream-event-property",
+ 2, 0, 0, (SCM sev, SCM sym),
+ "Get the property @var{sym} of stream event @var{mus}.\n"
+ "If @var{sym} is undefined, return @code{' ()}.\n")
+{
+ Stream_event *e = unsmob_stream_event (sev);
+ SCM_ASSERT_TYPE (e, sev, SCM_ARG1, __FUNCTION__, "stream event");
+ SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
+
+ return e->internal_get_property (sym);
+}
--- /dev/null
+/*
+ stream-event.cc -- implement Stream_event
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
+*/
+
+#include "stream-event.hh"
+
+#include "ly-smobs.icc"
+#include "context.hh"
+#include "input.hh"
+#include "input-smob.hh"
+
+// ES todo: Add stuff to lily-proto.hh: Stream_event and its subclasses, Stream_creator, etc.
+
+Stream_event::~Stream_event ()
+{
+}
+
+void
+Stream_event::init ()
+{
+ self_scm_ = SCM_EOL;
+ property_alist_ = SCM_EOL;
+ origin_ = 0;
+
+ smobify_self ();
+}
+
+Stream_event::Stream_event ()
+{
+ init ();
+}
+
+Stream_event::Stream_event (Context *c, Input *origin)
+{
+ init ();
+ set_property ("context", scm_int2num (c->get_unique()));
+ origin_ = origin;
+}
+
+Stream_event::Stream_event (SCM property_alist)
+{
+ init ();
+ property_alist_ = property_alist;
+ origin_ = &dummy_input_global;
+}
+
+Stream_event::Stream_event (Context *c, SCM class_name)
+{
+ init ();
+ set_property ("context", scm_int2num (c->get_unique()));
+ set_property ("class", class_name);
+ origin_ = &dummy_input_global;
+}
+
+Stream_event::Stream_event (Stream_event *ev)
+{
+ init ();
+ property_alist_ = scm_copy_tree (ev->property_alist_);
+ origin_ = ev->origin_;
+}
+
+Input *
+Stream_event::origin () const
+{
+ return origin_;
+}
+
+SCM
+Stream_event::mark_smob (SCM sm)
+{
+ Stream_event *me = (Stream_event *) SCM_CELL_WORD_1 (sm);
+ return me->property_alist_;
+}
+
+int
+Stream_event::print_smob (SCM s, SCM port, scm_print_state *)
+{
+ scm_puts ("#<Stream_event ", port);
+ scm_write (dump (s), port);
+ scm_puts (" >", port);
+ return 1;
+}
+
+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);
+
+SCM
+Stream_event::dump (SCM self)
+{
+ Stream_event *ev = unsmob_stream_event (self);
+ // Reversed alists look prettier.
+ return scm_reverse (ev->property_alist_);
+}
+
+SCM
+Stream_event::undump (SCM data)
+{
+ Stream_event *obj = new Stream_event ();
+ obj->property_alist_ = scm_reverse (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);
+}
;; load-from-path
'("lily-library.scm"
"file-cache.scm"
+ "define-event-classes.scm"
"define-music-types.scm"
"output-lib.scm"
"c++.scm"
projects / lilypond.git / commitdiff