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 %%%   incipit
  12 %%%     When true, do print incipit showing ancient keys/clefs 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! 'old-clef 'backend-type? ly:music?)
  43 #(set-object-property! 'old-clef 'backend-doc "Incipit clef music")
  44 #(set-object-property! 'old-key  'backend-type? ly:music?)
  45 #(set-object-property! 'old-key  'backend-doc "Incipit key music")
  46
  47 % #(ly:add-option 'ancient-style #f
  48 %       "Whether old clefs / keys should be printed (if provided)")
  49 % #(ly:add-option 'incipit #t
  50 %       "Whether to print an incipit with the old key / clef (if provided).
  51 %       If the 'ancient-style option is set to ##t, this option has no effect.")
  52
  53 #(define-public (filter-empty l)
  54   (filter (lambda (x) (not (null? x))) l))
  55
  56
  57 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58 % Workaround by Neil puttock (on lilypond-devel):
  59 % The incipit might not contain any notes, in which case, lilypond will
  60 % not use the width of the prefactory material (clefs, keys, etc) to
  61 % determine the width of the staff lines. This function calculates the
  62 % width and sets the 'width property accordingly
  63 #(define-public (incipit-after-line-breaking grob)
  64    (let* ((system (ly:grob-system grob))
  65           (elts (ly:grob-object system 'elements))
  66           (break-alignment #f))
  67
  68           (for-each
  69            (lambda (x)
  70              (let ((elt (ly:grob-array-ref elts x)))
  71                (if (grob::has-interface elt
  72                                         'break-alignment-interface)
  73                    (set! break-alignment elt))))
  74            (iota (ly:grob-array-length elts)))
  75
  76           (if break-alignment
  77               (set! (ly:grob-property grob 'width)
  78                     (+ (ly:output-def-lookup (ly:grob-layout grob) 'indent)
  79                        (interval-length
  80                         (interval-widen
  81                          (ly:grob-extent break-alignment system X) 0.4)))))))
  82
  83
  84 #(define-public (create-incipit-score grob instrument-name)
  85   (let ((clef (ly:grob-property grob 'old-clef))
  86          (key (ly:grob-property grob 'old-key)))
  87     (if (or (ly:music? clef) (ly:music? key))
  88         (let* ((music (make-music
  89                        'SequentialMusic
  90                        'elements (filter-empty (list
  91                            ; Workaround: Calculate the actual width of the key/clef
  92                            (make-music
  93                               'ContextSpeccedMusic
  94                               'context-type 'Score
  95                               'element (make-music
  96                                    'OverrideProperty
  97                                    'pop-first #t
  98                                    'grob-property-path (list 'after-line-breaking)
  99                                    'grob-value incipit-after-line-breaking
 100                                    'symbol 'StaffSymbol))
 101                            (make-music
 102                               'ContextSpeccedMusic
 103                               'context-type 'Staff
 104                               ; Remove time sig and key/clef engravers if necessary
 105                               'property-operations (filter-empty (list
 106                                    (list 'push 'VerticalAxisGroup '(-2 . 2) 'Y-extent)
 107                                    (list 'remove "Time_signature_engraver")
 108                                    (if (ly:music? key) '() (list 'remove "Key_engraver"))
 109                                    (if (ly:music? clef) '() (list 'remove "Clef_engraver"))))
 110                               'element (make-music
 111                                    'PropertySet
 112                                    'symbol 'instrumentName
 113                                    'value instrument-name))
 114                            (if (ly:music? clef) clef '())
 115                            (if (ly:music? key) key '())
 116                            (make-music 'SkipMusic 'duration (ly:make-duration 3 0 1 1))))))
 117                (score (ly:make-score music))
 118                (layout (ly:output-def-clone (ly:grob-layout grob)))
 119                (mm (ly:output-def-lookup layout 'mm))
 120                (indent (ly:output-def-lookup layout 'indent))
 121                (incipit-width (ly:output-def-lookup layout 'incipit-width))
 122                (width (* (if (number? incipit-width) incipit-width 6) mm)))
 123 ;           (ly:output-def-set-variable! layout 'line-width indent)
 124 ;           (ly:output-def-set-variable! layout 'indent (- indent width))
 125           (ly:output-def-set-variable! layout 'ragged-right #t)
 126           (ly:score-add-output-def! score layout)
 127           score)
 128         #f)))
 129
 130
 131 #(define-public (system-start-text::incipit-print grob)
 132   (let* ((left-bound (ly:spanner-bound grob LEFT))
 133          (left-mom (ly:grob-property left-bound 'when))
 134          (start-of-score (moment<=? left-mom ZERO-MOMENT))
 135          (name (if start-of-score
 136                  (ly:grob-property grob 'long-text)
 137                  (ly:grob-property grob 'text)))
 138          (incipit-score (if (and start-of-score
 139                  (or (eqv? #t (ly:get-option 'incipit))
 140                      (not (eqv? #t (ly:get-option 'ancient-style)))))
 141                  (create-incipit-score grob name)
 142                  #f)))
 143     (if (not (eqv? #f incipit-score))
 144         (begin
 145            (set! (ly:grob-property grob 'self-alignment-X) RIGHT)
 146            (set! (ly:grob-property grob 'padding) 0)
 147            (grob-interpret-markup grob (markup #:score incipit-score)))
 148         (if (and (markup? name) (!= (ly:item-break-dir left-bound) CENTER))
 149           (grob-interpret-markup grob name)
 150           (ly:grob-suicide! grob)))))
 151
 152
 153
 154 \layout {
 155   \context { \Staff
 156     \override InstrumentName #'stencil = #system-start-text::incipit-print
 157     instrumentName = ""
 158   }
 159 }
 160
 161 #(define french-clefs '((dessus french . treble)
 162                         (dessus2 soprano . treble)
 163                         (haute-contre soprano . treble)
 164                         (haute-contre2 mezzosoprano . treble)
 165                         (taille mezzosoprano . alto)
 166                         (taille2 alto . alto)
 167                         (quinte alto . alto)
 168                         (basse bass . bass)
 169                         (vdessus treble . treble)
 170                         (vbas-dessus soprano . treble)
 171                         (vpetite-haute-contre mezzosoprano . treble)
 172                         (vhaute-contre alto . G_8)
 173                         (vtaille tenor . G_8)
 174                         (vbasse-taille varbaritone . bass)
 175                         (vbasse bass . bass)
 176
 177                         (vtenor tenor . G_8)
 178                         (valto  alto . treble)
 179                         ))
 180
 181 #(define (make-ancient-or-modern-clef clef-name)
 182    (let* ((match (string-match "^(.*)/(.*)$" clef-name))
 183           (clefs (assoc (string->symbol clef-name) french-clefs))
 184           (ancient-clef (cond (match (match:substring match 1))
 185                               (clefs (symbol->string (cadr clefs)))
 186                               (else #f)))
 187           (modern-clef (cond (match (match:substring match 2))
 188                              (clefs (symbol->string (cddr clefs)))
 189                              (else clef-name))))
 190      (cond ((eqv? #t (ly:get-option 'ancient-style))
 191             ;; ancient clef only
 192             (make-clef-set (if ancient-clef ancient-clef clef-name)))
 193            ((eqv? #t (ly:get-option 'non-incipit))
 194             ;; modern clef only
 195             (make-clef-set modern-clef))
 196            ((not (eqv? #f ancient-clef))
 197             ;; modern clef + ancient clef in incipit, if different
 198             (make-music
 199              'SequentialMusic
 200              'elements (list (make-music
 201                               'ContextSpeccedMusic
 202                               'context-type 'Staff
 203                               'element (make-music
 204                                         'OverrideProperty
 205                                         'pop-first #t
 206                                         'grob-property-path '(old-clef)
 207                                         'grob-value (make-clef-set ancient-clef)
 208                                         'once #t
 209                                         'symbol 'InstrumentName))
 210                              (make-clef-set modern-clef))))
 211            (else
 212             ;; unly use modern clef, if no ancient clef given
 213             (make-clef-set modern-clef)))))
 214
 215 clef =
 216 #(define-music-function (parser location clef-name) (string?)
 217    (make-ancient-or-modern-clef clef-name))
 218
 219 forcedClef =
 220 #(define-music-function (parser location clef-name) (string?)
 221    (make-music 'SequentialMusic
 222                'elements (list (make-music 'ContextSpeccedMusic
 223                                            'context-type 'Staff
 224                                            'element (make-music 'PropertySet
 225                                                                 'value #t
 226                                                                 'symbol 'forceClef))
 227                                (make-ancient-or-modern-clef clef-name))))
 228
 229 #(define (make-key-set note key-alist)
 230    (let ((pitch (ly:music-property (car (ly:music-property
 231                                          note 'elements))
 232                                    'pitch)))
 233      (make-music 'KeyChangeEvent
 234                  'pitch-alist (ly:transpose-key-alist key-alist pitch)
 235                  'tonic pitch)))
 236
 237 oldKey =
 238 #(define-music-function (parser location note key-alist) (ly:music? list?)
 239    (let ((key-set (make-key-set note key-alist)))
 240      (if (eqv? #t (ly:get-option 'ancient-style))
 241          key-set
 242          (make-music 'ContextSpeccedMusic
 243                      'context-type 'Staff
 244                      'element (make-music 'OverrideProperty
 245                                           'pop-first #t
 246                                           'grob-property-path '(old-key)
 247                                           'grob-value key-set
 248                                           'once #t
 249                                           'symbol 'InstrumentName)))))
 250
 251 newKey =
 252 #(define-music-function (parser location note key-alist) (ly:music? list?)
 253    (if (eqv? #t (ly:get-option 'ancient-style))
 254        (make-music 'Music)
 255        (make-key-set note key-alist)))
 256
 257 keys =
 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
 263           'SequentialMusic
 264           'elements (list key-set
 265                           (make-music
 266                            'ContextSpeccedMusic
 267                            'context-type 'Staff
 268                            'element (make-music
 269                                      'OverrideProperty
 270                                      'pop-first #t
 271                                      'grob-property-path '(old-key)
 272                                      'grob-value key-set
 273                                      'once #t
 274                                      'symbol 'InstrumentName)))))))
 275