common/alterations.ily

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