-\version "2.13.36"
+\version "2.16.0"
\header {
texidoc = "Use @code{define-event-class}, scheme engraver methods,
in scheme."
}
-#(define-event-class 'scheme-text-span-event
- '(scheme-text-span-event
- span-event
- music-event
- StreamEvent))
+#(define my-grob-descriptions '())
+
+#(define my-event-classes (ly:make-context-mod))
+
+defineEventClass =
+#(define-void-function (parser location class parent)
+ (symbol? symbol?)
+ (ly:add-context-mod
+ my-event-classes
+ `(apply
+ ,(lambda (context class parent)
+ (ly:context-set-property!
+ context
+ 'EventClasses
+ (event-class-cons
+ class
+ parent
+ (ly:context-property context 'EventClasses '()))))
+ ,class ,parent)))
+
+\defineEventClass #'scheme-text-span-event #'span-event
#(define (add-grob-definition grob-name grob-entry)
(let* ((meta-entry (assoc-get 'meta grob-entry))
(set! meta-entry (assoc-set! meta-entry 'interfaces
ifaces-entry))
(set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
- (set! all-grob-descriptions
+ (set! my-grob-descriptions
(cons (cons grob-name grob-entry)
- all-grob-descriptions))))
+ my-grob-descriptions))))
#(add-grob-definition
'SchemeTextSpanner
(finished '())
(current-event '())
(event-drul '(() . ())))
- (list (cons 'listeners
- (list (cons 'scheme-text-span-event
- (lambda (engraver event)
- (if (= START (ly:event-property event 'span-direction))
- (set-car! event-drul event)
- (set-cdr! event-drul event))))))
- (cons 'acknowledgers
- (list (cons 'note-column-interface
- (lambda (engraver grob source-engraver)
- (if (ly:spanner? span)
- (begin
- (ly:pointer-group-interface::add-grob span 'note-columns grob)
- (add-bound-item span grob)))
- (if (ly:spanner? finished)
- (begin
- (ly:pointer-group-interface::add-grob finished 'note-columns grob)
- (add-bound-item finished grob)))))))
- (cons 'process-music
- (lambda (trans)
- (if (ly:stream-event? (cdr event-drul))
- (if (null? span)
- (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
- (begin (set! finished span)
- (ly:engraver-announce-end-grob trans finished current-event)
- (set! span '())
- (set! current-event '())
- (set-cdr! event-drul '()))))
- (if (ly:stream-event? (car event-drul))
- (begin (set! current-event (car event-drul))
- (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
- (set-axis! span Y)
- (set-car! event-drul '())))))
- (cons 'stop-translation-timestep
- (lambda (trans)
- (if (and (ly:spanner? span)
- (null? (ly:spanner-bound span LEFT)))
- (set! (ly:spanner-bound span LEFT)
- (ly:context-property context 'currentMusicalColumn)))
- (if (ly:spanner? finished)
- (begin
- (if (null? (ly:spanner-bound finished RIGHT))
- (set! (ly:spanner-bound finished RIGHT)
- (ly:context-property context 'currentMusicalColumn)))
- (set! finished '())
- (set! event-drul '(() . ()))))))
- (cons 'finalize
- (lambda (trans)
- (if (ly:spanner? finished)
- (begin
- (if (null? (ly:spanner-bound finished RIGHT))
- (set! (ly:spanner-bound finished RIGHT)
- (ly:context-property context 'currentMusicalColumn)))
- (set! finished '())))
- (if (ly:spanner? span)
- (begin
- (ly:warning "I think there's a dangling scheme text spanner :-(")
- (ly:grob-suicide! span)
- (set! span '()))))))))
+ (make-engraver
+ (listeners ((scheme-text-span-event engraver event)
+ (if (= START (ly:event-property event 'span-direction))
+ (set-car! event-drul event)
+ (set-cdr! event-drul event))))
+ (acknowledgers ((note-column-interface engraver grob source-engraver)
+ (if (ly:spanner? span)
+ (begin
+ (ly:pointer-group-interface::add-grob span 'note-columns grob)
+ (add-bound-item span grob)))
+ (if (ly:spanner? finished)
+ (begin
+ (ly:pointer-group-interface::add-grob finished 'note-columns grob)
+ (add-bound-item finished grob)))))
+ ((process-music trans)
+ (if (ly:stream-event? (cdr event-drul))
+ (if (null? span)
+ (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
+ (begin (set! finished span)
+ (ly:engraver-announce-end-grob trans finished current-event)
+ (set! span '())
+ (set! current-event '())
+ (set-cdr! event-drul '()))))
+ (if (ly:stream-event? (car event-drul))
+ (begin (set! current-event (car event-drul))
+ (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
+ (set-axis! span Y)
+ (set-car! event-drul '()))))
+ ((stop-translation-timestep trans)
+ (if (and (ly:spanner? span)
+ (null? (ly:spanner-bound span LEFT)))
+ (set! (ly:spanner-bound span LEFT)
+ (ly:context-property context 'currentMusicalColumn)))
+ (if (ly:spanner? finished)
+ (begin
+ (if (null? (ly:spanner-bound finished RIGHT))
+ (set! (ly:spanner-bound finished RIGHT)
+ (ly:context-property context 'currentMusicalColumn)))
+ (set! finished '())
+ (set! event-drul '(() . ())))))
+ ((finalize trans)
+ (if (ly:spanner? finished)
+ (begin
+ (if (null? (ly:spanner-bound finished RIGHT))
+ (set! (ly:spanner-bound finished RIGHT)
+ (ly:context-property context 'currentMusicalColumn)))
+ (set! finished '())))
+ (if (ly:spanner? span)
+ (begin
+ (ly:warning "I think there's a dangling scheme text spanner :-(")
+ (ly:grob-suicide! span)
+ (set! span '())))))))
schemeTextSpannerStart =
#(make-span-event 'SchemeTextSpanEvent START)
\layout {
\context {
\Global
- \grobdescriptions #all-grob-descriptions
+ \grobdescriptions #my-grob-descriptions
+ #my-event-classes
}
\context {
\Voice