sceaux_clef-key.ily

   1 \version "2.13.17"
   2 %%% -*- Mode: scheme -*-
   3 %%% clef.ily  -- ancient and modern clef command
   4 %%%
   5 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
   6 %%%
   7 %%% Options
   8 %%% =======
   9 %%%   ancient-style
  10 %%%     When true, use ancient clefs, instead of modern ones.
  11 %%%
  12 %%%   incipit
  13 %%%     When true, do print incipit showing ancient keys/clefs in modern style.
  14 %%%
  15 %%% Music functions
  16 %%% ===============
  17 %%%   \clef "ancient/modern"
  18 %%%   \clef "name"
  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
  26 %%%     staff.
  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.
  31 %%%
  32 %%%  \oldKey pitch mode
  33 %%%  \newKey pitch mode
  34 %%%  \keys pitch mode
  35 %%%
  36 %%% Dependencies
  37 %%% ============
  38 %%% This feature relies on LilyPond >=2.11.40
  39
  40 #(use-modules (ice-9 regex))
  41
  42 %% to avoid warnings:
  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")
  47
  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.")
  53
  54 #(define-public (filter-empty l)
  55   (filter (lambda (x) (not (null? x))) l))
  56
  57
  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))
  67           (break-alignment #f))
  68
  69           (for-each
  70            (lambda (x)
  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)))
  76
  77           (if break-alignment
  78               (set! (ly:grob-property grob 'width)
  79                     (+ (ly:output-def-lookup (ly:grob-layout grob) 'indent)
  80                        (interval-length
  81                         (interval-widen
  82                          (ly:grob-extent break-alignment system X) 0.4)))))))
  83
  84
  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
  90                        'SequentialMusic
  91                        'elements (filter-empty (list
  92                            ; Workaround: Calculate the actual width of the key/clef
  93                            (make-music
  94                               'ContextSpeccedMusic
  95                               'context-type 'Score
  96                               'element (make-music
  97                                    'OverrideProperty
  98                                    'pop-first #t
  99                                    'grob-property-path (list 'after-line-breaking)
 100                                    'grob-value incipit-after-line-breaking
 101                                    'symbol 'StaffSymbol))
 102                            (make-music
 103                               'ContextSpeccedMusic
 104                               'context-type 'Staff
 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"))))
 111                               'element (make-music
 112                                    'PropertySet
 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)
 128           score)
 129         #f)))
 130
 131
 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                  (eqv? #t (ly:get-option 'incipit))
 141                      (not (eqv? #t (ly:get-option 'ancient-style))))
 142                  (create-incipit-score grob name)
 143                  #f)))
 144     (if (not (eqv? #f incipit-score))
 145         (begin
 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)))))
 152
 153
 154
 155 \layout {
 156   \context { \Staff
 157     \override InstrumentName #'stencil = #system-start-text::incipit-print
 158     instrumentName = ""
 159   }
 160 }
 161
 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)
 168                         (quinte alto . alto)
 169                         (basse bass . bass)
 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)
 176                         (vbasse bass . bass)
 177
 178                         (vtenor tenor . G_8)
 179                         (valto  alto . treble)
 180                         ))
 181
 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)))
 187                               (else #f)))
 188           (modern-clef (cond (match (match:substring match 2))
 189                              (clefs (symbol->string (cddr clefs)))
 190                              (else clef-name))))
 191      (cond ((eqv? #t (ly:get-option 'ancient-style))
 192             ;; ancient clef only
 193             (make-clef-set (if ancient-clef ancient-clef clef-name)))
 194            ((eqv? #t (ly:get-option 'non-incipit))
 195             ;; modern clef only
 196             (make-clef-set modern-clef))
 197            ((not (eqv? #f ancient-clef))
 198             ;; modern clef + ancient clef in incipit, if different
 199             (make-music
 200              'SequentialMusic
 201              'elements (list (make-music
 202                               'ContextSpeccedMusic
 203                               'context-type 'Staff
 204                               'element (make-music
 205                                         'OverrideProperty
 206                                         'pop-first #t
 207                                         'grob-property-path '(old-clef)
 208                                         'grob-value (make-clef-set ancient-clef)
 209                                         'once #t
 210                                         'symbol 'InstrumentName))
 211                              (make-clef-set modern-clef))))
 212            (else
 213             ;; unly use modern clef, if no ancient clef given
 214             (make-clef-set modern-clef)))))
 215
 216 #(define (extract-ancient-or-modern-clef clef-name)
 217    (let* ((match (string-match "^(.*)/(.*)$" clef-name))
 218           (ancient-clef (cond (match (match:substring match 1))
 219                               (else #f)))
 220           (modern-clef (cond (match (match:substring match 2))
 221                              (else clef-name))))
 222      (cond ((eqv? #t (ly:get-option 'ancient-style))
 223             ;; ancient clef only
 224             (if ancient-clef ancient-clef clef-name))
 225            ((eqv? #t (ly:get-option 'non-incipit))
 226             ;; modern clef only
 227             modern-clef)
 228            ((not (eqv? #f ancient-clef))
 229             ;; modern clef + ancient clef in incipit, if different
 230             modern-clef)
 231            (else
 232             ;; unly use modern clef, if no ancient clef given
 233             modern-clef))))
 234
 235 clef =
 236 #(define-music-function (parser location clef-name) (string?)
 237    (make-ancient-or-modern-clef clef-name))
 238
 239 forcedClef =
 240 #(define-music-function (parser location clef-name) (string?)
 241    (make-music 'SequentialMusic
 242                'elements (list (make-music 'ContextSpeccedMusic
 243                                            'context-type 'Staff
 244                                            'element (make-music 'PropertySet
 245                                                                 'value #t
 246                                                                 'symbol 'forceClef))
 247                                (make-ancient-or-modern-clef clef-name))))
 248
 249 #(define (make-key-set note key-alist)
 250    (let ((pitch (ly:music-property (car (ly:music-property
 251                                          note 'elements))
 252                                    'pitch)))
 253      (make-music 'KeyChangeEvent
 254                  'pitch-alist (ly:transpose-key-alist key-alist pitch)
 255                  'tonic pitch)))
 256
 257 oldKey =
 258 #(define-music-function (parser location note key-alist) (ly:music? list?)
 259    (let ((key-set (make-key-set note key-alist)))
 260      (if (eqv? #t (ly:get-option 'ancient-style))
 261          key-set
 262          (make-music 'ContextSpeccedMusic
 263                      'context-type 'Staff
 264                      'element (make-music 'OverrideProperty
 265                                           'pop-first #t
 266                                           'grob-property-path '(old-key)
 267                                           'grob-value key-set
 268                                           'once #t
 269                                           'symbol 'InstrumentName)))))
 270
 271 newKey =
 272 #(define-music-function (parser location note key-alist) (ly:music? list?)
 273    (if (eqv? #t (ly:get-option 'ancient-style))
 274        (make-music 'Music)
 275        (make-key-set note key-alist)))
 276
 277 keys =
 278 #(define-music-function (parser location note key-alist) (ly:music? list?)
 279    (let ((key-set (make-key-set note key-alist)))
 280      (if (eqv? #t (ly:get-option 'ancient-style))
 281          key-set
 282          (make-music
 283           'SequentialMusic
 284           'elements (list key-set
 285                           (make-music
 286                            'ContextSpeccedMusic
 287                            'context-type 'Staff
 288                            'element (make-music
 289                                      'OverrideProperty
 290                                      'pop-first #t
 291                                      'grob-property-path '(old-key)
 292                                      'grob-value key-set
 293                                      'once #t
 294                                      'symbol 'InstrumentName)))))))
 295