(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)
(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")