From: David Kastrup Date: Sat, 18 Feb 2012 15:21:53 +0000 (+0100) Subject: Use make-engraver when feasible X-Git-Tag: release/2.15.31-1~59 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=6ec4177a4076c45e00e904fd6457dcf57130119d;p=lilypond.git Use make-engraver when feasible --- diff --git a/Documentation/snippets/new/centering-markup-on-note-heads-automatically.ly b/Documentation/snippets/new/centering-markup-on-note-heads-automatically.ly index 47169a559b..2d1ec280ef 100644 --- a/Documentation/snippets/new/centering-markup-on-note-heads-automatically.ly +++ b/Documentation/snippets/new/centering-markup-on-note-heads-automatically.ly @@ -1,4 +1,4 @@ -\version "2.14.0" +\version "2.15.31" \header { lsrtags = "text, tweaks-and-overrides, contexts-and-engravers" @@ -17,29 +17,23 @@ been shifted via @code{force-hshift}. #(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 { diff --git a/Documentation/snippets/new/defining-an-engraver-in-scheme-ambitus-engraver.ly b/Documentation/snippets/new/defining-an-engraver-in-scheme-ambitus-engraver.ly index 379dc69147..8958cd9e12 100644 --- a/Documentation/snippets/new/defining-an-engraver-in-scheme-ambitus-engraver.ly +++ b/Documentation/snippets/new/defining-an-engraver-in-scheme-ambitus-engraver.ly @@ -1,4 +1,4 @@ -\version "2.14.0" +\version "2.15.31" \header { @@ -21,10 +21,6 @@ %%% 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}. @@ -188,7 +184,7 @@ position of middle C and key signature from @var{translator}'s context." ;; 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 @@ -292,23 +288,24 @@ position of middle C and key signature from @var{translator}'s context." (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 diff --git a/Documentation/snippets/new/numbers-as-easy-note-heads.ly b/Documentation/snippets/new/numbers-as-easy-note-heads.ly index 03e0578af2..2b86eb9f1a 100644 --- a/Documentation/snippets/new/numbers-as-easy-note-heads.ly +++ b/Documentation/snippets/new/numbers-as-easy-note-heads.ly @@ -1,4 +1,4 @@ -\version "2.14.0" +\version "2.15.31" \header { lsrtags = "pitches" @@ -15,21 +15,19 @@ object it sees. } #(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) diff --git a/input/regression/scheme-engraver-instance.ly b/input/regression/scheme-engraver-instance.ly index d78e85a5db..fa32f95200 100644 --- a/input/regression/scheme-engraver-instance.ly +++ b/input/regression/scheme-engraver-instance.ly @@ -8,7 +8,7 @@ } -\version "2.14.0" +\version "2.15.31" \layout { \context { @@ -19,14 +19,14 @@ (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))))))))) } } diff --git a/input/regression/scheme-engraver.ly b/input/regression/scheme-engraver.ly index 115429f90c..0be6f0d947 100644 --- a/input/regression/scheme-engraver.ly +++ b/input/regression/scheme-engraver.ly @@ -5,68 +5,49 @@ } -\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)))) }} diff --git a/input/regression/scheme-text-spanner.ly b/input/regression/scheme-text-spanner.ly index 6541f05a34..c0204d55c7 100644 --- a/input/regression/scheme-text-spanner.ly +++ b/input/regression/scheme-text-spanner.ly @@ -1,4 +1,4 @@ -\version "2.14.0" +\version "2.15.31" \header { texidoc = "Use @code{define-event-class}, scheme engraver methods, @@ -119,64 +119,58 @@ schemeTextSpannerEngraver = (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) diff --git a/ly/event-listener.ly b/ly/event-listener.ly index 71d560b075..20615e8c2a 100644 --- a/ly/event-listener.ly +++ b/ly/event-listener.ly @@ -32,7 +32,7 @@ -\version "2.15.0" +\version "2.15.31" %%%% Helper functions @@ -205,21 +205,19 @@ optionally outputs to the console as well." \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))) } }