X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fparser-clef.scm;h=6ba1261ca726846bf4093a9f11fc748d21e66766;hb=ca6e130e62a717b99db393f7262c9b34cb3d127d;hp=6d46cc626cc8df1cc64743af3428bed24fc665d7;hpb=743f0d4b067e76d591487f085240a7ff9ace85a7;p=lilypond.git diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm index 6d46cc626c..6ba1261ca7 100644 --- a/scm/parser-clef.scm +++ b/scm/parser-clef.scm @@ -16,10 +16,10 @@ ;;;; along with LilyPond. If not, see . -;; (name . (glyph clef-position octavation)) +;; (name . (glyph clef-position transposition)) ;; -;; -- the name clefOctavation is misleading. The value 7 is 1 octave, -;; not 7 Octaves. +;; -- the name clefTransposition is a bit misleading. Value 7 means +;; a transposition of an octave, not a seventh. (define-public supported-clefs '(("treble" . ("clefs.G" -2 0)) ("violin" . ("clefs.G" -2 0)) @@ -57,16 +57,23 @@ ("hufnagel-fa1" . ("clefs.hufnagel.fa" -1 0)) ("hufnagel-fa2" . ("clefs.hufnagel.fa" 1 0)) ("hufnagel-do-fa" . ("clefs.hufnagel.do.fa" 4 0)) - ("mensural-c1" . ("clefs.mensural.c" -2 0)) - ("mensural-c2" . ("clefs.mensural.c" 0 0)) - ("mensural-c3" . ("clefs.mensural.c" 2 0)) - ("mensural-c4" . ("clefs.mensural.c" 4 0)) + ("mensural-c1" . ("clefs.mensural.c" -4 0)) + ("mensural-c2" . ("clefs.mensural.c" -2 0)) + ("mensural-c3" . ("clefs.mensural.c" 0 0)) + ("mensural-c4" . ("clefs.mensural.c" 2 0)) + ("mensural-c5" . ("clefs.mensural.c" 4 0)) + ("blackmensural-c1" . ("clefs.blackmensural.c" -4 0)) + ("blackmensural-c2" . ("clefs.blackmensural.c" -2 0)) + ("blackmensural-c3" . ("clefs.blackmensural.c" 0 0)) + ("blackmensural-c4" . ("clefs.blackmensural.c" 2 0)) + ("blackmensural-c5" . ("clefs.blackmensural.c" 4 0)) ("mensural-f" . ("clefs.mensural.f" 2 0)) ("mensural-g" . ("clefs.mensural.g" -2 0)) ("neomensural-c1" . ("clefs.neomensural.c" -4 0)) ("neomensural-c2" . ("clefs.neomensural.c" -2 0)) ("neomensural-c3" . ("clefs.neomensural.c" 0 0)) ("neomensural-c4" . ("clefs.neomensural.c" 2 0)) + ("neomensural-c5" . ("clefs.neomensural.c" 4 0)) ("petrucci-c1" . ("clefs.petrucci.c1" -4 0)) ("petrucci-c2" . ("clefs.petrucci.c2" -2 0)) ("petrucci-c3" . ("clefs.petrucci.c3" 0 0)) @@ -97,6 +104,7 @@ ("clefs.mensural.c" . 0) ("clefs.mensural.f" . 4) ("clefs.mensural.g" . -4) + ("clefs.blackmensural.c" . 0) ("clefs.neomensural.c" . 0) ("clefs.petrucci.c1" . 0) ("clefs.petrucci.c2" . 0) @@ -111,106 +119,87 @@ "Generate the clef setting commands for a clef with name @var{clef-name}." (define (make-prop-set props) (let ((m (make-music 'PropertySet))) - (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props) + (for-each (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props) m)) (let ((e '()) - (c0 0) - (oct 0) - (match (string-match "^(.*)([_^])([1-9][0-9]*)$" clef-name))) + (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 3)) 1))))) + (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) + ((equal? (match:substring match 3) "[") 'bracketed) + (else style))))) (set! e (assoc-get clef-name supported-clefs)) (if e - (let* ((musics (map make-prop-set - `(((symbol . clefGlyph) (value . ,(car e))) - ((symbol . middleCClefPosition) - (value . ,(+ oct - (cadr e) - (assoc-get (car e) c0-pitch-alist)))) - ((symbol . clefPosition) (value . ,(cadr e))) - ((symbol . clefOctavation) (value . ,(- oct)))))) - (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)) - (begin - (ly:warning (_ "unknown clef type `~a'") clef-name) - (ly:warning (_ "supported clefs: ~a") - (string-join - (sort (map car supported-clefs) stringnumber (match:substring match 3)) 1))))) - (set! e (assoc-get clef-name supported-clefs)) - (if e - (let* ((musics (map make-prop-set - `(((symbol . cueClefGlyph) (value . ,(car e))) - ((symbol . middleCCuePosition) - (value . ,(+ oct - (cadr e) - (assoc-get (car e) c0-pitch-alist)))) - ((symbol . cueClefPosition) (value . ,(cadr e))) - ((symbol . cueClefOctavation) (value . ,(- oct)))))) - (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)) - (begin - (ly:warning (_ "unknown clef type `~a'") clef-name) - (ly:warning (_ "supported clefs: ~a") - (string-join - (sort (map car supported-clefs) string