-\version "2.14.0"
+\version "2.15.31"
\header {
lsrtags = "text, tweaks-and-overrides, contexts-and-engravers"
#(define (Text_align_engraver ctx)
(let ((scripts '())
(note-column #f))
-
- `((acknowledgers
- (note-column-interface
- . ,(lambda (trans grob source)
- ;; cache NoteColumn in this Voice context
- (set! note-column grob)))
-
- (text-script-interface
- . ,(lambda (trans grob source)
- ;; whenever a TextScript is acknowledged,
- ;; add it to `scripts' list
- (set! scripts (cons grob scripts)))))
-
- (stop-translation-timestep
- . ,(lambda (trans)
- ;; if any TextScript grobs exist,
- ;; set NoteColumn as X-parent
- (and (pair? scripts)
- (for-each (lambda (script)
- (set! (ly:grob-parent script X) note-column))
- scripts))
- ;; clear scripts ready for next timestep
- (set! scripts '()))))))
+ (make-engraver
+ (acknowledgers
+ ((note-column-interface trans grob source)
+ ;; cache NoteColumn in this Voice context
+ (set! note-column grob))
+ ((text-script-interface trans grob source)
+ ;; whenever a TextScript is acknowledged,
+ ;; add it to `scripts' list
+ (set! scripts (cons grob scripts))))
+ ((stop-translation-timestep trans)
+ ;; if any TextScript grobs exist,
+ ;; set NoteColumn as X-parent
+ (for-each (lambda (script)
+ (set! (ly:grob-parent script X) note-column))
+ scripts)
+ ;; clear scripts ready for next timestep
+ (set! scripts '())))))
\layout {
\context {
-\version "2.14.0"
+\version "2.15.31"
\header {
%%% Grob utilities
%%%
%%% These are literal rewrites of some C++ methods used by the ambitus engraver.
-#(define (ly:event::in-event-class event class-name)
- "Check if @var{event} the given class.
-Rewrite of @code{Stream_event::internal_in_event_class} from @file{lily/stream-event.cc}."
- (memq class-name (ly:make-event-class (ly:event-property event 'class))))
#(define (ly:separation-item::add-conditional-item grob grob-item)
"Add @var{grob-item} to the array of conditional elements of @var{grob}.
;; Get the event that caused the note-grob creation
;; and check that it is a note-event.
(let ((note-event (ly:grob-property note-grob 'cause)))
- (if (ly:event::in-event-class note-event 'note-event)
+ (if (ly:in-event-class? note-event 'note-event)
;; get the pitch from the note event
(let ((pitch (ly:event-property note-event 'pitch)))
;; if this pitch is lower than the current ambitus lower
(lambda (context)
(let ((ambitus #f))
;; when music is processed: make the ambitus object, if not already built
- `((process-music . ,(lambda (translator)
- (if (not ambitus)
- (set! ambitus (make-ambitus translator)))))
- ;; set the ambitus clef and key signature state
- (stop-translation-timestep . ,(lambda (translator)
- (if ambitus
- (initialize-ambitus-state ambitus translator))))
- ;; when a note-head grob is built, update the ambitus notes
- (acknowledgers
- (note-head-interface . ,(lambda (engraver grob source-engraver)
- (if ambitus
- (update-ambitus-notes ambitus grob)))))
- ;; finally, typeset the ambitus according to its upper and lower notes
- ;; (if any).
- (finalize . ,(lambda (translator)
- (if ambitus
- (typeset-ambitus ambitus translator))))))))
+ (make-engraver
+ ((process-music translator)
+ (if (not ambitus)
+ (set! ambitus (make-ambitus translator))))
+ ;; set the ambitus clef and key signature state
+ ((stop-translation-timestep translator)
+ (if ambitus
+ (initialize-ambitus-state ambitus translator)))
+ ;; when a note-head grob is built, update the ambitus notes
+ (acknowledgers
+ ((note-head-interface engraver grob source-engraver)
+ (if ambitus
+ (update-ambitus-notes ambitus grob))))
+ ;; finally, typeset the ambitus according to its upper and lower notes
+ ;; (if any).
+ ((finalize translator)
+ (if ambitus
+ (typeset-ambitus ambitus translator)))))))
%%%
%%% Example
-\version "2.14.0"
+\version "2.15.31"
\header {
lsrtags = "pitches"
}
#(define Ez_numbers_engraver
- (list
- (cons 'acknowledgers
- (list
- (cons 'note-head-interface
- (lambda (engraver grob source-engraver)
- (let* ((context (ly:translator-context engraver))
- (tonic-pitch (ly:context-property context 'tonic))
- (tonic-name (ly:pitch-notename tonic-pitch))
- (grob-pitch
- (ly:event-property (event-cause grob) 'pitch))
- (grob-name (ly:pitch-notename grob-pitch))
- (delta (modulo (- grob-name tonic-name) 7))
- (note-names
- (make-vector 7 (number->string (1+ delta)))))
- (ly:grob-set-property! grob 'note-names note-names))))))))
+ (make-engraver
+ (acknowledgers
+ ((note-head-interface engraver grob source-engraver)
+ (let* ((context (ly:translator-context engraver))
+ (tonic-pitch (ly:context-property context 'tonic))
+ (tonic-name (ly:pitch-notename tonic-pitch))
+ (grob-pitch
+ (ly:event-property (event-cause grob) 'pitch))
+ (grob-name (ly:pitch-notename grob-pitch))
+ (delta (modulo (- grob-name tonic-name) 7))
+ (note-names
+ (make-vector 7 (number->string (1+ delta)))))
+ (ly:grob-set-property! grob 'note-names note-names))))))
#(set-global-staff-size 26)
}
-\version "2.14.0"
+\version "2.15.31"
\layout {
\context {
(set! instance-counter (1+ instance-counter))
(let ((instance-id instance-counter)
(private-note-counter 0))
- `((listeners
- (note-event
- . ,(lambda (engraver event)
- (set! private-note-counter (1+ private-note-counter))
- (let ((text (ly:engraver-make-grob engraver 'TextScript event)))
- (ly:grob-set-property! text 'text
- (format #f "~a.~a" instance-id
- private-note-counter))))))))))
+ (make-engraver
+ (listeners
+ ((note-event engraver event)
+ (set! private-note-counter (1+ private-note-counter))
+ (let ((text (ly:engraver-make-grob engraver 'TextScript event)))
+ (ly:grob-set-property! text 'text
+ (format #f "~a.~a" instance-id
+ private-note-counter)))))))))
}
}
}
-\version "2.14.0"
+\version "2.15.31"
\layout {
\context {
\Voice
\consists
- #(list
- (cons 'initialize
- (lambda (trans)
- (display (list "initialize"
- (ly:context-current-moment
- (ly:translator-context trans)) "\n") (current-error-port))))
- (cons 'start-translation-timestep
- (lambda (trans)
- (display (list "start-trans"
- (ly:context-current-moment
- (ly:translator-context trans)) "\n") (current-error-port))))
- (cons 'listeners
- (list
- (cons 'rest-event (lambda (engraver event)
- (let*
- ((x (ly:engraver-make-grob engraver 'TextScript event)))
- (display (list "caught event" event "\ncreate:\n" x "\n") (current-error-port))
- (ly:grob-set-property! x 'text "hi"))
- ))
- ))
- (cons 'acknowledgers
- (list
- (cons 'note-head-interface
- (lambda (engraver grob source-engraver)
- (display (list "saw head: " grob " coming from " source-engraver) (current-error-port))
- ))
- ))
- (cons 'end-acknowledgers
- (list
- (cons 'beam-interface
- (lambda (engraver grob source-engraver)
- (display (list "saw end of beam: " grob " coming from " source-engraver) (current-error-port))
- ))
- ))
- (cons 'process-music
- (lambda (trans)
- (display (list "process-music"
- (ly:context-current-moment
- (ly:translator-context trans)) "\n") (current-error-port))))
- (cons 'process-acknowledged
- (lambda (trans)
- (display (list "process-acknowledged"
- (ly:context-current-moment
- (ly:translator-context trans)) "\n") (current-error-port))))
- (cons 'stop-translation-timestep
- (lambda (trans)
- (display (list "stop-trans"
- (ly:context-current-moment
- (ly:translator-context trans)) "\n") (current-error-port))))
- (cons 'finalize
- (lambda (trans)
- (display (list "finalize"
- (ly:context-current-moment
- (ly:translator-context trans)) "\n") (current-error-port))))
- )
-
+ #(make-engraver
+ ((initialize trans)
+ (display (list "initialize"
+ (ly:context-current-moment
+ (ly:translator-context trans)) "\n") (current-error-port)))
+ ((start-translation-timestep trans)
+ (display (list "start-trans"
+ (ly:context-current-moment
+ (ly:translator-context trans)) "\n") (current-error-port)))
+ (listeners
+ ((rest-event engraver event)
+ (let*
+ ((x (ly:engraver-make-grob engraver 'TextScript event)))
+ (display (list "caught event" event "\ncreate:\n" x "\n") (current-error-port))
+ (ly:grob-set-property! x 'text "hi"))))
+ (acknowledgers
+ ((note-head-interface engraver grob source-engraver)
+ (display (list "saw head: " grob " coming from " source-engraver) (current-error-port))))
+ (end-acknowledgers
+ ((beam-interface engraver grob source-engraver)
+ (display (list "saw end of beam: " grob " coming from " source-engraver) (current-error-port))))
+ ((process-music trans)
+ (display (list "process-music"
+ (ly:context-current-moment
+ (ly:translator-context trans)) "\n") (current-error-port)))
+ ((process-acknowledged trans)
+ (display (list "process-acknowledged"
+ (ly:context-current-moment
+ (ly:translator-context trans)) "\n") (current-error-port)))
+ ((stop-translation-timestep trans)
+ (display (list "stop-trans"
+ (ly:context-current-moment
+ (ly:translator-context trans)) "\n") (current-error-port)))
+ ((finalize trans)
+ (display (list "finalize"
+ (ly:context-current-moment
+ (ly:translator-context trans)) "\n") (current-error-port))))
}}
-\version "2.14.0"
+\version "2.15.31"
\header {
texidoc = "Use @code{define-event-class}, scheme engraver methods,
(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)
-\version "2.15.0"
+\version "2.15.31"
%%%% Helper functions
\layout {
\context {
\Voice
- \consists #(list
- (cons 'listeners
- (list
- (cons 'tempo-change-event format-tempo)
- (cons 'rest-event format-rest)
- (cons 'note-event format-note)
- (cons 'articulation-event format-articulation)
- (cons 'text-script-event format-text)
- (cons 'slur-event format-slur)
- (cons 'breathing-event format-breathe)
- (cons 'dynamic-event format-dynamic)
- (cons 'crescendo-event format-cresc)
- (cons 'decrescendo-event format-decresc)
- (cons 'text-span-event format-textspan)
- (cons 'tie-event format-tie)
- )))
+ \consists #(make-engraver
+ (listeners
+ (tempo-change-event . format-tempo)
+ (rest-event . format-rest)
+ (note-event . format-note)
+ (articulation-event . format-articulation)
+ (text-script-event . format-text)
+ (slur-event . format-slur)
+ (breathing-event . format-breathe)
+ (dynamic-event . format-dynamic)
+ (crescendo-event . format-cresc)
+ (decrescendo-event . format-decresc)
+ (text-span-event . format-textspan)
+ (tie-event . format-tie)))
}
}
projects / lilypond.git / commitdiff