1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 2004--2015 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 transposition))
21 ;; -- the name clefTransposition is a bit misleading. Value 7 means
22 ;; a transposition of an octave, not a seventh.
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 ("GG" . ("clefs.GG" -2 0))
29 ("tenorG" . ("clefs.tenorG" -2 0))
30 ("french" . ("clefs.G" -4 0))
31 ("soprano" . ("clefs.C" -4 0))
32 ("mezzosoprano" . ("clefs.C" -2 0))
33 ("alto" . ("clefs.C" 0 0))
34 ("C" . ("clefs.C" 0 0))
35 ("varC" . ("clefs.varC" 0 0))
36 ("altovarC" . ("clefs.varC" 0 0))
37 ("tenor" . ("clefs.C" 2 0))
38 ("tenorvarC" . ("clefs.varC" 2 0))
39 ("baritone" . ("clefs.C" 4 0))
40 ("baritonevarC" . ("clefs.varC" 4 0))
41 ("varbaritone" . ("clefs.F" 0 0))
42 ("baritonevarF" . ("clefs.F" 0 0))
43 ("bass" . ("clefs.F" 2 0))
44 ("F" . ("clefs.F" 2 0))
45 ("subbass" . ("clefs.F" 4 0))
46 ("percussion" . ("clefs.percussion" 0 0))
47 ("varpercussion" . ("clefs.varpercussion" 0 0))
48 ("tab" . ("clefs.tab" 0 0))
50 ;; should move mensural stuff to separate file?
51 ("vaticana-do1" . ("clefs.vaticana.do" -1 0))
52 ("vaticana-do2" . ("clefs.vaticana.do" 1 0))
53 ("vaticana-do3" . ("clefs.vaticana.do" 3 0))
54 ("vaticana-fa1" . ("clefs.vaticana.fa" -1 0))
56 ("vaticana-fa2" . ("clefs.vaticana.fa" 1 0))
57 ("medicaea-do1" . ("clefs.medicaea.do" -1 0))
58 ("medicaea-do2" . ("clefs.medicaea.do" 1 0))
59 ("medicaea-do3" . ("clefs.medicaea.do" 3 0))
60 ("medicaea-fa1" . ("clefs.medicaea.fa" -1 0))
61 ("medicaea-fa2" . ("clefs.medicaea.fa" 1 0))
62 ("hufnagel-do1" . ("clefs.hufnagel.do" -1 0))
63 ("hufnagel-do2" . ("clefs.hufnagel.do" 1 0))
64 ("hufnagel-do3" . ("clefs.hufnagel.do" 3 0))
65 ("hufnagel-fa1" . ("clefs.hufnagel.fa" -1 0))
66 ("hufnagel-fa2" . ("clefs.hufnagel.fa" 1 0))
67 ("hufnagel-do-fa" . ("clefs.hufnagel.do.fa" 4 0))
68 ("mensural-c1" . ("clefs.mensural.c" -4 0))
69 ("mensural-c2" . ("clefs.mensural.c" -2 0))
70 ("mensural-c3" . ("clefs.mensural.c" 0 0))
71 ("mensural-c4" . ("clefs.mensural.c" 2 0))
72 ("mensural-c5" . ("clefs.mensural.c" 4 0))
73 ("blackmensural-c1" . ("clefs.blackmensural.c" -4 0))
74 ("blackmensural-c2" . ("clefs.blackmensural.c" -2 0))
75 ("blackmensural-c3" . ("clefs.blackmensural.c" 0 0))
76 ("blackmensural-c4" . ("clefs.blackmensural.c" 2 0))
77 ("blackmensural-c5" . ("clefs.blackmensural.c" 4 0))
78 ("mensural-f" . ("clefs.mensural.f" 2 0))
79 ("mensural-g" . ("clefs.mensural.g" -2 0))
80 ("neomensural-c1" . ("clefs.neomensural.c" -4 0))
81 ("neomensural-c2" . ("clefs.neomensural.c" -2 0))
82 ("neomensural-c3" . ("clefs.neomensural.c" 0 0))
83 ("neomensural-c4" . ("clefs.neomensural.c" 2 0))
84 ("neomensural-c5" . ("clefs.neomensural.c" 4 0))
85 ("petrucci-c1" . ("clefs.petrucci.c1" -4 0))
86 ("petrucci-c2" . ("clefs.petrucci.c2" -2 0))
87 ("petrucci-c3" . ("clefs.petrucci.c3" 0 0))
88 ("petrucci-c4" . ("clefs.petrucci.c4" 2 0))
89 ("petrucci-c5" . ("clefs.petrucci.c5" 4 0))
90 ("petrucci-f3" . ("clefs.petrucci.f" 0 0))
91 ("petrucci-f4" . ("clefs.petrucci.f" 2 0))
92 ("petrucci-f5" . ("clefs.petrucci.f" 4 0))
93 ("petrucci-f" . ("clefs.petrucci.f" 2 0))
94 ("petrucci-g" . ("clefs.petrucci.g" -2 0))
95 ("kievan-do" . ("clefs.kievan.do" 0 0))))
97 ;; "an alist mapping GLYPHNAME to the position of the middle C for
99 (define c0-pitch-alist
106 ("clefs.percussion" . 0)
107 ("clefs.varpercussion" . 0)
109 ("clefs.vaticana.do" . 0)
110 ("clefs.vaticana.fa" . 4)
111 ("clefs.medicaea.do" . 0)
112 ("clefs.medicaea.fa" . 4)
113 ("clefs.hufnagel.do" . 0)
114 ("clefs.hufnagel.fa" . 4)
115 ("clefs.hufnagel.do.fa" . 0)
116 ("clefs.mensural.c" . 0)
117 ("clefs.mensural.f" . 4)
118 ("clefs.mensural.g" . -4)
119 ("clefs.blackmensural.c" . 0)
120 ("clefs.neomensural.c" . 0)
121 ("clefs.petrucci.c1" . 0)
122 ("clefs.petrucci.c2" . 0)
123 ("clefs.petrucci.c3" . 0)
124 ("clefs.petrucci.c4" . 0)
125 ("clefs.petrucci.c5" . 0)
126 ("clefs.petrucci.f" . 4)
127 ("clefs.petrucci.g" . -4)
128 ("clefs.kievan.do" . 0)))
130 (define-public (make-clef-set clef-name)
131 "Generate the clef setting commands for a clef with name @var{clef-name}."
132 (let* ((match (string-match "^(.*)([_^])([^0-9a-zA-Z]*)([1-9][0-9]*)([^0-9a-zA-Z]*)$" clef-name))
133 (e (assoc-get (if match (match:substring match 1) clef-name) supported-clefs))
135 ((if (equal? (match:substring match 2) "^") - +)
136 (1- (string->number (match:substring match 4))))
138 (style (cond ((not match) 'default)
139 ((equal? (match:substring match 3) "(") 'parenthesized)
140 ((equal? (match:substring match 3) "[") 'bracketed)
144 (make-property-set 'clefGlyph (car e))
145 (make-property-set 'middleCClefPosition
147 (assoc-get (car e) c0-pitch-alist)))
148 (make-property-set 'clefPosition (cadr e))
149 (make-property-set 'clefTransposition (- oct))
150 (make-property-set 'clefTranspositionStyle style)
151 (make-apply-context ly:set-middle-C!))))
152 (context-spec-music (make-sequential-music musics) 'Staff))
154 (ly:warning (_ "unknown clef type `~a'") clef-name)
155 (ly:warning (_ "supported clefs: ~a")
157 (sort (map car supported-clefs) string<?)))
158 (make-music 'Music)))))
160 (define-public (make-cue-clef-set clef-name)
161 "Generate the clef setting commands for a cue clef with name
164 '((clefGlyph . cueClefGlyph)
165 (middleCClefPosition . middleCCuePosition)
166 (clefPosition . cueClefPosition)
167 (clefTransposition . cueClefTransposition)
168 (clefTranspositionStyle . cueClefTranspositionStyle)))
169 (let ((clef (make-clef-set clef-name)))
172 (let ((mapped (assq-ref cue-clef-map
173 (ly:music-property m 'symbol))))
175 (set! (ly:music-property m 'symbol) mapped))))
176 (extract-named-music clef 'PropertySet))
179 (define-public (make-cue-clef-unset)
180 "Reset the clef settings for a cue clef."
183 (and (eq? (ly:music-property m 'name) 'PropertySet)
184 (make-music 'PropertyUnset
185 'symbol (ly:music-property m 'symbol))))
186 (make-cue-clef-set "treble_(8)")))
188 ;; a function to add new clefs at runtime
189 (define-public (add-new-clef clef-name clef-glyph clef-position transposition c0-position)
190 "Append the entries for a clef symbol to supported clefs and
191 @code{c0-pitch-alist}."
192 (set! supported-clefs
193 (acons clef-name (list clef-glyph clef-position transposition) supported-clefs))
195 (acons clef-glyph c0-position c0-pitch-alist)))