X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=492050a9ba27271468553b43b89780ada644030d;hb=8508ea37a36b61030fd17b4ec86259f235872f39;hp=8708cc1d73a950627947f0cb52477333d0b6af61;hpb=c962a0162c67d8b67593c848d08c9345c8b045f0;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 8708cc1d73..492050a9ba 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -89,8 +89,7 @@ expression." (define (pitch= pitch1 pitch2) (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2)) (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2)))) - (let* ((pitches (ly:parser-lookup 'pitchnames)) - (result (rassoc ly-pitch pitches pitch=))) + (let* ((result (rassoc ly-pitch pitchnames pitch=))) (and result (car result)))) (define-public (octave->lily-string pitch) @@ -126,8 +125,7 @@ expression." ;;; post events ;;; -(define (post-event? m) - (music-is-of-type? m 'post-event)) +(define post-event? (music-type-predicate 'post-event)) (define* (event-direction->lily-string event #:optional (required #t)) (let ((direction (ly:music-property event 'direction))) @@ -387,20 +385,6 @@ expression." (music->lily-string music)) (ly:music-property sim 'elements))))) -(define-extra-display-method SimultaneousMusic (expr) - "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\". -Otherwise, return #f." - ;; TODO: do something with afterGraceFraction? - (with-music-match (expr (music 'SimultaneousMusic - elements (?before-grace - (music 'SequentialMusic - elements ((music 'SkipMusic) - (music 'GraceMusic - element ?grace)))))) - (format #f "\\afterGrace ~a ~a" - (music->lily-string ?before-grace) - (music->lily-string ?grace)))) - ;;; ;;; Chords ;;; @@ -418,7 +402,7 @@ Otherwise, return #f." (chord-repeat (ly:music-property chord 'duration))) (call-with-values (lambda () - (partition (lambda (m) (music-is-of-type? m 'rhythmic-event)) + (partition (music-type-predicate 'rhythmic-event) elements)) (lambda (chord-elements other-elements) (cond ((pair? chord-elements) @@ -553,10 +537,9 @@ Otherwise, return #f." (music->lily-string (ly:music-property chord 'element))) (define-display-method MarkEvent (mark) - (let ((label (ly:music-property mark 'label))) - (if (null? label) - "\\mark \\default" - (format #f "\\mark ~a" (markup->lily-string label))))) + (let ((label (ly:music-property mark 'label #f))) + (string-append "\\mark " + (if label (value->lily-string label) "\\default")))) (define-display-method KeyChangeEvent (key) (let ((pitch-alist (ly:music-property key 'pitch-alist)) @@ -630,7 +613,7 @@ Otherwise, return #f." (format #f "~s" string) string)) (markup->lily-string text))) - (map-in-order (lambda (m) (music->lily-string m)) + (map-in-order music->lily-string (ly:music-property lyric 'articulations)))) (define-display-method BreathingEvent (event) @@ -741,6 +724,26 @@ Otherwise, return #f." (parameterize ((*current-context* ctype)) (music->lily-string music))))) +;; \afterGrace +(define-extra-display-method ContextSpeccedMusic (expr) + "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\". +Otherwise, return #f." + ;; TODO: do something with afterGraceFraction? + (with-music-match + (expr (music 'ContextSpeccedMusic + context-type 'Bottom + element + (music 'SimultaneousMusic + elements (?before-grace + (music 'SequentialMusic + elements ((music 'SkipMusic) + (music 'GraceMusic + element ?grace))))))) + (format #f "\\afterGrace ~a ~a" + (music->lily-string ?before-grace) + (music->lily-string ?grace)))) + + ;; special cases: \figures \lyrics \drums (define-extra-display-method ContextSpeccedMusic (expr) (with-music-match (expr (music 'ContextSpeccedMusic @@ -781,8 +784,6 @@ Otherwise, return #f." (define-public (value->lily-string arg) (cond ((ly:music? arg) (music->lily-string arg)) - ((string? arg) - (format #f "#~s" arg)) ((markup? arg) (markup->lily-string arg)) ((ly:duration? arg) @@ -810,7 +811,8 @@ Otherwise, return #f." (new-line->lily-string)))) (define-display-method PropertyUnset (expr) - (format #f "\\unset ~a~a~a" + (format #f "~a\\unset ~a~a~a" + (if (ly:music-property expr 'once #f) "\\once " "") (if (eqv? (*current-context*) 'Bottom) "" (format #f "~a . " (*current-context*))) @@ -840,8 +842,11 @@ Otherwise, return #f." (define-display-method RevertProperty (expr) (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" + (list (ly:music-property expr + 'grob-property)))) + (once (ly:music-property expr 'once #f))) + (format #f "~a\\revert ~{~a~^.~}~a" + (if once "\\once " "") (if (eqv? (*current-context*) 'Bottom) (cons symbol properties) (cons* (*current-context*) symbol properties)) @@ -857,7 +862,11 @@ Otherwise, return #f." num den (new-line->lily-string)) (format #f - "\\time #'~a ~a/~a~a" + ;; This is silly but the latter will also work for #f + ;; and other + (if (key-list? structure) + "\\time ~{~a~^,~} ~a/~a~a" + "\\time #'~a ~a/~a~a") structure num den (new-line->lily-string))))) @@ -985,9 +994,11 @@ Otherwise, return #f." (define-display-method ApplyOutputEvent (applyoutput) (let ((proc (ly:music-property applyoutput 'procedure)) - (ctx (ly:music-property applyoutput 'context-type))) - (format #f "\\applyOutput #'~a #~a" + (ctx (ly:music-property applyoutput 'context-type)) + (grob (ly:music-property applyoutput 'symbol))) + (format #f "\\applyOutput ~a~@[.~a~] #~a" ctx + (and (symbol? grob) grob) (or (procedure-name proc) (with-output-to-string (lambda () @@ -1039,7 +1050,8 @@ Otherwise, return #f." (music 'ContextSpeccedMusic context-id "null" context-type 'NullVoice) - ?pc-music)))) + ?pc-music + ?pc-marks)))) (with-music-match (?pc-music (music 'PartCombineMusic)) (format #f "~a" (music->lily-string ?pc-music))))) @@ -1118,7 +1130,10 @@ Otherwise, return #f." elements ((music 'ContextSpeccedMusic context-id "up" context-type 'Staff - element (music 'SimultaneousMusic elements (?ac-music))) + element ?ac-music) + (music 'ContextSpeccedMusic + context-id "up" + context-type 'Staff) (music 'ContextSpeccedMusic context-id "down" context-type 'Staff))))