context = new Context (key);
context->definition_ = self_scm ();
+ context->definition_mods_ = ops;
SCM trans_names = get_translator_names (ops);
#include "context.hh"
#include "context-def.hh"
+#include "dispatcher.hh"
LY_DEFINE (ly_context_id, "ly:context-id",
1, 0, 0, (SCM context),
SCM_ASSERT_TYPE (ctx, context, SCM_ARG1, __FUNCTION__, "Context");
return ctx->now_mom ().smobbed_copy ();
}
+
+LY_DEFINE (ly_context_event_source, "ly:context-event-source",
+ 1, 0, 0, (SCM context),
+ "Return event-source of context CONTEXT")
+{
+ Context *ctx = unsmob_context (context);
+ SCM_ASSERT_TYPE (ctx, context, SCM_ARG1, __FUNCTION__, "Context");
+ return ctx->event_source ()->self_scm ();
+}
+
+LY_DEFINE (ly_context_events_below, "ly:context-events-below",
+ 1, 0, 0, (SCM context),
+ "Return a stream-distributor that distributes all events\n"
+ " from @var{context} and all its subcontexts.")
+{
+ Context *ctx = unsmob_context (context);
+ SCM_ASSERT_TYPE (ctx, context, SCM_ARG1, __FUNCTION__, "Context");
+ return ctx->events_below ()->self_scm ();
+}
#include "context.hh"
#include "context-def.hh"
+#include "dispatcher.hh"
#include "international.hh"
#include "ly-smobs.icc"
#include "main.hh"
Context::is_removable () const
{
return context_list_ == SCM_EOL && ! iterator_count_
- && !dynamic_cast<Score_context const *> (this);
+ && !dynamic_cast<Global_context const *> (daddy_context_);
}
void
accepts_list_ = SCM_EOL;
context_list_ = SCM_EOL;
definition_ = SCM_EOL;
+ definition_mods_ = SCM_EOL;
unique_ = -1;
+ event_source_ = 0;
+ events_below_ = 0;
smobify_self ();
Scheme_hash_table *tab = new Scheme_hash_table;
properties_scm_ = tab->unprotect ();
+ event_source_ = new Dispatcher ();
+ event_source_->unprotect ();
+ events_below_ = new Dispatcher ();
+ events_below_->unprotect ();
/*
UGH UGH
/*
Don't create multiple score contexts.
*/
- if (dynamic_cast<Global_context *> (this)
- && dynamic_cast<Global_context *> (this)->get_score_context ())
- return get_score_context ()->create_unique_context (name, id, operations);
+ Global_context *gthis = dynamic_cast<Global_context *> (this);
+ if (gthis && gthis->get_score_context ())
+ return gthis->get_score_context ()->create_unique_context (name, id, operations);
/*
TODO: use accepts_list_.
/*
Don't create multiple score contexts.
*/
- if (dynamic_cast<Global_context *> (this)
- && dynamic_cast<Global_context *> (this)->get_score_context ())
- return get_score_context ()->find_create_context (n, id, operations);
+ Global_context *gthis = dynamic_cast<Global_context *> (this);
+ if (gthis && gthis->get_score_context ())
+ return gthis->get_score_context ()->find_create_context (n, id, operations);
if (Context *existing = find_context_below (this, n, id))
return existing;
string id,
SCM ops)
{
+ int unique = get_global_context()->new_unique();
+
+ // TODO: The following should be carried out by a listener.
string type = ly_symbol2string (cdef->get_context_name ());
Object_key const *key = key_manager_.get_context_key (now_mom(), type, id);
Context *new_context
= cdef->instantiate (ops, key);
- new_context->unique_ = get_global_context()->new_unique();
new_context->id_string_ = id;
+ new_context->unique_ = unique;
+
+ new_context->events_below_->register_as_listener (new_context->event_source_);
+
add_context (new_context);
apply_property_operations (new_context, ops);
+ events_below_->register_as_listener (new_context->events_below_);
+
+ // TODO: The above operations should be performed by a listener to the following event.
+ send_stream_event (this, "CreateContext",
+ ly_symbol2scm ("unique"), scm_int2num (unique),
+ ly_symbol2scm ("ops"), ops,
+ ly_symbol2scm ("type"), cdef->get_context_name (),
+ ly_symbol2scm ("id"), scm_makfrom0str (id.c_str ()));
return new_context;
}
}
Context *tg = create_context (t, "", SCM_EOL);
- if (!tg->is_bottom_context ())
- return tg->get_default_interpreter ();
- else
- return tg;
+ return tg->get_default_interpreter ();
}
return this;
}
return val;
}
+void
+Context::internal_send_stream_event (SCM type, SCM props[])
+{
+ Stream_event *e = new Stream_event (this, type);
+ for (int i = 0; props[i]; i++)
+ {
+ assert(props[i+1]);
+ e->internal_set_property (props[i], props[i+1]);
+ }
+ event_source_->broadcast (e);
+ e->unprotect ();
+}
+
bool
Context::is_alias (SCM sym) const
{
return trans;
}
+
/*
ID == "" means accept any ID.
*/
return found;
}
+Context *
+find_context_below (Context *where,
+ int unique)
+{
+ if (where->get_unique () == unique)
+ return where;
+
+ Context *found = 0;
+ for (SCM s = where->children_contexts ();
+ !found && scm_is_pair (s); s = scm_cdr (s))
+ {
+ Context *tr = unsmob_context (scm_car (s));
+
+ found = find_context_below (tr, unique);
+ }
+
+ return found;
+}
+
SCM
Context::properties_as_alist () const
{
scm_gc_mark (me->context_list_);
scm_gc_mark (me->aliases_);
scm_gc_mark (me->definition_);
+ scm_gc_mark (me->definition_mods_);
scm_gc_mark (me->properties_scm_);
scm_gc_mark (me->accepts_list_);
if (me->implementation_)
scm_gc_mark (me->implementation_->self_scm ());
+ if (me->event_source_) scm_gc_mark (me->event_source_->self_scm ());
+ if (me->events_below_) scm_gc_mark (me->events_below_->self_scm ());
return me->properties_scm_;
}
dispatchers_ = SCM_EOL;
listen_classes_ = SCM_EOL;
smobify_self ();
- listeners_ = scm_c_make_hash_table (0);
+// TODO: use resizable hash (guile 1.8)
+// listeners_ = scm_c_make_hash_table (0);
+ listeners_ = scm_c_make_hash_table (17);
priority_count_ = 0;
}
lists[i].list = next;
}
+/* TODO: Uncomment.
if (!sent)
warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
+*/
}
void
protected:
int unique_;
Context *daddy_context_;
+ /* The used Context_def */
SCM definition_;
+ /* Additions to the Context_def, given by \with */
+ SCM definition_mods_;
Context_key_manager key_manager_;
SCM properties_scm_;
SCM aliases_;
Translator_group *implementation_;
string id_string_;
+
+ /* Events reported in the context is sent to this dispatcher. */
+ Dispatcher *event_source_;
+
+ /* Events reported to this context or recursively in any of its
+ children, are sent to this dispatcher. */
+ Dispatcher *events_below_;
friend class Context_def;
void clear_key_disambiguations ();
SCM default_child_context_name () const;
int get_unique() { return unique_; }
+ Dispatcher *event_source () const { return event_source_; }
+ Dispatcher *events_below () const { return events_below_; }
+ void internal_send_stream_event (SCM type, SCM props[]);
+
+ SCM get_definition () const { return definition_; }
+ SCM get_definition_mods () const { return definition_mods_; }
+
Translator_group *implementation () const { return implementation_; }
Context *get_parent_context () const;
Context (Object_key const *);
Rational measure_length (Context const *context);
void set_context_property_on_children (Context *trans, SCM sym, SCM val);
+/* Shorthand for creating and broadcasting stream events. */
+#define send_stream_event(ctx, type, ...) \
+{ \
+ SCM props[] = { __VA_ARGS__, 0 }; \
+ ctx->internal_send_stream_event (ly_symbol2scm (type), props); \
+}
+
#endif /* CONTEXT_HH */
/// Scale the music in time by #factor#.
void compress (Moment factor);
+
+ // Broadcast the event in a context's event-source.
+ void send_to_context (Context *c);
DECLARE_SCHEME_CALLBACK (duration_length_callback, (SCM));
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 */
#include "ly-smobs.icc"
#include "warn.hh"
-/*
-Listener_target::~Listener_target ()
-{
-}
-*/
-
Listener::Listener (const void *target, Listener_function_table *type)
{
target_ = (void *)target;
Music_iterator *it = b ? (Music_iterator *) this : 0; // ugh
if (!it)
it = try_music_in_children (m);
+ else
+ /* TODO: try_music should only do the following:
+ - descend iterator to bottom context
+ - send music to a bottom context.
+ The function should also be renamed, and it should not return a value. */
+ m->send_to_context (get_outlet ());
return it;
}
#include "music.hh"
+#include "context.hh"
+#include "dispatcher.hh"
#include "duration.hh"
#include "input-smob.hh"
#include "international.hh"
return ip ? ip : &dummy_input_global;
}
+void
+Music::send_to_context (Context *c)
+{
+ send_stream_event (c, "MusicEvent",
+ ly_symbol2scm("music"), self_scm ());
+}
+
Music *
make_music_by_name (SCM sym)
{
MusicEvent CreateContext Prepare OneTimeStep Finish) . StreamEvent)
))
+;; Maps event-class to a list of ancestors (inclusive)
+;; TODO: use resizable hash
+(define ancestor-lookup (make-hash-table 1))
+
;; Each class will be defined as
;; (class parent grandparent .. )
;; so that (eq? (cdr class) parent) holds.
(lambda (rel)
(for-each
(lambda (type)
- (primitive-eval `(define ,type (cons ',type ,(cdr rel)))))
+ (hashq-set! ancestor-lookup type (cons type (hashq-ref ancestor-lookup (cdr rel) '())))) ;; `(define ,type (cons ',type ,(cdr rel)))))
(car rel)))
event-classes)
;; TODO: Allow entering more complex classes, by taking unions.
(define-public (ly:make-event-class leaf)
- (primitive-eval leaf))
+ (hashq-ref ancestor-lookup leaf))
+;; (primitive-eval leaf))
(defmacro-public make-stream-event (expr)
(Stream_event::undump (primitive-eval (list 'quasiquote expr))))
;; load-from-path
'("lily-library.scm"
"file-cache.scm"
-; "define-event-classes.scm"
+ "define-event-classes.scm"
"define-music-types.scm"
"output-lib.scm"
"c++.scm"
projects / lilypond.git / commitdiff