sceaux_clef-key.ily

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