From 564524f8822ef252bfa8679059e82f276ba3d307 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Sun, 27 Jul 2014 18:01:09 +0200 Subject: [PATCH] Issue 4033: All subsequent clef transpositions are marked as optional This removes a bug cover-up in scm/parser-clef.scm, implements the necessary functionality in display-lily-music and adds some regtests for that functionality. --- input/regression/display-lily-tests.ly | 2 + scm/define-music-display-methods.scm | 27 +++++++----- scm/parser-clef.scm | 60 ++++++++------------------ 3 files changed, 37 insertions(+), 52 deletions(-) diff --git a/input/regression/display-lily-tests.ly b/input/regression/display-lily-tests.ly index 3b99a96bc2..b14fa52090 100644 --- a/input/regression/display-lily-tests.ly +++ b/input/regression/display-lily-tests.ly @@ -168,6 +168,8 @@ stderr of this run." \test ##[ \key e \minor #] \test ##[ \clef "bass" #] \test ##[ \clef "french^2" #] +\test ##[ \clef "treble_[8]" #] +\test ##[ \clef "bass^(15)" #] \test ##[ \clef "alto_3" #] \test ##[ \time 2/4 #] \test ##[ \time #'(3 2) 5/8 #] diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index c4ed534478..f448ee8bb7 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -946,21 +946,26 @@ Otherwise, return @code{#f}." (music 'PropertySet value ?clef-transposition symbol 'clefTransposition) + (music 'PropertySet + value ?clef-transposition-style + symbol 'clefTranspositionStyle) (music 'ApplyContext procedure ly:set-middle-C!))))) (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0) clef-name-alist))) - (if clef-name - (format #f "\\clef \"~a~{~a~a~}\"~a" - clef-name - (cond ((= 0 ?clef-transposition) - (list "" "")) - ((> ?clef-transposition 0) - (list "^" (1+ ?clef-transposition))) - (else - (list "_" (- 1 ?clef-transposition)))) - (new-line->lily-string)) - #f)))) + (and clef-name + (format #f "\\clef \"~a~?\"~a" + clef-name + (case ?clef-transposition-style + ((parenthesized) "~a(~a)") + ((bracketed) "~a[~a]") + (else "~a~a")) + (cond ((zero? ?clef-transposition) + (list "" "")) + ((positive? ?clef-transposition) + (list "^" (1+ ?clef-transposition))) + (else (list "_" (- 1 ?clef-transposition)))) + (new-line->lily-string)))))) ;;; \bar (define-extra-display-method ContextSpeccedMusic (expr parser) diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm index 6d45dd5376..9ba29937f9 100644 --- a/scm/parser-clef.scm +++ b/scm/parser-clef.scm @@ -129,49 +129,27 @@ (define-public (make-clef-set clef-name) "Generate the clef setting commands for a clef with name @var{clef-name}." - (define (make-prop-set props) - (let ((m (make-music 'PropertySet))) - (for-each (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props) - m)) - (let ((e '()) - (c0 0) - (oct 0) - (style 'default) - (match (string-match "^(.*)([_^])([^0-9a-zA-Z]*)([1-9][0-9]*)([^0-9a-zA-Z]*)$" clef-name))) - (if match - (begin - (set! clef-name (match:substring match 1)) - (set! oct - (* (if (equal? (match:substring match 2) "^") -1 1) - (- (string->number (match:substring match 4)) 1))) - (set! style - (cond ((equal? (match:substring match 3) "(") 'parenthesized) + (let* ((match (string-match "^(.*)([_^])([^0-9a-zA-Z]*)([1-9][0-9]*)([^0-9a-zA-Z]*)$" clef-name)) + (e (assoc-get (if match (match:substring match 1) clef-name) supported-clefs)) + (oct (if match + ((if (equal? (match:substring match 2) "^") - +) + (1- (string->number (match:substring match 4)))) + 0)) + (style (cond ((not match) 'default) + ((equal? (match:substring match 3) "(") 'parenthesized) ((equal? (match:substring match 3) "[") 'bracketed) - (else style))))) - (set! e (assoc-get clef-name supported-clefs)) + (else 'default)))) (if e - (let* ((prop-list `(((symbol . clefGlyph) (value . ,(car e))) - ((symbol . middleCClefPosition) - (value . ,(+ oct - (cadr e) - (assoc-get (car e) c0-pitch-alist)))) - ((symbol . clefPosition) (value . ,(cadr e))) - ((symbol . clefTransposition) (value . ,(- oct))))) - ;; the clefTranspositionStyle property is set only when - ;; not 'default to calm display-lily-tests.scm - (prop-list (if (eq? style 'default) - prop-list - (append - prop-list - `(((symbol . clefTranspositionStyle) - (value . ,style)))))) - (musics (map make-prop-set prop-list)) - (recalc-mid-C (make-music 'ApplyContext)) - (seq (make-music 'SequentialMusic - 'elements (append musics (list recalc-mid-C)))) - (csp (make-music 'ContextSpeccedMusic))) - (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!) - (context-spec-music seq 'Staff)) + (let ((musics (list + (make-property-set 'clefGlyph (car e)) + (make-property-set 'middleCClefPosition + (+ oct (cadr e) + (assoc-get (car e) c0-pitch-alist))) + (make-property-set 'clefPosition (cadr e)) + (make-property-set 'clefTransposition (- oct)) + (make-property-set 'clefTranspositionStyle style) + (make-apply-context ly:set-middle-C!)))) + (context-spec-music (make-sequential-music musics) 'Staff)) (begin (ly:warning (_ "unknown clef type `~a'") clef-name) (ly:warning (_ "supported clefs: ~a") -- 2.39.2