]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
* lily/rest.cc (polyphonic_offset_callback): new function. Do
[lilypond.git] / scm / music-functions.scm
index 5af90d22606c00012469bd194f4551a81b077257..29194e3326b4745a73b41641282b59553a2c04e8 100644 (file)
@@ -189,6 +189,19 @@ i.e.  this is not an override"
      m
    
    ))
+(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"
+  
+   (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)
+               
+     m
+   
+   ))
 
 
 (define-public (make-grob-property-revert grob gprop)
@@ -201,13 +214,15 @@ i.e.  this is not an override"
    
    ))
 
+(define direction-polyphonic-grobs
+   '(Tie Rest Slur Script TextScript Stem Dots DotColumn))
 
 (define-public (make-voice-props-set n)
   (make-sequential-music
    (append
       (map (lambda (x) (make-grob-property-set x 'direction
                                               (if (odd? n) -1 1)))
-          '(Tie Slur Script TextScript Stem Dots))
+          direction-polyphonic-grobs)
       (list
        (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
        (make-grob-property-set 'MultiMeasureRest 'staff-position
@@ -218,21 +233,19 @@ i.e.  this is not an override"
    )
   ))
 
-
 (define-public (make-voice-props-revert)
   (make-sequential-music
-   (list
-      (make-grob-property-revert 'Tie 'direction)
-      (make-grob-property-revert 'Dots 'direction)
-      (make-grob-property-revert 'Stem 'direction)
-      (make-grob-property-revert 'Slur 'direction)         
-      (make-grob-property-revert 'NoteColumn 'horizontal-shift)
+   (append
+    (map (lambda (x) (make-grob-property-revert x 'direction))
+        direction-polyphonic-grobs)
+      
+      (list (make-grob-property-revert 'NoteColumn 'horizontal-shift))
    ))
   )
 
 
 (define-public (context-spec-music m context . rest)
-  "Add \context CONTEXT = foo to M. "
+  "Add \\context CONTEXT = foo to M. "
   
   (let* ((cm (make-music-by-name 'ContextSpeccedMusic)))
     (ly:set-mus-property! cm 'element m)
@@ -270,8 +283,8 @@ i.e.  this is not an override"
     ))
 
 
-(define-public (make-nonevent-skip dur)
-  (let*  ((m (make-music-by-name 'NonEventSkip)))
+(define-public (make-skip-music dur)
+  (let*  ((m (make-music-by-name 'SkipMusic)))
     (ly:set-mus-property! m 'duration dur)
     m
   ))
@@ -283,24 +296,18 @@ i.e.  this is not an override"
   (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))
-       (seq  (make-music-by-name 'MultiMeasureRestMusicGroup))
+       (seq (make-music-by-name 'MultiMeasureRestMusicGroup))
        )
 
     (map (lambda (x) (ly:set-mus-property! x 'origin location))
-        (list start stop skip ch ch2 seq))
-    (ly:set-mus-property! start 'span-direction START)
-    (ly:set-mus-property! stop 'span-direction STOP)    
-    (ly:set-mus-property! skip 'duration duration)
+        (list start ch ch2 seq))
+    (ly:set-mus-property! start 'duration duration)
     (ly:set-mus-property! seq 'elements
      (list
       ch
       (make-event-chord (list start))
-      (make-event-chord (list skip))
-      (make-event-chord (list stop))
       ch2
       ))
 
@@ -308,7 +315,7 @@ i.e.  this is not an override"
     ))
 
 (define-public (glue-mm-rest-texts music)
-  "Check if we have R1*4-\markup { .. }, and if applicable convert to
+  "Check if we have R1*4-\\markup { .. }, and if applicable convert to
 a property set for MultiMeasureRestNumber."
   
   (define (script-to-mmrest-text script-music)
@@ -363,9 +370,10 @@ a property set for MultiMeasureRestNumber."
     
   
   (define (ottava-modify context)
-    "Either reset centralCPosition to the stored original,
-or remember old centralCPosition, add OCTAVATION to centralCPosition,
-and set OTTAVATION to `8va', or whatever appropriate."
+    "Either reset centralCPosition to the stored original, or remember
+old centralCPosition, add OCTAVATION to centralCPosition, and set
+OTTAVATION to `8va', or whatever appropriate."
+    
     (if (number? (ly:get-context-property  context 'centralCPosition))
        
        (if (= octavation 0)
@@ -422,6 +430,27 @@ Rest can contain a list of beat groupings
     (context-spec-music
      (make-sequential-music basic) 'Timing)))
 
+(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-by-name 'MarkEvent))
+       (ch (make-event-chord (list ev)))
+       )
+
+    
+    (if set
+       (make-sequential-music (list set ch))
+       (begin
+         (ly:set-mus-property! ev 'label label)
+         ch))))
+    
+
+
 (define-public (set-time-signature num den . rest)
   (ly:export (apply make-time-signature-set `(,num ,den . ,rest))))
 
@@ -472,7 +501,6 @@ Rest can contain a list of beat groupings
 
 
 ;;; splitting chords into voices.
-
 (define (voicify-list lst number)
    "Make a list of Musics.
 
@@ -488,7 +516,7 @@ Rest can contain a list of beat groupings
                (make-simultaneous-music (car lst))))
 
              'Voice  (number->string number))
-             (voicify-list (cdr lst) (+ number 1))
+             (voicify-list (cdr lst) (1+ number))
        ))
    )
 
@@ -519,7 +547,7 @@ Rest can contain a list of beat groupings
      (if
       (and (equal? (ly:music-name m) "Simultaneous_music")
           (reduce (lambda (x y ) (or x y)) #f (map music-separator? es)))
-      (voicify-chord m)
+      (set! m  (context-spec-music (voicify-chord m)  'Staff))
       )
 
      m
@@ -711,10 +739,50 @@ Rest can contain a list of beat groupings
   m)
 
 (define-public toplevel-music-functions
-  (list check-start-chords
+  (list
+;;   check-start-chords ; ; no longer needed with chord syntax. 
        voicify-music
        (lambda (x) (music-map glue-mm-rest-texts x))
 ; switch-on-debugging
        ))
 
 
+
+
+;;;;;;;;;;;;;;;;;
+;; lyrics
+
+(define (apply-durations lyric-music durations) 
+  (define (apply-duration music)
+    (if (and (not (equal? (ly:music-length music) ZERO-MOMENT))
+            (ly:duration?  (ly:get-mus-property music 'duration)))
+       (begin
+         (ly:set-mus-property! music 'duration (car durations))
+         (set! durations (cdr durations))
+         )))
+
+  (music-map apply-duration lyric-music))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+
+
+(define-public ((add-balloon-text object-name text off) grob orig-context cur-context)
+   "Usage: see input/regression/balloon.ly "
+  (let*
+   ((meta (ly:get-grob-property grob 'meta))
+    (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant"))
+    (cb (ly:get-grob-property grob 'print-function)))
+    
+   (if (equal? nm object-name)
+    (begin
+     (ly:set-grob-property! grob 'print-function Balloon_interface::print)
+     (ly:set-grob-property! grob 'balloon-original-callback cb)
+     (ly:set-grob-property! grob 'balloon-text text)
+     (ly:set-grob-property! grob 'balloon-text-offset off)
+     (ly:set-grob-property! grob 'balloon-text-props '((font-family . roman)))
+
+     ))))
+
+