Add make-void-music function for syntax consistency.

[lilypond.git] / scm / music-functions.scm

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 324e5aa8f0087114cbb76da277fba7d028ace8e8..923a48dc58b331413ca67579af5ad41f389449c6 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -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--2010 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;                 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))
 
 
 ;; (use-modules (ice-9 optargs))
 


@@ -25,10 +36,22 @@
   (make-procedure-with-setter ly:grob-property
                              ly:grob-set-property!))
 
   (make-procedure-with-setter ly:grob-property
                              ly:grob-set-property!))
 

+(define-public ly:grob-object
+  (make-procedure-with-setter ly:grob-object
+                             ly:grob-set-object!))
+
+(define-public ly:grob-parent
+  (make-procedure-with-setter ly:grob-parent
+                             ly:grob-set-parent!))
+

 (define-public ly:prob-property
   (make-procedure-with-setter ly:prob-property
                              ly:prob-set-property!))
 
 (define-public ly:prob-property
   (make-procedure-with-setter ly:prob-property
                              ly:prob-set-property!))
 

+(define-public ly:context-property
+  (make-procedure-with-setter ly:context-property
+                             ly:context-set-property!))
+

 (define-public (music-map function music)
   "Apply @var{function} to @var{music} and all of the music it contains.
 
 (define-public (music-map function music)
   "Apply @var{function} to @var{music} and all of the music it contains.
 


@@ -111,7 +134,7 @@ For instance,
          ((and (not (string? arg)) (markup? arg)) ;; a markup
           (inner-markup->make-markup arg))
          (else                                  ;; scheme arg
          ((and (not (string? arg)) (markup? arg)) ;; a markup
           (inner-markup->make-markup arg))
          (else                                  ;; scheme arg

-          arg)))
+          (music->make-music arg))))

   (define (inner-markup->make-markup mrkup)
     (if (string? mrkup)
        `(#:simple ,mrkup)
   (define (inner-markup->make-markup mrkup)
     (if (string? mrkup)
        `(#:simple ,mrkup)


@@ -246,9 +269,20 @@ through MUSIC."
     (set! (ly:music-property r 'element) main)
     (set! (ly:music-property r 'repeat-count) (max times 1))
     (set! (ly:music-property r 'elements) talts)
     (set! (ly:music-property r 'element) main)
     (set! (ly:music-property r 'repeat-count) (max times 1))
     (set! (ly:music-property r 'elements) talts)

-    (if (equal? name "tremolo")
-       (let* ((dots (1- (logcount times)))
-              (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots))))
+    (if (and (equal? name "tremolo")
+            (or (pair? (ly:music-property main 'elements))
+                (ly:music? (ly:music-property main 'element))))
+       ;; This works for single-note and multi-note tremolos!
+       (let* ((children (if (music-is-of-type? main 'sequential-music)
+                            ;; \repeat tremolo n { ... }
+                            (length (ly:music-property main 'elements))
+                            ;; \repeat tremolo n c4
+                            1))
+              ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+              (dots (1- (logcount (* times children))))
+              ;; The remaining missing multiplicator to scale the notes by
+              ;; times * children
+              (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))

               (shift (- (ly:intlog2 (floor mult))))
               (note-duration (first-note-duration r))
               (duration-log (if (ly:duration? note-duration)
               (shift (- (ly:intlog2 (floor mult))))
               (note-duration (first-note-duration r))
               (duration-log (if (ly:duration? note-duration)


@@ -258,20 +292,10 @@ through MUSIC."
          (set! (ly:music-property r 'tremolo-type) tremolo-type)
          (if (not (integer?  mult))
               (ly:warning (_ "invalid tremolo repeat count: ~a") times))
          (set! (ly:music-property r 'tremolo-type) tremolo-type)
          (if (not (integer?  mult))
               (ly:warning (_ "invalid tremolo repeat count: ~a") times))

-         (if (memq 'sequential-music (ly:music-property main 'types))
-             ;; \repeat "tremolo" { c4 d4 }
-             (let ((children (length (ly:music-property main 'elements))))
-
-               ;; fixme: should be more generic.
-               (if (and (not (= children 2))
-                        (not (= children 1)))
-                   (ly:warning (_ "expecting 2 elements for chord tremolo, found ~a") children))
-               (ly:music-compress r (ly:make-moment 1 children))
-               (shift-duration-log r
-                                   (if (= children 2)  (1- shift) shift)
-                                   dots))
-             ;; \repeat "tremolo" c4
-             (shift-duration-log r shift dots)))
+         ;; Adjust the time of the notes
+         (ly:music-compress r (ly:make-moment 1 children))
+         ;; Adjust the displayed note durations
+         (shift-duration-log r shift dots))

        r)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        r)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


@@ -292,38 +316,37 @@ through MUSIC."
 ;; repeats.
 
 (define-public (unfold-repeats music)
 ;; repeats.
 
 (define-public (unfold-repeats music)

-  "
-This function replaces all repeats  with unfold repeats. "
+  "This function replaces all repeats with unfolded repeats."

 
   (let ((es (ly:music-property music 'elements))
 
   (let ((es (ly:music-property music 'elements))

-       (e  (ly:music-property music 'element))
-       )
-    (if (memq 'repeated-music (ly:music-property music 'types))
-       (let*
-           ((props (ly:music-mutable-properties music))
-            (old-name (ly:music-property music 'name))
-            (flattened  (flatten-alist props)))
+       (e (ly:music-property music 'element)))

 
 

+    (if (memq 'repeated-music (ly:music-property music 'types))
+       (let* ((props (ly:music-mutable-properties music))
+              (old-name (ly:music-property music 'name))
+              (flattened (flatten-alist props)))

          (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
                                              flattened)))
 
          (if (equal? old-name 'TremoloRepeatedMusic)
              (let* ((seq-arg? (memq 'sequential-music
                                     (ly:music-property e 'types)))
          (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
                                              flattened)))
 
          (if (equal? old-name 'TremoloRepeatedMusic)
              (let* ((seq-arg? (memq 'sequential-music
                                     (ly:music-property e 'types)))

-                    (count  (ly:music-property music 'repeat-count))
+                    (count (ly:music-property music 'repeat-count))

                     (dot-shift (if (= 0 (remainder count 3))
                     (dot-shift (if (= 0 (remainder count 3))

-                                   -1 0)))
+                                   -1 0))
+                    (child-count (if seq-arg?
+                                     (length (ly:music-property e 'elements))
+                                     0)))

 
                (if (= 0 -1)
                    (set! count (* 2 (quotient count 3))))
 
 
                (if (= 0 -1)
                    (set! count (* 2 (quotient count 3))))
 

-               (shift-duration-log music (+ (if seq-arg? 1 0)
+               (shift-duration-log music (+ (if (= 2 child-count)
+                                                1 0)

                                             (ly:intlog2 count)) dot-shift)
 
                (if seq-arg?
                                             (ly:intlog2 count)) dot-shift)
 
                (if seq-arg?

-                   (ly:music-compress e (ly:make-moment (length (ly:music-property
-                                                                 e 'elements)) 1)))))))
-
+                   (ly:music-compress e (ly:make-moment child-count 1)))))))

 
     (if (pair? es)
        (set! (ly:music-property music 'elements)
 
     (if (pair? es)
        (set! (ly:music-property music 'elements)


@@ -447,6 +470,10 @@ i.e.  this is not an override"
   (make-music 'SkipMusic
              'duration dur))
 
   (make-music 'SkipMusic
              'duration dur))
 

+(define-public make-void-music
+  (make-music 'Music
+             'void #t))
+

 (define-public (make-grace-music music)
   (make-music 'GraceMusic
              'element music))
 (define-public (make-grace-music music)
   (make-music 'GraceMusic
              'element music))


@@ -468,87 +495,24 @@ i.e.  this is not an override"
   (make-music 'PropertyUnset
              'symbol sym))
 
   (make-music 'PropertyUnset
              'symbol sym))
 

-(define-public (make-ottava-set octavation)
-  (let ((m (make-music 'ApplyContext)))
-    (define (ottava-modify context)
-      "Either reset middleCPosition to the stored original, or remember
-old middleCPosition, add OCTAVATION to middleCPosition, and set
-OTTAVATION to `8va', or whatever appropriate."
-      (if (number? (ly:context-property         context 'middleCOffset))
-         (let ((where (ly:context-property-where-defined context 'middleCOffset)))
-           (ly:context-unset-property where 'middleCOffset)
-           (ly:context-unset-property where 'ottavation)))
-
-      (let* ((offset (* -7 octavation))
-            (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)))
-    (set! (ly:music-property m 'procedure) ottava-modify)
-    (context-spec-music m 'Staff)))
-
-(define-public (set-octavation ottavation)
-  (ly:export (make-ottava-set ottavation)))
-

 ;;; Need to keep this definition for \time calls from parser
 (define-public (make-time-signature-set num den)
   "Set properties for time signature NUM/DEN."
 ;;; Need to keep this definition for \time calls from parser
 (define-public (make-time-signature-set num den)
   "Set properties for time signature NUM/DEN."

-  (make-beam-rule-time-signature-set num den '()))
+  (make-music 'TimeSignatureMusic
+              'numerator num
+              'denominator den
+              'beat-structure '()))

 
 ;;; Used for calls that include beat-grouping setting
 (define-public (set-time-signature num den . rest)
   "Set properties for time signature @var{num/den}.
 
 ;;; Used for calls that include beat-grouping setting
 (define-public (set-time-signature num den . rest)
   "Set properties for time signature @var{num/den}.

-If @var{rest} is present, it is used to make a default
-@code{beamSetting} rule."
- (ly:export (apply make-beam-rule-time-signature-set
-                    (list num den rest))))
-
-(define-public (make-beam-rule-time-signature-set num den rest)
-  "Implement settings for new time signature.  Can be
-called from either make-time-signature-set (used by \time
-in parser) or set-time-signature (called from scheme code
-included in .ly file."
-
-  (define (make-default-beaming-rule context)
-   (override-property-setting
-    context
-    'beamSettings
-    (list (cons num den) 'end)
-    (list (cons '* (car rest)))))
-
-  (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den)))
-        (beat (ly:make-moment 1 den))
-        (len  (ly:make-moment num den))
-        (set2 (make-property-set 'beatLength beat))
-        (set3 (make-property-set 'measureLength len))
-         (beaming-rule
-          (if (null? rest)
-              '()
-              (list (make-apply-context make-default-beaming-rule))))
-         (output (cons* set1 set2 set3 beaming-rule)))
-    (descend-to-context
-     (context-spec-music
-      (make-sequential-music output)
-       'Timing)
-     'Score)))
-
-(define-public (make-mark-set label)
-  "Make the music for the \\mark command."
-  (let* ((set (if (integer? label)
-                 (context-spec-music (make-property-set 'rehearsalMark label)
-                                     'Score)
-                 #f))
-        (ev (make-music 'MarkEvent))
-        (ch (make-event-chord (list ev))))
-    (if set
-       (make-sequential-music (list set ch))
-       (begin
-         (set! (ly:music-property ev 'label) label)
-         ch))))
+If @var{rest} is present, it is used to set
+@code{beatStructure}."
+  (ly:export
+   (make-music 'TimeSignatureMusic
+              'numerator num
+              'denominator den
+              'beat-structure (if (null? rest) rest (car rest)))))

 
 (define-safe-public (make-articulation name)
   (make-music 'ArticulationEvent
 
 (define-safe-public (make-articulation name)
   (make-music 'ArticulationEvent


@@ -657,7 +621,7 @@ inside of and outside of chord construct."
 ;; Make a function that checks score element for being of a specific type.
 (define-public (make-type-checker symbol)
   (lambda (elt)
 ;; Make a function that checks score element for being of a specific type.
 (define-public (make-type-checker symbol)
   (lambda (elt)

-    (not (eq? #f (memq symbol (ly:grob-property elt 'interfaces))))))
+    (grob::has-interface elt symbol)))

 
 (define-public ((outputproperty-compatibility func sym val) grob g-context ao-context)
   (if (func grob)
 
 (define-public ((outputproperty-compatibility func sym val) grob g-context ao-context)
   (if (func grob)


@@ -904,32 +868,21 @@ Syntax:
   (ly:moment-main-numerator moment)
   (ly:moment-main-denominator moment)))
 
   (ly:moment-main-numerator moment)
   (ly:moment-main-denominator moment)))
 

-(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."
+(define (make-skipped moment bool)
+ "Depending on BOOL, set or unset skipTypesetting,
+then make SkipMusic of the given MOMENT length, and
+then revert skipTypesetting."

  (make-sequential-music
   (list
  (make-sequential-music
   (list

-   (context-spec-music (make-property-set 'skipTypesetting #f)
+   (context-spec-music (make-property-set 'skipTypesetting bool)

     'Score)
    (make-music 'SkipMusic 'duration
     (make-duration-of-length moment))
     'Score)
    (make-music 'SkipMusic 'duration
     (make-duration-of-length moment))

-   (context-spec-music (make-property-set 'skipTypesetting #t)
+   (context-spec-music (make-property-set 'skipTypesetting (not bool))

     'Score))))
 
 (define (skip-as-needed music parser)
     'Score))))
 
 (define (skip-as-needed music parser)

- "Replace MUSIC by
+  "Replace MUSIC by

  << {  \\set skipTypesetting = ##f
  LENGTHOF(\\showFirstLength)
  \\set skipTypesetting = ##t
  << {  \\set skipTypesetting = ##f
  LENGTHOF(\\showFirstLength)
  \\set skipTypesetting = ##t


@@ -940,51 +893,56 @@ Syntax:
  When only showFirstLength is set,
  the 'length property of the music is
  overridden to speed up compiling."
  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))
-
-   (else music))))
+  (let*
+      ((show-last (ly:parser-lookup parser 'showLastLength))
+       (show-first (ly:parser-lookup parser 'showFirstLength))
+       (show-last-length (if (ly:music? show-last)
+                             (ly:music-length show-last)
+                             #f))
+       (show-first-length (if (ly:music? show-first)
+                              (ly:music-length show-first)
+                              #f))
+       (orig-length (ly:music-length music)))
+
+    ;;FIXME: if using either showFirst- or showLastLength,
+    ;; make sure that skipBars is not set.
+
+    (cond
+
+     ;; both properties may be set.
+     ((and show-first-length show-last-length)
+      (let
+          ((skip-length (ly:moment-sub orig-length show-last-length)))
+        (make-simultaneous-music
+         (list
+          (make-sequential-music
+           (list
+            (make-skipped skip-length #t)
+            ;; let's draw a separator between the beginning and the end
+            (context-spec-music (make-property-set 'whichBar "||")
+                                'Timing)))
+          (make-skipped show-first-length #f)
+          music))))
+
+     ;; we may only want to print the last length
+     (show-last-length
+      (let
+          ((skip-length (ly:moment-sub orig-length show-last-length)))
+        (make-simultaneous-music
+         (list
+          (make-skipped skip-length #t)
+          music))))
+
+     ;; we may only want to print the beginning; in this case
+     ;; only the first length will be processed (much faster).
+     (show-first-length
+      ;; the first length must not exceed the original length.
+      (if (ly:moment<? show-first-length orig-length)
+          (set! (ly:music-property music 'length)
+                show-first-length))
+      music)
+
+     (else music))))

 
 
 (define-public toplevel-music-functions
 
 
 (define-public toplevel-music-functions


@@ -1293,6 +1251,29 @@ use GrandStaff as a context. "
                                           ,(make-accidental-rule 'same-octave 1)
                                           ,neo-modern-accidental-rule)
                                   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)
       ;; Accidentals as they were common in dodecaphonic music with no tonality.
       ;; Each note gets one accidental.
       ((equal? style 'dodecaphonic)