common/clef-key.ily

   1 %%% clef.ily  -- ancient and modern clef command
   2 %%%
   3 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
   4 %%%
   5 %%% Options
   6 %%% =======
   7 %%%   ancient-style
   8 %%%     When true, use ancient clefs, instead of modern ones.
   9 %%%
  10 %%%   non-incipit
  11 %%%     When true, do not print incipit in modern style.
  12 %%%
  13 %%%   forbid-key-modification
  14 %%%     When true, always use original key signature.
  15 %%%
  16 %%% Music functions
  17 %%% ===============
  18 %%%   \clef "ancient/modern"
  19 %%%   \clef "name"
  20 %%%     Overrides the \clef music command, with this extra feature: two
  21 %%%     clefs may be given as an argument to \clef, seperated by a
  22 %%%     slash. The first one is the ancient clef, the second the modern
  23 %%%     clef. The actually displayed clef depends on the value of the
  24 %%%     'ancient-style option: if 'ancient-style option is #t, then the
  25 %%%     ancient clef is displayed; otherwise, the modern clef is
  26 %%%     displayed, preceeded by the ancient clef if at the beginning of a
  27 %%%     staff.
  28 %%%     \clef "soprano/treble" is like:
  29 %%%     - \clef "soprano" when (ly:get-option 'ancient-style) is #t
  30 %%%     - \clef "treble" otherwise, but with an soprano clef in an incipit
  31 %%%       preceeding the first line.
  32 %%%
  33 %%%  \oldKey pitch mode
  34 %%%  \newKey pitch mode
  35 %%%  \keys pitch mode
  36 %%%
  37 %%% Dependencies
  38 %%% ============
  39 %%% This feature relies on LilyPond >=2.11.40
  40
  41 #(use-modules (ice-9 regex))
  42
  43 %% to avoid warnings:
  44 #(set-object-property! 'clef 'backend-type? ly:music?)
  45 #(set-object-property! 'clef 'backend-doc "Incipit clef music")
  46 #(set-object-property! 'key  'backend-type? ly:music?)
  47 #(set-object-property! 'key  'backend-doc "Incipit key music")
  48
  49 staffStart =
  50 #(define-music-function (parser location) ()
  51    (if (or (eqv? #t (ly:get-option 'non-incipit))
  52            (eqv? #t (ly:get-option 'ancient-style)))
  53        (make-music 'Music)
  54        #{
  55   \set Staff.vocalName = ""
  56   \once \override Staff.InstrumentName #'self-alignment-X = #RIGHT
  57   \once \override Staff.InstrumentName #'padding = #0
  58   \once \override Staff.InstrumentName #'stencil =
  59   #(lambda (grob)
  60      (let* ((clef (ly:grob-property grob 'clef))
  61             (forbid-key-modification (eqv? #t (ly:get-option 'forbid-key-modification)))
  62             (key (if forbid-key-modification
  63                      (ly:make-music 'Music)
  64                      (ly:grob-property grob 'key))))
  65        (if (ly:music? clef)
  66            (let* ((instrument-name (ly:grob-property grob 'long-text))
  67                   (layout (ly:output-def-clone (ly:grob-layout grob)))
  68                   (music (make-music
  69                           'SequentialMusic
  70                           'elements (list (make-music
  71                                            'ContextSpeccedMusic
  72                                            'context-type 'Staff
  73                                            'property-operations '((remove "Time_signature_engraver")
  74                                                                   (push VerticalAxisGroup (-2 . 2) Y-extent))
  75                                            'element (make-music
  76                                                      'PropertySet
  77                                                      'symbol 'instrumentName
  78                                                      'value instrument-name))
  79                                           clef
  80                                           (if (ly:music? key)
  81                                               key
  82                                               (make-music 'Music))
  83                                           (make-music
  84                                            'SkipMusic
  85                                            'duration
  86                                            (ly:make-duration 3 0 1 1)))))
  87                   (score (ly:make-score music))
  88                   (mm (ly:output-def-lookup layout 'mm))
  89                   (indent (ly:output-def-lookup layout 'indent 0))
  90                   (incipit-width (ly:output-def-lookup layout 'incipit-width))
  91                   (width (* (if (number? incipit-width)
  92                                 incipit-width
  93                                 (if forbid-key-modification 10 15))
  94                             mm)))
  95              (ly:output-def-set-variable! layout 'line-width indent)
  96              (ly:output-def-set-variable! layout 'indent (- indent width))
  97              (ly:output-def-set-variable! layout 'ragged-right #f)
  98              (ly:score-add-output-def! score layout)
  99              (set! (ly:grob-property grob 'long-text) (markup #:score score)))))
 100      ;; hack. Why are Staff.InstrumentName overrides permanent,
 101      ;; even with \once, and non re-overridable?
 102      (let ((short-text (ly:grob-property grob 'text)))
 103        (if (markup? short-text)
 104            (set! (ly:grob-property grob 'text)
 105                  (markup #:null #:raise -4.5 #:concat (short-text #:hspace 0.5)))))
 106      (system-start-text::print grob))
 107   #}))
 108
 109 #(define french-clefs '((dessus french . treble)
 110                         (dessus2 soprano . treble)
 111                         (haute-contre soprano . alto)
 112                         (haute-contre2 mezzosoprano . alto)
 113                         (taille mezzosoprano . alto)
 114                         (taille2 alto . alto)
 115                         (quinte alto . alto)
 116                         (basse bass . bass)
 117                         (vdessus treble . treble)
 118                         (vbas-dessus soprano . treble)
 119                         (vpetite-haute-contre mezzosoprano . treble)
 120                         (vhaute-contre alto . G_8)
 121                         (vtaille tenor . G_8)
 122                         (vbasse-taille varbaritone . bass)
 123                         (vbasse bass . bass)
 124
 125                         (vtenor tenor . G_8)
 126                         (valto  alto . treble)
 127                         ))
 128
 129 #(define (modern-clef tessitura)
 130    (cddr (assoc tessitura french-clefs)))
 131
 132 #(define (set-modern-clef! tessitura clef)
 133    (set-cdr! (assoc tessitura french-clefs)
 134              (cons (cadr (assoc tessitura french-clefs))
 135                    clef)))
 136
 137 #(define (make-ancient-or-modern-clef clef-name)
 138    (let* ((match (string-match "^(.*)/(.*)$" clef-name))
 139           (clefs (assoc (string->symbol clef-name) french-clefs))
 140           (ancient-clef (cond (match (match:substring match 1))
 141                               (clefs (symbol->string (cadr clefs)))
 142                               (else clef-name)))
 143           (modern-clef (cond (match (match:substring match 2))
 144                              (clefs (symbol->string (cddr clefs)))
 145                              (else clef-name))))
 146      (cond ((eqv? #t (ly:get-option 'ancient-style))
 147             ;; ancient clef only
 148             (make-clef-set ancient-clef))
 149            ((eqv? #t (ly:get-option 'non-incipit))
 150             ;; modern clef only
 151             (make-clef-set modern-clef))
 152            (else
 153             ;; modern clef + ancient clef in incipit
 154             (make-music
 155              'SequentialMusic
 156              'elements (list (make-music
 157                               'ContextSpeccedMusic
 158                               'context-type 'Staff
 159                               'element (make-music
 160                                         'OverrideProperty
 161                                         'pop-first #t
 162                                         'grob-property-path '(clef)
 163                                         'grob-value (make-clef-set ancient-clef)
 164                                         'once #t
 165                                         'symbol 'InstrumentName))
 166                              (make-clef-set modern-clef)))))))
 167
 168 clef =
 169 #(define-music-function (parser location clef-name) (string?)
 170    (make-ancient-or-modern-clef clef-name))
 171
 172 forcedClef =
 173 #(define-music-function (parser location clef-name) (string?)
 174    (make-music 'SequentialMusic
 175                'elements (list (make-music 'ContextSpeccedMusic
 176                                            'context-type 'Staff
 177                                            'element (make-music 'PropertySet
 178                                                                 'value #t
 179                                                                 'symbol 'forceClef))
 180                                (make-ancient-or-modern-clef clef-name))))
 181
 182 #(define (make-key-set note key-alist)
 183    (let ((pitch (ly:music-property note 'pitch)))
 184      (make-music 'KeyChangeEvent
 185                  'pitch-alist (ly:transpose-key-alist key-alist pitch)
 186                  'tonic pitch)))
 187
 188 oldKey =
 189 #(define-music-function (parser location note key-alist) (ly:music? list?)
 190    (let ((key-set (make-key-set note key-alist)))
 191      (if (or (eqv? #t (ly:get-option 'ancient-style))
 192              (eqv? #t (ly:get-option 'forbid-key-modification)))
 193          key-set
 194          (make-music 'ContextSpeccedMusic
 195                      'context-type 'Staff
 196                      'element (make-music 'OverrideProperty
 197                                           'pop-first #t
 198                                           'grob-property-path '(key)
 199                                           'grob-value key-set
 200                                           'once #t
 201                                           'symbol 'InstrumentName)))))
 202
 203 newKey =
 204 #(define-music-function (parser location note key-alist) (ly:music? list?)
 205    (if (or (eqv? #t (ly:get-option 'ancient-style))
 206            (eqv? #t (ly:get-option 'forbid-key-modification)))
 207        (make-music 'Music)
 208        (make-key-set note key-alist)))
 209
 210 keys =
 211 #(define-music-function (parser location note key-alist) (ly:music? list?)
 212    (let ((key-set (make-key-set note key-alist)))
 213      (if (or (eqv? #t (ly:get-option 'ancient-style))
 214              (eqv? #t (ly:get-option 'forbid-key-modification)))
 215          key-set
 216          (make-music
 217           'SequentialMusic
 218           'elements (list key-set
 219                           (make-music
 220                            'ContextSpeccedMusic
 221                            'context-type 'Staff
 222                            'element (make-music
 223                                      'OverrideProperty
 224                                      'pop-first #t
 225                                      'grob-property-path '(key)
 226                                      'grob-value key-set
 227                                      'once #t
 228                                      'symbol 'InstrumentName)))))))
 229