X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=3ecfce5aaf1cdffce6a962576f3454bb8d996011;hb=0c5927ef30c9f9a9ddec37cc2b9e660695d27303;hp=0ee424018b9d6ad0a2f1077608e28ef499df5404;hpb=94408d4a2e538e8812561f29e09116ede58dd042;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 0ee424018b..3ecfce5aaf 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 +;;; Copyright (C) 2005--2011 Nicolas Sceaux ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -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) @@ -156,6 +157,7 @@ 'SlurEvent 'SostenutoEvent 'StringNumberEvent + 'StrokeFingerEvent 'SustainEvent 'TextScriptEvent 'TextSpanEvent @@ -235,6 +237,9 @@ (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 "\\<" "\\!") @@ -282,7 +287,7 @@ (music 'SlurEvent span-direction START)))))) - #t) + #t) (with-music-match (?stop (music 'SequentialMusic elements ((music @@ -324,7 +329,7 @@ grob-property-path '(stroke-style) grob-value "grace" symbol 'Stem))))) - #t) + #t) (with-music-match (?stop (music 'SequentialMusic elements ((music @@ -456,11 +461,11 @@ 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) + ;; 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)) @@ -883,6 +888,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." @@ -900,53 +919,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) @@ -955,8 +956,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 @@ -974,7 +975,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 @@ -987,41 +988,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 'baseMoment)) - #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 '())~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 ...\". @@ -1031,33 +997,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." @@ -1067,13 +1009,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))))) ;;; ;;;