]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/define-music-display-methods.scm
Issue 4296: Let \displayLilyMusic print even repeated durations
[lilypond.git] / scm / define-music-display-methods.scm
index 6d9dc8250603c6d8bc8e480e9728c0f95c3bb017..ca532c5029a3bd669f901468263f8066559e4966 100644 (file)
@@ -1,7 +1,7 @@
 ;;; define-music-display-methods.scm -- data for displaying music
 ;;; expressions using LilyPond notation.
 ;;;
-;;; Copyright (C) 2005--2012 Nicolas Sceaux  <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2015 Nicolas Sceaux  <nicolas.sceaux@free.fr>
 ;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -105,15 +105,13 @@ expression."
 ;;;
 ;;; durations
 ;;;
-(define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
-                                       (force-duration (*force-duration*))
-                                       (time-scale (*time-scale*))
-                                       remember)
-  (if remember (*previous-duration* ly-duration))
+(define*-public (duration->lily-string ly-duration #:key
+                                       (force-duration #f)
+                                       (time-scale (*time-scale*)))
   (let ((log2    (ly:duration-log ly-duration))
         (dots    (ly:duration-dot-count ly-duration))
         (scale (ly:duration-scale ly-duration)))
-    (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
+    (if (or force-duration (not (*omit-duration*)))
         (string-append (case log2
                          ((-1) "\\breve")
                          ((-2) "\\longa")
@@ -167,10 +165,8 @@ expression."
 
 
 (define-display-method TremoloEvent (event parser)
-  (let ((tremolo-type (ly:music-property event 'tremolo-type)))
-    (format #f ":~a" (if (= 0 tremolo-type)
-                         ""
-                         tremolo-type))))
+  (let ((tremolo-type (ly:music-property event 'tremolo-type 8)))
+    (format #f ":~a" tremolo-type)))
 
 (define-display-method ArticulationEvent (event parser) #t
   (let* ((articulation  (ly:music-property event 'articulation-type))
@@ -179,7 +175,7 @@ expression."
             ((marcato) "^")
             ((stopped) "+")
             ((tenuto)    "-")
-            ((staccatissimo) "|")
+            ((staccatissimo) "!")
             ((accent) ">")
             ((staccato) ".")
             ((portato) "_")
@@ -431,14 +427,15 @@ Otherwise, return #f."
                ;; '<' (notepitch | drumpitch)* '>" duration post_events
                (let ((duration (duration->lily-string (ly:music-property
                                                        (car chord-elements)
-                                                       'duration)
-                                                      #:remember #t)))
+                                                       'duration))))
                  ;; Format duration first so that it does not appear on
                  ;; chord elements
                  (format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}"
-                         (map-in-order (lambda (music)
-                                         (music->lily-string music parser))
-                                       chord-elements)
+                         (parameterize ((*omit-duration* #t))
+                                       (map-in-order
+                                        (lambda (music)
+                                          (music->lily-string music parser))
+                                        chord-elements))
                          duration
                          (map-in-order (lambda (music)
                                          (list
@@ -446,8 +443,7 @@ Otherwise, return #f."
                                           (music->lily-string music parser)))
                                        other-elements))))
               ((ly:duration? chord-repeat)
-               (let ((duration (duration->lily-string chord-repeat
-                                                      #:remember #t)))
+               (let ((duration (duration->lily-string chord-repeat)))
                  (format #f "q~a~:{~:[-~;~]~a~^ ~}"
                          duration
                          (map-in-order (lambda (music)
@@ -469,8 +465,7 @@ Otherwise, return #f."
 
 (define-display-method MultiMeasureRestMusic (mmrest parser)
   (format #f "R~a~{~a~^ ~}"
-          (duration->lily-string (ly:music-property mmrest 'duration)
-                                 #:remember #t)
+          (duration->lily-string (ly:music-property mmrest 'duration))
           (map-in-order (lambda (music)
                           (music->lily-string music parser))
                         (ly:music-property mmrest 'articulations))))
@@ -506,8 +501,7 @@ Otherwise, return #f."
                                         (make-string (1- (* -1 octave-check)) #\,))
                                        (else "")))
                 ""))
-          (duration->lily-string (ly:music-property event 'duration)
-                                 #:remember #t)
+          (duration->lily-string (ly:music-property event 'duration))
           (if ((make-music-type-predicate 'RestEvent) event)
               "\\rest" "")
           (map-in-order (lambda (event)
@@ -521,13 +515,18 @@ Otherwise, return #f."
          (simple-note->lily-string note parser))
         ((not (null? (ly:music-property note 'drum-type))) ;; drum
          (format #f "~a~a~{~a~}" (ly:music-property note 'drum-type)
-                 (duration->lily-string (ly:music-property note 'duration)
-                                        #:remember #t)
+                 (duration->lily-string (ly:music-property note 'duration))
                  (map-in-order (lambda (event)
                                  (music->lily-string event parser))
                                (ly:music-property note 'articulations))))
-        (else ;; unknown?
-         "")))
+        (else
+         ;; pure duration
+         (format #f "~a~{~a~}"
+                 (duration->lily-string (ly:music-property note 'duration)
+                                        #:force-duration #t)
+                 (map-in-order (lambda (event)
+                                 (music->lily-string event parser))
+                               (ly:music-property note 'articulations))))))
 
 (define-display-method ClusterNoteEvent (note parser)
   (simple-note->lily-string note parser))
@@ -536,20 +535,17 @@ Otherwise, return #f."
   (if (not (null? (ly:music-property rest 'pitch)))
       (simple-note->lily-string rest parser)
       (format #f "r~a~{~a~}"
-              (duration->lily-string (ly:music-property rest 'duration)
-                                     #:remember #t)
+              (duration->lily-string (ly:music-property rest 'duration))
               (map-in-order (lambda (event)
                               (music->lily-string event parser))
                             (ly:music-property rest 'articulations)))))
 
 (define-display-method MultiMeasureRestEvent (rest parser)
-  (string-append "R" (duration->lily-string (ly:music-property rest 'duration)
-                                            #:remember #t)))
+  (string-append "R" (duration->lily-string (ly:music-property rest 'duration))))
 
 (define-display-method SkipEvent (rest parser)
   (format #f "s~a~{~a~}"
-          (duration->lily-string (ly:music-property rest 'duration)
-                                 #:remember #t)
+          (duration->lily-string (ly:music-property rest 'duration))
           (map-in-order (lambda (event)
                           (music->lily-string event parser))
                         (ly:music-property rest 'articulations))))
@@ -624,7 +620,7 @@ Otherwise, return #f."
             (if (null? bracket-stop) "" "]"))))
 
 (define-display-method LyricEvent (lyric parser)
-  (format "~a~{~a~^ ~}"
+  (format #f "~a~{~a~^ ~}"
           (let ((text (ly:music-property lyric 'text)))
             (if (or (string? text)
                     (eqv? (first text) simple-markup))
@@ -667,7 +663,6 @@ Otherwise, return #f."
           (and span (duration->lily-string span #:force-duration #t)))
          (scale (/ num den))
          (time-scale (*time-scale*)))
-    (*previous-duration* #f)
     (let ((result
            (parameterize ((*force-line-break* #f)
                           (*time-scale* (* time-scale scale)))
@@ -676,7 +671,6 @@ Otherwise, return #f."
                                  num
                                  formatted-span
                                  (music->lily-string (ly:music-property times 'element) parser)))))
-      (*previous-duration* #f)
       result)))
 
 (define-display-method RelativeOctaveMusic (m parser)
@@ -715,29 +709,7 @@ Otherwise, return #f."
   (repeat->lily-string expr "percent" parser))
 
 (define-display-method TremoloRepeatedMusic (expr parser)
-  (let* ((main (ly:music-property expr 'element))
-         (children (if (music-is-of-type? main 'sequential-music)
-                       ;; \repeat tremolo n { ... }
-                       (length (extract-named-music main '(EventChord
-                                                           NoteEvent)))
-                       ;; \repeat tremolo n c4
-                       1))
-         (times (ly:music-property expr 'repeat-count))
-
-         ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
-         (dots (1- (logcount (* times children))))
-         ;; The remaining missing multiplicator to scale the notes by
-         ;; times * children
-         (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
-         (shift (- (ly:intlog2 (floor mult)))))
-    (set! main (ly:music-deep-copy main))
-    ;; Adjust the time of the notes
-    (ly:music-compress main (ly:make-moment children 1))
-    ;; Adjust the displayed note durations
-    (shift-duration-log main (- shift) (- dots))
-    (format #f "\\repeat tremolo ~a ~a"
-            times
-            (music->lily-string main parser))))
+  (repeat->lily-string expr "tremolo" parser))
 
 ;;;
 ;;; Contexts
@@ -808,13 +780,19 @@ Otherwise, return #f."
                       (music->lily-string element parser))
         #f)))
 
-(define (property-value->lily-string arg parser)
+(define-public (value->lily-string arg parser)
   (cond ((ly:music? arg)
          (music->lily-string arg parser))
         ((string? arg)
          (format #f "#~s" arg))
         ((markup? arg)
          (markup->lily-string arg))
+        ((ly:duration? arg)
+         (format #f "##{ ~a #}" (duration->lily-string arg #:force-duration #t)))
+        ((ly:pitch? arg)
+         (format #f "~a~a"
+                 (note-name->lily-string arg parser)
+                 (octave->lily-string arg)))
         (else
          (format #f "#~a" (scheme-expr->lily-string arg)))))
 
@@ -830,7 +808,7 @@ Otherwise, return #f."
                 ""
                 (format #f "~a . " (*current-context*)))
             property
-            (property-value->lily-string value parser)
+            (value->lily-string value parser)
             (new-line->lily-string))))
 
 (define-display-method PropertyUnset (expr parser)
@@ -858,7 +836,7 @@ Otherwise, return #f."
             (if (eqv? (*current-context*) 'Bottom)
                 (cons symbol properties)
                 (cons* (*current-context*) symbol properties))
-            (property-value->lily-string value parser)
+            (value->lily-string value parser)
             (new-line->lily-string))))
 
 (define-display-method RevertProperty (expr parser)
@@ -917,7 +895,7 @@ Otherwise, return #f."
                                 '())
                             (duration->lily-string ?unit #:force-duration #t)
                             (if (pair? ?count)
-                                (format #f "~a ~~ ~a" (car ?count) (cdr ?count))
+                                (format #f "~a - ~a" (car ?count) (cdr ?count))
                                 ?count)
                             (new-line->lily-string))))
 
@@ -955,21 +933,26 @@ Otherwise, return @code{#f}."
                                                           (music 'PropertySet
                                                                  value ?clef-transposition
                                                                  symbol 'clefTransposition)
+                                                          (music 'PropertySet
+                                                                 value ?clef-transposition-style
+                                                                 symbol 'clefTranspositionStyle)
                                                           (music 'ApplyContext
                                                                  procedure ly:set-middle-C!)))))
                     (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
                                                 clef-name-alist)))
-                      (if clef-name
-                          (format #f "\\clef \"~a~{~a~a~}\"~a"
-                                  clef-name
-                                  (cond ((= 0 ?clef-transposition)
-                                         (list "" ""))
-                                        ((> ?clef-transposition 0)
-                                         (list "^" (1+ ?clef-transposition)))
-                                        (else
-                                         (list "_" (- 1 ?clef-transposition))))
-                                  (new-line->lily-string))
-                          #f))))
+                      (and clef-name
+                           (format #f "\\clef \"~a~?\"~a"
+                                   clef-name
+                                   (case ?clef-transposition-style
+                                     ((parenthesized) "~a(~a)")
+                                     ((bracketed) "~a[~a]")
+                                     (else "~a~a"))
+                                   (cond ((zero? ?clef-transposition)
+                                          (list "" ""))
+                                         ((positive? ?clef-transposition)
+                                          (list "^" (1+ ?clef-transposition)))
+                                         (else (list "_" (- 1 ?clef-transposition))))
+                                   (new-line->lily-string))))))
 
 ;;; \bar
 (define-extra-display-method ContextSpeccedMusic (expr parser)
@@ -993,7 +976,7 @@ Otherwise, return #f."
                                     context-type 'Timing
                                     element (music
                                              'PartialSet
-                                             partial-duration ?duration))))
+                                             duration ?duration))))
 
                     (and ?duration
                          (format #f "\\partial ~a"
@@ -1054,7 +1037,7 @@ Otherwise, return #f."
                                quoted-voice-direction ?quoted-voice-direction
                                quoted-music-name ?quoted-music-name
                                quoted-context-id "cue"
-                               quoted-context-type 'Voice
+                               quoted-context-type 'CueVoice
                                element ?music))
                         (format #f "\\cueDuring #~s #~a ~a"
                                 ?quoted-music-name
@@ -1108,7 +1091,8 @@ Otherwise, return #f."
 (define-display-method LyricCombineMusic (expr parser)
   (format #f "\\lyricsto ~s ~a"
           (ly:music-property expr 'associated-context)
-          (parameterize ((*explicit-mode* #f))
+          (parameterize ((*explicit-mode* #f)
+                         (*omit-duration* #t))
                         (music->lily-string (ly:music-property expr 'element) parser))))
 
 ;; \addlyrics
@@ -1128,7 +1112,8 @@ Otherwise, return #f."
                         (format #f "~a~a \\addlyrics ~a"
                                 (music->lily-string ?note-sequence parser)
                                 (new-line->lily-string)
-                                (parameterize ((*explicit-mode* #f))
+                                (parameterize ((*explicit-mode* #f)
+                                               (*omit-duration* #t))
                                               (music->lily-string ?lyric-sequence parser)))
                         #f)))