]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/define-music-display-methods.scm
Imported Upstream version 2.14.2
[lilypond.git] / scm / define-music-display-methods.scm
index 9a3a4c10691cfb1bb14ac43910c2fdf562a42895..c0041ba2a98344efe4fdef5fe097a9e0f832e0cb 100644 (file)
@@ -1,7 +1,7 @@
 ;;; define-music-display-methods.scm -- data for displaying music
 ;;; expressions using LilyPond notation.
 ;;;
-;;; (c) 2005--2009 Nicolas Sceaux  <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2011 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)
@@ -81,7 +83,7 @@
     (if (and (car alist) (test item (cdar alist)))
        (set! result (car alist)))))
 
-(define (note-name->lily-string ly-pitch parser)
+(define-public (note-name->lily-string ly-pitch parser)
   ;; here we define a custom pitch= function, since we do not want to
   ;; test whether octaves are also equal. (otherwise, we would be using equal?)
   (define (pitch= pitch1 pitch2)
@@ -92,7 +94,7 @@
        (car result)
        #f)))
 
-(define (octave->lily-string pitch)
+(define-public (octave->lily-string pitch)
   (let ((octave (ly:pitch-octave pitch)))
     (cond ((>= octave 0)
           (make-string (1+ octave) #\'))
 ;;;
 ;;; durations
 ;;;
-(define* (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
+(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*)))
 ;;; post events
 ;;;
 
-(define post-event? (make-music-type-predicate
-                    'StringNumberEvent
-                    'ArticulationEvent
-                    'FingeringEvent
-                    'TextScriptEvent
-                    'MultiMeasureTextEvent
-                    'HyphenEvent
-                    'ExtenderEvent
-                    'BeamEvent
-                    'SlurEvent
-                    'TieEvent
-                    'CrescendoEvent
-                    'DecrescendoEvent
-                    'PhrasingSlurEvent
-                    'TremoloEvent
-                    'SustainEvent
-                    'SostenutoEvent
-                    'TextSpanEvent
-                    'HarmonicEvent
-                    'BeamForbidEvent
-                    'AbsoluteDynamicEvent
-                    'TupletSpanEvent
-                    'TrillSpanEvent
-                    'GlissandoEvent
-                    'ArpeggioEvent
-                    'NoteGroupingEvent
-                    'UnaCordaEvent))
+(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
+    'StrokeFingerEvent
+    'SustainEvent
+    'TextScriptEvent
+    'TextSpanEvent
+    'TieEvent
+    'TremoloEvent
+    'TrillSpanEvent
+    'TupletSpanEvent
+    'UnaCordaEvent))
 
 (define* (event-direction->lily-string event #:optional (required #t))
   (let ((direction (ly:music-property event 'direction)))
 (define-post-event-display-method MultiMeasureTextEvent (event parser) #t
   (markup->lily-string (ly:music-property event 'text)))
 
+(define-post-event-display-method BendAfterEvent (event parser) #t
+  (format #f "\\bendAfter #~a" (ly:music-property event 'delta-step)))
+
 (define-post-event-display-method HarmonicEvent (event parser) #f "\\harmonic")
 (define-post-event-display-method GlissandoEvent (event parser) #t "\\glissando")
 (define-post-event-display-method ArpeggioEvent (event parser) #t "\\arpeggio")
 (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 "\\<" "\\!")
 (define-span-event-display-method DecrescendoEvent (event parser) #f "\\>" "\\!")
+(define-span-event-display-method EpisemaEvent (event parser) #f "\\episemInitium" "\\episemFinis")
 (define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)")
 (define-span-event-display-method SustainEvent (event parser) #f "\\sustainOn" "\\sustainOff")
 (define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff")
                                                         (music
                                                          'SlurEvent
                                                          span-direction START))))))
-                          #t)
+          #t)
          (with-music-match (?stop (music
                                    'SequentialMusic
                                    elements ((music
                                                        grob-property-path '(stroke-style)
                                                        grob-value "grace"
                                                        symbol 'Stem)))))
-                          #t)
+          #t)
         (with-music-match (?stop (music
                                   'SequentialMusic
                                   elements ((music
@@ -449,12 +462,14 @@ Otherwise, return #f."
        (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))))
+                ;; 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)))
+                ;; same for simple_element with \tweak
+                (null? (ly:music-property (car simple-elements) 'tweaks)))
            ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
            (let* ((simple-element (car simple-elements))
                   (duration (ly:music-property simple-element 'duration))
@@ -505,6 +520,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...
 ;;;
@@ -556,6 +574,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)
@@ -756,7 +777,7 @@ Otherwise, return #f."
                                         (*indent*)
                                         (first op)
                                         (second op)))
-                              (reverse operations)))
+                              operations))
                        (*indent*)))
            (parameterize ((*current-context* ctype))
              (music->lily-string music parser)))))
@@ -870,6 +891,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."
@@ -887,53 +922,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)
@@ -942,8 +959,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
@@ -960,11 +977,11 @@ Otherwise, return #f."
                                                                 symbol 'clefOctavation)
                                                          (music 'ApplyContext
                                                                 procedure ly:set-middle-C!)))))
-    (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
-                                clef-name-alist)))
-      (if clef-prop+name
+    (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
+                               clef-name-alist)))
+      (if clef-name
          (format #f "\\clef \"~a~{~a~a~}\"~a"
-                 (cdr clef-prop+name)
+                 clef-name
                  (cond ((= 0 ?clef-octavation)
                         (list "" ""))
                        ((> ?clef-octavation 0)
@@ -974,36 +991,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."
-  (with-music-match (expr (music
-                          'ContextSpeccedMusic
-                          element (music
-                                   'ContextSpeccedMusic
-                                   context-type 'Timing
-                                   element (music
-                                            'SequentialMusic
-                                            elements ((music
-                                                       'PropertySet
-                                                       value ?num+den
-                                                       symbol 'timeSignatureFraction)
-                                                      (music
-                                                       'PropertySet
-                                                       symbol 'beatLength)
-                                                      (music
-                                                       'PropertySet
-                                                       symbol 'measureLength)
-                                                      (music
-                                                       'PropertySet
-                                                       value ?grouping
-                                                       symbol 'beatGrouping))))))
-    (if (null? ?grouping)
-       (format #f "\\time ~a/~a~a" (car ?num+den) (cdr ?num+den) (new-line->lily-string))
-       (format #f "#(set-time-signature ~a ~a '~s)~a"
-               (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string)))))
-
 ;;; \bar
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a bar, return \"\\bar ...\".
@@ -1013,34 +1000,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)
-  (let ((result (assoc (- moment) moment-duration-alist =)))
-    (and result
-        (cdr result))))
-
 (define-extra-display-method ContextSpeccedMusic (expr parser)
   "If `expr' is a partial measure, return \"\\partial ...\".
 Otherwise, return #f."
@@ -1050,13 +1012,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)))))
 
 ;;;
 ;;;
@@ -1191,4 +1152,6 @@ Otherwise, return #f."
                  (music->lily-string ?lyric-sequence parser)))
        #f)))
 
-
+;; Silence internal event sent at end of each lyrics block
+(define-display-method CompletizeExtenderEvent (expr parser)
+  "")