X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-display-methods.scm;h=53bddaac9359616232bfa2943c4241bec3029b19;hb=a1c2a3a778efafbb8abbd44eb212a3f52f34c5f9;hp=91be3e28b38bfc0892a5cea2261dbb2523c33f13;hpb=93e65fdd05c82e674d188e0388332d3f950a0b33;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 91be3e28b3..53bddaac93 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. ;;; -;;; (c) 2005--2006 Nicolas Sceaux +;;; Copyright (C) 2005--2010 Nicolas Sceaux ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -58,7 +58,7 @@ (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) @@ -81,7 +81,7 @@ (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) @@ -92,7 +92,7 @@ (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) #\')) @@ -103,7 +103,7 @@ ;;; ;;; 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*))) @@ -134,32 +134,36 @@ ;;; 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 - 'TrillSpanEvent - 'GlissandoEvent - 'ArpeggioEvent - 'NoteGroupingEvent - 'UnaCordaEvent)) +(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* (event-direction->lily-string event #:optional (required #t)) (let ((direction (ly:music-property event 'direction))) @@ -222,7 +226,10 @@ (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 BendAfterEvent (event parser) #t + (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 AbsoluteDynamicEvent (event parser) #f @@ -232,9 +239,10 @@ (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") @@ -246,7 +254,7 @@ ;;; (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 @@ -264,7 +272,7 @@ ?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 @@ -275,7 +283,7 @@ 'SlurEvent span-direction START)))))) #t) - (with-music-match (?stop (music + (with-music-match (?stop (music 'SequentialMusic elements ((music 'EventChord @@ -299,7 +307,7 @@ ?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 @@ -317,7 +325,7 @@ grob-value "grace" symbol 'Stem))))) #t) - (with-music-match (?stop (music + (with-music-match (?stop (music 'SequentialMusic elements ((music 'ContextSpeccedMusic @@ -356,7 +364,7 @@ (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)) @@ -423,7 +431,7 @@ Otherwise, return #f." (format #f "\\afterGrace ~a ~a" (music->lily-string ?before-grace parser) (music->lily-string ?grace parser)))) - + ;;; ;;; Chords ;;; @@ -438,7 +446,7 @@ Otherwise, return #f." ;; tagged_post_event: '-' \tag embedded_scm post_event (let* ((elements (ly:music-property chord 'elements)) - (simple-elements (filter (make-music-type-predicate + (simple-elements (filter (make-music-type-predicate 'NoteEvent 'ClusterNoteEvent 'RestEvent 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent) elements))) @@ -447,7 +455,13 @@ Otherwise, return #f." ;; and BreathingEvent (\breathe) (music->lily-string (car elements) parser) (if (and (not (null? simple-elements)) - (null? (cdr 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)) @@ -474,7 +488,7 @@ Otherwise, return #f." (music->lily-string music parser)) chord-elements) (duration->lily-string (ly:music-property (car chord-elements) - 'duration)) + 'duration)) (map-in-order (lambda (music) (music->lily-string music parser)) post-events)))) @@ -549,6 +563,9 @@ Otherwise, return #f." (define-display-method SkipEvent (rest parser) "s") +(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 (null? label) @@ -561,7 +578,7 @@ Otherwise, return #f." (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) @@ -575,7 +592,7 @@ Otherwise, return #f." (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)))) @@ -606,7 +623,7 @@ Otherwise, return #f." (else fig)) (if (null? alteration) "" - (cond + (cond ((= alteration DOUBLE-FLAT) "--") ((= alteration FLAT) "-") ((= alteration NATURAL) "!") @@ -654,7 +671,7 @@ Otherwise, return #f." (parameterize ((*force-line-break* #f) (*time-factor-numerator* (/ num nd-gcd)) (*time-factor-denominator* (/ den nd-gcd))) - (format #f "\\times ~a/~a ~a" + (format #f "\\times ~a/~a ~a" num den (music->lily-string (ly:music-property times 'element) parser))))) @@ -688,9 +705,6 @@ Otherwise, return #f." (define-display-method UnfoldedRepeatedMusic (expr parser) (repeat->lily-string expr "unfold" parser)) -(define-display-method FoldedRepeatedMusic (expr parser) - (repeat->lily-string expr "fold" parser)) - (define-display-method PercentRepeatedMusic (expr parser) (repeat->lily-string expr "percent" parser)) @@ -727,7 +741,7 @@ Otherwise, return #f." ;;; ;;; Contexts -;;; +;;; (define-display-method ContextSpeccedMusic (expr parser) (let ((id (ly:music-property expr 'context-id)) @@ -744,15 +758,15 @@ Otherwise, return #f." "" (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))))) @@ -812,8 +826,8 @@ Otherwise, return #f." (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) @@ -821,8 +835,8 @@ Otherwise, return #f." (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))) @@ -843,8 +857,8 @@ Otherwise, return #f." (not once)) "" "\\once ") - (if (eqv? (*current-context*) 'Bottom) - "" + (if (eqv? (*current-context*) 'Bottom) + "" (format #f "~a . " (*current-context*))) symbol (if (null? (cdr properties)) @@ -852,13 +866,13 @@ Otherwise, return #f." 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))) (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)) @@ -883,23 +897,50 @@ Otherwise, return #f." "\\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." - (with-music-match (expr (music 'ContextSpeccedMusic + (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) + ?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) + ?unit-count)) + (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 + value ?tempo-text + symbol 'tempoText))))) + (format #f "\\tempo ~a" (scheme-expr->lily-string ?tempo-text))))) + +;;; \clef (define clef-name-alist #f) (define-public (memoize-clef-names clefs) "Initialize `clef-name-alist', if not already set." @@ -920,18 +961,20 @@ Otherwise, return #f." 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) + 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-prop+name + (if clef-name (format #f "\\clef \"~a~{~a~a~}\"~a" - (cdr clef-prop+name) + clef-name (cond ((= 0 ?clef-octavation) (list "" "")) ((> ?clef-octavation 0) @@ -944,32 +987,37 @@ Otherwise, return #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))))) +Otherwise, return #f. Note: default grouping is not available." + (with-music-match + (expr (music + 'ContextSpeccedMusic + element (music + 'ContextSpeccedMusic + context-type 'Timing + element (music + 'SequentialMusic + elements ?elts)))) + (and + (> (length ?elts) 2) + (with-music-match ((cadr ?elts) + (music 'PropertySet + symbol 'beatLength)) + #t) + (with-music-match ((caddr ?elts) + (music 'PropertySet + symbol 'measureLength)) + #t) + (with-music-match ((car ?elts) + (music 'PropertySet + value ?num+den + symbol 'timeSignatureFraction)) + (if (eq? (length ?elts) 3) + (format + #f "\\time ~a/~a~a" + (car ?num+den) (cdr ?num+den) (new-line->lily-string)) + (format + #f "#(set-time-signature ~a ~a '())~a" + (car ?num+den) (cdr ?num+den) (new-line->lily-string))))))) ;;; \bar (define-extra-display-method ContextSpeccedMusic (expr parser) @@ -994,6 +1042,7 @@ Otherwise, return #f." ((= i dots) m) (set! m (+ m delta))) factor)))) + (define moment-duration-alist (map (lambda (duration) (cons (duration->moment duration) duration)) @@ -1004,9 +1053,7 @@ Otherwise, return #f." (list 0 1 2 3 4)))) (define (moment->duration moment) - (let ((result (assoc (- moment) moment-duration-alist =))) - (and result - (cdr result)))) + (assoc-get (- moment) moment-duration-alist)) (define-extra-display-method ContextSpeccedMusic (expr parser) "If `expr' is a partial measure, return \"\\partial ...\". @@ -1158,4 +1205,6 @@ Otherwise, return #f." (music->lily-string ?lyric-sequence parser))) #f))) - +;; Silence internal event sent at end of each lyrics block +(define-display-method CompletizeExtenderEvent (expr parser) + "")