X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=db21afda90aacfb9aa62b0f45e169582c9762213;hb=252ec5e71b5e121734a9c9897245137cb07e4a1f;hp=2440e15bea791191bd9104a06cb589e9852395ad;hpb=4c35239288c2ef7fc4d789091feaa782391ddae6;p=lilypond.git

diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm
index 2440e15bea..db21afda90 100644
--- a/scm/define-music-display-methods.scm
+++ b/scm/define-music-display-methods.scm
@@ -1,7 +1,7 @@
 ;;; define-music-display-methods.scm -- data for displaying music
 ;;; expressions using LilyPond notation.
 ;;;
-;;; Copyright (C) 2005--2011 Nicolas Sceaux  <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2012 Nicolas Sceaux  <nicolas.sceaux@free.fr>
 ;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -16,7 +16,8 @@
 ;;;
 (define (scheme-expr->lily-string scm-arg)
   (cond ((or (number? scm-arg)
-	     (string? scm-arg))
+             (string? scm-arg)
+             (boolean? scm-arg))
 	 (format #f "~s" scm-arg))
 	((or (symbol? scm-arg)
 	     (list? scm-arg))
@@ -107,7 +108,9 @@ expression."
 (define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
 			(force-duration (*force-duration*))
 			(time-factor-numerator (*time-factor-numerator*))
-			(time-factor-denominator (*time-factor-denominator*)))
+			(time-factor-denominator (*time-factor-denominator*))
+			remember)
+  (if remember (*previous-duration* ly-duration))
   (let ((log2	 (ly:duration-log ly-duration))
 	(dots	 (ly:duration-dot-count ly-duration))
 	(num+den (ly:duration-factor ly-duration)))
@@ -135,36 +138,8 @@ expression."
 ;;; post events
 ;;;
 
-(define post-event?
-  (make-music-type-predicate
-    'AbsoluteDynamicEvent
-    'ArpeggioEvent
-    'ArticulationEvent
-    'BeamEvent
-    'BeamForbidEvent
-    'BendAfterEvent
-    'CrescendoEvent
-    'DecrescendoEvent
-    'EpisemaEvent
-    'ExtenderEvent
-    'FingeringEvent
-    'GlissandoEvent
-    'HarmonicEvent
-    'HyphenEvent
-    'MultiMeasureTextEvent
-    'NoteGroupingEvent
-    'PhrasingSlurEvent
-    'SlurEvent
-    'SostenutoEvent
-    'StringNumberEvent
-    'SustainEvent
-    'TextScriptEvent
-    'TextSpanEvent
-    'TieEvent
-    'TremoloEvent
-    'TrillSpanEvent
-    'TupletSpanEvent
-    'UnaCordaEvent))
+(define (post-event? m)
+  (music-is-of-type? m 'post-event))
 
 (define* (event-direction->lily-string event #:optional (required #t))
   (let ((direction (ly:music-property event 'direction)))
@@ -236,6 +211,9 @@ expression."
 (define-post-event-display-method AbsoluteDynamicEvent (event parser) #f
   (format #f "\\~a" (ly:music-property event 'text)))
 
+(define-post-event-display-method StrokeFingerEvent (event parser) #t
+  (format #f "\\rightHandFinger #~a" (ly:music-property event 'digit)))
+
 (define-span-event-display-method BeamEvent (event parser) #f "[" "]")
 (define-span-event-display-method SlurEvent (event parser) #f "(" ")")
 (define-span-event-display-method CrescendoEvent (event parser) #f "\\<" "\\!")
@@ -276,24 +254,22 @@ expression."
     (and (with-music-match (?start (music
 				    'SequentialMusic
 				    elements ((music
-					       'EventChord
-					       elements ((music
-							  'SkipEvent
-							  duration (ly:make-duration 0 0 0 1))
-							 (music
-							  'SlurEvent
-							  span-direction START))))))
-	   #t)
-	  (with-music-match (?stop (music
-				    'SequentialMusic
-				    elements ((music
-					       'EventChord
-					       elements ((music
-							  'SkipEvent
-							  duration (ly:make-duration 0 0 0 1))
-							 (music
-							  'SlurEvent
-							  span-direction STOP))))))
+					       'SkipEvent
+					       duration (ly:make-duration 0 0 0 1)
+					       articulations
+					       ((music
+						 'SlurEvent
+						 span-direction START))))))
+	    #t)
+	 (with-music-match (?stop (music
+				   'SequentialMusic
+				   elements ((music
+					      'SkipEvent
+					      duration (ly:make-duration 0 0 0 1)
+					      articulations
+					      ((music
+						'SlurEvent
+						span-direction STOP))))))
 	    (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
 
 
@@ -311,20 +287,19 @@ expression."
     (and (with-music-match (?start (music
 				    'SequentialMusic
 				    elements ((music
-					       'EventChord
-					       elements ((music
-							  'SkipEvent
-							  duration (ly:make-duration 0 0 0 1))
-							 (music
-							  'SlurEvent
-							  span-direction START)))
+					       'SkipEvent
+					       duration (ly:make-duration 0 0 0 1)
+					       articulations
+					       ((music
+						 'SlurEvent
+						 span-direction START)))
 					      (music
 					       'ContextSpeccedMusic
 					       element (music
 							'OverrideProperty
 							grob-property-path '(stroke-style)
 							grob-value "grace"
-							symbol 'Stem)))))
+							symbol 'Flag)))))
 	   #t)
 	 (with-music-match (?stop (music
 				   'SequentialMusic
@@ -333,15 +308,15 @@ expression."
 					      element (music
 						       'RevertProperty
 						       grob-property-path '(stroke-style)
-						       symbol 'Stem))
+						       symbol 'Flag))
+
 					     (music
-					      'EventChord
-					      elements ((music
-							 'SkipEvent
-							 duration (ly:make-duration 0 0 0 1))
-							(music
-							 'SlurEvent
-							 span-direction STOP))))))
+					      'SkipEvent
+					      duration (ly:make-duration 0 0 0 1)
+					      articulations
+					      ((music
+						'SlurEvent
+						span-direction STOP))))))
 	   (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
 
 (define-extra-display-method GraceMusic (expr parser)
@@ -370,12 +345,16 @@ expression."
 				  (*max-element-number-before-break*))))
 	(elements (ly:music-property seq 'elements))
 	(chord? (make-music-type-predicate 'EventChord))
+	(note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent
+						   'LyricEvent 'RestEvent
+						   'ClusterNoteEvent))
 	(cluster? (make-music-type-predicate 'ClusterNoteEvent))
 	(note? (make-music-type-predicate 'NoteEvent)))
-    (format #f "~a~a{~v%~v_~{~a ~}~v%~v_}"
+    (format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}"
 	    (if (any (lambda (e)
-		       (and (chord? e)
-			    (any cluster? (ly:music-property e 'elements))))
+		       (or (cluster? e)
+			   (and (chord? e)
+				(any cluster? (ly:music-property e 'elements)))))
 		     elements)
 		"\\makeClusters "
 		"")
@@ -390,15 +369,17 @@ expression."
 		       "\\figuremode ")
 		      ((any (lambda (chord)
 			      (any (make-music-type-predicate 'LyricEvent)
-				   (ly:music-property chord 'elements)))
-			    (filter chord? elements))
+				   (cons chord
+					 (ly:music-property chord 'elements))))
+			    (filter note-or-chord? elements))
 		       "\\lyricmode ")
 		      ((any (lambda (chord)
 			      (any (lambda (event)
 				     (and (note? event)
 					  (not (null? (ly:music-property event 'drum-type)))))
-				   (ly:music-property chord 'elements)))
-			    (filter chord? elements))
+				   (cons chord
+					 (ly:music-property chord 'elements))))
+			    (filter note-or-chord? elements))
 		       "\\drummode ")
 		      (else ;; TODO: other modes?
 		       ""))
@@ -410,7 +391,7 @@ expression."
 					  (music->lily-string music parser))
 					elements))
 	    (if force-line-break 1 0)
-	    (if force-line-break (*indent*) 0))))
+	    (if force-line-break (*indent*) 1))))
 
 (define-display-method SimultaneousMusic (sim parser)
   (parameterize ((*indent* (+ 3 (*indent*))))
@@ -449,60 +430,33 @@ Otherwise, return #f."
   (let* ((elements (ly:music-property chord 'elements))
 	 (simple-elements (filter (make-music-type-predicate
 				   'NoteEvent 'ClusterNoteEvent 'RestEvent
-				   'MultiMeasureRestEvent 'SkipEvent 'LyricEvent)
+				   'SkipEvent 'LyricEvent)
 				  elements)))
-    (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingEvent) (car elements))
-	;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff)
-	;; and BreathingEvent (\breathe)
-	(music->lily-string (car elements) parser)
-	(if (and (not (null? simple-elements))
-		 (null? (cdr simple-elements))
-		 ;; special case: if this simple_element has any post_events in
-		 ;; its 'articulations list, it should be interpreted instead
-		 ;; as a note_chord_element to prevent spurious output, e.g.,
-		 ;; \displayLilyMusic < c-1\4 >8 -> c-1\48
-		 (null? (filter post-event?
-				(ly:music-property (car simple-elements) 'articulations))))
-	    ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
-	    (let* ((simple-element (car simple-elements))
-		   (duration (ly:music-property simple-element 'duration))
-		   (lily-string (format #f "~a~a~a~{~a ~}"
-					(music->lily-string simple-element parser)
-					(duration->lily-string duration)
-					(if (and ((make-music-type-predicate 'RestEvent) simple-element)
-						 (ly:pitch? (ly:music-property simple-element 'pitch)))
-					    "\\rest"
-					    "")
-					(map-in-order (lambda (music)
-							(music->lily-string music parser))
-						      (filter post-event? elements)))))
-	      (*previous-duration* duration)
-	      lily-string)
 	    (let ((chord-elements (filter (make-music-type-predicate
 					   'NoteEvent 'ClusterNoteEvent 'BassFigureEvent)
 					  elements))
 		  (post-events (filter post-event? elements)))
 	      (if (not (null? chord-elements))
 		  ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events
-		  (let ((lily-string (format #f "< ~{~a ~}>~a~{~a ~}"
-					     (map-in-order (lambda (music)
-							     (music->lily-string music parser))
-							   chord-elements)
-					     (duration->lily-string (ly:music-property (car chord-elements)
-										       'duration))
-					     (map-in-order (lambda (music)
-							     (music->lily-string music parser))
-							   post-events))))
-		    (*previous-duration* (ly:music-property (car chord-elements) 'duration))
-		    lily-string)
+		  (let* ((duration (duration->lily-string
+				    (ly:music-property (car chord-elements) 'duration)
+				    #:remember #t)))
+		    (format #f "< ~{~a ~}>~a~{~a~^ ~}"
+			    (map-in-order (lambda (music)
+					    (music->lily-string music parser))
+					  chord-elements)
+			    duration
+			    (map-in-order (lambda (music)
+					    (music->lily-string music parser))
+					  post-events)))
 		  ;; command_element
-		  (format #f "~{~a ~}" (map-in-order (lambda (music)
+		  (format #f "~{~a~^ ~}" (map-in-order (lambda (music)
 						       (music->lily-string music parser))
-						     elements))))))))
+						     elements))))))
 
 (define-display-method MultiMeasureRestMusic (mmrest parser)
   (let* ((dur (ly:music-property mmrest 'duration))
-	 (ly (format #f "R~a~{~a ~}"
+	 (ly (format #f "R~a~{~a~^ ~}"
 		     (duration->lily-string dur)
 		     (map-in-order (lambda (music)
 				     (music->lily-string music parser))
@@ -521,7 +475,7 @@ Otherwise, return #f."
 ;;;
 
 (define (simple-note->lily-string event parser)
-  (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
+  (format #f "~a~a~a~a~a~a~{~a~}" ; pitchname octave !? octave-check duration optional_rest articulations
 	  (note-name->lily-string (ly:music-property event 'pitch) parser)
 	  (octave->lily-string (ly:music-property event 'pitch))
 	  (let ((forced (ly:music-property event 'force-accidental))
@@ -541,6 +495,10 @@ Otherwise, return #f."
 					(make-string (1- (* -1 octave-check)) #\,))
 				       (else "")))
 		""))
+	  (duration->lily-string (ly:music-property event 'duration)
+				 #:remember #t)
+	  (if ((make-music-type-predicate 'RestEvent) event)
+	      "\\rest" "")
 	  (map-in-order (lambda (event)
 			  (music->lily-string event parser))
 			(ly:music-property event 'articulations))))
@@ -549,7 +507,9 @@ Otherwise, return #f."
   (cond ((not (null? (ly:music-property note 'pitch))) ;; note
 	 (simple-note->lily-string note parser))
 	((not (null? (ly:music-property note 'drum-type))) ;; drum
-	 (format #f "~a" (ly:music-property note 'drum-type)))
+	 (format #f "~a~a" (ly:music-property note 'drum-type)
+		 (duration->lily-string (ly:music-property note 'duration)
+					#:remember #t)))
 	(else ;; unknown?
 	 "")))
 
@@ -559,13 +519,16 @@ Otherwise, return #f."
 (define-display-method RestEvent (rest parser)
   (if (not (null? (ly:music-property rest 'pitch)))
       (simple-note->lily-string rest parser)
-      "r"))
+      (string-append "r" (duration->lily-string (ly:music-property rest 'duration)
+						#:remember #t))))
 
 (define-display-method MultiMeasureRestEvent (rest parser)
-  "R")
+  (string-append "R" (duration->lily-string (ly:music-property rest 'duration)
+					    #:remember #t)))
 
 (define-display-method SkipEvent (rest parser)
-  "s")
+  (string-append "s" (duration->lily-string (ly:music-property rest 'duration)
+					    #:remember #t)))
 
 (define-display-method RepeatedChord (chord parser)
   (music->lily-string (ly:music-property chord 'element) parser))
@@ -637,18 +600,21 @@ Otherwise, return #f."
 	    (if (null? bracket-stop) "" "]"))))
 
 (define-display-method LyricEvent (lyric parser)
-  (let ((text (ly:music-property lyric 'text)))
-    (if (or (string? text)
-	    (eqv? (first text) simple-markup))
-	;; a string or a simple markup
-	(let ((string (if (string? text)
-			  text
-			  (second text))))
-	  (if (string-match "(\"| |[0-9])" string)
-	      ;; TODO check exactly in which cases double quotes should be used
-	      (format #f "~s" string)
-	      string))
-	(markup->lily-string text))))
+  (format "~a~{~a~^ ~}"
+	  (let ((text (ly:music-property lyric 'text)))
+	    (if (or (string? text)
+		    (eqv? (first text) simple-markup))
+		;; a string or a simple markup
+		(let ((string (if (string? text)
+				  text
+				  (second text))))
+		  (if (string-match "(\"| |[0-9])" string)
+		      ;; TODO check exactly in which cases double quotes should be used
+		      (format #f "~s" string)
+		      string))
+		(markup->lily-string text)))
+	  (map-in-order (lambda (m) (music->lily-string m parser))
+			(ly:music-property lyric 'articulations))))
 
 (define-display-method BreathingEvent (event parser)
   "\\breathe")
@@ -690,6 +656,8 @@ Otherwise, return #f."
 ;;; Repeats
 ;;;
 
+(define-display-method AlternativeEvent (alternative parser) "")
+
 (define (repeat->lily-string expr repeat-type parser)
   (format #f "\\repeat ~a ~a ~a ~a"
 	  repeat-type
@@ -849,10 +817,8 @@ Otherwise, return #f."
 
 (define-display-method OverrideProperty (expr parser)
   (let* ((symbol	  (ly:music-property expr 'symbol))
-	 (property-path   (ly:music-property expr 'grob-property-path))
-	 (properties      (if (pair? property-path)
-			      property-path
-			      (list (ly:music-property expr 'grob-property))))
+	 (properties   (ly:music-property expr 'grob-property-path
+                                             (list (ly:music-property expr 'grob-property))))
 	 (value	  (ly:music-property expr 'grob-value))
 	 (once	  (ly:music-property expr 'once)))
 
@@ -872,8 +838,9 @@ Otherwise, return #f."
 	    (new-line->lily-string))))
 
 (define-display-method RevertProperty (expr parser)
-  (let ((symbol (ly:music-property expr 'symbol))
-	(properties (ly:music-property expr 'grob-property-path)))
+  (let* ((symbol (ly:music-property expr 'symbol))
+         (properties (ly:music-property expr 'grob-property-path
+                                             (list (ly:music-property expr 'grob-property)))))
     (format #f "\\revert ~a~a #'~a~a"
 	    (if (eqv? (*current-context*) 'Bottom)
 		""
@@ -894,8 +861,8 @@ Otherwise, return #f."
                 num den
                 (new-line->lily-string))
         (format #f
-                "#(set-time-signature ~a ~a '~a)~a"
-                num den structure
+                "\\time #'~a ~a/~a~a" 
+                structure num den
                 (new-line->lily-string)))))
 
 ;;; \melisma and \melismaEnd