X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=9631da734ddd6ad0d6e3389ec2fb5683b9b5a10f;hb=c0a47b91cd930053074d42363047a77b889e05f7;hp=f58d60fa35330990983baf421b6183c9efb64de5;hpb=9a2ffbf058002a6a82acc5748a2998840885afb8;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index f58d60fa35..9631da734d 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--2011 Nicolas Sceaux +;;; Copyright (C) 2005--2012 Nicolas Sceaux ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -107,11 +107,12 @@ expression." ;;; (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") @@ -119,54 +120,17 @@ expression." ((-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 - '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 (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))) @@ -208,17 +172,22 @@ expression." "" 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)) @@ -229,16 +198,16 @@ expression." (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 +(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) #t "\\glissando") -(define-post-event-display-method ArpeggioEvent (event parser) #t "\\arpeggio") +(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) #t +(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 "[" "]") @@ -282,23 +251,19 @@ expression." '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)))))) @@ -317,19 +282,17 @@ expression." '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))))) + symbol 'Flag))))) #t) (with-music-match (?stop (music 'SequentialMusic @@ -338,15 +301,14 @@ expression." 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) @@ -375,12 +337,16 @@ expression." (*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 " "") @@ -395,15 +361,17 @@ expression." "\\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? "")) @@ -415,7 +383,7 @@ expression." (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*)))) @@ -443,79 +411,69 @@ 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 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)) - (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))) @@ -528,7 +486,7 @@ Otherwise, return #f." ;;; (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)) @@ -548,15 +506,26 @@ 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)) + (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? ""))) @@ -566,13 +535,24 @@ Otherwise, return #f." (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)) @@ -644,18 +624,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") @@ -678,10 +661,17 @@ Otherwise, return #f." (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))) + (*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 @@ -697,18 +687,21 @@ 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 - (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)) @@ -720,35 +713,29 @@ Otherwise, return #f." (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 @@ -900,8 +887,8 @@ Otherwise, return #f." 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