]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
*** empty log message ***
[lilypond.git] / scm / music-functions.scm
index d734535f31e17a7db81037cf3980998cebe43ec4..95b83cb1d6a2f5595756b67ef818f3490a254667 100644 (file)
@@ -2,47 +2,49 @@
 ;; tuplets.
 
 (define-public (denominator-tuplet-formatter mus)
-  (number->string (ly-get-mus-property mus 'denominator)))
+  (number->string (ly:get-mus-property mus 'denominator)))
 
 (define-public (fraction-tuplet-formatter mus)
-  (string-append (number->string (ly-get-mus-property mus 'numerator))
+  (string-append (number->string (ly:get-mus-property mus 'numerator))
                 ":"
-                (number->string (ly-get-mus-property mus 'denominator))
+                (number->string (ly:get-mus-property mus 'denominator))
                 ))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 (define-public (shift-duration-log music shift dot)
-  "Recurse through music, adding SHIFT to duration-log and optionally 
+  "Recurse through music, adding SHIFT to ly:duration-log and optionally 
   a dot to any note encountered. This scales the music up by a factor 
   2^shift * (2 - (1/2)^dot)"
-  (let* ((es (ly-get-mus-property music 'elements))
-         (e (ly-get-mus-property music 'element))
-         (n  (ly-music-name music))
+  (let* ((es (ly:get-mus-property music 'elements))
+         (e (ly:get-mus-property music 'element))
+         (n  (ly:music-name music))
         (f  (lambda (x)  (shift-duration-log x shift dot)))
         )
+
+    ;; FIXME: broken by the great music rename.
     (if (or (equal? n "Note_req")
            (equal? n "Rest_req"))
        (let* (
-              (d (ly-get-mus-property music 'duration))
-              (cp (duration-factor d))
-              (nd (make-duration (+ shift (duration-log d))
+              (d (ly:get-mus-property music 'duration))
+              (cp (ly:duration-factor d))
+              (nd (ly:make-duration (+ shift (ly:duration-log d))
                                  (+ dot (duration-dot-count d))
                                  (car cp)
                                  (cdr cp)))
               
               )
-         (ly-set-mus-property! music 'duration nd)
+         (ly:set-mus-property! music 'duration nd)
          ))
     
     (if (pair? es)
-        (ly-set-mus-property!
+        (ly:set-mus-property!
          music 'elements
          (map f es)))
     
-    (if (music? e)
-        (ly-set-mus-property!
+    (if (ly:music? e)
+        (ly:set-mus-property!
          music 'element
          (f e)))
     
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; repeats.
 
-(define-public (repeat-name-to-ctor name)
-  (let*
-      ((supported-reps
-       `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor)
-                     (start-moment-function .  ,Repeated_music::first_start)
-                     (length . ,Repeated_music::volta_music_length)))
-         
-           ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor)
-                        (start-moment-function .  ,Repeated_music::first_start)                         
-                        (length . ,Repeated_music::unfolded_music_length)))
-           ("fold" . ((iterator-ctor  . ,Folded_repeat_iterator::constructor)
-                      (start-moment-function .  ,Repeated_music::minimum_start)                         
-                      (length . ,Repeated_music::folded_music_length)))
-           ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor)
-                         (start-moment-function .  ,Repeated_music::first_start)
-                         (length . ,Repeated_music::unfolded_music_length)))
-           ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor)
-                         (start-moment-function .  ,Repeated_music::first_start)
-
-                         ;; the length of the repeat is handled by shifting the note logs
-                         (length . ,Repeated_music::folded_music_length)))))
-         
-       (handle (assoc name supported-reps)))
-
-    (if (pair? handle)
-       (cdr handle)
-       (begin
-         (ly-warn
-          (string-append "Unknown repeat type `" name "'\nSee scm/c++.scm for supported repeats"))
-         '(type . 'repeated-music)))))
-
 (define-public (unfold-repeats music)
 "
 This function replaces all repeats  with unfold repeats. It was 
 written by Rune Zedeler. "
-  (let* ((es (ly-get-mus-property music 'elements))
-         (e (ly-get-mus-property music 'element))
-         (n  (ly-music-name music)))
+  (let* ((es (ly:get-mus-property music 'elements))
+         (e (ly:get-mus-property music 'element))
+         (n  (ly:music-name music)))
  
     (if (equal? n "Repeated_music")
         (begin
          (if (equal?
-              (ly-get-mus-property music 'iterator-ctor)
+              (ly:get-mus-property music 'iterator-ctor)
               Chord_tremolo_iterator::constructor)
-             (shift-duration-log music  (intlog2 (ly-get-mus-property music 'repeat-count)) 0)
+             (shift-duration-log music  (ly:intlog2 (ly:get-mus-property music 'repeat-count)) 0)
              )
-          (ly-set-mus-property!
+          (ly:set-mus-property!
            music 'length Repeated_music::unfolded_music_length)
-         (ly-set-mus-property!
+         (ly:set-mus-property!
           music 'start-moment-function Repeated_music::first_start)
-          (ly-set-mus-property!
+          (ly:set-mus-property!
            music 'iterator-ctor Unfolded_repeat_iterator::constructor)))
 
     (if (pair? es)
-        (ly-set-mus-property!
+        (ly:set-mus-property!
          music 'elements
          (map unfold-repeats es)))
 
-    (if (music? e)
-        (ly-set-mus-property!
+    (if (ly:music? e)
+        (ly:set-mus-property!
          music 'element
          (unfold-repeats e)))
 
@@ -125,29 +96,29 @@ written by Rune Zedeler. "
   "Copy the pitch fields of the Note_requests into  Text_script_requests, to aid
 Fingering_engraver."
   (define (find-note musics)
-    (filter-list (lambda (m) (equal? (ly-music-name m) "Note_req")) musics)
+    (filter-list (lambda (m) (equal? (ly:music-name m) "Note_req")) musics)
     )
   (define (find-scripts musics)
-    (filter-list (lambda (m) (equal? (ly-music-name m) "Text_script_req")) musics))
+    (filter-list (lambda (m) (equal? (ly:music-name m) "Text_script_req")) musics))
 
   (let* (
-        (e (ly-get-mus-property music 'element))
-        (es (ly-get-mus-property music 'elements))
+        (e (ly:get-mus-property music 'element))
+        (es (ly:get-mus-property music 'elements))
         (notes (find-note es))
-        (pitch (if (pair? notes) (ly-get-mus-property (car  notes) 'pitch) #f))
+        (pitch (if (pair? notes) (ly:get-mus-property (car  notes) 'pitch) #f))
         )
 
     (if pitch
-       (map (lambda (x) (ly-set-mus-property! x 'pitch pitch)) (find-scripts es))
+       (map (lambda (x) (ly:set-mus-property! x 'pitch pitch)) (find-scripts es))
        )
        
     (if (pair? es)
-        (ly-set-mus-property!
+        (ly:set-mus-property!
          music 'elements
          (map pitchify-scripts es)))
 
-    (if (music? e)
-        (ly-set-mus-property!
+    (if (ly:music? e)
+        (ly:set-mus-property!
          music 'element
          (pitchify-scripts e)))
 
@@ -161,12 +132,11 @@ Fingering_engraver."
 this is not an override 
 "
   
-   (let* ((m (ly-make-music  "Music")))
-     (ly-set-mus-property! m 'iterator-ctor Push_property_iterator::constructor)
-     (ly-set-mus-property! m 'symbol grob)
-     (ly-set-mus-property! m 'grob-property gprop)
-     (ly-set-mus-property! m 'grob-value val)
-     (ly-set-mus-property! m 'pop-first #t)
+   (let* ((m (make-music-by-name  'OverrideProperty)))
+     (ly:set-mus-property! m 'symbol grob)
+     (ly:set-mus-property! m 'grob-property gprop)
+     (ly:set-mus-property! m 'grob-value val)
+     (ly:set-mus-property! m 'pop-first #t)
                
      m
    
@@ -175,10 +145,9 @@ this is not an override
 
 (define-public (make-grob-property-revert grob gprop)
   "Revert the grob property GPROP for GROB."
-   (let* ((m (ly-make-music  "Music")))
-     (ly-set-mus-property! m 'iterator-ctor Pop_property_iterator::constructor)
-     (ly-set-mus-property! m 'symbol grob)
-     (ly-set-mus-property! m 'grob-property gprop)
+   (let* ((m (make-music-by-name  'OverrideProperty)))
+     (ly:set-mus-property! m 'symbol grob)
+     (ly:set-mus-property! m 'grob-property gprop)
                
      m
    
@@ -190,7 +159,13 @@ this is not an override
       (map (lambda (x) (make-grob-property-set x 'direction
                                               (if (odd? n) -1 1)))
           '(Tie Slur Stem Dots))
-      (list (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)))
+      (list
+       (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
+       (make-grob-property-set 'MultiMeasureRest 'staff-position
+                              (if (odd? n) -4 4)
+                              )
+       
+       )
    )
   ))
 
@@ -208,38 +183,131 @@ this is not an override
 (define-public (context-spec-music m context . rest)
   "Add \context CONTEXT = foo to M. "
   
-  (let* ((cm (ly-make-music "Context_specced_music")))
-    (ly-set-mus-property! cm 'element m)
-    (ly-set-mus-property! cm 'context-type context)
+  (let* ((cm (make-music-by-name 'ContextSpeccedMusic)))
+    (ly:set-mus-property! cm 'element m)
+    (ly:set-mus-property! cm 'context-type context)
     (if (and  (pair? rest) (string? (car rest)))
-       (ly-set-mus-property! cm 'context-id (car rest))
+       (ly:set-mus-property! cm 'context-id (car rest))
     )
     cm
   ))
 
 (define-public (make-sequential-music elts)
-  (let*  ((m (ly-make-music "Sequential_music")))
-    (ly-set-mus-property! m 'elements elts)
+  (let*  ((m (make-music-by-name 'SequentialMusic)))
+    (ly:set-mus-property! m 'elements elts)
     m
   ))
 
 (define-public (make-simultaneous-music elts)
-  (let*  ((m (ly-make-music "Simultaneous_music")))
-    (ly-set-mus-property! m 'elements elts)
+  (let*  ((m (make-music-by-name 'SimultaneousMusic)))
+    (ly:set-mus-property! m 'elements elts)
+    m
+    ))
+
+(define-public (make-event-chord elts)
+  (let*  ((m (make-music-by-name 'EventChord)))
+    (ly:set-mus-property! m 'elements elts)
+    m
+    ))
+
+
+(define-public (make-multi-measure-rest duration location)
+  (let*
+      (
+       (start (make-music-by-name 'MultiMeasureRestEvent))
+       (stop  (make-music-by-name 'MultiMeasureRestEvent))
+       (skip ( make-music-by-name 'SkipEvent))
+       (ch (make-music-by-name 'BarCheck))
+       (ch2  (make-music-by-name 'BarCheck))
+       )
+
+    (ly:set-mus-property! start 'span-direction START)
+    (ly:set-mus-property! stop 'span-direction STOP)    
+    (ly:set-mus-property! skip 'duration duration)
+    (map (lambda (x) (ly:set-mus-property! x 'origin location))
+        (list start stop skip ch ch2))
+    (make-sequential-music
+     (list
+      ch
+      (make-event-chord (list start))
+      (make-event-chord (list skip))
+      (make-event-chord (list stop))
+      ch2
+      ))
+    ))
+
+
+(define-public (make-property-set sym val)
+  (let*
+      (
+       (m (make-music-by-name 'PropertySet))
+       )
+    (ly:set-mus-property! m 'symbol sym)
+    (ly:set-mus-property! m 'value val)
+    m
+  ))
+
+(define-public (make-time-signature-set num den . rest)
+  " Set properties for time signature NUM/DEN.
+Rest can contain a list of beat groupings 
+
+"
+  
+  (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))
+       (set4 (make-property-set 'beatGrouping (if (pair? rest)
+                                                 (car rest)
+                                                 '())))
+       (basic  (list set1 set2 set3 set4))
+       
+       )
+
+    (context-spec-music
+     (make-sequential-music basic) "Timing")))
+
+(define-public (set-time-signature num den . rest)
+  (ly:export (apply make-time-signature-set `(,num ,den . ,rest)))
+  )
+
+(define-public (make-penalty-music pen)
+ (let
+     ((m (make-music-by-name 'BreakEvent)))
+   (ly:set-mus-property! m 'penalty pen)
+   m))
+
+(define-public (make-articulation name)
+  (let* (
+        (m (make-music-by-name 'ArticulationEvent))
+      )
+      (ly:set-mus-property! m 'articulation-type name)
+      m
+  ))
+
+(define-public (make-span-event type spandir)
+  (let* (
+        (m (make-music-by-name  type))
+        )
+    (ly:set-mus-property! m 'span-direction spandir)
     m
     ))
 
 (define-public (set-mus-properties! m alist)
+  "Set all of ALIST as properties of M." 
   (if (pair? alist)
       (begin
-       (ly-set-mus-property! m (caar alist) (cdar alist))
+       (ly:set-mus-property! m (caar alist) (cdar alist))
        (set-mus-properties! m (cdr alist)))
   ))
 
 (define-public (music-separator? m)
-  "Is M a separator."
-  (let* ((n (ly-get-mus-property m 'name )))
-    (and (symbol? n) (equal? 'separator n))
+  "Is M a separator?"
+  (let* ((ts (ly:get-mus-property m 'types )))
+    (memq 'separator ts)
   ))
 
 (define (split-one sep?  l acc)
@@ -293,10 +361,10 @@ this is not an override
 
 (define (voicify-chord ch)
   "Split the parts of a chord into different Voices using separator"
-   (let* ((es (ly-get-mus-property ch 'elements)))
+   (let* ((es (ly:get-mus-property ch 'elements)))
 
 
-     (ly-set-mus-property!  ch 'elements
+     (ly:set-mus-property!  ch 'elements
        (voicify-list (split-list es music-separator?) 0))
      ch
    ))
@@ -304,20 +372,20 @@ this is not an override
 (define (voicify-music m)
    "Recursively split chords that are separated with \\ "
    
-   (if (not (music? m))
+   (if (not (ly:music? m))
        (begin (display m)
        (error "not music!"))
        )
    (let*
-       ((es (ly-get-mus-property m 'elements))
-       (e (ly-get-mus-property m 'element))
+       ((es (ly:get-mus-property m 'elements))
+       (e (ly:get-mus-property m 'element))
        )
      (if (pair? es)
-        (ly-set-mus-property! m 'elements (map voicify-music es)))
-     (if (music? e)
-        (ly-set-mus-property! m 'element  (voicify-music e)))
+        (ly:set-mus-property! m 'elements (map voicify-music es)))
+     (if (ly:music? e)
+        (ly:set-mus-property! m 'element  (voicify-music e)))
      (if
-      (and (equal? (ly-music-name m) "Simultaneous_music")
+      (and (equal? (ly:music-name m) "Simultaneous_music")
           (reduce (lambda (x y ) (or x y))     (map music-separator? es)))
       (voicify-chord m)
       )
@@ -326,7 +394,7 @@ this is not an override
      ))
 
 (define-public (empty-music)
-  (ly-id (ly-make-music "Music"))
+  (ly:export (make-music-by-name 'Music))
   )
 ;;;
 
@@ -334,35 +402,36 @@ this is not an override
 (define-public (make-type-checker symbol)
   (lambda (elt)
     ;;(display  symbol)
-    ;;(eq? #t (ly-get-grob-property elt symbol))
-    (not (eq? #f (memq symbol (ly-get-grob-property elt 'interfaces))))))
+    ;;(eq? #t (ly:get-grob-property elt symbol))
+    (not (eq? #f (memq symbol (ly:get-grob-property elt 'interfaces))))))
+
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; warn for bare chords at start.
 
 (define (has-request-chord elts)
-  (reduce (lambda (x y) (or x y)) (map (lambda (x) (equal? (ly-music-name x)
+  (reduce (lambda (x y) (or x y)) (map (lambda (x) (equal? (ly:music-name x)
                                                           "Request_chord")) elts)
   ))
 
-(define (ly-music-message music msg)
+(define (ly:music-message music msg)
   (let* (
-      (ip (ly-get-mus-property music 'origin))
+      (ip (ly:get-mus-property music 'origin))
       )
 
-    (if (ly-input-location? ip)
-       (ly-input-message ip msg)
-       (ly-warn msg))
+    (if (ly:input-location? ip)
+       (ly:input-message ip msg)
+       (ly:warn msg))
   ))
   
 (define (check-start-chords music)
   "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), without context specification. Called  from parser."
   
      (let*
-       ((es (ly-get-mus-property music 'elements))
-       (e (ly-get-mus-property music 'element))
-       (name (ly-music-name music)) 
+       ((es (ly:get-mus-property music 'elements))
+       (e (ly:get-mus-property music 'element))
+       (name (ly:music-name music)) 
        )
 
        (cond 
@@ -370,13 +439,13 @@ this is not an override
         ((equal? name "Simultaneous_music")
 
          (if (has-request-chord es)
-             (ly-music-message music "Starting score with a chord.\nPlease insert an explicit \\context before chord")
+             (ly:music-message music "Starting score with a chord.\nPlease insert an explicit \\context before chord")
              (map check-start-chords es)))
         
         ((equal? name "Sequential_music")
           (if (pair? es)
               (check-start-chords (car es))))
-         (else (if (music? e) (check-start-chords e )))
+         (else (if (ly:music? e) (check-start-chords e )))
        
        ))
      music
@@ -400,3 +469,4 @@ this is not an override
 ; switch-on-debugging
        ))
 
+