]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Merge commit 'origin'
[lilypond.git] / scm / music-functions.scm
index bc1cadace77166f1a68bbe43144e2c913998758e..fd950bf28a08899c1c23ba50c588e25b3fbf98f9 100644 (file)
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2008 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;; (use-modules (ice-9 optargs)) 
@@ -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))
@@ -720,8 +736,10 @@ SkipEvent. Useful for extracting parts from crowded scores"
 
 
 
-(defmacro-public def-grace-function (start stop)
+(defmacro-public def-grace-function (start stop . docstring)
+  "Helper macro for defining grace music"
   `(define-music-function (parser location music) (ly:music?)
+     ,@docstring
      (make-music 'GraceMusic
                 'origin location
                 'element (make-music 'SequentialMusic
@@ -735,7 +753,7 @@ Syntax:
   (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
     ...function body...)
 "
-  (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
+(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
       ;; When the music function definition contains a i10n doc string,
       ;; (_i "doc string"), keep the literal string only
       (let ((docstring (cadar body))
@@ -937,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
@@ -955,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
@@ -963,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