]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Merge branch 'master' of ssh://git.sv.gnu.org/srv/git/lilypond
[lilypond.git] / scm / music-functions.scm
index 1372a15a526e34cb6009c190d56d69cf231692a8..78bcd753e26c7b3432d622c782238c3dd360405c 100644 (file)
@@ -1,9 +1,20 @@
-;;;; music-functions.scm --
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; (use-modules (ice-9 optargs))
 
@@ -346,8 +357,7 @@ i.e.  this is not an override"
              'pop-first #t))
 
 (define-public (make-grob-property-override grob gprop val)
-  "Make a Music expression that sets GPROP to VAL in GROB. Does a pop first,
-i.e.  this is not an override"
+  "Make a Music expression that overrides GPROP to VAL in GROB."
   (make-music 'OverrideProperty
              'symbol grob
              'grob-property gprop
@@ -384,11 +394,11 @@ i.e.  this is not an override"
                        ;; TODO: take this from voicedGraceSettings or similar.
                        '((Voice Stem font-size -3)
                          (Voice NoteHead font-size -3)
-                          (Voice TabNoteHead font-size -4)
+                         (Voice TabNoteHead font-size -4)
                          (Voice Dots font-size -3)
                          (Voice Stem length-fraction 0.8)
                          (Voice Stem no-stem-extend #t)
-                         (Voice Beam thickness 0.384)
+                         (Voice Beam beam-thickness 0.384)
                          (Voice Beam length-fraction 0.8)
                          (Voice Accidental font-size -4)
                          (Voice AccidentalCautionary font-size -4)
@@ -481,11 +491,11 @@ OTTAVATION to `8va', or whatever appropriate."
            (ly:context-unset-property where 'ottavation)))
 
       (let* ((offset (* -7 octavation))
-            (string (cdr (assoc octavation '((2 . "15ma")
-                                             (1 . "8va")
-                                             (0 . #f)
-                                             (-1 . "8vb")
-                                             (-2 . "15mb"))))))
+            (string (assoc-get octavation '((2 . "15ma")
+                                            (1 . "8va")
+                                            (0 . #f)
+                                            (-1 . "8vb")
+                                            (-2 . "15mb")))))
        (ly:context-set-property! context 'middleCOffset offset)
        (ly:context-set-property! context 'ottavation string)
        (ly:set-middle-C! context)))
@@ -564,7 +574,42 @@ included in .ly file."
   (make-music type
              'span-direction span-dir))
 
-(define-public (set-mus-properties! m alist)
+(define-public (override-head-style heads style)
+  "Override style for @var{heads} to @var{style}."
+  (make-sequential-music
+    (if (pair? heads)
+        (map (lambda (h)
+              (make-grob-property-override h 'style style))
+         heads)
+        (list (make-grob-property-override heads 'style style)))))
+
+(define-public (revert-head-style heads)
+  "Revert style for @var{heads}."
+  (make-sequential-music
+    (if (pair? heads)
+        (map (lambda (h)
+              (make-grob-property-revert h 'style))
+         heads)
+        (list (make-grob-property-revert heads 'style)))))
+
+(define-public (style-note-heads heads style music)
+ "Set @var{style} for all @var{heads} in @var{music}.  Works both
+inside of and outside of chord construct."
+  ;; are we inside a <...>?
+  (if (eq? (ly:music-property music 'name) 'NoteEvent)
+      ;; yes -> use a tweak
+      (begin
+        (set! (ly:music-property music 'tweaks)
+              (acons 'style style (ly:music-property music 'tweaks)))
+        music)
+      ;; not in <...>, so use overrides
+      (make-sequential-music
+        (list
+          (override-head-style heads style)
+          music
+          (revert-head-style heads)))))
+
+ (define-public (set-mus-properties! m alist)
   "Set all of ALIST as properties of M."
   (if (pair? alist)
       (begin
@@ -591,7 +636,7 @@ included in .ly file."
             (make-sequential-music
              (list (make-voice-props-set number)
                    (make-simultaneous-music (car lst))))
-            'Voice  (number->string (1+ number)))
+            'Bottom  (number->string (1+ number)))
            (voicify-list (cdr lst) (1+ number)))))
 
 (define (voicify-chord ch)
@@ -637,7 +682,7 @@ included in .ly file."
 
 "
   (let ((meta (ly:grob-property grob 'meta)))
-    (if (equal?  (cdr (assoc 'name meta)) grob-name)
+    (if (equal? (assoc-get 'name meta) grob-name)
        (set! (ly:grob-property grob symbol) val))))
 
 
@@ -1040,15 +1085,15 @@ specifies whether accidentals should be canceled in different octaves."
         (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)))
+        (from-same-octave (assoc-get pitch-handle local-key-sig))
+        (from-key-sig (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)))
+       (set! from-key-sig (assoc-get pitch-handle key-sig)))
 
     ;; loop through localKeySignature to search for a notename match from other octaves
     (let loop ((l local-key-sig))
@@ -1259,6 +1304,29 @@ use GrandStaff as a context. "
                                           ,(make-accidental-rule 'same-octave 1)
                                           ,neo-modern-accidental-rule)
                                   context))
+      ((equal? style 'neo-modern-voice)
+       (set-accidentals-properties #f
+                                  `(Voice ,(make-accidental-rule 'same-octave 0)
+                                          ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                          ,neo-modern-accidental-rule
+                                    Staff ,(make-accidental-rule 'same-octave 0)
+                                          ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                     ,neo-modern-accidental-rule)
+                                  '()
+                                  context))
+      ((equal? style 'neo-modern-voice-cautionary)
+       (set-accidentals-properties #f
+                                  `(Voice ,(make-accidental-rule 'same-octave 0))
+                                  `(Voice ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                          ,neo-modern-accidental-rule
+                                    Staff ,(make-accidental-rule 'same-octave 0)
+                                          ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                          ,neo-modern-accidental-rule)
+                                  context))
       ;; Accidentals as they were common in dodecaphonic music with no tonality.
       ;; Each note gets one accidental.
       ((equal? style 'dodecaphonic)