X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=9631da734ddd6ad0d6e3389ec2fb5683b9b5a10f;hb=cfa910f1c13ae760756692175a733db4e5a8899a;hp=3e87b4a8a8bab722ac34ac4846fccbaacd3c27ed;hpb=9ff4029627f34267fc9f040c703d568b1dfd10b1;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 3e87b4a8a8..9631da734d 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -107,13 +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") @@ -121,17 +120,9 @@ 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)))) ""))) ;;; @@ -181,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)) @@ -202,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 "[" "]") @@ -254,9 +250,8 @@ expression." (and (with-music-match (?start (music 'SequentialMusic elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1) - articulations + 'EventChord + elements ((music 'SlurEvent span-direction START)))))) @@ -264,9 +259,8 @@ expression." (with-music-match (?stop (music 'SequentialMusic elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1) - articulations + 'EventChord + elements ((music 'SlurEvent span-direction STOP)))))) @@ -287,9 +281,8 @@ expression." (and (with-music-match (?start (music 'SequentialMusic elements ((music - 'SkipEvent - duration (ly:make-duration 0 0 0 1) - articulations + 'EventChord + elements ((music 'SlurEvent span-direction START))) @@ -311,9 +304,8 @@ expression." symbol 'Flag)) (music - 'SkipEvent - duration (ly:make-duration 0 0 0 1) - articulations + 'EventChord + elements ((music 'SlurEvent span-direction STOP)))))) @@ -426,38 +418,54 @@ Otherwise, return #f." ;; post_events : ( post_event | tagged_post_event )* ;; tagged_post_event: '-' \tag embedded_scm post_event - (let* ((elements (ly:music-property chord 'elements)) - (chord-elements (filter (lambda (m) - (music-is-of-type? m 'rhythmic-event)) - elements)) - (post-events (filter post-event? elements)) + (let* ((elements (append (ly:music-property chord 'elements) + (ly:music-property chord 'articulations))) (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)) - post-events)))) - (else - ;; command_element - (format #f "~{~a~^ ~}" (map-in-order (lambda (music) - (music->lily-string music parser)) - elements)))))) + (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) (format #f "R~a~{~a~^ ~}" @@ -478,7 +486,7 @@ Otherwise, return #f." ;;; (define (simple-note->lily-string event parser) - (format #f "~a~a~a~a~a~a~{~a~}" ; pitchname octave !? octave-check duration optional_rest 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)) @@ -503,16 +511,21 @@ Otherwise, return #f." (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~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))) + #:remember #t) + (map-in-order (lambda (event) + (music->lily-string event parser)) + (ly:music-property note 'articulations)))) (else ;; unknown? ""))) @@ -522,16 +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) - (string-append "r" (duration->lily-string (ly:music-property rest 'duration) - #:remember #t)))) + (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) (string-append "R" (duration->lily-string (ly:music-property rest 'duration) #:remember #t))) (define-display-method SkipEvent (rest parser) - (string-append "s" (duration->lily-string (ly:music-property rest 'duration) - #:remember #t))) + (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)) @@ -640,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 @@ -662,17 +690,18 @@ Otherwise, return #f." (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)) @@ -684,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