]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Web: use free software and mention that we're part of GNU.
[lilypond.git] / scm / music-functions.scm
index 9f173ff7641d6544e73852dddc47e232a9fa32e9..688900411fa446304cb390465cdbb6aae86f418f 100644 (file)
   (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.
 
@@ -130,7 +134,7 @@ For instance,
          ((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)
@@ -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)
-    (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!
-       (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))))
-              ;; 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))))
@@ -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))
-         ;; \repeat tremolo n c4
          ;; 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)))
-
          (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
                                              flattened)))
 
@@ -483,87 +491,24 @@ i.e.  this is not an override"
   (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."
-  (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}.
-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
@@ -919,32 +864,21 @@ Syntax:
   (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
-   (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))
-   (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)
- "Replace MUSIC by
 "Replace MUSIC by
  << {  \\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."
- (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