X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fparser-clef.scm;h=b2c6dc20849a47eddc2a73fa02c45860bdff88cd;hb=a7570a4873af5fff7bf302b374ba5221469dea90;hp=2f17701d4672f6d492885368207f3bf8fd716cd2;hpb=bc95f4434f760d41191341ab4508b2064eb19025;p=lilypond.git diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm index 2f17701d46..b2c6dc2084 100644 --- a/scm/parser-clef.scm +++ b/scm/parser-clef.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2004--2010 Han-Wen Nienhuys +;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -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)) @@ -74,8 +81,10 @@ ("petrucci-c5" . ("clefs.petrucci.c5" 4 0)) ("petrucci-f3" . ("clefs.petrucci.f" 0 0)) ("petrucci-f4" . ("clefs.petrucci.f" 2 0)) + ("petrucci-f5" . ("clefs.petrucci.f" 4 0)) ("petrucci-f" . ("clefs.petrucci.f" 2 0)) - ("petrucci-g" . ("clefs.petrucci.g" -2 0)))) + ("petrucci-g" . ("clefs.petrucci.g" -2 0)) + ("kievan-do" . ("clefs.kievan.do" 0 0)))) ;; "an alist mapping GLYPHNAME to the position of the middle C for ;; that symbol" @@ -95,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) @@ -102,10 +112,11 @@ ("clefs.petrucci.c4" . 0) ("clefs.petrucci.c5" . 0) ("clefs.petrucci.f" . 4) - ("clefs.petrucci.g" . -4))) + ("clefs.petrucci.g" . -4) + ("clefs.kievan.do" . 0))) (define-public (make-clef-set clef-name) - "Generate the clef setting commands for a clef with name 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))) (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props) @@ -113,23 +124,36 @@ (let ((e '()) (c0 0) (oct 0) - (match (string-match "^(.*)([_^])([0-9]+)$" clef-name))) + (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))))) + (- (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)))))) + (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 . clefOctavation) (value . ,(- oct))))) + ;; the clefOctavationStyle 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 . clefOctavationStyle) + (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)))) @@ -143,9 +167,82 @@ (sort (map car supported-clefs) stringnumber (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* ((prop-list `(((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))))) + (prop-list (if (eq? style 'default) + prop-list + (append + prop-list + `(((symbol . cueClefOctavationStyle) + (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)) + (begin + (ly:warning (_ "unknown clef type `~a'") clef-name) + (ly:warning (_ "supported clefs: ~a") + (string-join + (sort (map car supported-clefs) string