X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Fdefine-music-display-methods.scm;h=0d7e3c451b80d64913cbdcf57333145a1cd2b36c;hb=2005e201323314c8439d6aca062386c70c784294;hp=9a3a4c10691cfb1bb14ac43910c2fdf562a42895;hpb=5210bde1557b43911002ffeee7dc0c1119a8b2ec;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 9a3a4c1069..0d7e3c451b 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--2009 Nicolas Sceaux +;;; Copyright (C) 2005--2011 Nicolas Sceaux ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -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,33 +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 - 'TupletSpanEvent - '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))) @@ -223,6 +226,9 @@ (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 + (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") @@ -233,6 +239,7 @@ (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 "\\sustainOn" "\\sustainOff") (define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff") @@ -505,6 +512,9 @@ Otherwise, return #f." (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... ;;; @@ -556,6 +566,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) @@ -756,7 +769,7 @@ Otherwise, return #f." (*indent*) (first op) (second op))) - (reverse operations))) + operations)) (*indent*))) (parameterize ((*current-context* ctype)) (music->lily-string music parser))))) @@ -870,6 +883,20 @@ Otherwise, return #f." 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 + "#(set-time-signature ~a ~a '~a)~a" + num den structure + (new-line->lily-string))))) + ;;; \melisma and \melismaEnd (define-extra-display-method ContextSpeccedMusic (expr parser) "If expr is a melisma, return \"\\melisma\", otherwise, return #f." @@ -907,7 +934,11 @@ Otherwise, return #f." (format #f "\\tempo ~a ~a = ~a" (scheme-expr->lily-string ?unit-text) (duration->lily-string ?unit-duration #:force-duration #t) - ?unit-count)) + (if (number-pair? ?unit-count) + (format #f "~a ~~ ~a" + (car ?unit-count) + (cdr ?unit-count)) + ?unit-count))) (with-music-match (expr (music 'ContextSpeccedMusic element (music 'SequentialMusic elements ((music 'PropertyUnset @@ -922,7 +953,11 @@ Otherwise, return #f." symbol 'tempoUnitCount))))) (format #f "\\tempo ~a = ~a" (duration->lily-string ?unit-duration #:force-duration #t) - ?unit-count)) + (if (number-pair? ?unit-count) + (format #f "~a ~~ ~a" + (car ?unit-count) + (cdr ?unit-count)) + ?unit-count))) (with-music-match (expr (music 'ContextSpeccedMusic element (music 'SequentialMusic elements ((music 'PropertySet @@ -960,11 +995,11 @@ Otherwise, return #f." symbol 'clefOctavation) (music 'ApplyContext procedure ly:set-middle-C!))))) - (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0) + (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) @@ -974,36 +1009,6 @@ Otherwise, return #f." (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 ...\". @@ -1016,30 +1021,6 @@ Otherwise, return #f." (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 ...\". @@ -1050,13 +1031,12 @@ 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))))) ;;; ;;; @@ -1191,4 +1171,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) + "")