;;; define-music-display-methods.scm -- data for displaying music
;;; expressions using LilyPond notation.
;;;
-;;; Copyright (C) 2005--2011 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; Copyright (C) 2005--2012 Nicolas Sceaux <nicolas.sceaux@free.fr>
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(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))
(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*))))
(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))
;;;
(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))
(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))))
(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?
"")))
(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))
(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")
;;; Repeats
;;;
+(define-display-method AlternativeEvent (alternative parser) "")
+
(define (repeat->lily-string expr repeat-type parser)
(format #f "\\repeat ~a ~a ~a ~a"
repeat-type
(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)))
(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)
""
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
"\\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)
- (if (number-pair? ?unit-count)
- (format #f "~a ~~ ~a"
- (car ?unit-count)
- (cdr ?unit-count))
- ?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)
- (if (number-pair? ?unit-count)
- (format #f "~a ~~ ~a"
- (car ?unit-count)
- (cdr ?unit-count))
- ?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)
(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
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."
'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)))))
;;;
;;;