]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Run `make grand-replace'.
[lilypond.git] / scm / music-functions.scm
index 0ec10069e05bbedd5e2aa503ac74ee93564f2929..f425eb17385f63edcc5bca8b2677b488155a6dd9 100644 (file)
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2008 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;; (use-modules (ice-9 optargs)) 
@@ -823,41 +823,94 @@ Syntax:
        (ly:music-length music))
   music)
 
-(define (skip-to-last music parser)
+(define-public (make-duration-of-length moment)
+ "Make duration of the given MOMENT length."
+ (ly:make-duration 0 0
+  (ly:moment-main-numerator moment)
+  (ly:moment-main-denominator moment)))
 
-  "Replace MUSIC by
+(define (skip-this moment)
+ "set skipTypesetting, make SkipMusic of the given MOMENT length,
+ and then unset skipTypesetting."
+ (make-sequential-music
+  (list
+   (context-spec-music (make-property-set 'skipTypesetting #t)
+    'Score)
+   (make-music 'SkipMusic 'duration
+    (make-duration-of-length moment))
+   (context-spec-music (make-property-set 'skipTypesetting #f)
+    'Score))))
+
+(define (unskip-this moment)
+ "unset skipTypesetting, make SkipMusic of the given MOMENT length,
+ and then set skipTypesetting."
+ (make-sequential-music
+  (list
+   (context-spec-music (make-property-set 'skipTypesetting #f)
+    'Score)
+   (make-music 'SkipMusic 'duration
+    (make-duration-of-length moment))
+   (context-spec-music (make-property-set 'skipTypesetting #t)
+    'Score))))
+
+(define (skip-as-needed music parser)
+ "Replace MUSIC by
+ << {  \\set skipTypesetting = ##f
+ LENGTHOF(\\showFirstLength)
+ \\set skipTypesetting = ##t
+ LENGTHOF(\\showLastLength) }
+ MUSIC >>
+ if appropriate.
+
+ When only showFirstLength is set,
+ the 'length property of the music is
+ overridden to speed up compiling."
+ (let*
+  ((show-last (ly:parser-lookup parser 'showLastLength))
+   (show-first (ly:parser-lookup parser 'showFirstLength)))
+  (cond
+
+   ;; both properties may be set.
+   ((and (ly:music? show-first) (ly:music? show-last))
+    (let*
+     ((orig-length (ly:music-length music))
+      (skip-length (ly:moment-sub orig-length (ly:music-length show-last)))
+      (begin-length (ly:music-length show-first)))
+     (make-simultaneous-music
+      (list
+       (make-sequential-music
+        (list
+         (skip-this skip-length)
+         ;; let's draw a separator between the beginning and the end
+         (context-spec-music (make-property-set 'whichBar "||")
+          'Timing)))
+       (unskip-this begin-length)
+       music))))
+
+   ;; we may only want to print the last length
+   ((ly:music? show-last)
+    (let*
+     ((orig-length (ly:music-length music))
+      (skip-length (ly:moment-sub orig-length (ly:music-length show-last))))
+     (make-simultaneous-music
+      (list
+       (skip-this skip-length)
+       music))))
+
+   ;; we may only want to print the beginning; in this case
+   ;; only the first length will be processed (much faster).
+   ((ly:music? show-first)
+    (let*
+     ((orig-length (ly:music-length music))
+      (begin-length (ly:music-length show-first)))
+     ;; the first length must not exceed the original length.
+     (if (ly:moment<? begin-length orig-length)
+      (set! (ly:music-property music 'length)
+       (ly:music-length show-first)))
+     music))
 
-<< { \\set skipTypesetting = ##t
-     LENGTHOF(\\showLastLength)
-     \\set skipTypesetting = ##t  }
-    MUSIC >>
+   (else music))))
 
-if appropriate.
- "
-  (let*
-      ((show-last  (ly:parser-lookup parser 'showLastLength)))
-    
-    (if (ly:music? show-last)
-       (let*
-           ((orig-length (ly:music-length music))
-            (skip-length (ly:moment-sub orig-length (ly:music-length show-last))))
-
-         (make-simultaneous-music
-          (list
-           (make-sequential-music
-            (list
-             (context-spec-music (make-property-set 'skipTypesetting #t)
-                                 'Score)
-             (make-music 'SkipMusic 'duration
-                         (ly:make-duration
-                          0 0
-                          (ly:moment-main-numerator skip-length)
-                          (ly:moment-main-denominator skip-length)))
-             (context-spec-music (make-property-set 'skipTypesetting #f)
-                                 'Score)))
-           music)))
-       music)))
-    
 
 (define-public toplevel-music-functions
   (list
@@ -872,7 +925,7 @@ if appropriate.
    (lambda (x parser) (music-map cue-substitute x))
  
    (lambda (x parser)
-     (skip-to-last x parser)
+     (skip-as-needed x parser)
    )))
 
 
@@ -974,6 +1027,23 @@ if appropriate.
          (cons #f (not (or (equal? acc key-acc)
                            (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
 
+(define-public (teaching-accidental-rule context pitch barnum measurepos)
+  "an accidental rule that typesets a cautionary accidental
+  if it is included in the key signature AND does not directly follow
+  a note on the same staff-line."
+  (let* ((keysig (ly:context-property context 'localKeySignature))
+        (entry (find-pitch-entry keysig pitch #t #t)))
+    (if (equal? #f entry)
+       (cons #f #f)
+       (let* ((global-entry (find-pitch-entry keysig pitch #f #f))
+              (key-acc (if (equal? global-entry #f)
+                           0
+                           (key-entry-alteration global-entry)))
+              (acc (ly:pitch-alteration pitch))
+              (entrymp (key-entry-measure-position entry))
+              (entrybn (key-entry-bar-number entry)))
+         (cons #f (not (or (equal? acc key-acc)
+                           (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
 
 (define-public (set-accidentals-properties extra-natural
                                           auto-accs auto-cauts
@@ -1095,6 +1165,15 @@ use GrandStaff as a context. "
                                           ,(make-accidental-rule 'any-octave 0)
                                           ,(make-accidental-rule 'same-octave 1))
                                   pcontext))
+
+      ;; same as modern, but cautionary accidentals are printed for all sharp or flat
+      ;; tones specified by the key signature.  
+       ((equal? style 'teaching)
+       (set-accidentals-properties #f
+                                   `(Staff ,(make-accidental-rule 'same-octave 0))
+                                   `(Staff ,(make-accidental-rule 'same-octave 1)
+                                          ,teaching-accidental-rule)
+                                  context))
       
       ;; do not set localKeySignature when a note alterated differently from
       ;; localKeySignature is found.
@@ -1116,7 +1195,7 @@ use GrandStaff as a context. "
                                   '()
                                   context))
       (else
-       (ly:warning (_ "unknown accidental style: ~S" style))
+       (ly:warning (_ "unknown accidental style: ~S") style)
        (make-sequential-music '()))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;