Web: use free software and mention that we're part of GNU.

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 9f173ff7641d6544e73852dddc47e232a9fa32e9..688900411fa446304cb390465cdbb6aae86f418f 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -48,6 +48,10 @@
   (make-procedure-with-setter ly:prob-property
                              ly:prob-set-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.
 


@@ -130,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)


@@ -265,12 +269,18 @@ 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 (and (equal? name "tremolo") (> (length (ly:music-property main 'elements)) 0))
+    (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!
        ;; This works for single-note and multi-note tremolos!

-       (let* ((children (length (ly:music-property main 'elements)))
+       (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))))
               ;; # 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 
+              ;; 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))))
               ;; times * children
               (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
               (shift (- (ly:intlog2 (floor mult))))


@@ -282,7 +292,6 @@ 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))

-         ;; \repeat tremolo n c4

          ;; Adjust the time of the notes
          (ly:music-compress r (ly:make-moment 1 children))
          ;; Adjust the displayed note durations
          ;; Adjust the time of the notes
          (ly:music-compress r (ly:make-moment 1 children))
          ;; Adjust the displayed note durations


@@ -316,7 +325,6 @@ through MUSIC."
        (let* ((props (ly:music-mutable-properties music))
               (old-name (ly:music-property music 'name))
               (flattened (flatten-alist props)))
        (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)))
 
          (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
                                              flattened)))
 


@@ -483,87 +491,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


@@ -919,32 +864,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."
+(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 #t)
+   (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 #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)
+   (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


@@ -955,51 +889,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