2 %%% -*- Mode: scheme -*-
3 %%% clef.ily -- ancient and modern clef command
5 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
10 %%% When true, use ancient clefs, instead of modern ones.
13 %%% When true, do print incipit showing ancient keys/clefs in modern style.
17 %%% \clef "ancient/modern"
19 %%% Overrides the \clef music command, with this extra feature: two
20 %%% clefs may be given as an argument to \clef, seperated by a
21 %%% slash. The first one is the ancient clef, the second the modern
22 %%% clef. The actually displayed clef depends on the value of the
23 %%% 'ancient-style option: if 'ancient-style option is #t, then the
24 %%% ancient clef is displayed; otherwise, the modern clef is
25 %%% displayed, preceeded by the ancient clef if at the beginning of a
27 %%% \clef "soprano/treble" is like:
28 %%% - \clef "soprano" when (ly:get-option 'ancient-style) is #t
29 %%% - \clef "treble" otherwise, but with an soprano clef in an incipit
30 %%% preceeding the first line.
32 %%% \oldKey pitch mode
33 %%% \newKey pitch mode
38 %%% This feature relies on LilyPond >=2.11.40
40 #(use-modules (ice-9 regex))
43 #(set-object-property! 'old-clef 'backend-type? ly:music?)
44 #(set-object-property! 'old-clef 'backend-doc "Incipit clef music")
45 #(set-object-property! 'old-key 'backend-type? ly:music?)
46 #(set-object-property! 'old-key 'backend-doc "Incipit key music")
48 % #(ly:add-option 'ancient-style #f
49 % "Whether old clefs / keys should be printed (if provided)")
50 % #(ly:add-option 'incipit #t
51 % "Whether to print an incipit with the old key / clef (if provided).
52 % If the 'ancient-style option is set to ##t, this option has no effect.")
54 #(define-public (filter-empty l)
55 (filter (lambda (x) (not (null? x))) l))
58 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
59 % Workaround by Neil puttock (on lilypond-devel):
60 % The incipit might not contain any notes, in which case, lilypond will
61 % not use the width of the prefactory material (clefs, keys, etc) to
62 % determine the width of the staff lines. This function calculates the
63 % width and sets the 'width property accordingly
64 #(define-public (incipit-after-line-breaking grob)
65 (let* ((system (ly:grob-system grob))
66 (elts (ly:grob-object system 'elements))
71 (let ((elt (ly:grob-array-ref elts x)))
72 (if (grob::has-interface elt
73 'break-alignment-interface)
74 (set! break-alignment elt))))
75 (iota (ly:grob-array-length elts)))
78 (set! (ly:grob-property grob 'width)
79 (+ (ly:output-def-lookup (ly:grob-layout grob) 'indent)
82 (ly:grob-extent break-alignment system X) 0.4)))))))
85 #(define-public (create-incipit-score grob instrument-name)
86 (let ((clef (ly:grob-property grob 'old-clef))
87 (key (ly:grob-property grob 'old-key)))
88 (if (or (ly:music? clef) (ly:music? key))
89 (let* ((music (make-music
91 'elements (filter-empty (list
92 ; Workaround: Calculate the actual width of the key/clef
99 'grob-property-path (list 'after-line-breaking)
100 'grob-value incipit-after-line-breaking
101 'symbol 'StaffSymbol))
105 ; Remove time sig and key/clef engravers if necessary
106 'property-operations (filter-empty (list
107 (list 'push 'VerticalAxisGroup '(-2 . 2) 'Y-extent)
108 (list 'remove "Time_signature_engraver")
109 (if (ly:music? key) '() (list 'remove "Key_engraver"))
110 (if (ly:music? clef) '() (list 'remove "Clef_engraver"))))
113 'symbol 'instrumentName
114 'value instrument-name))
115 (if (ly:music? clef) clef '())
116 (if (ly:music? key) key '())
117 (make-music 'SkipMusic 'duration (ly:make-duration 3 0 1 1))))))
118 (score (ly:make-score music))
119 (layout (ly:output-def-clone (ly:grob-layout grob)))
120 (mm (ly:output-def-lookup layout 'mm))
121 (indent (ly:output-def-lookup layout 'indent))
122 (incipit-width (ly:output-def-lookup layout 'incipit-width))
123 (width (* (if (number? incipit-width) incipit-width 6) mm)))
124 ; (ly:output-def-set-variable! layout 'line-width indent)
125 ; (ly:output-def-set-variable! layout 'indent (- indent width))
126 (ly:output-def-set-variable! layout 'ragged-right #t)
127 (ly:score-add-output-def! score layout)
132 #(define-public (system-start-text::incipit-print grob)
133 (let* ((left-bound (ly:spanner-bound grob LEFT))
134 (left-mom (ly:grob-property left-bound 'when))
135 (start-of-score (moment<=? left-mom ZERO-MOMENT))
136 (name (if start-of-score
137 (ly:grob-property grob 'long-text)
138 (ly:grob-property grob 'text)))
139 (incipit-score (if (and start-of-score
140 (or (eqv? #t (ly:get-option 'incipit))
141 (not (eqv? #t (ly:get-option 'ancient-style)))))
142 (create-incipit-score grob name)
144 (if (not (eqv? #f incipit-score))
146 (set! (ly:grob-property grob 'self-alignment-X) RIGHT)
147 (set! (ly:grob-property grob 'padding) 0)
148 (grob-interpret-markup grob (markup #:score incipit-score)))
149 (if (and (markup? name) (!= (ly:item-break-dir left-bound) CENTER))
150 (grob-interpret-markup grob name)
151 (ly:grob-suicide! grob)))))
157 \override InstrumentName #'stencil = #system-start-text::incipit-print
162 #(define french-clefs '((dessus french . treble)
163 (dessus2 soprano . treble)
164 (haute-contre soprano . treble)
165 (haute-contre2 mezzosoprano . treble)
166 (taille mezzosoprano . alto)
167 (taille2 alto . alto)
170 (vdessus treble . treble)
171 (vbas-dessus soprano . treble)
172 (vpetite-haute-contre mezzosoprano . treble)
173 (vhaute-contre alto . G_8)
174 (vtaille tenor . G_8)
175 (vbasse-taille varbaritone . bass)
179 (valto alto . treble)
182 #(define (make-ancient-or-modern-clef clef-name)
183 (let* ((match (string-match "^(.*)/(.*)$" clef-name))
184 (clefs (assoc (string->symbol clef-name) french-clefs))
185 (ancient-clef (cond (match (match:substring match 1))
186 (clefs (symbol->string (cadr clefs)))
188 (modern-clef (cond (match (match:substring match 2))
189 (clefs (symbol->string (cddr clefs)))
191 (cond ((eqv? #t (ly:get-option 'ancient-style))
193 (make-clef-set (if ancient-clef ancient-clef clef-name)))
194 ((eqv? #t (ly:get-option 'non-incipit))
196 (make-clef-set modern-clef))
197 ((not (eqv? #f ancient-clef))
198 ;; modern clef + ancient clef in incipit, if different
201 'elements (list (make-music
207 'grob-property-path '(old-clef)
208 'grob-value (make-clef-set ancient-clef)
210 'symbol 'InstrumentName))
211 (make-clef-set modern-clef))))
213 ;; unly use modern clef, if no ancient clef given
214 (make-clef-set modern-clef)))))
217 #(define-music-function (parser location clef-name) (string?)
218 (make-ancient-or-modern-clef clef-name))
221 #(define-music-function (parser location clef-name) (string?)
222 (make-music 'SequentialMusic
223 'elements (list (make-music 'ContextSpeccedMusic
225 'element (make-music 'PropertySet
228 (make-ancient-or-modern-clef clef-name))))
230 #(define (make-key-set note key-alist)
231 (let ((pitch (ly:music-property (car (ly:music-property
234 (make-music 'KeyChangeEvent
235 'pitch-alist (ly:transpose-key-alist key-alist pitch)
239 #(define-music-function (parser location note key-alist) (ly:music? list?)
240 (let ((key-set (make-key-set note key-alist)))
241 (if (eqv? #t (ly:get-option 'ancient-style))
243 (make-music 'ContextSpeccedMusic
245 'element (make-music 'OverrideProperty
247 'grob-property-path '(old-key)
250 'symbol 'InstrumentName)))))
253 #(define-music-function (parser location note key-alist) (ly:music? list?)
254 (if (eqv? #t (ly:get-option 'ancient-style))
256 (make-key-set note key-alist)))
259 #(define-music-function (parser location note key-alist) (ly:music? list?)
260 (let ((key-set (make-key-set note key-alist)))
261 (if (eqv? #t (ly:get-option 'ancient-style))
265 'elements (list key-set
272 'grob-property-path '(old-key)
275 'symbol 'InstrumentName)))))))