X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=574ba04678a4aaae15d77b0c89ce76c5e72df5d5;hb=e3a15ec3c1951dd16f6ee71fbd79870d9e2fb3a0;hp=e0df840e89717ed8f55de76a48a236a3b5854f13;hpb=05349bcf5d3be935173bb0cef4bc674174f68f9c;p=lilypond.git

diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm
index e0df840e89..574ba04678 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--2010 Nicolas Sceaux  <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2011 Nicolas Sceaux  <nicolas.sceaux@free.fr>
 ;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -37,7 +37,8 @@
 ;;;
 
 (define-public (markup->lily-string markup-expr)
-  "Return a string describing, in LilyPond syntax, the given markup expression."
+  "Return a string describing, in LilyPond syntax, the given markup
+expression."
   (define (proc->command proc)
     (let ((cmd-markup (symbol->string (procedure-name proc))))
       (substring cmd-markup 0 (- (string-length cmd-markup)
@@ -282,7 +283,7 @@
 							 (music
 							  'SlurEvent
 							  span-direction START))))))
-			   #t)
+	   #t)
 	  (with-music-match (?stop (music
 				    'SequentialMusic
 				    elements ((music
@@ -324,7 +325,7 @@
 							grob-property-path '(stroke-style)
 							grob-value "grace"
 							symbol 'Stem)))))
-			   #t)
+	   #t)
 	 (with-music-match (?stop (music
 				   'SequentialMusic
 				   elements ((music
@@ -512,6 +513,9 @@ Otherwise, return #f."
 (define-display-method SkipMusic (skip parser)
   (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
 
+(define-display-method OttavaMusic (ottava parser)
+  (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number)))
+
 ;;;
 ;;; Notes, rests, skips...
 ;;;
@@ -563,6 +567,9 @@ Otherwise, return #f."
 (define-display-method SkipEvent (rest parser)
   "s")
 
+(define-display-method RepeatedChord (chord parser)
+  (music->lily-string (ly:music-property chord 'element) parser))
+
 (define-display-method MarkEvent (mark parser)
   (let ((label (ly:music-property mark 'label)))
     (if (null? label)
@@ -877,6 +884,20 @@ Otherwise, return #f."
 		properties)
 	    (new-line->lily-string))))
 
+(define-display-method TimeSignatureMusic (expr parser)
+  (let* ((num (ly:music-property expr 'numerator))
+         (den (ly:music-property expr 'denominator))
+         (structure (ly:music-property expr 'beat-structure)))
+    (if (null? structure)
+        (format #f
+                "\\time ~a/~a~a"
+                num den
+                (new-line->lily-string))
+        (format #f
+                "#(set-time-signature ~a ~a '~a)~a"
+                num den structure
+                (new-line->lily-string)))))
+
 ;;; \melisma and \melismaEnd
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
@@ -894,53 +915,35 @@ Otherwise, return #f."
     "\\melismaEnd"))
 
 ;;; \tempo
-;;; Check for all three different syntaxes of tempo:
-;;; \tempo string duration=note, \tempo duration=note and \tempo string
-(define-extra-display-method ContextSpeccedMusic (expr parser)
-  "If expr is a tempo, return \"\\tempo x = nnn\", otherwise return #f."
-  (or   (with-music-match (expr (music 'ContextSpeccedMusic
-		element (music 'SequentialMusic
-			      elements ((music 'PropertySet
-					  value ?unit-text
-					  symbol 'tempoText)
-					(music 'PropertySet
-					  symbol 'tempoWholesPerMinute)
-					(music 'PropertySet
-					  value ?unit-duration
-					  symbol 'tempoUnitDuration)
-					(music 'PropertySet
-					  value ?unit-count
-					  symbol 'tempoUnitCount)))))
-		(format #f "\\tempo ~a ~a = ~a"
-			(scheme-expr->lily-string ?unit-text)
-			(duration->lily-string ?unit-duration #:force-duration #t)
-			?unit-count))
-	(with-music-match (expr (music 'ContextSpeccedMusic
-		    element (music 'SequentialMusic
-			      elements ((music 'PropertyUnset
-					  symbol 'tempoText)
-					(music 'PropertySet
-					  symbol 'tempoWholesPerMinute)
-					(music 'PropertySet
-					  value ?unit-duration
-					  symbol 'tempoUnitDuration)
-					(music 'PropertySet
-					  value ?unit-count
-					  symbol 'tempoUnitCount)))))
-			(format #f "\\tempo ~a = ~a"
-				(duration->lily-string ?unit-duration #:force-duration #t)
-				?unit-count))
-	(with-music-match (expr (music 'ContextSpeccedMusic
-			    element (music 'SequentialMusic
-				      elements ((music 'PropertySet
-						  value ?tempo-text
-						 symbol 'tempoText)))))
-			(format #f "\\tempo ~a" (scheme-expr->lily-string ?tempo-text)))))
+(define-extra-display-method SequentialMusic (expr parser)
+  (with-music-match (expr (music 'SequentialMusic
+				 elements ((music 'TempoChangeEvent
+						  text ?text
+						  tempo-unit ?unit
+						  metronome-count ?count)
+					   (music 'ContextSpeccedMusic
+						  element (music 'PropertySet
+								 symbol 'tempoWholesPerMinute)))))
+    (format #f "\\tempo ~{~a~a~}~a = ~a~a"
+	    (if (markup? ?text)
+		(list (markup->lily-string ?text) " ")
+		'())
+	    (duration->lily-string ?unit #:force-duration #t)
+	    (if (pair? ?count)
+		(format #f "~a ~~ ~a" (car ?count) (cdr ?count))
+		?count)
+	    (new-line->lily-string))))
+
+(define-display-method TempoChangeEvent (expr parser)
+  (let ((text (ly:music-property expr 'text)))
+    (format #f "\\tempo ~a~a"
+	    (markup->lily-string text)
+	    (new-line->lily-string))))
 
 ;;; \clef
 (define clef-name-alist #f)
 (define-public (memoize-clef-names clefs)
-  "Initialize `clef-name-alist', if not already set."
+  "Initialize @code{clef-name-alist}, if not already set."
   (if (not clef-name-alist)
       (set! clef-name-alist
             (map (lambda (name+vals)
@@ -949,8 +952,8 @@ Otherwise, return #f."
                  clefs))))
 
 (define-extra-display-method ContextSpeccedMusic (expr parser)
-  "If `expr' is a clef change, return \"\\clef ...\"
-Otherwise, return #f."
+  "If @var{expr} is a clef change, return \"\\clef ...\".
+Otherwise, return @code{#f}."
   (with-music-match (expr (music 'ContextSpeccedMusic
 				 context-type 'Staff
 				 element (music 'SequentialMusic
@@ -968,7 +971,7 @@ Otherwise, return #f."
 							  (music 'ApplyContext
 								 procedure ly:set-middle-C!)))))
     (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
-				 clef-name-alist)))
+				clef-name-alist)))
       (if clef-name
 	  (format #f "\\clef \"~a~{~a~a~}\"~a"
 		  clef-name
@@ -981,41 +984,6 @@ Otherwise, return #f."
 		  (new-line->lily-string))
 	  #f))))
 
-;;; \time
-(define-extra-display-method ContextSpeccedMusic (expr parser)
-  "If `expr' is a time signature set, return \"\\time ...\".
-Otherwise, return #f.  Note: default grouping is not available."
-  (with-music-match
-   (expr (music
-           'ContextSpeccedMusic
-	   element (music
-	            'ContextSpeccedMusic
-		    context-type 'Timing
-		    element (music
-			     'SequentialMusic
-			     elements ?elts))))
-   (and
-    (> (length ?elts) 2)
-    (with-music-match ((cadr ?elts)
-                       (music 'PropertySet
-                              symbol 'beatLength))
-       #t)
-    (with-music-match ((caddr ?elts)
-                       (music 'PropertySet
-                              symbol 'measureLength))
-       #t)
-    (with-music-match ((car ?elts)
-                       (music 'PropertySet
-                              value ?num+den
-                              symbol 'timeSignatureFraction))
-       (if (eq? (length ?elts) 3)
-           (format
-             #f "\\time ~a/~a~a"
-             (car ?num+den) (cdr ?num+den) (new-line->lily-string))
-           (format
-             #f "#(set-time-signature ~a ~a '(<grouping-specifier>))~a"
-             (car ?num+den) (cdr ?num+den)  (new-line->lily-string)))))))
-
 ;;; \bar
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a bar, return \"\\bar ...\".
@@ -1025,33 +993,9 @@ Otherwise, return #f."
 				 element (music 'PropertySet
 						value ?bar-type
 						symbol 'whichBar)))
-     (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
+    (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
 
 ;;; \partial
-(define (duration->moment ly-duration)
-  (let ((log2	 (ly:duration-log ly-duration))
-	(dots	 (ly:duration-dot-count ly-duration))
-	(num+den (ly:duration-factor ly-duration)))
-    (let* ((m (expt 2 (- log2)))
-	   (factor (/ (car num+den) (cdr num+den))))
-      (/ (do ((i 0 (1+ i))
-	      (delta (/ m 2) (/ delta 2)))
-	     ((= i dots) m)
-	   (set! m (+ m delta)))
-	 factor))))
-
-(define moment-duration-alist (map (lambda (duration)
-				     (cons (duration->moment duration)
-					   duration))
-				   (append-map (lambda (log2)
-						 (map (lambda (dots)
-							(ly:make-duration log2 dots 1 1))
-						      (list 0 1 2 3)))
-					       (list 0 1 2 3 4))))
-
-(define (moment->duration moment)
-  (assoc-get (- moment) moment-duration-alist))
-
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a partial measure, return \"\\partial ...\".
 Otherwise, return #f."
@@ -1061,13 +1005,12 @@ Otherwise, return #f."
 				    'ContextSpeccedMusic
 				    context-type 'Timing
 				    element (music
-					     'PropertySet
-					     value ?moment
-					     symbol 'measurePosition))))
-     (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment)
-					  (ly:moment-main-denominator ?moment)))))
-       (and duration (format #f "\\partial ~a" (duration->lily-string duration
-						 #:force-duration #t))))))
+					     'PartialSet
+					     partial-duration ?duration))))
+
+    (and ?duration
+	 (format #f "\\partial ~a"
+		 (duration->lily-string ?duration #:force-duration #t)))))
 
 ;;;
 ;;;