1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
5 ;;;; LilyPond is free software: you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation, either version 3 of the License, or
8 ;;;; (at your option) any later version.
10 ;;;; LilyPond is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
19 ;; (name . (glyph clef-position octavation))
21 ;; -- the name clefOctavation is misleading. The value 7 is 1 octave,
23 (define-public supported-clefs
24 '(("treble" . ("clefs.G" -2 0))
25 ("violin" . ("clefs.G" -2 0))
26 ("G" . ("clefs.G" -2 0))
27 ("G2" . ("clefs.G" -2 0))
28 ("french" . ("clefs.G" -4 0))
29 ("soprano" . ("clefs.C" -4 0))
30 ("mezzosoprano" . ("clefs.C" -2 0))
31 ("alto" . ("clefs.C" 0 0))
32 ("C" . ("clefs.C" 0 0))
33 ("tenor" . ("clefs.C" 2 0))
34 ("baritone" . ("clefs.C" 4 0))
35 ("varbaritone" . ("clefs.F" 0 0))
36 ("bass" . ("clefs.F" 2 0))
37 ("F" . ("clefs.F" 2 0))
38 ("subbass" . ("clefs.F" 4 0))
39 ("percussion" . ("clefs.percussion" 0 0))
40 ("tab" . ("clefs.tab" 0 0))
42 ;; should move mensural stuff to separate file?
43 ("vaticana-do1" . ("clefs.vaticana.do" -1 0))
44 ("vaticana-do2" . ("clefs.vaticana.do" 1 0))
45 ("vaticana-do3" . ("clefs.vaticana.do" 3 0))
46 ("vaticana-fa1" . ("clefs.vaticana.fa" -1 0))
48 ("vaticana-fa2" . ("clefs.vaticana.fa" 1 0))
49 ("medicaea-do1" . ("clefs.medicaea.do" -1 0))
50 ("medicaea-do2" . ("clefs.medicaea.do" 1 0))
51 ("medicaea-do3" . ("clefs.medicaea.do" 3 0))
52 ("medicaea-fa1" . ("clefs.medicaea.fa" -1 0))
53 ("medicaea-fa2" . ("clefs.medicaea.fa" 1 0))
54 ("hufnagel-do1" . ("clefs.hufnagel.do" -1 0))
55 ("hufnagel-do2" . ("clefs.hufnagel.do" 1 0))
56 ("hufnagel-do3" . ("clefs.hufnagel.do" 3 0))
57 ("hufnagel-fa1" . ("clefs.hufnagel.fa" -1 0))
58 ("hufnagel-fa2" . ("clefs.hufnagel.fa" 1 0))
59 ("hufnagel-do-fa" . ("clefs.hufnagel.do.fa" 4 0))
60 ("mensural-c1" . ("clefs.mensural.c" -2 0))
61 ("mensural-c2" . ("clefs.mensural.c" 0 0))
62 ("mensural-c3" . ("clefs.mensural.c" 2 0))
63 ("mensural-c4" . ("clefs.mensural.c" 4 0))
64 ("mensural-f" . ("clefs.mensural.f" 2 0))
65 ("mensural-g" . ("clefs.mensural.g" -2 0))
66 ("neomensural-c1" . ("clefs.neomensural.c" -4 0))
67 ("neomensural-c2" . ("clefs.neomensural.c" -2 0))
68 ("neomensural-c3" . ("clefs.neomensural.c" 0 0))
69 ("neomensural-c4" . ("clefs.neomensural.c" 2 0))
70 ("petrucci-c1" . ("clefs.petrucci.c1" -4 0))
71 ("petrucci-c2" . ("clefs.petrucci.c2" -2 0))
72 ("petrucci-c3" . ("clefs.petrucci.c3" 0 0))
73 ("petrucci-c4" . ("clefs.petrucci.c4" 2 0))
74 ("petrucci-c5" . ("clefs.petrucci.c5" 4 0))
75 ("petrucci-f3" . ("clefs.petrucci.f" 0 0))
76 ("petrucci-f4" . ("clefs.petrucci.f" 2 0))
77 ("petrucci-f5" . ("clefs.petrucci.f" 4 0))
78 ("petrucci-f" . ("clefs.petrucci.f" 2 0))
79 ("petrucci-g" . ("clefs.petrucci.g" -2 0))
80 ("kievan-do" . ("clefs.kievan.do" 0 0))))
82 ;; "an alist mapping GLYPHNAME to the position of the middle C for
84 (define c0-pitch-alist
88 ("clefs.percussion" . 0)
90 ("clefs.vaticana.do" . 0)
91 ("clefs.vaticana.fa" . 4)
92 ("clefs.medicaea.do" . 0)
93 ("clefs.medicaea.fa" . 4)
94 ("clefs.hufnagel.do" . 0)
95 ("clefs.hufnagel.fa" . 4)
96 ("clefs.hufnagel.do.fa" . 0)
97 ("clefs.mensural.c" . 0)
98 ("clefs.mensural.f" . 4)
99 ("clefs.mensural.g" . -4)
100 ("clefs.neomensural.c" . 0)
101 ("clefs.petrucci.c1" . 0)
102 ("clefs.petrucci.c2" . 0)
103 ("clefs.petrucci.c3" . 0)
104 ("clefs.petrucci.c4" . 0)
105 ("clefs.petrucci.c5" . 0)
106 ("clefs.petrucci.f" . 4)
107 ("clefs.petrucci.g" . -4)
108 ("clefs.kievan.do" . 0)))
110 (define-public (make-clef-set clef-name)
111 "Generate the clef setting commands for a clef with name @var{clef-name}."
112 (define (make-prop-set props)
113 (let ((m (make-music 'PropertySet)))
114 (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
119 (match (string-match "^(.*)([_^])([1-9][0-9]*)$" clef-name)))
122 (set! clef-name (match:substring match 1))
124 (* (if (equal? (match:substring match 2) "^") -1 1)
125 (- (string->number (match:substring match 3)) 1)))))
126 (set! e (assoc-get clef-name supported-clefs))
128 (let* ((musics (map make-prop-set
129 `(((symbol . clefGlyph) (value . ,(car e)))
130 ((symbol . middleCClefPosition)
133 (assoc-get (car e) c0-pitch-alist))))
134 ((symbol . clefPosition) (value . ,(cadr e)))
135 ((symbol . clefOctavation) (value . ,(- oct))))))
136 (recalc-mid-C (make-music 'ApplyContext))
137 (seq (make-music 'SequentialMusic
138 'elements (append musics (list recalc-mid-C))))
139 (csp (make-music 'ContextSpeccedMusic)))
140 (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
141 (context-spec-music seq 'Staff))
143 (ly:warning (_ "unknown clef type `~a'") clef-name)
144 (ly:warning (_ "supported clefs: ~a")
146 (sort (map car supported-clefs) string<?)))
147 (make-music 'Music)))))
149 (define-public (make-cue-clef-set clef-name)
150 "Generate the clef setting commands for a cue clef with name
152 (define (make-prop-set props)
153 (let ((m (make-music 'PropertySet)))
154 (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
159 (match (string-match "^(.*)([_^])([1-9][0-9]*)$" clef-name)))
162 (set! clef-name (match:substring match 1))
164 (* (if (equal? (match:substring match 2) "^") -1 1)
165 (- (string->number (match:substring match 3)) 1)))))
166 (set! e (assoc-get clef-name supported-clefs))
168 (let* ((musics (map make-prop-set
169 `(((symbol . cueClefGlyph) (value . ,(car e)))
170 ((symbol . middleCCuePosition)
173 (assoc-get (car e) c0-pitch-alist))))
174 ((symbol . cueClefPosition) (value . ,(cadr e)))
175 ((symbol . cueClefOctavation) (value . ,(- oct))))))
176 (recalc-mid-C (make-music 'ApplyContext))
177 (seq (make-music 'SequentialMusic
178 'elements (append musics (list recalc-mid-C))))
179 (csp (make-music 'ContextSpeccedMusic)))
180 (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
181 (context-spec-music seq 'Staff))
183 (ly:warning (_ "unknown clef type `~a'") clef-name)
184 (ly:warning (_ "supported clefs: ~a")
186 (sort (map car supported-clefs) string<?)))
187 (make-music 'Music)))))
190 (define-public (make-cue-clef-unset)
191 "Reset the clef settings for a cue clef."
192 (define (make-prop-unset props)
193 (let ((m (make-music 'PropertyUnset)))
194 (set! (ly:music-property m (car props)) (cdr props))
196 (let* ((musics (map make-prop-unset
197 `((symbol . cueClefGlyph)
198 (symbol . middleCCuePosition)
199 (symbol . cueClefPosition)
200 (symbol . cueClefOctavation))))
201 (recalc-mid-C (make-music 'ApplyContext))
202 (seq (make-music 'SequentialMusic
203 'elements (append musics (list recalc-mid-C))))
204 (csp (make-music 'ContextSpeccedMusic)))
205 (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
206 (context-spec-music seq 'Staff)))
209 ;; a function to add new clefs at runtime
210 (define-public (add-new-clef clef-name clef-glyph clef-position octavation c0-position)
211 "Append the entries for a clef symbol to supported clefs and
212 @code{c0-pitch-alist}."
213 (set! supported-clefs
214 (acons clef-name (list clef-glyph clef-position octavation) supported-clefs))
216 (acons clef-glyph c0-position c0-pitch-alist)))