- (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))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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)))