X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fparser-clef.scm;h=f0a79c518f0e31ff6fc9f32500dd7b82d9d91c18;hb=2f7de62c4aae9fca03fd754a9f44ff02a272eb30;hp=ede242b4aa9cb29056bb61198b960745563ee75b;hpb=a8b368dd6f242b00932b03ba170ab7e7389cb105;p=lilypond.git diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm index ede242b4aa..f0a79c518f 100644 --- a/scm/parser-clef.scm +++ b/scm/parser-clef.scm @@ -1,8 +1,19 @@ -;;;; clef.scm -- Clef settings +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter +;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys ;;;; -;;;; (c) 2004--2007 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 +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;; (name . (glyph clef-position octavation)) @@ -46,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)) @@ -63,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" @@ -84,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) @@ -91,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) @@ -102,22 +124,22 @@ (let ((e '()) (c0 0) (oct 0) - (match (string-match "^(.*)([_^])([0-9]+)$" clef-name))) + (match (string-match "^(.*)([_^])([1-9][0-9]*)$" 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))))) - (set! e (assoc clef-name supported-clefs)) - (if (pair? e) + (set! e (assoc-get clef-name supported-clefs)) + (if e (let* ((musics (map make-prop-set - `(((symbol . clefGlyph) (value . ,(cadr e))) + `(((symbol . clefGlyph) (value . ,(car e))) ((symbol . middleCClefPosition) (value . ,(+ oct - (caddr e) - (cdr (assoc (cadr e) c0-pitch-alist))))) - ((symbol . clefPosition) (value . ,(caddr e))) + (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 @@ -132,3 +154,71 @@ (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