]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/define-music-display-methods.scm
Merge branch 'master' into lilypond/translation
[lilypond.git] / scm / define-music-display-methods.scm
index 3b896a245017f6aa463fcb8d412b0dcd495aa617..db21afda90aacfb9aa62b0f45e169582c9762213 100644 (file)
@@ -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--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))
@@ -37,7 +38,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)
 (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)))
 ;;; 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)))
 (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 "\\<" "\\!")
     (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))))))
 
 
     (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)))))
-                          #t)
+                                                       symbol 'Flag)))))
+          #t)
         (with-music-match (?stop (music
                                   'SequentialMusic
                                   elements ((music
                                              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)
                                  (*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 "
                "")
                       "\\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?
                       ""))
                                          (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*))))
@@ -448,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 a HarmonicEvent in its
-                ;; 'articulations list, it should be interpreted instead as a
-                ;; note_chord_element, since \harmonic only works inside chords,
-                ;; even for single notes, e.g., < c\harmonic >
-                (null? (filter (make-music-type-predicate 'HarmonicEvent)
-                               (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))
@@ -520,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))
@@ -540,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))))
@@ -548,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?
         "")))
 
@@ -558,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))
@@ -636,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")
@@ -689,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
@@ -848,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)))
 
@@ -871,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)
                ""
@@ -893,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
@@ -914,53 +882,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)
@@ -969,8 +919,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
@@ -988,7 +938,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
@@ -1010,10 +960,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-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a partial measure, return \"\\partial ...\".
 Otherwise, return #f."
@@ -1026,9 +975,9 @@ Otherwise, return #f."
                                             'PartialSet
                                             partial-duration ?duration))))
 
-                   (and ?duration
-                        (format #f "\\partial ~a"
-                                (duration->lily-string ?duration #:force-duration #t)))))
+    (and ?duration
+        (format #f "\\partial ~a"
+                (duration->lily-string ?duration #:force-duration #t)))))
 
 ;;;
 ;;;