From: Neil Puttock Date: Mon, 26 Jul 2010 22:01:34 +0000 (+0100) Subject: Fix #765: Display method for \ottava. X-Git-Tag: release/2.13.29-1~30 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=d00ca5c25ad78a6de4ed5098673bb151707f28c1;p=lilypond.git Fix #765: Display method for \ottava. Since \ottava currently uses ApplyContext to set the relevant context properties which trigger creation of an ottava bracket, the information useful to its display method (i.e., the octavation) is inaccessible: the only music property which can be extracted is the argument to ApplyContext, its procedure. By wrapping the existing code which creates an ottava bracket (make-ottava-set) in a synthetic event, the octavation can be passed as a music property, thus making it accessible from a display method. * input/regression/display-lily-tests.ly: add test for \ottava * ly/music-functions-init.ly (ottava): create ottava bracket via synthetic OttavaMusic * scm/define-music-display-methods.scm: add display method for \ottava, which simply catches OttavaMusic and reads 'ottava-number * scm/define-music-properties.scm (all-music-properties): add 'ottava-number * scm/define-music-types.scm: copy make-ottava-set from scm/music-functions.scm add OttavaMusic: uses a sequential iterator to call make-ottava-set via its elements-callback * scm/music-functions.scm: add ly:context-property as procedure-with-setter remove make-ottava-set --- diff --git a/input/regression/display-lily-tests.ly b/input/regression/display-lily-tests.ly index 2e0aa7c23a..1d8d0097a9 100644 --- a/input/regression/display-lily-tests.ly +++ b/input/regression/display-lily-tests.ly @@ -233,6 +233,8 @@ stderr of this run." \test "" ##[ \cueDuring #"foo" #1 { c d } #] \test "" ##[ \quoteDuring #"foo" { c d } #] +%% \ottava +\test "" ##[ \ottava #1 #] % OttavaMusic %% end test. diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index f26e0a1154..0e5093e8a5 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -405,9 +405,10 @@ octaveCheck = 'pitch (pitch-of-note pitch-note))) ottava = -#(define-music-function (parser location octave) (number?) +#(define-music-function (parser location octave) (integer?) (_i "Set the octavation.") - (make-ottava-set octave)) + (make-music 'OttavaMusic + 'ottava-number octave)) overrideTimeSignatureSettings = #(define-music-function diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index f3304dadab..0ee424018b 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -512,6 +512,9 @@ Otherwise, return #f." (define-display-method SkipMusic (skip parser) (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t))) +(define-display-method OttavaMusic (ottava parser) + (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number))) + ;;; ;;; Notes, rests, skips... ;;; diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm index 2af8f923af..2694e48ec5 100644 --- a/scm/define-music-properties.scm +++ b/scm/define-music-properties.scm @@ -115,6 +115,7 @@ For chord inversions, this is negative.") (origin ,ly:input-location? "Where was this piece of music defined?") (original-chord ,ly:music? "Original chord of a repeated chord. Used by repeated chords in \\relative mode, to determine the first note octave") + (ottava-number ,integer? "The octavation for @code{\\ottava}.") (page-break-permission ,symbol? "When the music is at top-level, whether to allow, forbid or force a page break.") diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm index a0762025de..d9a5f09ac8 100644 --- a/scm/define-music-types.scm +++ b/scm/define-music-types.scm @@ -32,6 +32,24 @@ to be used by the sequential-iterator" (make-music 'BarCheck 'origin location)))) +(define (make-ottava-set music) + "Set context properties for an ottava bracket." + (let ((octavation (ly:music-property music 'ottava-number))) + + (list (context-spec-music + (make-apply-context + (lambda (context) + (let ((offset (* -7 octavation)) + (string (assoc-get octavation '((2 . "15ma") + (1 . "8va") + (0 . #f) + (-1 . "8vb") + (-2 . "15mb"))))) + (set! (ly:context-property context 'middleCOffset) offset) + (set! (ly:context-property context 'ottavation) string) + (ly:set-middle-C! context)))) + 'Staff)))) + (define-public music-descriptions `( (AbsoluteDynamicEvent @@ -336,6 +354,13 @@ Note the explicit font switch.") (types . (general-music event note-grouping-event)) )) + (OttavaMusic + . ((description . "Start or stop an ottava bracket.") + (iterator-ctor . ,ly:sequential-iterator::constructor) + (elements-callback . ,make-ottava-set) + (types . (general-music ottava-music)) + )) + (OverrideProperty . ((description . "Extend the definition of a graphical object. diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 011cdaf2ab..40c68c0c7d 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -48,6 +48,10 @@ (make-procedure-with-setter ly:prob-property ly:prob-set-property!)) +(define-public ly:context-property + (make-procedure-with-setter ly:context-property + ly:context-set-property!)) + (define-public (music-map function music) "Apply @var{function} to @var{music} and all of the music it contains. @@ -487,32 +491,6 @@ i.e. this is not an override" (make-music 'PropertyUnset 'symbol sym)) -(define-public (make-ottava-set octavation) - (let ((m (make-music 'ApplyContext))) - (define (ottava-modify context) - "Either reset middleCPosition to the stored original, or remember -old middleCPosition, add OCTAVATION to middleCPosition, and set -OTTAVATION to `8va', or whatever appropriate." - (if (number? (ly:context-property context 'middleCOffset)) - (let ((where (ly:context-property-where-defined context 'middleCOffset))) - (ly:context-unset-property where 'middleCOffset) - (ly:context-unset-property where 'ottavation))) - - (let* ((offset (* -7 octavation)) - (string (assoc-get octavation '((2 . "15ma") - (1 . "8va") - (0 . #f) - (-1 . "8vb") - (-2 . "15mb"))))) - (ly:context-set-property! context 'middleCOffset offset) - (ly:context-set-property! context 'ottavation string) - (ly:set-middle-C! context))) - (set! (ly:music-property m 'procedure) ottava-modify) - (context-spec-music m 'Staff))) - -(define-public (set-octavation ottavation) - (ly:export (make-ottava-set ottavation))) - ;;; Need to keep this definition for \time calls from parser (define-public (make-time-signature-set num den) "Set properties for time signature NUM/DEN."