common/alterations.ily

   1 %%%
   2 %%% An baroque alteration style
   3 %%% When `ancient-alteration' option is #t, natural (bécarre) signs
   4 %%% are changed into # or b.
   5
   6 #(define (recent-enough? bar-number alteration-def laziness)
   7   (or (number? alteration-def)
   8       (equal? laziness #t)
   9       (<= bar-number (+ (cadr alteration-def) laziness))))
  10
  11 #(define (accidental-invalid? alteration-def)
  12   "Checks an alteration entry for being invalid.
  13
  14 Non-key alterations are invalidated when tying into the next bar or
  15 when there is a clef change, since neither repetition nor cancellation
  16 can be omitted when the same note occurs again.
  17
  18 Returns @code{#f} or the reason for the invalidation, a symbol."
  19   (let* ((def (if (pair? alteration-def)
  20                   (car alteration-def)
  21                   alteration-def)))
  22     (and (symbol? def) def)))
  23
  24 #(define (extract-alteration alteration-def)
  25   (cond ((number? alteration-def)
  26          alteration-def)
  27         ((pair? alteration-def)
  28          (car alteration-def))
  29         (else 0)))
  30
  31 #(define (my-check-pitch-against-signature context pitch barnum laziness octaveness)
  32   (let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t)
  33                               ((equal? octaveness 'same-octave) #f)
  34                               (else
  35                                (ly:warning (_ "Unknown octaveness type: ~S ") octaveness)
  36                                (ly:warning (_ "Defaulting to 'any-octave."))
  37                                #t)))
  38          (key-sig (ly:context-property context 'keySignature))
  39          (local-key-sig (ly:context-property context 'localKeySignature))
  40          (notename (ly:pitch-notename pitch))
  41          (octave (ly:pitch-octave pitch))
  42          (pitch-handle (cons octave notename))
  43          (sharp-neutral #f)
  44          (need-accidental #f)
  45          (previous-alteration #f)
  46          (from-other-octaves #f)
  47          (from-same-octave (assoc-get pitch-handle local-key-sig))
  48          (from-key-sig (or (assoc-get notename local-key-sig)
  49
  50     ;; If no key signature match is found from localKeySignature, we may have a custom
  51     ;; type with octave-specific entries of the form ((octave . pitch) alteration)
  52     ;; instead of (pitch . alteration).  Since this type cannot coexist with entries in
  53     ;; localKeySignature, try extracting from keySignature instead.
  54                            (assoc-get pitch-handle key-sig))))
  55
  56     ;; loop through localKeySignature to search for a notename match from other octaves
  57     (let loop ((l local-key-sig))
  58       (if (pair? l)
  59           (let ((entry (car l)))
  60             (if (and (pair? (car entry))
  61                      (= (cdar entry) notename))
  62                 (set! from-other-octaves (cdr entry))
  63                 (loop (cdr l))))))
  64
  65     ;; find previous alteration-def for comparison with pitch
  66     (cond
  67      ;; from same octave?
  68      ((and (not ignore-octave)
  69            from-same-octave
  70            (recent-enough? barnum from-same-octave laziness))
  71       (set! previous-alteration from-same-octave))
  72
  73      ;; from any octave?
  74      ((and ignore-octave
  75            from-other-octaves
  76            (recent-enough? barnum from-other-octaves laziness))
  77       (set! previous-alteration from-other-octaves))
  78
  79      ;; not recent enough, extract from key signature/local key signature
  80      (from-key-sig
  81       (set! previous-alteration from-key-sig)))
  82
  83     (if (accidental-invalid? previous-alteration)
  84         (set! need-accidental #t)
  85
  86         (let* ((prev-alt (extract-alteration previous-alteration))
  87                (this-alt (ly:pitch-alteration pitch)))
  88
  89           (if (not (= this-alt prev-alt))
  90               (begin
  91                 (set! need-accidental #t)
  92                 (set! sharp-neutral (< prev-alt 0)))
  93               (let* ((sig-b (assoc 6 key-sig))
  94                      (sig-b-alt (if (pair? sig-b) (cdr sig-b) 0))
  95                      (sig-f (assoc 3 key-sig))
  96                      (sig-f-alt (if (pair? sig-f) (cdr sig-f) 0)))
  97                 (set! sharp-neutral
  98                       (cond ((< sig-b-alt 0) #t) ; sharp
  99                             ((> sig-f-alt 0) #f) ; flat
 100                             (else ; could not be decided...
 101                                   #f)))))))
 102     (cons sharp-neutral need-accidental)))
 103
 104 #(define-public ((make-baroque-accidental-rule octaveness laziness) context pitch barnum measurepos)
 105   (my-check-pitch-against-signature context pitch barnum laziness octaveness))
 106
 107 #(define (accidental-interface::calc-ancient-alteration grob)
 108    (let* ((alteration (accidental-interface::calc-alteration grob))
 109           (sharp-natural (eqv? #t (ly:grob-property grob 'restore-first))))
 110      (if sharp-natural
 111          (set! (ly:grob-property grob 'restore-first) #f))
 112      (if (= 0 alteration)
 113          (if sharp-natural 1/2 -1/2)
 114          alteration)))
 115
 116 #(define (accidental-interface::calc-generic-alteration grob)
 117    (if (eqv? #t (ly:get-option 'ancient-alteration))
 118        (accidental-interface::calc-ancient-alteration grob)
 119        (accidental-interface::calc-alteration grob)))
 120
 121 ancientAccidentals = \with {
 122   autoAccidentals = #`(Staff ,(make-baroque-accidental-rule 'same-octave 0))
 123   \override Accidental #'alteration = #accidental-interface::calc-generic-alteration
 124   \override AccidentalCautionary #'alteration = #accidental-interface::calc-generic-alteration
 125   printKeyCancellation = ##f
 126 }
 127
 128 \layout {
 129   \context {
 130     \Score
 131     autoAccidentals = #(if (eqv? #t (ly:get-option 'ancient-alteration))
 132                            `(Staff ,(make-baroque-accidental-rule 'same-octave 0))
 133                            `(Staff ,(make-accidental-rule 'same-octave 0)))
 134     \override Accidental #'alteration = #accidental-interface::calc-generic-alteration
 135     \override AccidentalCautionary #'alteration = #accidental-interface::calc-generic-alteration
 136     printKeyCancellation = #(not (eqv? #t (ly:get-option 'ancient-alteration)))
 137   }
 138 }