X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=5c7ec677de70850bc7f33e1e18a8dcf4d4edec41;hb=6a1a605d8235d799c5f19f334c9341e19e2d587c;hp=3254a90469b53788ab81f6ed0ca2b60fab9765d6;hpb=a6bd229f7fe1dc4a03478e14ccc0c0c66b225061;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 3254a90469..5c7ec677de 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--2012 Nicolas Sceaux ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -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) @@ -106,7 +108,9 @@ (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))) @@ -134,34 +138,8 @@ ;;; post events ;;; -(define post-event? - (make-music-type-predicate - 'AbsoluteDynamicEvent - 'ArpeggioEvent - 'ArticulationEvent - 'BeamEvent - 'BeamForbidEvent - 'CrescendoEvent - 'DecrescendoEvent - '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))) @@ -224,16 +202,23 @@ (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") @@ -269,24 +254,22 @@ (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)))))) @@ -304,21 +287,20 @@ (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 @@ -326,15 +308,15 @@ 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) @@ -363,12 +345,16 @@ (*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 " "") @@ -383,15 +369,17 @@ "\\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? "")) @@ -403,7 +391,7 @@ (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*)))) @@ -431,87 +419,67 @@ Otherwise, return #f." ;;; (define-display-method EventChord (chord parser) - ;; event_chord : simple_element post_events - ;; | command_element + ;; event_chord : command_element ;; | note_chord_element ;; TODO : tagged post_events ;; post_events : ( post_event | tagged_post_event )* ;; tagged_post_event: '-' \tag embedded_scm post_event - (let* ((elements (ly:music-property chord 'elements)) - (simple-elements (filter (make-music-type-predicate - 'NoteEvent 'ClusterNoteEvent 'RestEvent - 'MultiMeasureRestEvent '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) - ;; command_element - (format #f "~{~a ~}" (map-in-order (lambda (music) - (music->lily-string music parser)) - elements)))))))) - -(define-display-method MultiMeasureRestMusic (mmrest parser) - (let* ((dur (ly:music-property mmrest 'duration)) - (ly (format #f "R~a~{~a ~}" - (duration->lily-string dur) + (let* ((elements (append (ly:music-property chord 'elements) + (ly:music-property chord 'articulations))) + (chord-elements (filter (lambda (m) + (music-is-of-type? m 'rhythmic-event)) + elements)) + (post-events (filter post-event? elements)) + (chord-repeat (ly:music-property chord 'duration))) + (cond ((ly:duration? chord-repeat) + (let ((duration (duration->lily-string chord-repeat #:remember #t))) + (format #f "q~a~{~a~^ ~}" + duration + (map-in-order (lambda (music) + (music->lily-string music parser)) + post-events)))) + ((pair? chord-elements) + ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events + (let ((duration (duration->lily-string (ly:music-property + (car chord-elements) + 'duration) #:remember #t))) + ;; 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) + duration (map-in-order (lambda (music) (music->lily-string music parser)) - (ly:music-property mmrest 'articulations))))) - (*previous-duration* dur) - ly)) + post-events)))) + (else + ;; command_element + (format #f "~{~a~^ ~}" (map-in-order (lambda (music) + (music->lily-string music parser)) + elements)))))) + +(define-display-method MultiMeasureRestMusic (mmrest parser) + (format #f "R~a~{~a~^ ~}" + (duration->lily-string (ly:music-property mmrest 'duration) + #:remember #t) + (map-in-order (lambda (music) + (music->lily-string music parser)) + (ly:music-property mmrest 'articulations)))) (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... ;;; (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)) @@ -531,6 +499,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)))) @@ -539,7 +511,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? ""))) @@ -549,13 +523,19 @@ 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)) (define-display-method MarkEvent (mark parser) (let ((label (ly:music-property mark 'label))) @@ -624,18 +604,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") @@ -677,6 +660,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 @@ -757,7 +742,7 @@ Otherwise, return #f." (*indent*) (first op) (second op))) - (reverse operations))) + operations)) (*indent*))) (parameterize ((*current-context* ctype)) (music->lily-string music parser))))) @@ -836,10 +821,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))) @@ -859,8 +842,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) "" @@ -871,6 +855,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 + "\\time #'~a ~a/~a~a" + structure num den + (new-line->lily-string))))) + ;;; \melisma and \melismaEnd (define-extra-display-method ContextSpeccedMusic (expr parser) "If expr is a melisma, return \"\\melisma\", otherwise, return #f." @@ -888,53 +886,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) @@ -943,8 +923,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 @@ -962,7 +942,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 @@ -975,41 +955,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 '())~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 ...\". @@ -1019,33 +964,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." @@ -1055,13 +976,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))))) ;;; ;;; @@ -1196,4 +1116,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) + "")