%%% -*- Mode: scheme -*- %%% clef.ily -- ancient and modern clef command %%% %%% Author: Nicolas Sceaux %%% %%% Options %%% ======= %%% ancient-style %%% When true, use ancient clefs, instead of modern ones. %%% %%% incipit %%% When true, do print incipit showing ancient keys/clefs in modern style. %%% %%% Music functions %%% =============== %%% \clef "ancient/modern" %%% \clef "name" %%% Overrides the \clef music command, with this extra feature: two %%% clefs may be given as an argument to \clef, seperated by a %%% slash. The first one is the ancient clef, the second the modern %%% clef. The actually displayed clef depends on the value of the %%% 'ancient-style option: if 'ancient-style option is #t, then the %%% ancient clef is displayed; otherwise, the modern clef is %%% displayed, preceeded by the ancient clef if at the beginning of a %%% staff. %%% \clef "soprano/treble" is like: %%% - \clef "soprano" when (ly:get-option 'ancient-style) is #t %%% - \clef "treble" otherwise, but with an soprano clef in an incipit %%% preceeding the first line. %%% %%% \oldKey pitch mode %%% \newKey pitch mode %%% \keys pitch mode %%% %%% Dependencies %%% ============ %%% This feature relies on LilyPond >=2.11.40 #(use-modules (ice-9 regex)) %% to avoid warnings: #(set-object-property! 'old-clef 'backend-type? ly:music?) #(set-object-property! 'old-clef 'backend-doc "Incipit clef music") #(set-object-property! 'old-key 'backend-type? ly:music?) #(set-object-property! 'old-key 'backend-doc "Incipit key music") % #(ly:add-option 'ancient-style #f % "Whether old clefs / keys should be printed (if provided)") % #(ly:add-option 'incipit #t % "Whether to print an incipit with the old key / clef (if provided). % If the 'ancient-style option is set to ##t, this option has no effect.") #(define-public (filter-empty l) (filter (lambda (x) (not (null? x))) l)) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Workaround by Neil puttock (on lilypond-devel): % The incipit might not contain any notes, in which case, lilypond will % not use the width of the prefactory material (clefs, keys, etc) to % determine the width of the staff lines. This function calculates the % width and sets the 'width property accordingly #(define-public (incipit-after-line-breaking grob) (let* ((system (ly:grob-system grob)) (elts (ly:grob-object system 'elements)) (break-alignment #f)) (for-each (lambda (x) (let ((elt (ly:grob-array-ref elts x))) (if (grob::has-interface elt 'break-alignment-interface) (set! break-alignment elt)))) (iota (ly:grob-array-length elts))) (if break-alignment (set! (ly:grob-property grob 'width) (+ (ly:output-def-lookup (ly:grob-layout grob) 'indent) (interval-length (interval-widen (ly:grob-extent break-alignment system X) 0.4))))))) #(define-public (create-incipit-score grob instrument-name) (let ((clef (ly:grob-property grob 'old-clef)) (key (ly:grob-property grob 'old-key))) (if (or (ly:music? clef) (ly:music? key)) (let* ((music (make-music 'SequentialMusic 'elements (filter-empty (list ; Workaround: Calculate the actual width of the key/clef (make-music 'ContextSpeccedMusic 'context-type 'Score 'element (make-music 'OverrideProperty 'pop-first #t 'grob-property-path (list 'after-line-breaking) 'grob-value incipit-after-line-breaking 'symbol 'StaffSymbol)) (make-music 'ContextSpeccedMusic 'context-type 'Staff ; Remove time sig and key/clef engravers if necessary 'property-operations (filter-empty (list (list 'push 'VerticalAxisGroup '(-2 . 2) 'Y-extent) (list 'remove "Time_signature_engraver") (if (ly:music? key) '() (list 'remove "Key_engraver")) (if (ly:music? clef) '() (list 'remove "Clef_engraver")))) 'element (make-music 'PropertySet 'symbol 'instrumentName 'value instrument-name)) (if (ly:music? clef) clef '()) (if (ly:music? key) key '()) (make-music 'SkipMusic 'duration (ly:make-duration 3 0 1 1)))))) (score (ly:make-score music)) (layout (ly:output-def-clone (ly:grob-layout grob))) (mm (ly:output-def-lookup layout 'mm)) (indent (ly:output-def-lookup layout 'indent)) (incipit-width (ly:output-def-lookup layout 'incipit-width)) (width (* (if (number? incipit-width) incipit-width 6) mm))) ; (ly:output-def-set-variable! layout 'line-width indent) ; (ly:output-def-set-variable! layout 'indent (- indent width)) (ly:output-def-set-variable! layout 'ragged-right #t) (ly:score-add-output-def! score layout) score) #f))) #(define-public (system-start-text::incipit-print grob) (let* ((left-bound (ly:spanner-bound grob LEFT)) (left-mom (ly:grob-property left-bound 'when)) (start-of-score (moment<=? left-mom ZERO-MOMENT)) (name (if start-of-score (ly:grob-property grob 'long-text) (ly:grob-property grob 'text))) (incipit-score (if (and start-of-score (or (eqv? #t (ly:get-option 'incipit)) (not (eqv? #t (ly:get-option 'ancient-style))))) (create-incipit-score grob name) #f))) (if (not (eqv? #f incipit-score)) (begin (set! (ly:grob-property grob 'self-alignment-X) RIGHT) (set! (ly:grob-property grob 'padding) 0) (grob-interpret-markup grob (markup #:score incipit-score))) (if (and (markup? name) (!= (ly:item-break-dir left-bound) CENTER)) (grob-interpret-markup grob name) (ly:grob-suicide! grob))))) \layout { \context { \Staff \override InstrumentName #'stencil = #system-start-text::incipit-print instrumentName = "" } } #(define french-clefs '((dessus french . treble) (dessus2 soprano . treble) (haute-contre soprano . treble) (haute-contre2 mezzosoprano . treble) (taille mezzosoprano . alto) (taille2 alto . alto) (quinte alto . alto) (basse bass . bass) (vdessus treble . treble) (vbas-dessus soprano . treble) (vpetite-haute-contre mezzosoprano . treble) (vhaute-contre alto . G_8) (vtaille tenor . G_8) (vbasse-taille varbaritone . bass) (vbasse bass . bass) (vtenor tenor . G_8) (valto alto . treble) )) #(define (make-ancient-or-modern-clef clef-name) (let* ((match (string-match "^(.*)/(.*)$" clef-name)) (clefs (assoc (string->symbol clef-name) french-clefs)) (ancient-clef (cond (match (match:substring match 1)) (clefs (symbol->string (cadr clefs))) (else #f))) (modern-clef (cond (match (match:substring match 2)) (clefs (symbol->string (cddr clefs))) (else clef-name)))) (cond ((eqv? #t (ly:get-option 'ancient-style)) ;; ancient clef only (make-clef-set (if ancient-clef ancient-clef clef-name))) ((eqv? #t (ly:get-option 'non-incipit)) ;; modern clef only (make-clef-set modern-clef)) ((not (eqv? #f ancient-clef)) ;; modern clef + ancient clef in incipit, if different (make-music 'SequentialMusic 'elements (list (make-music 'ContextSpeccedMusic 'context-type 'Staff 'element (make-music 'OverrideProperty 'pop-first #t 'grob-property-path '(old-clef) 'grob-value (make-clef-set ancient-clef) 'once #t 'symbol 'InstrumentName)) (make-clef-set modern-clef)))) (else ;; unly use modern clef, if no ancient clef given (make-clef-set modern-clef))))) clef = #(define-music-function (parser location clef-name) (string?) (make-ancient-or-modern-clef clef-name)) forcedClef = #(define-music-function (parser location clef-name) (string?) (make-music 'SequentialMusic 'elements (list (make-music 'ContextSpeccedMusic 'context-type 'Staff 'element (make-music 'PropertySet 'value #t 'symbol 'forceClef)) (make-ancient-or-modern-clef clef-name)))) #(define (make-key-set note key-alist) (let ((pitch (ly:music-property (car (ly:music-property note 'elements)) 'pitch))) (make-music 'KeyChangeEvent 'pitch-alist (ly:transpose-key-alist key-alist pitch) 'tonic pitch))) oldKey = #(define-music-function (parser location note key-alist) (ly:music? list?) (let ((key-set (make-key-set note key-alist))) (if (eqv? #t (ly:get-option 'ancient-style)) key-set (make-music 'ContextSpeccedMusic 'context-type 'Staff 'element (make-music 'OverrideProperty 'pop-first #t 'grob-property-path '(old-key) 'grob-value key-set 'once #t 'symbol 'InstrumentName))))) newKey = #(define-music-function (parser location note key-alist) (ly:music? list?) (if (eqv? #t (ly:get-option 'ancient-style)) (make-music 'Music) (make-key-set note key-alist))) keys = #(define-music-function (parser location note key-alist) (ly:music? list?) (let ((key-set (make-key-set note key-alist))) (if (eqv? #t (ly:get-option 'ancient-style)) key-set (make-music 'SequentialMusic 'elements (list key-set (make-music 'ContextSpeccedMusic 'context-type 'Staff 'element (make-music 'OverrideProperty 'pop-first #t 'grob-property-path '(old-key) 'grob-value key-set 'once #t 'symbol 'InstrumentName)))))))