;;; define-music-display-methods.scm -- data for displaying music
;;; expressions using LilyPond notation.
;;;
-;;; (c) 2005--2006 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 (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)
(args (cdr expr)))
(if (eqv? cmd simple-markup) ;; a simple markup
(format #f "~s" (car args))
- (format #f "\\~a~{ ~a~}"
+ (format #f "\\~a~{ ~a~}"
(proc->command cmd)
(map-in-order arg->string args))))))
(cond ((string? markup-expr)
(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)
(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*)))
+ (time-scale (*time-scale*))
+ 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)))
+ (scale (ly:duration-scale ly-duration)))
(if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
(string-append (case log2
((-1) "\\breve")
((-3) "\\maxima")
(else (number->string (expt 2 log2))))
(make-string dots #\.)
- (let ((num? (not (or (= 1 (car num+den))
- (and time-factor-numerator
- (= (car num+den) time-factor-numerator)))))
- (den? (not (or (= 1 (cdr num+den))
- (and time-factor-denominator
- (= (cdr num+den) time-factor-denominator))))))
- (cond (den?
- (format #f "*~a/~a" (car num+den) (cdr num+den)))
- (num?
- (format #f "*~a" (car num+den)))
- (else ""))))
+ (let ((end-scale (/ scale time-scale)))
+ (if (= end-scale 1) ""
+ (format #f "*~a" end-scale))))
"")))
;;;
;;; 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? m)
+ (music-is-of-type? m 'post-event))
(define* (event-direction->lily-string event #:optional (required #t))
(let ((direction (ly:music-property event 'direction)))
""
tremolo-type))))
-(define-post-event-display-method ArticulationEvent (event parser) #t
- (let ((articulation (ly:music-property event 'articulation-type)))
- (case (string->symbol articulation)
- ((marcato) "^")
- ((stopped) "+")
- ((tenuto) "-")
- ((staccatissimo) "|")
- ((accent) ">")
- ((staccato) ".")
- ((portato) "_")
- (else (format #f "\\~a" articulation)))))
+(define-display-method ArticulationEvent (event parser) #t
+ (let* ((articulation (ly:music-property event 'articulation-type))
+ (shorthand
+ (case (string->symbol articulation)
+ ((marcato) "^")
+ ((stopped) "+")
+ ((tenuto) "-")
+ ((staccatissimo) "|")
+ ((accent) ">")
+ ((staccato) ".")
+ ((portato) "_")
+ (else #f))))
+ (format #f "~a~:[\\~;~]~a"
+ (event-direction->lily-string event shorthand)
+ shorthand
+ (or shorthand articulation))))
(define-post-event-display-method FingeringEvent (event parser) #t
(ly:music-property event 'digit))
(define-post-event-display-method MultiMeasureTextEvent (event parser) #t
(markup->lily-string (ly:music-property event 'text)))
-(define-post-event-display-method HarmonicEvent (event parser) #t "\\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 BendAfterEvent (event parser) #f
+ (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) #f "\\glissando")
+(define-post-event-display-method ArpeggioEvent (event parser) #f "\\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) #f
+ (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 "\\sustainDown" "\\sustainUp")
-(define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoDown" "\\sostenutoUp")
+(define-span-event-display-method SustainEvent (event parser) #f "\\sustainOn" "\\sustainOff")
+(define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff")
(define-span-event-display-method TextSpanEvent (event parser) #f "\\startTextSpan" "\\stopTextSpan")
(define-span-event-display-method TrillSpanEvent (event parser) #f "\\startTrillSpan" "\\stopTrillSpan")
(define-span-event-display-method StaffSpanEvent (event parser) #f "\\startStaff" "\\stopStaff")
;;;
(define-display-method GraceMusic (expr parser)
- (format #f "\\grace ~a"
+ (format #f "\\grace ~a"
(music->lily-string (ly:music-property expr 'element) parser)))
;; \acciaccatura \appoggiatura \grace
?stop))))
;; we check whether ?start and ?stop look like
;; startAppoggiaturaMusic stopAppoggiaturaMusic
- (and (with-music-match (?start (music
+ (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))))))
+ elements
+ ((music
+ 'SlurEvent
+ span-direction START))))))
+ #t)
+ (with-music-match (?stop (music
+ 'SequentialMusic
+ elements ((music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction STOP))))))
(format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
?stop))))
;; we check whether ?start and ?stop look like
;; startAcciaccaturaMusic stopAcciaccaturaMusic
- (and (with-music-match (?start (music
+ (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)))
+ elements
+ ((music
+ 'SlurEvent
+ span-direction START)))
(music
'ContextSpeccedMusic
element (music
'OverrideProperty
grob-property-path '(stroke-style)
grob-value "grace"
- symbol 'Stem)))))
- #t)
- (with-music-match (?stop (music
+ symbol 'Flag)))))
+ #t)
+ (with-music-match (?stop (music
'SequentialMusic
elements ((music
'ContextSpeccedMusic
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))))))
+ elements
+ ((music
+ 'SlurEvent
+ span-direction STOP))))))
(format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
(define-extra-display-method GraceMusic (expr parser)
(define-display-method SequentialMusic (seq parser)
(let ((force-line-break (and (*force-line-break*)
- ;; hm
+ ;; hm
(> (length (ly:music-property seq 'elements))
(*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*))))
(format #f "\\afterGrace ~a ~a"
(music->lily-string ?before-grace parser)
(music->lily-string ?grace parser))))
-
+
;;;
;;; Chords
;;;
(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)))
- ;; 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))))))))
+ (let* ((elements (append (ly:music-property chord 'elements)
+ (ly:music-property chord 'articulations)))
+ (chord-repeat (ly:music-property chord 'duration)))
+ (call-with-values
+ (lambda ()
+ (partition (lambda (m) (music-is-of-type? m 'rhythmic-event))
+ elements))
+ (lambda (chord-elements other-elements)
+ (cond ((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)
+ (list
+ (post-event? music)
+ (music->lily-string music parser)))
+ other-elements))))
+ ((ly:duration? chord-repeat)
+ (let ((duration (duration->lily-string chord-repeat
+ #:remember #t)))
+ (format #f "q~a~:{~:[-~;~]~a~^ ~}"
+ duration
+ (map-in-order (lambda (music)
+ (list
+ (post-event? music)
+ (music->lily-string music parser)))
+ other-elements))))
+
+ ((and (= 1 (length other-elements))
+ (not (post-event? (car other-elements))))
+ (format #f (music->lily-string (car other-elements) parser)))
+ (else
+ (format #f "< >~:{~:[-~;~]~a~^ ~}"
+ (map-in-order (lambda (music)
+ (list
+ (post-event? music)
+ (music->lily-string music parser)))
+ other-elements))))))))
(define-display-method MultiMeasureRestMusic (mmrest parser)
- (let* ((dur (ly:music-property mmrest 'duration))
- (ly (format #f "R~a~{~a ~}"
- (duration->lily-string dur)
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- (ly:music-property mmrest 'articulations)))))
- (*previous-duration* dur)
- ly))
+ (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))
(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))
+ (list
+ (post-event? event)
+ (music->lily-string event parser)))
(ly:music-property event 'articulations))))
(define-display-method NoteEvent (note parser)
(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~{~a~}" (ly:music-property note 'drum-type)
+ (duration->lily-string (ly:music-property note 'duration)
+ #:remember #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property note 'articulations))))
(else ;; unknown?
"")))
(define-display-method RestEvent (rest parser)
(if (not (null? (ly:music-property rest 'pitch)))
(simple-note->lily-string rest parser)
- "r"))
+ (format #f "r~a~{~a~}"
+ (duration->lily-string (ly:music-property rest 'duration)
+ #:remember #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property rest 'articulations)))))
(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")
+ (format #f "s~a~{~a~}"
+ (duration->lily-string (ly:music-property rest 'duration)
+ #:remember #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property rest 'articulations))))
+
+(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 (or (null? pitch-alist)
(null? tonic))
"\\key \\default"
- (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
+ (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
(ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
(format #f "\\key ~a \\~a~a"
(note-name->lily-string (ly:music-property key 'tonic) parser)
(define-display-method RelativeOctaveCheck (octave parser)
(let ((pitch (ly:music-property octave 'pitch)))
- (format #f "\\octave ~a~a"
+ (format #f "\\octaveCheck ~a~a"
(note-name->lily-string pitch parser)
(octave->lily-string pitch))))
(else fig))
(if (null? alteration)
""
- (cond
+ (cond
((= alteration DOUBLE-FLAT) "--")
((= alteration FLAT) "-")
((= alteration NATURAL) "!")
(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")
(define-display-method TimeScaledMusic (times parser)
(let* ((num (ly:music-property times 'numerator))
(den (ly:music-property times 'denominator))
- (nd-gcd (gcd num den)))
+ (scale (/ num den))
+ (dur (*previous-duration*))
+ (time-scale (*time-scale*)))
+
(parameterize ((*force-line-break* #f)
- (*time-factor-numerator* (/ num nd-gcd))
- (*time-factor-denominator* (/ den nd-gcd)))
- (format #f "\\times ~a/~a ~a"
+ (*previous-duration*
+ (ly:make-duration (ly:duration-log dur)
+ (ly:duration-dot-count dur)
+ (* (ly:duration-scale dur)
+ scale)))
+ (*time-scale* (* time-scale scale)))
+ (format #f "\\times ~a/~a ~a"
num
den
(music->lily-string (ly:music-property times 'element) parser)))))
;;; Repeats
;;;
+(define-display-method AlternativeEvent (alternative parser) "")
+
(define (repeat->lily-string expr repeat-type parser)
- (format #f "\\repeat ~a ~a ~a ~a"
- repeat-type
- (ly:music-property expr 'repeat-count)
- (music->lily-string (ly:music-property expr 'element) parser)
- (let ((alternatives (ly:music-property expr 'elements)))
- (if (null? alternatives)
- ""
- (format #f "\\alternative { ~{~a ~}}"
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- alternatives))))))
+ (let* ((main (music->lily-string (ly:music-property expr 'element) parser)))
+ (format #f "\\repeat ~a ~a ~a ~a"
+ repeat-type
+ (ly:music-property expr 'repeat-count)
+ main
+ (let ((alternatives (ly:music-property expr 'elements)))
+ (if (null? alternatives)
+ ""
+ (format #f "\\alternative { ~{~a ~}}"
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ alternatives)))))))
(define-display-method VoltaRepeatedMusic (expr parser)
(repeat->lily-string expr "volta" parser))
(repeat->lily-string expr "percent" parser))
(define-display-method TremoloRepeatedMusic (expr parser)
- (let* ((count (ly:music-property expr 'repeat-count))
- (dots (if (= 0 (modulo count 3)) 0 1))
- (shift (- (log2 (if (= 0 dots)
- (/ (* count 2) 3)
- count))))
- (element (ly:music-property expr 'element))
- (den-mult 1))
- (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
- (begin
- (set! shift (1- shift))
- (set! den-mult (length (ly:music-property element 'elements)))))
- (music-map (lambda (m)
- (let ((duration (ly:music-property m 'duration)))
- (if (ly:duration? duration)
- (let* ((dlog (ly:duration-log duration))
- (ddots (ly:duration-dot-count duration))
- (dfactor (ly:duration-factor duration))
- (dnum (car dfactor))
- (dden (cdr dfactor)))
- (set! (ly:music-property m 'duration)
- (ly:make-duration (- dlog shift)
- ddots ;;(- ddots dots) ; ????
- dnum
- (/ dden den-mult))))))
- m)
- element)
+ (let* ((main (ly:music-property expr 'element))
+ (children (if (music-is-of-type? main 'sequential-music)
+ ;; \repeat tremolo n { ... }
+ (length (extract-named-music main '(EventChord
+ NoteEvent)))
+ ;; \repeat tremolo n c4
+ 1))
+ (times (ly:music-property expr 'repeat-count))
+
+ ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+ (dots (1- (logcount (* times children))))
+ ;; The remaining missing multiplicator to scale the notes by
+ ;; times * children
+ (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
+ (shift (- (ly:intlog2 (floor mult)))))
+ (set! main (ly:music-deep-copy main))
+ ;; Adjust the time of the notes
+ (ly:music-compress main (ly:make-moment children 1))
+ ;; Adjust the displayed note durations
+ (shift-duration-log main (- shift) (- dots))
(format #f "\\repeat tremolo ~a ~a"
- count
- (music->lily-string element parser))))
+ times
+ (music->lily-string main parser))))
;;;
;;; Contexts
-;;;
+;;;
(define-display-method ContextSpeccedMusic (expr parser)
(let ((id (ly:music-property expr 'context-id))
""
(format #f " = ~s" id))
(if (null? operations)
- ""
- (format #f " \\with {~{~a~}~%~v_}"
+ ""
+ (format #f " \\with {~{~a~}~%~v_}"
(parameterize ((*indent* (+ (*indent*) 2)))
(map (lambda (op)
(format #f "~%~v_\\~a ~s"
(*indent*)
(first op)
(second op)))
- (reverse operations)))
+ operations))
(*indent*)))
(parameterize ((*current-context* ctype))
(music->lily-string music parser)))))
(if (and (not (null? once)))
"\\once "
"")
- (if (eqv? (*current-context*) 'Bottom)
- ""
+ (if (eqv? (*current-context*) 'Bottom)
+ ""
(format #f "~a . " (*current-context*)))
property
(property-value->lily-string value parser)
(define-display-method PropertyUnset (expr parser)
(format #f "\\unset ~a~a~a"
- (if (eqv? (*current-context*) 'Bottom)
- ""
+ (if (eqv? (*current-context*) 'Bottom)
+ ""
(format #f "~a . " (*current-context*)))
(ly:music-property expr 'symbol)
(new-line->lily-string)))
(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)))
(not once))
""
"\\once ")
- (if (eqv? (*current-context*) 'Bottom)
- ""
+ (if (eqv? (*current-context*) 'Bottom)
+ ""
(format #f "~a . " (*current-context*)))
symbol
(if (null? (cdr properties))
properties)
(property-value->lily-string value parser)
(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)
- ""
+ (if (eqv? (*current-context*) 'Bottom)
+ ""
(format #f "~a . " (*current-context*)))
symbol
(if (null? (cdr properties))
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."
"\\melismaEnd"))
;;; \tempo
-(define-extra-display-method ContextSpeccedMusic (expr parser)
- "If expr is a tempo, return \"\\tempo x = nnn\", otherwise return #f."
- (with-music-match (expr (music 'ContextSpeccedMusic
- element (music 'SequentialMusic
- elements ((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)))
-
-;;; \clef
+(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)
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
value ?clef-glyph
symbol 'clefGlyph)
(music 'PropertySet
- symbol 'middleCPosition)
+ symbol 'middleCClefPosition)
(music 'PropertySet
value ?clef-position
symbol 'clefPosition)
(music 'PropertySet
value ?clef-octavation
- symbol 'clefOctavation)))))
- (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0)
- clef-name-alist)))
- (if clef-prop+name
+ symbol 'clefOctavation)
+ (music 'ApplyContext
+ procedure ly:set-middle-C!)))))
+ (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)
(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 ...\".
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."
'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)))))
;;;
;;;
(music->lily-string ?lyric-sequence parser)))
#f)))
-
+;; Silence internal event sent at end of each lyrics block
+(define-display-method CompletizeExtenderEvent (expr parser)
+ "")
projects / lilypond.git / blobdiff