From: Erik Sandberg Date: Fri, 5 May 2006 15:59:21 +0000 (+0000) Subject: Added data structures for music streams. X-Git-Tag: release/2.9.4~13 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=2a8dcc4faa8a16229774d3414eedbf46feceac84;p=lilypond.git Added data structures for music streams. --- diff --git a/ChangeLog b/ChangeLog index 9965de0e1b..567fd6b785 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2006-05-05 Erik Sandberg + * 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 * scm/define-markup-commands.scm (note-by-number): remove debug display. diff --git a/lily/context.cc b/lily/context.cc index 2445ea12f3..9ebdb10695 100644 --- a/lily/context.cc +++ b/lily/context.cc @@ -96,6 +96,7 @@ Context::Context (Object_key const *key) accepts_list_ = SCM_EOL; context_list_ = SCM_EOL; definition_ = SCM_EOL; + unique_ = -1; smobify_self (); @@ -236,6 +237,7 @@ Context::create_context (Context_def *cdef, 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); diff --git a/lily/dispatcher-scheme.cc b/lily/dispatcher-scheme.cc new file mode 100644 index 0000000000..a8a2b273a1 --- /dev/null +++ b/lily/dispatcher-scheme.cc @@ -0,0 +1,61 @@ +/* + dispatcher.cc -- implement Scheme bindings for Dispatcher + + source file of the GNU LilyPond music typesetter + + (c) 2006 Erik Sandberg +*/ + +#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; +} diff --git a/lily/dispatcher.cc b/lily/dispatcher.cc new file mode 100644 index 0000000000..c6fedb2374 --- /dev/null +++ b/lily/dispatcher.cc @@ -0,0 +1,260 @@ +/* + dispatcher.cc -- implement Dispatcher + + source file of the GNU LilyPond music typesetter + + (c) 2005-2006 Erik Sandberg +*/ + +#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 ("#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)); + } +} diff --git a/lily/global-context.cc b/lily/global-context.cc index df2f1f5160..6e2d26a58a 100644 --- a/lily/global-context.cc +++ b/lily/global-context.cc @@ -28,6 +28,8 @@ Global_context::Global_context (Output_def *o, Moment final, Object_key *key) 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) @@ -204,3 +206,9 @@ Global_context::get_default_interpreter () else return Context::get_default_interpreter (); } + +int +Global_context::new_unique () +{ + return ++unique_count_; +} diff --git a/lily/include/context.hh b/lily/include/context.hh index d0b9ac7248..4b85bd31cd 100644 --- a/lily/include/context.hh +++ b/lily/include/context.hh @@ -31,6 +31,7 @@ private: bool init_; protected: + int unique_; Context *daddy_context_; SCM definition_; Context_key_manager key_manager_; @@ -54,6 +55,7 @@ public: 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; diff --git a/lily/include/dispatcher.hh b/lily/include/dispatcher.hh new file mode 100644 index 0000000000..8b24f03c22 --- /dev/null +++ b/lily/include/dispatcher.hh @@ -0,0 +1,41 @@ +/* + dispatcher.hh -- declare Dispatcher + + source file of the GNU LilyPond music typesetter + + (c) 2005 Erik Sandberg +*/ + +#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 diff --git a/lily/include/global-context.hh b/lily/include/global-context.hh index 515c7c3266..cc87ff3c9b 100644 --- a/lily/include/global-context.hh +++ b/lily/include/global-context.hh @@ -16,6 +16,7 @@ class Global_context : public virtual Context { PQueue extra_mom_pq_; Output_def *output_def_; + int unique_count_; DECLARE_CLASSNAME(Global_context); @@ -39,6 +40,7 @@ public: virtual Moment now_mom () const; virtual Context *get_default_interpreter (); + int new_unique (); Moment previous_moment () const; protected: Moment final_mom_; diff --git a/lily/include/lily-proto.hh b/lily/include/lily-proto.hh index 9bb315e097..b2b12416c4 100644 --- a/lily/include/lily-proto.hh +++ b/lily/include/lily-proto.hh @@ -44,6 +44,7 @@ class Column_x_positions; class Context; class Context_def; class Context_specced_music; +class Dispatcher; class Engraver; class Engraver; class Engraver_group; @@ -77,6 +78,7 @@ class Lily_parser; 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; @@ -152,6 +154,7 @@ class Spanner; class Staff_group_bar_engraver; class Staff_performer; class Stencil; +class Stream_event; class Swallow_engraver; class Swallow_performer; class System; diff --git a/lily/include/listener.hh b/lily/include/listener.hh new file mode 100644 index 0000000000..fd7a7e2adf --- /dev/null +++ b/lily/include/listener.hh @@ -0,0 +1,105 @@ +/* + listener.hh -- declare Listener + + source file of the GNU LilyPond music typesetter + + (c) 2005 Erik Sandberg +*/ + +#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 */ diff --git a/lily/include/scheme-listener.hh b/lily/include/scheme-listener.hh new file mode 100644 index 0000000000..1fbf6c2c40 --- /dev/null +++ b/lily/include/scheme-listener.hh @@ -0,0 +1,30 @@ +/* + scheme-listener.hh -- Declare Scheme_listener + + source file of the GNU LilyPond music typesetter + + (c) 2006 Erik Sandberg +*/ + +#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 */ diff --git a/lily/include/stream-event.hh b/lily/include/stream-event.hh new file mode 100644 index 0000000000..9966a35eb9 --- /dev/null +++ b/lily/include/stream-event.hh @@ -0,0 +1,56 @@ +/* + stream-event.hh -- declare Stream_event + + source file of the GNU LilyPond music typesetter + + (c) 2005-2006 Erik Sandberg +*/ + +#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 */ diff --git a/lily/listener.cc b/lily/listener.cc new file mode 100644 index 0000000000..8b9f3ad9ac --- /dev/null +++ b/lily/listener.cc @@ -0,0 +1,60 @@ +/* + listener.cc -- implement Listener and Listener_target + + source file of the GNU LilyPond music typesetter + + (c) 2005 Erik Sandberg +*/ + +#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 ("#", 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"); diff --git a/lily/scheme-listener-scheme.cc b/lily/scheme-listener-scheme.cc new file mode 100644 index 0000000000..b8946871c0 --- /dev/null +++ b/lily/scheme-listener-scheme.cc @@ -0,0 +1,24 @@ +/* + scheme-listener-scheme.cc -- Connect listeners to Scheme through Scheme_listener + + source file of the GNU LilyPond music typesetter + + (c) 2006 Erik Sandberg +*/ + +#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; +} diff --git a/lily/scheme-listener.cc b/lily/scheme-listener.cc new file mode 100644 index 0000000000..d6ef475150 --- /dev/null +++ b/lily/scheme-listener.cc @@ -0,0 +1,48 @@ +/* + scheme-listener.cc -- Implement Scheme_listener + + source file of the GNU LilyPond music typesetter + + (c) 2006 Erik Sandberg +*/ + +#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 ("#callback_, p); + scm_puts (">", p); + return 1; +} + +Scheme_listener::~Scheme_listener () +{ +} diff --git a/lily/stream-event-scheme.cc b/lily/stream-event-scheme.cc new file mode 100644 index 0000000000..bdccd1483b --- /dev/null +++ b/lily/stream-event-scheme.cc @@ -0,0 +1,30 @@ +/* + stream-event.cc -- implement Scheme bindings for Stream_event + + source file of the GNU LilyPond music typesetter + + (c) 2006 Erik Sandberg +*/ + +#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); +} diff --git a/lily/stream-event.cc b/lily/stream-event.cc new file mode 100644 index 0000000000..f8c868c34a --- /dev/null +++ b/lily/stream-event.cc @@ -0,0 +1,124 @@ +/* + stream-event.cc -- implement Stream_event + + source file of the GNU LilyPond music typesetter + + (c) 2005-2006 Erik Sandberg +*/ + +#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 ("#", 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); +} diff --git a/scm/lily.scm b/scm/lily.scm index 9ded6f526e..b45f5987ff 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -223,6 +223,7 @@ The syntax is the same as `define*-public'." ;; load-from-path '("lily-library.scm" "file-cache.scm" + "define-event-classes.scm" "define-music-types.scm" "output-lib.scm" "c++.scm"