X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=fd950bf28a08899c1c23ba50c588e25b3fbf98f9;hb=cfc4cbf34569db6a6c8968694f86e36b206a9d05;hp=42a08cc344c0ec8731d3c1f428f0d7a06a6a5c4b;hpb=cfbc499b05b4d656241759f46f21cc25d85d9d55;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 42a08cc344..fd950bf28a 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -369,7 +369,11 @@ i.e. this is not an override" (Voice Stem no-stem-extend #t) (Voice Beam thickness 0.384) (Voice Beam length-fraction 0.8) - (Voice Accidental font-size -4))) + (Voice Accidental font-size -4) + (Voice AccidentalCautionary font-size -4) + (Voice Script font-size -3) + (Voice Fingering font-size -8) + (Voice StringNumber font-size -8))) (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) @@ -479,17 +483,29 @@ of beat groupings " "Some standard subdivisions for time signatures." (let* ((key (cons num den)) - (entry (assoc key '(((6 . 8) . (3 3)) - ((5 . 8) . (3 2)) - ((9 . 8) . (3 3 3)) - ((12 . 8) . (3 3 3 3)) - ((8 . 8) . (3 3 2)) - )))) + (entry (assoc key '( + ; Simple time signatures + (( 3 . 8) . (3)) + (( 4 . 8) . (2 2)) + ; Compound time signatures + (( 6 . 4) . (3 3)) + (( 6 . 8) . (3 3)) + (( 6 . 16) . (3 3)) + (( 9 . 4) . (3 3 3)) + (( 9 . 8) . (3 3 3)) + (( 9 . 16) . (3 3 3)) + ((12 . 4) . (3 3 3 3)) + ((12 . 8) . (3 3 3 3)) + ((12 . 16) . (3 3 3 3)) + ; Some common irregular time signatures + (( 5 . 8) . (3 2)) + (( 8 . 8) . (3 3 2)) + )))) (if entry (cdr entry) - '()))) - + '()))) + (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den))) (beat (ly:make-moment 1 den)) (len (ly:make-moment num den)) @@ -939,6 +955,16 @@ Syntax: (skip-as-needed x parser) ))) +;;;;;;;;;; +;;; general purpose music functions + +(define (shift-octave pitch octave-shift) + (_i "Add @var{octave-shift} to the octave of @var{pitch}.") + (ly:make-pitch + (+ (ly:pitch-octave pitch) octave-shift) + (ly:pitch-notename pitch) + (ly:pitch-alteration pitch))) + ;;;;;;;;;;;;;;;;; ;; lyrics @@ -957,7 +983,103 @@ Syntax: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; accidentals -(define-public ((make-accidental-rule octaveness lazyness) context pitch barnum measurepos) +(define (recent-enough? bar-number alteration-def laziness) + (if (or (number? alteration-def) + (equal? laziness #t)) + #t + (<= bar-number (+ (cadr alteration-def) laziness)))) + +(define (is-tied? alteration-def) + (let* ((def (if (pair? alteration-def) + (car alteration-def) + alteration-def))) + + (if (equal? def 'tied) #t #f))) + +(define (extract-alteration alteration-def) + (cond ((number? alteration-def) + alteration-def) + ((pair? alteration-def) + (car alteration-def)) + (else 0))) + +(define (check-pitch-against-signature context pitch barnum laziness octaveness) + "Checks the need for an accidental and a @q{restore} accidental against +@code{localKeySignature}. The @var{laziness} is the number of measures +for which reminder accidentals are used (i.e., if @var{laziness} is zero, +only cancel accidentals in the same measure; if @var{laziness} is three, +we cancel accidentals up to three measures after they first appear. +@var{octaveness} is either @code{'same-octave} or @code{'any-octave} and +specifies whether accidentals should be canceled in different octaves." + (let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t) + ((equal? octaveness 'same-octave) #f) + (else + (ly:warning (_ "Unknown octaveness type: ~S ") octaveness) + (ly:warning (_ "Defaulting to 'any-octave.")) + #t))) + (key-sig (ly:context-property context 'keySignature)) + (local-key-sig (ly:context-property context 'localKeySignature)) + (notename (ly:pitch-notename pitch)) + (octave (ly:pitch-octave pitch)) + (pitch-handle (cons octave notename)) + (need-restore #f) + (need-accidental #f) + (previous-alteration #f) + (from-other-octaves #f) + (from-same-octave (ly:assoc-get pitch-handle local-key-sig)) + (from-key-sig (ly:assoc-get notename local-key-sig))) + + ;; If no key signature match is found from localKeySignature, we may have a custom + ;; type with octave-specific entries of the form ((octave . pitch) alteration) + ;; instead of (pitch . alteration). Since this type cannot coexist with entries in + ;; localKeySignature, try extracting from keySignature instead. + (if (equal? from-key-sig #f) + (set! from-key-sig (ly:assoc-get pitch-handle key-sig))) + + ;; loop through localKeySignature to search for a notename match from other octaves + (let loop ((l local-key-sig)) + (if (pair? l) + (let ((entry (car l))) + (if (and (pair? (car entry)) + (= (cdar entry) notename)) + (set! from-other-octaves (cdr entry)) + (loop (cdr l)))))) + + ;; find previous alteration-def for comparison with pitch + (cond + ;; from same octave? + ((and (eq? ignore-octave #f) + (not (equal? from-same-octave #f)) + (recent-enough? barnum from-same-octave laziness)) + (set! previous-alteration from-same-octave)) + + ;; from any octave? + ((and (eq? ignore-octave #t) + (not (equal? from-other-octaves #f)) + (recent-enough? barnum from-other-octaves laziness)) + (set! previous-alteration from-other-octaves)) + + ;; not recent enough, extract from key signature/local key signature + ((not (equal? from-key-sig #f)) + (set! previous-alteration from-key-sig))) + + (if (is-tied? previous-alteration) + (set! need-accidental #t) + + (let* ((prev-alt (extract-alteration previous-alteration)) + (this-alt (ly:pitch-alteration pitch))) + + (if (not (= this-alt prev-alt)) + (begin + (set! need-accidental #t) + (if (and (not (= this-alt 0)) + (or (< (abs this-alt) (abs prev-alt)) + (< (* prev-alt this-alt) 0))) + (set! need-restore #t)))))) + + (cons need-restore need-accidental))) + +(define-public ((make-accidental-rule octaveness laziness) context pitch barnum measurepos) "Creates an accidental rule that makes its decision based on the octave of the note and a laziness value. octaveness is either 'same-octave or 'any-octave and defines whether the rule should @@ -965,13 +1087,12 @@ Syntax: normal way to typeset accidentals - an accidental is made if the alteration is different from the last active pitch in the same octave. 'any-octave looks at the last active pitch in any octave. - lazyness states over how many bars an accidental should be remembered. + laziness states over how many bars an accidental should be remembered. 0 is default - accidental lasts over 0 bar lines, that is, to the end of current measure. A positive integer means that the accidental lasts over that many bar lines. -1 is 'forget immediately', that is, only look at key signature. #t is forever." - (let ((keysig (ly:context-property context 'localKeySignature))) - (ly:find-accidentals-simple keysig pitch barnum lazyness octaveness))) + (check-pitch-against-signature context pitch barnum laziness octaveness)) (define (key-entry-notename entry) "Return the pitch of an entry in localKeySignature. The entry is either of the form