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
  62              (eqv? #t (ly:get-option 'forbid-key-modification)))
  63             (key (if forbid-key-modification
  64                      (ly:make-music 'Music)
  65                      (ly:grob-property grob 'key))))
  66        (if (ly:music? clef)
  67            (let* ((instrument-name (ly:grob-property grob 'long-text))
  68                   (layout (ly:output-def-clone (ly:grob-layout grob)))
  69                   (music (make-music
  70                           'SequentialMusic
  71                           'elements
  72                           (list
  73                            (make-music
  74                             'ContextSpeccedMusic
  75                             'context-type 'Staff
  76                             'property-operations
  77                             '((remove "Time_signature_engraver")
  78                               (push VerticalAxisGroup (-2 . 2) Y-extent)
  79                               (push InstrumentName 0 self-alignment-X)
  80                               (push InstrumentName 0.3 padding))
  81                             'element (make-music
  82                                       'PropertySet
  83                                       'symbol 'instrumentName
  84                                       'value instrument-name))
  85                            clef
  86                            (if (ly:music? key)
  87                                key
  88                                (make-music 'Music))
  89                            (make-music
  90                             'SkipMusic
  91                             'duration (ly:make-duration 3 0 1 1)))))
  92                   (score (ly:make-score music))
  93                   (mm (ly:output-def-lookup layout 'mm))
  94                   (indent (ly:output-def-lookup layout 'indent 0))
  95                   (incipit-width (ly:output-def-lookup layout 'incipit-width))
  96                   (width (* (if (number? incipit-width)
  97                                 incipit-width
  98                                 (if forbid-key-modification 10 15))
  99                             mm)))
 100              (ly:output-def-set-variable! layout 'line-width (+ indent width))
 101              (ly:output-def-set-variable! layout 'indent indent)
 102              (ly:output-def-set-variable! layout 'ragged-right #f)
 103              (ly:score-add-output-def! score layout)
 104              (set! (ly:grob-property grob 'long-text)
 105                    (markup #:score score)))))
 106      ;; hack. Why are Staff.InstrumentName overrides permanent,
 107      ;; even with \once, and non re-overridable?
 108      (let ((short-text (ly:grob-property grob 'text)))
 109        (if (markup? short-text)
 110            (set! (ly:grob-property grob 'text)
 111                  (markup #:null #:raise -1 #:concat (short-text #:hspace 1)))))
 112      (system-start-text::print grob))
 113   #}))
 114
 115 #(define french-clefs '((dessus french . treble)
 116                         (dessus2 soprano . treble)
 117                         (haute-contre soprano . alto)
 118                         (haute-contre2 mezzosoprano . alto)
 119                         (taille mezzosoprano . alto)
 120                         (taille2 alto . alto)
 121                         (quinte alto . alto)
 122                         (basse bass . bass)
 123                         (vdessus treble . treble)
 124                         (vbas-dessus soprano . treble)
 125                         (vpetite-haute-contre mezzosoprano . G_8)
 126                         (vhaute-contre alto . G_8)
 127                         (vhaute-contre2 alto . G_8)
 128                         (vtaille tenor . G_8)
 129                         (vbasse-taille varbaritone . bass)
 130                         (vbasse bass . bass)
 131
 132                         (vtenor tenor . G_8)
 133                         (valto  alto . treble)
 134                         ))
 135
 136 #(define (modern-clef tessitura)
 137    (cddr (assoc tessitura french-clefs)))
 138
 139 #(define (set-modern-clef! tessitura clef)
 140    (set-cdr! (assoc tessitura french-clefs)
 141              (cons (cadr (assoc tessitura french-clefs))
 142                    clef)))
 143
 144 #(define (make-ancient-or-modern-clef clef-name)
 145    (let* ((match (string-match "^(.*)/(.*)$" clef-name))
 146           (clefs (assoc (string->symbol clef-name) french-clefs))
 147           (ancient-clef (cond (match (match:substring match 1))
 148                               (clefs (symbol->string (cadr clefs)))
 149                               (else clef-name)))
 150           (modern-clef (cond (match (match:substring match 2))
 151                              (clefs (symbol->string (cddr clefs)))
 152                              (else clef-name))))
 153      (cond ((eqv? #t (ly:get-option 'ancient-style))
 154             ;; ancient clef only
 155             (make-clef-set ancient-clef))
 156            ((eqv? #t (ly:get-option 'non-incipit))
 157             ;; modern clef only
 158             (make-clef-set modern-clef))
 159            (else
 160             ;; modern clef + ancient clef in incipit
 161             (make-music
 162              'SequentialMusic
 163              'elements (list (make-music
 164                               'ContextSpeccedMusic
 165                               'context-type 'Staff
 166                               'element (make-music
 167                                         'OverrideProperty
 168                                         'pop-first #t
 169                                         'grob-property-path '(clef)
 170                                         'grob-value (make-clef-set ancient-clef)
 171                                         'once #t
 172                                         'symbol 'InstrumentName))
 173                              (make-clef-set modern-clef)))))))
 174
 175 clef =
 176 #(define-music-function (parser location clef-name) (string?)
 177    (make-ancient-or-modern-clef clef-name))
 178
 179 forcedClef =
 180 #(define-music-function (parser location clef-name) (string?)
 181    (make-music 'SequentialMusic
 182                'elements (list (make-music 'ContextSpeccedMusic
 183                                            'context-type 'Staff
 184                                            'element (make-music 'PropertySet
 185                                                                 'value #t
 186                                                                 'symbol 'forceClef))
 187                                (make-ancient-or-modern-clef clef-name))))
 188
 189 #(define (make-key-set note key-alist)
 190    (let ((pitch (ly:music-property note 'pitch)))
 191      (make-music 'KeyChangeEvent
 192                  'pitch-alist (ly:transpose-key-alist key-alist pitch)
 193                  'tonic pitch)))
 194
 195 oldKey =
 196 #(define-music-function (parser location note key-alist) (ly:music? list?)
 197    (let ((key-set (make-key-set note key-alist)))
 198      (if (or (eqv? #t (ly:get-option 'ancient-style))
 199              (eqv? #t (ly:get-option 'forbid-key-modification)))
 200          key-set
 201          (make-music 'ContextSpeccedMusic
 202                      'context-type 'Staff
 203                      'element (make-music 'OverrideProperty
 204                                           'pop-first #t
 205                                           'grob-property-path '(key)
 206                                           'grob-value key-set
 207                                           'once #t
 208                                           'symbol 'InstrumentName)))))
 209
 210 newKey =
 211 #(define-music-function (parser location note key-alist) (ly:music? list?)
 212    (if (or (eqv? #t (ly:get-option 'ancient-style))
 213            (eqv? #t (ly:get-option 'forbid-key-modification)))
 214        (make-music 'Music)
 215        (make-key-set note key-alist)))
 216
 217 keys =
 218 #(define-music-function (parser location note key-alist) (ly:music? list?)
 219    (let ((key-set (make-key-set note key-alist)))
 220      (if (or (eqv? #t (ly:get-option 'ancient-style))
 221              (eqv? #t (ly:get-option 'forbid-key-modification)))
 222          key-set
 223          (make-music
 224           'SequentialMusic
 225           'elements (list key-set
 226                           (make-music
 227                            'ContextSpeccedMusic
 228                            'context-type 'Staff
 229                            'element (make-music
 230                                      'OverrideProperty
 231                                      'pop-first #t
 232                                      'grob-property-path '(key)
 233                                      'grob-value key-set
 234                                      'once #t
 235                                      'symbol 'InstrumentName)))))))
 236
 237 %%%%%%%%%%%%%%%%
 238 %%% print the ancient clef and the modern clef (side by side)
 239 #(set-object-property! 'orig-glyph
 240                        'backend-type? string?)
 241 #(set-object-property! 'orig-glyph
 242                        'backend-doc "Original clef glyph")
 243 #(set-object-property! 'orig-clef-position
 244                        'backend-type? number?)
 245 #(set-object-property! 'orig-clef-position
 246                        'backend-doc "Original clef position")
 247
 248 clefWithOriginal =
 249 #(define-music-function (parser location clef-name) (string?)
 250    (let* ((match (string-match "^(.*)/(.*)$" clef-name))
 251           (clefs (assoc (string->symbol clef-name) french-clefs))
 252           (ancient-clef (cond (match (match:substring match 1))
 253                               (clefs (symbol->string (cadr clefs)))
 254                               (else clef-name)))
 255           (modern-clef (cond (match (match:substring match 2))
 256                              (clefs (symbol->string (cddr clefs)))
 257                              (else clef-name))))
 258      (if (symbol? (*part*))
 259          ;; part: modern clef only
 260          (make-clef-set modern-clef)
 261          (let ((clef-def (assoc ancient-clef supported-clefs)))
 262            (if (not (pair? clef-def))
 263                (ly:error "~a is not a supported clef" ancient-clef))
 264            (let ((glyph (cadr clef-def))
 265                  (position (caddr clef-def)))
 266              #{ \set Staff.forceClef = ##t
 267 \once\override Staff.Clef.orig-glyph = #glyph
 268 \once\override Staff.Clef.orig-clef-position = #position
 269 \once\override Staff.Clef.stencil = #print-clef-with-original-clef
 270 \once\override Staff.Clef.full-size-change = ##t
 271 \once\override Staff.ClefModifier.X-offset =
 272 #clef-modifier-with-original-clef-x-offset
 273 $(make-clef-set modern-clef)
 274                     #})))))
 275
 276 #(define (original-clef-stencil clef)
 277    (ly:stencil-translate-axis
 278     (parenthesize-stencil
 279      (ly:font-get-glyph (ly:grob-default-font clef)
 280                         (string-append (ly:grob-property clef 'orig-glyph)
 281                                        "_change"))
 282      0.05 0.25 0.5 0.2)
 283     (/ (- (ly:grob-property clef 'orig-clef-position)
 284           (ly:grob-property clef 'staff-position))
 285        2.0)
 286     Y))
 287
 288 #(define (print-clef-with-original-clef clef)
 289    (ly:stencil-combine-at-edge
 290     (original-clef-stencil clef)
 291     X RIGHT
 292     (ly:clef::print clef)
 293     0.2))
 294
 295 #(define (clef-modifier-with-original-clef-x-offset clef-modifier)
 296    (+ (ly:self-alignment-interface::x-aligned-on-self clef-modifier)
 297       (ly:self-alignment-interface::centered-on-x-parent clef-modifier)
 298       0.1 ;; padding / 2
 299       (* 0.5 (interval-length
 300                (ly:stencil-extent
 301                 (original-clef-stencil (ly:grob-parent clef-modifier Y))
 302                 X)))))