syllabify : prise en compte langues sans espace insécable avant les
[nenuvar.git] / common / alterations.ily
blobb766d4e74a02e671721d051b5f4721e93c4cc1af
1 %%%
2 %%% An baroque alteration style
3 %%% When `ancient-alteration' option is #t, natural (bécarre) signs
4 %%% are changed into # or b.
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))))
11 #(define (accidental-invalid? alteration-def)
12   "Checks an alteration entry for being invalid.
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.
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)))
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)))
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)
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))))
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))))))
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))
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))
79      ;; not recent enough, extract from key signature/local key signature
80      (from-key-sig
81       (set! previous-alteration from-key-sig)))
83     (if (accidental-invalid? previous-alteration)
84         (set! need-accidental #t)
86         (let* ((prev-alt (extract-alteration previous-alteration))
87                (this-alt (ly:pitch-alteration pitch)))
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)))
104 #(define-public ((make-baroque-accidental-rule octaveness laziness) context pitch barnum measurepos)
105   (my-check-pitch-against-signature context pitch barnum laziness octaveness))
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)))
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)))
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
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   }