From 9ae6f70b41aac56b65ba62d5c6db97dbe449cb67 Mon Sep 17 00:00:00 2001 From: Nicolas Sceaux Date: Sat, 6 Mar 2010 14:39:05 +0100 Subject: [PATCH] Doc: document the ambitus scheme engraver snippet --- .../snippets/new/scheme-engraver-ambitus.ly | 242 +++++++++++++----- 1 file changed, 171 insertions(+), 71 deletions(-) diff --git a/Documentation/snippets/new/scheme-engraver-ambitus.ly b/Documentation/snippets/new/scheme-engraver-ambitus.ly index 2a382e63fa..2da39dba15 100644 --- a/Documentation/snippets/new/scheme-engraver-ambitus.ly +++ b/Documentation/snippets/new/scheme-engraver-ambitus.ly @@ -20,17 +20,28 @@ %%% %%% 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}. +Rewrite of @code{Separation_item::add_conditional_item} from @file{lily/separation-item.cc}." (ly:pointer-group-interface::add-grob grob 'conditional-elements grob-item)) #(define (ly:accidental-placement::accidental-pitch accidental-grob) + "Get the pitch from the grob cause of @var{accidental-grob}. +Rewrite of @code{accidental_pitch} from @file{lily/accidental-placement.cc}." (ly:event-property (ly:grob-property (ly:grob-parent accidental-grob Y) 'cause) 'pitch)) #(define (ly:accidental-placement::add-accidental grob accidental-grob) + "Add @var{accidental-grob}, an @code{Accidental} grob, to the +list of the accidental grobs of @var{grob}, an @code{AccidentalPlacement} +grob. +Rewrite of @code{Accidental_placement::add_accidental} from @file{lily/accidental-placement.cc}." (let ((pitch (ly:accidental-placement::accidental-pitch accidental-grob))) (set! (ly:grob-parent accidental-grob X) grob) (set! (ly:grob-property accidental-grob 'X-offset) @@ -39,53 +50,59 @@ (handle (assq (ly:pitch-notename pitch) accidentals)) (entry (if handle (cdr handle) '()))) (set! (ly:grob-object grob 'accidental-grobs) - (assq-set! accidentals (ly:pitch-notename pitch) (cons accidental-grob entry)))))) + (assq-set! accidentals + (ly:pitch-notename pitch) + (cons accidental-grob entry)))))) %%% %%% Ambitus data structure %%% + +%%% The class holds the various grobs that are created +%%% to print an ambitus: +%%% - ambitus-group: the grob that groups all the components of an ambitus +%%% (Ambitus grob); +%%% - ambitus-line: the vertical line between the upper and lower ambitus +%%% notes (AmbitusLine grob); +%%% - ambitus-up-note and ambitus-down-note: the note head and accidental +%%% for the lower and upper note of the ambitus (see class +%%% below). +%%% The other slots define the key and clef context of the engraver: +%%% - start-c0: position of middle c at the beginning of the piece. It +%%% is used to place the ambitus notes according to their pitch; +%%% - start-key-sig: the key signature at the beginning of the piece. It +%%% is used to determine if accidentals shall be printed next to ambitus +%%% notes. + #(define-class () - (ambitus-line #:accessor ambitus-line) (ambitus-group #:accessor ambitus-group) + (ambitus-line #:accessor ambitus-line) (ambitus-up-note #:getter ambitus-up-note #:init-form (make )) (ambitus-down-note #:getter ambitus-down-note #:init-form (make )) - (is-typeset #:accessor ambitus-is-typeset - #:init-value #f) (start-c0 #:accessor ambitus-start-c0 #:init-value #f) (start-key-sig #:accessor ambitus-start-key-sig #:init-value '())) +%%% Accessor for the lower and upper note data of an ambitus #(define-method (ambitus-note (ambitus ) direction) + "If @var{direction} is @code{UP}, then return the upper ambitus note +of @var{ambitus}, otherwise return the lower ambitus note." (if (= direction UP) (ambitus-up-note ambitus) (ambitus-down-note ambitus))) -#(define-accessor ambitus-head) -#(define-method (ambitus-head (ambitus ) direction) - (ambitus-note-head (ambitus-note ambitus direction))) -#(define-method ((setter ambitus-head) (ambitus ) direction head) - (set! (ambitus-note-head (ambitus-note ambitus direction)) head)) - -#(define-accessor ambitus-accidental) -#(define-method (ambitus-accidental (ambitus ) direction) - (ambitus-note-accidental (ambitus-note ambitus direction))) -#(define-method ((setter ambitus-accidental) (ambitus ) direction accidental) - (set! (ambitus-note-accidental (ambitus-note ambitus direction)) accidental)) - -#(define-accessor ambitus-cause) -#(define-method (ambitus-cause (ambitus ) direction) - (ambitus-note-cause (ambitus-note ambitus direction))) -#(define-method ((setter ambitus-cause) (ambitus ) direction cause) - (set! (ambitus-note-cause (ambitus-note ambitus direction)) cause)) - -#(define-accessor ambitus-pitch) -#(define-method (ambitus-pitch (ambitus ) direction) - (ambitus-note-pitch (ambitus-note ambitus direction))) -#(define-method ((setter ambitus-pitch) (ambitus ) direction pitch) - (set! (ambitus-note-pitch (ambitus-note ambitus direction)) pitch)) +%%% The class holds the grobs that are specific to ambitus +%%% (lower and upper) notes: +%%% - head: an AmbitusNoteHead grob; +%%% - accidental: an AmbitusAccidental grob, to be possibly printed next +%%% to the ambitus note head. +%%% Moreover: +%%% - pitch is the absolute pitch of the note +%%% - cause is the note event that causes this ambitus note, i.e. the lower +%%% or upper note of the considered music sequence. #(define-class () (head #:accessor ambitus-note-head @@ -100,28 +117,62 @@ %%% %%% Ambitus engraving logics %%% +%%% Rewrite of the code from @file{lily/ambitus-engraver.cc}. + #(define (make-ambitus translator) + "Build an ambitus object: initialize all the grobs and their relations. + +The Ambitus grob contain all other grobs: + Ambitus + |- AmbitusLine + |- AmbitusNoteHead for upper note + |- AmbitusAccidental for upper note + |- AmbitusNoteHead for lower note + |- AmbitusAccidental for lower note + +The parent of an accidental is the corresponding note head, +and the accidental is set as the 'accidental-grob of the note head +so that is printed by the function that prints notes." + ;; make the ambitus object (let ((ambitus (make ))) - (set! (ambitus-line ambitus) (ly:engraver-make-grob translator 'AmbitusLine '())) + ;; build the Ambitus grob, which will contain all other grobs (set! (ambitus-group ambitus) (ly:engraver-make-grob translator 'Ambitus '())) + ;; build the AmbitusLine grob (line between lower and upper note) + (set! (ambitus-line ambitus) (ly:engraver-make-grob translator 'AmbitusLine '())) + ;; build the upper and lower AmbitusNoteHead and AmbitusAccidental (for-each (lambda (direction) (let ((head (ly:engraver-make-grob translator 'AmbitusNoteHead '())) (accidental (ly:engraver-make-grob translator 'AmbitusAccidental '())) (group (ambitus-group ambitus))) + ;; The parent of the AmbitusAccidental grob is the + ;; AmbitusNoteHead grob (set! (ly:grob-parent accidental Y) head) + ;; The AmbitusAccidental grob is set as the accidental-grob + ;; object of the AmbitusNoteHead. This is later used by the + ;; function that prints notes. (set! (ly:grob-object head 'accidental-grob) accidental) + ;; both the note head and the accidental grobs are added + ;; to the main ambitus grob. (ly:axis-group-interface::add-element group head) (ly:axis-group-interface::add-element group accidental) - (set! (ambitus-head ambitus direction) head) - (set! (ambitus-accidental ambitus direction) accidental))) + ;; the note head and the accidental grobs are added to the + ;; ambitus object + (set! (ambitus-note-head (ambitus-note ambitus direction)) + head) + (set! (ambitus-note-accidental (ambitus-note ambitus direction)) + accidental))) (list DOWN UP)) - (set! (ly:grob-parent (ambitus-line ambitus) X) (ambitus-head ambitus DOWN)) + ;; The parent of the ambitus line is the lower ambitus note head + (set! (ly:grob-parent (ambitus-line ambitus) X) + (ambitus-note-head (ambitus-note ambitus DOWN))) + ;; the ambitus line is added to the ambitus main grob (ly:axis-group-interface::add-element (ambitus-group ambitus) (ambitus-line ambitus)) - (set! (ambitus-is-typeset ambitus) #f) ambitus)) -#(define-method (typeset-ambitus (ambitus ) translator) - (if (not (ambitus-is-typeset ambitus)) +#(define-method (initialize-ambitus-state (ambitus ) translator) + "Initialize the state of @var{ambitus}, by getting the starting +position of middle C and key signature from @var{translator}'s context." + (if (not (ambitus-start-c0 ambitus)) (begin (set! (ambitus-start-c0 ambitus) (ly:context-property (ly:translator-context translator) @@ -129,36 +180,65 @@ 0)) (set! (ambitus-start-key-sig ambitus) (ly:context-property (ly:translator-context translator) - 'keySignature)) - (set! (ambitus-is-typeset ambitus) #t)))) + 'keySignature))))) #(define-method (update-ambitus-notes (ambitus ) note-grob) + "Update the upper and lower ambitus pithes of @var{ambitus}, using +@var{note-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) + ;; get the pitch from the note event (let ((pitch (ly:event-property note-event 'pitch))) - (if (or (not (ambitus-pitch ambitus DOWN)) - (ly:pitch) translator) - (if (and (ambitus-pitch ambitus UP) (ambitus-pitch ambitus DOWN)) - (let ((accidental-placement (ly:engraver-make-grob translator - 'AccidentalPlacement - (ambitus-accidental ambitus DOWN)))) + ;; if this pitch is lower than the current ambitus lower + ;; note pitch (or it has not been initialized yet), + ;; then this pitch is the new ambitus lower pitch, + ;; and conversely for upper pitch. + (for-each (lambda (direction pitch-compare) + (if (or (not (ambitus-note-pitch (ambitus-note ambitus direction))) + (pitch-compare pitch + (ambitus-note-pitch (ambitus-note ambitus direction)))) + (begin + (set! (ambitus-note-pitch (ambitus-note ambitus direction)) + pitch) + (set! (ambitus-note-cause (ambitus-note ambitus direction)) + note-event)))) + (list DOWN UP) + (list ly:pitch) translator) + "Typeset the ambitus: +- place the lower and upper ambitus notes according to their pitch and + the position of the middle C; +- typeset or delete the note accidentals, according to the key signature. + An accidental, if it is to be printed, is added to an AccidentalPlacement + grob (a grob dedicated to the placement of accidentals near a chord); +- both note heads are added to the ambitus line grob, so that a line should + be printed between them." + ;; check if there are lower and upper pitches + (if (and (ambitus-note-pitch (ambitus-note ambitus UP)) + (ambitus-note-pitch (ambitus-note ambitus DOWN))) + ;; make an AccidentalPlacement grob, for placement of note accidentals + (let ((accidental-placement (ly:engraver-make-grob + translator + 'AccidentalPlacement + (ambitus-note-accidental (ambitus-note ambitus DOWN))))) + ;; For lower and upper ambitus notes: (for-each (lambda (direction) - (let ((pitch (ambitus-pitch ambitus direction))) - (set! (ly:grob-property (ambitus-head ambitus direction) 'cause) - (ambitus-cause ambitus direction)) - (set! (ly:grob-property (ambitus-head ambitus direction) 'staff-position) + (let ((pitch (ambitus-note-pitch (ambitus-note ambitus direction)))) + ;; set the cause and the staff position of the ambitus note + ;; according to the associated pitch + (set! (ly:grob-property (ambitus-note-head (ambitus-note ambitus direction)) + 'cause) + (ambitus-note-cause (ambitus-note ambitus direction))) + (set! (ly:grob-property (ambitus-note-head (ambitus-note ambitus direction)) + 'staff-position) (+ (ambitus-start-c0 ambitus) (ly:pitch-steps pitch))) + ;; determine if an accidental shall be printed for this note, + ;; according to the key signature (let* ((handle (or (assoc (cons (ly:pitch-octave pitch) (ly:pitch-notename pitch)) (ambitus-start-key-sig ambitus)) @@ -166,27 +246,42 @@ (ambitus-start-key-sig ambitus)))) (sig-alter (if handle (cdr handle) 0))) (cond ((= (ly:pitch-alteration pitch) sig-alter) - (ly:grob-suicide! (ambitus-accidental ambitus direction)) - (set! (ly:grob-object (ambitus-head ambitus direction) + ;; the note alteration is in the key signature + ;; => it does not have to be printed + (ly:grob-suicide! + (ambitus-note-accidental (ambitus-note ambitus direction))) + (set! (ly:grob-object (ambitus-note-head (ambitus-note ambitus direction)) 'accidental-grob) '())) (else - (set! (ly:grob-property (ambitus-accidental ambitus direction) + ;; otherwise, the accidental shall be printed + (set! (ly:grob-property (ambitus-note-accidental + (ambitus-note ambitus direction)) 'alteration) (ly:pitch-alteration pitch))))) - (ly:separation-item::add-conditional-item (ambitus-head ambitus direction) - accidental-placement) - (ly:accidental-placement::add-accidental accidental-placement - (ambitus-accidental ambitus direction)) - (ly:pointer-group-interface::add-grob (ambitus-line ambitus) - 'note-heads - (ambitus-head ambitus direction)))) + ;; add the AccidentalPlacement grob to the + ;; conditional items of the AmbitusNoteHead + (ly:separation-item::add-conditional-item + (ambitus-note-head (ambitus-note ambitus direction)) + accidental-placement) + ;; add the AmbitusAccidental to the list of the + ;; AccidentalPlacement grob accidentals + (ly:accidental-placement::add-accidental + accidental-placement + (ambitus-note-accidental (ambitus-note ambitus direction))) + ;; add the AmbitusNoteHead grob to the AmbitusLine grob + (ly:pointer-group-interface::add-grob + (ambitus-line ambitus) + 'note-heads + (ambitus-note-head (ambitus-note ambitus direction))))) (list DOWN UP)) + ;; add the AccidentalPlacement grob to the main Ambitus grob (ly:axis-group-interface::add-element (ambitus-group ambitus) accidental-placement)) - (begin ;; no pitch ==> suicide all grobs + ;; no notes ==> suicide the grobs + (begin (for-each (lambda (direction) - (ly:grob-suicide! (ambitus-accidental ambitus direction)) - (ly:grob-suicide! (ambitus-head ambitus direction))) + (ly:grob-suicide! (ambitus-note-accidental (ambitus-note ambitus direction))) + (ly:grob-suicide! (ambitus-note-head (ambitus-note ambitus direction)))) (list DOWN UP)) (ly:grob-suicide! ambitus-line)))) @@ -196,19 +291,24 @@ #(define ambitus-engraver (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 - (typeset-ambitus ambitus translator)))) + (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 - (finalize-ambitus ambitus translator)))))))) + (typeset-ambitus ambitus translator)))))))) %%% %%% Example -- 2.39.5