X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-music-callbacks.scm;h=5cc1db14cd7b12fd22ebc664fe18b5ea1f9ae1c4;hb=HEAD;hp=06d616f8b014e3cfbb4e57da6811315af3020f07;hpb=a42aaa559b71ce5776795fa11a7e1df9110d85b7;p=lilypond.git diff --git a/scm/define-music-callbacks.scm b/scm/define-music-callbacks.scm index 06d616f8b0..5cc1db14cd 100644 --- a/scm/define-music-callbacks.scm +++ b/scm/define-music-callbacks.scm @@ -1,7 +1,7 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 1998--2011 Han-Wen Nienhuys -;;;; Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2015 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen ;;;; Neil Puttock ;;;; Carl Sorensen ;;;; @@ -23,16 +23,24 @@ (define (mm-rest-child-list music) "Generate events for multimeasure rests, to be used by the sequential-iterator" - (let ((location (ly:music-property music 'origin)) - (duration (ly:music-property music 'duration))) - (list (make-music 'BarCheck - 'origin location) - (make-event-chord (cons (make-music 'MultiMeasureRestEvent - 'origin location - 'duration duration) - (ly:music-property music 'articulations))) - (make-music 'BarCheck - 'origin location)))) + (ly:set-origin! (list (make-music 'BarCheck) + (make-music 'MultiMeasureRestEvent + (ly:music-deep-copy music)) + (make-music 'BarCheck)) + music)) + +(define (make-unfolded-set music) + (let ((n (ly:music-property music 'repeat-count)) + (alts (ly:music-property music 'elements)) + (body (ly:music-property music 'element))) + (cond ((<= n 0) '()) + ((null? alts) (make-list n body)) + (else + (concatenate + (zip (make-list n body) + (append! (make-list (max 0 (- n (length alts))) + (car alts)) + alts))))))) (define (make-volta-set music) (let* ((alts (ly:music-property music 'elements)) @@ -40,25 +48,25 @@ to be used by the sequential-iterator" (times (ly:music-property music 'repeat-count))) (map (lambda (x y) (make-music - 'SequentialMusic - 'elements - ;; set properties for proper bar numbering - (append + 'SequentialMusic + 'elements + ;; set properties for proper bar numbering + (append + (list (make-music 'AlternativeEvent + 'alternative-dir (if (= y 0) + -1 + 0) + 'alternative-increment + (if (= 0 y) + (1+ (- times + lalts)) + 1))) + (list x) + (if (= y (1- lalts)) (list (make-music 'AlternativeEvent - 'alternative-dir (if (= y 0) - -1 - 0) - 'alternative-increment - (if (= 0 y) - (1+ (- times - lalts)) - 1))) - (list x) - (if (= y (1- lalts)) - (list (make-music 'AlternativeEvent - 'alternative-dir 1 - 'alternative-increment 0)) - '())))) + 'alternative-dir 1 + 'alternative-increment 0)) + '())))) alts (iota lalts)))) @@ -67,18 +75,18 @@ to be used by the sequential-iterator" (let ((octavation (ly:music-property music 'ottava-number))) (list (context-spec-music - (make-apply-context - (lambda (context) - (let ((offset (* -7 octavation)) - (string (assoc-get octavation '((2 . "15ma") - (1 . "8va") - (0 . #f) - (-1 . "8vb") - (-2 . "15mb"))))) - (set! (ly:context-property context 'middleCOffset) offset) - (set! (ly:context-property context 'ottavation) string) - (ly:set-middle-C! context)))) - 'Staff)))) + (make-apply-context + (lambda (context) + (let ((offset (* -7 octavation)) + (string (assoc-get octavation '((2 . "15ma") + (1 . "8va") + (0 . #f) + (-1 . "8vb") + (-2 . "15mb"))))) + (set! (ly:context-property context 'middleCOffset) offset) + (set! (ly:context-property context 'ottavation) string) + (ly:set-middle-C! context)))) + 'Staff)))) (define (make-time-signature-set music) "Set context properties for a time signature." @@ -87,31 +95,60 @@ to be used by the sequential-iterator" (structure (ly:music-property music 'beat-structure)) (fraction (cons num den))) (list (descend-to-context - (context-spec-music - (make-apply-context - (lambda (context) - (let* ((time-signature-settings - (ly:context-property context 'timeSignatureSettings)) - (my-base-fraction - (base-fraction fraction time-signature-settings)) - (my-beat-structure - (if (null? structure) - (beat-structure my-base-fraction - fraction - time-signature-settings) - structure)) - (beaming-exception - (beam-exceptions fraction time-signature-settings)) - (new-measure-length (ly:make-moment num den))) - (ly:context-set-property! - context 'timeSignatureFraction fraction) - (ly:context-set-property! - context 'baseMoment (fraction->moment my-base-fraction)) - (ly:context-set-property! - context 'beatStructure my-beat-structure) - (ly:context-set-property! - context 'beamExceptions beaming-exception) - (ly:context-set-property! - context 'measureLength new-measure-length)))) - 'Timing) - 'Score)))) + (context-spec-music + (make-apply-context + (lambda (context) + (let* ((time-signature-settings + (ly:context-property context 'timeSignatureSettings)) + (my-base-length + (base-length fraction time-signature-settings)) + (my-beat-structure + (if (null? structure) + (beat-structure my-base-length + fraction + time-signature-settings) + structure)) + (beaming-exception + (beam-exceptions fraction time-signature-settings)) + (new-measure-length (ly:make-moment num den))) + (ly:context-set-property! + context 'timeSignatureFraction fraction) + (ly:context-set-property! + context 'baseMoment (ly:make-moment my-base-length)) + (ly:context-set-property! + context 'beatStructure my-beat-structure) + (ly:context-set-property! + context 'beamExceptions beaming-exception) + (ly:context-set-property! + context 'measureLength new-measure-length)))) + 'Timing) + 'Score) + ;; (make-music 'TimeSignatureEvent music) would always + ;; create a Bottom context. So instead, we just send the + ;; event to whatever context may be currently active. If + ;; that is not contained within an existing context with + ;; TimeSignatureEngraver at the time \time is iterated, it + ;; will drop through the floor which mostly means that + ;; point&click and tweaks are not available for any time + ;; signatures engraved due to the Timing property changes + ;; but without a \time of its own. This is more a + ;; "notification" rather than an "event" (which is always + ;; sent to Bottom) but we don't currently have iterators for + ;; that. + (make-apply-context + (lambda (context) + (ly:broadcast (ly:context-event-source context) + (ly:make-stream-event + (ly:make-event-class 'time-signature-event) + (ly:music-mutable-properties music)))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Some MIDI callbacks -- is this a good place for them? + +(define-public (breathe::midi-length len context) + ;;Shorten by half, or by up to a second, but always by a power of 2 + (let* ((desired (min (ly:moment-main (seconds->moment 1 context)) + (* (ly:moment-main len) 1/2))) + (scale (inexact->exact (ceiling (/ (log desired) (log 1/2))))) + (breath (ly:make-moment (expt 1/2 scale)))) + (ly:moment-sub (ly:make-moment (ly:moment-main len)) breath)))