]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Merge branch 'master' of ssh+git://hanwen@git.sv.gnu.org/srv/git/lilypond
[lilypond.git] / scm / music-functions.scm
index 2f3e4370919c31cbc2689b6e7f50b310deca704f..681c2c7b082bcc6719601d03f054e9f72aeaab50 100644 (file)
@@ -74,6 +74,7 @@ First it recurses over the children, then the function is applied to MUSIC.
 
 (define-public (display-music music)
   "Display music, not done with music-map for clarity of presentation."
+
   (display music)
   (display ": { ")  
   (let ((es (ly:music-property music 'elements))
@@ -185,6 +186,21 @@ Returns `obj'.
   (newline)
   obj)
 
+;;;
+;;; Scheme music expression --> Lily-syntax-using string translator
+;;;
+(use-modules (srfi srfi-39)
+             (scm display-lily))
+
+(define*-public (display-lily-music expr parser #:key force-duration)
+  "Display the music expression using LilyPond syntax"
+  (memoize-clef-names supported-clefs)
+  (parameterize ((*indent* 0)
+                (*previous-duration* (ly:make-duration 2))
+                (*force-duration* force-duration))
+    (display (music->lily-string expr parser))
+    (newline)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (shift-one-duration-log music shift dot)
@@ -209,7 +225,7 @@ Returns `obj'.
   "create a repeat music expression, with all properties initialized properly"
   (let ((talts (if (< times (length alts))
                   (begin
-                    (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
+                    (ly:warning (_ "More alternatives than repeats.  Junking excess alternatives"))
                     (take alts times))
                   alts))
        (r (make-repeated-music name)))
@@ -227,10 +243,15 @@ Returns `obj'.
          (if (memq 'sequential-music (ly:music-property main 'types))
              ;; \repeat "tremolo" { c4 d4 }
              (let ((children (length (ly:music-property main 'elements))))
-               (if (not (= children 2))
+
+               ;; 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 (1- shift) dots))
+               (shift-duration-log r
+                                   (if (= children 2)  (1- shift) shift)
+                                   dots))
              ;; \repeat "tremolo" c4
              (shift-duration-log r shift dots)))
        r)))
@@ -409,23 +430,26 @@ i.e.  this is not an override"
 old middleCPosition, add OCTAVATION to middleCPosition, and set
 OTTAVATION to `8va', or whatever appropriate."     
       (if (number? (ly:context-property         context 'middleCPosition))
-         (if (= octavation 0)
-             (let ((where (ly:context-property-where-defined context 'middleCPosition))
-                   (oc0 (ly:context-property context 'originalCentralCPosition)))
-               (ly:context-set-property! context 'middleCPosition oc0)
-               (ly:context-unset-property where 'originalCentralCPosition)
-               (ly:context-unset-property where 'ottavation))
-             (let* ((where (ly:context-property-where-defined context 'middleCPosition))
-                    (c0 (ly:context-property context 'middleCPosition))
-                    (new-c0 (+ c0 (* -7 octavation)))
-                    (string (cdr (assoc octavation '((2 . "15ma")
-                                                     (1 . "8va")
-                                                     (0 . #f)
-                                                     (-1 . "8va bassa")
-                                                     (-2 . "15ma bassa"))))))
-               (ly:context-set-property! context 'middleCPosition new-c0)
-               (ly:context-set-property! context 'originalCentralCPosition c0)
-               (ly:context-set-property! context 'ottavation string)))))
+         (begin
+           (if (number? (ly:context-property context 'originalMiddleCPosition))
+               (let ((where (ly:context-property-where-defined context 'middleCPosition)))
+                 
+                 (ly:context-set-property! context 'middleCPosition
+                                           (ly:context-property context 'originalMiddleCPosition))
+                 (ly:context-unset-property where 'originalMiddleCPosition)
+                 (ly:context-unset-property where 'ottavation)))
+ot         
+           (let* ((where (ly:context-property-where-defined context 'middleCPosition))
+                  (c0 (ly:context-property context 'middleCPosition))
+                  (new-c0 (+ c0 (* -7 octavation)))
+                  (string (cdr (assoc octavation '((2 . "15ma")
+                                                   (1 . "8va")
+                                                   (0 . #f)
+                                                   (-1 . "8vb")
+                                                   (-2 . "15mb"))))))
+             (ly:context-set-property! context 'middleCPosition new-c0)
+             (ly:context-set-property! context 'originalMiddleCPosition c0)
+             (ly:context-set-property! context 'ottavation string)))))
     (set! (ly:music-property m 'procedure) ottava-modify)
     (context-spec-music m 'Staff)))
 
@@ -490,9 +514,9 @@ of beat groupings "
              'duration duration
              'text string))
 
-(define-safe-public (make-span-event type spandir)
+(define-safe-public (make-span-event type span-dir)
   (make-music type
-             'span-direction spandir))
+             'span-direction span-dir))
 
 (define-public (set-mus-properties! m alist)
   "Set all of ALIST as properties of M." 
@@ -596,7 +620,7 @@ of beat groupings "
   "Replace MUS by RestEvent of the same duration if it is a
 SkipEvent. Useful for extracting parts from crowded scores"
 
-  (if (equal? (ly:music-property mus 'name) 'SkipEvent)
+  (if  (memq (ly:music-property mus 'name) '(SkipEvent SkipMusic))
    (make-music 'RestEvent 'duration (ly:music-property mus 'duration))
    mus))
 
@@ -604,11 +628,6 @@ SkipEvent. Useful for extracting parts from crowded scores"
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; warn for bare chords at start.
 
-(define (has-request-chord elts)
-  (reduce (lambda (x y) (or x y)) #f
-         (map (lambda (x)
-                (equal? (ly:music-property x 'name) 'RequestChord))
-              elts)))
 
 (define-public (ly:music-message music msg)
   (let ((ip (ly:music-property music 'origin)))
@@ -616,25 +635,6 @@ SkipEvent. Useful for extracting parts from crowded scores"
        (ly:input-message ip msg)
        (ly:warning 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:music-property music 'elements))
-       (e (ly:music-property music 'element))
-       (name (ly:music-property music 'name)))
-    (cond ((equal? name "Context_specced_music") #t)
-         ((equal? name "Simultaneous_music")
-          (if (has-request-chord es)
-              (ly:music-message music "Starting score with a chord.\nInsert an explicit \\context before chord")
-              (map check-start-chords es)))
-         ((equal? name "SequentialMusic")
-          (if (pair? es)
-              (check-start-chords (car es))))
-         (else (if (ly:music? e) (check-start-chords e)))))
-  music)
-
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; setting stuff for grace context.
@@ -744,7 +744,7 @@ Syntax:
              (set! (ly:music-property music 'quoted-events) quoted-vector)
              (set! (ly:music-property music 'iterator-ctor)
                    ly:quote-iterator::constructor))
-           (ly:warning (_ "can't find quoted music `~S'" quoted-name))))
+           (ly:warning (_ "cannot find quoted music: `~S'") quoted-name)))
     music))
 
 
@@ -800,12 +800,15 @@ if appropriate.
           (list
            (make-sequential-music
             (list
-             (context-spec-music (make-property-set 'skipTypesetting #t) 'Score)
+             (context-spec-music (make-property-set 'skipTypesetting #t)
+                                 'Score)
              (make-music 'SkipMusic 'duration
-                         (ly:make-duration 0 0
-                                           (ly:moment-main-numerator skip-length)
-                                           (ly:moment-main-denominator skip-length)))
-             (context-spec-music (make-property-set 'skipTypesetting #f) 'Score)))
+                         (ly:make-duration
+                          0 0
+                          (ly:moment-main-numerator skip-length)
+                          (ly:moment-main-denominator skip-length)))
+             (context-spec-music (make-property-set 'skipTypesetting #f)
+                                 'Score)))
            music)))
        music)))
     
@@ -917,11 +920,14 @@ use GrandStaff as a context. "
                                   '(Staff (any-octave . 0) (same-octave . 1)
                                           GrandStaff (any-octave . 0) (same-octave . 1))
                                   pcontext))
+      
       ;; do not set localKeySignature when a note alterated differently from
       ;; localKeySignature is found.
       ;; Causes accidentals to be printed at every note instead of
       ;; remembered for the duration of a measure.
-      ;; accidentals not being remembered, causing accidentals always to be typeset relative to the time signature
+      ;; accidentals not being remembered, causing accidentals always to
+      ;; be typeset relative to the time signature
+      
       ((equal? style 'forget)
        (set-accidentals-properties '()
                                   '(Staff (same-octave . -1))