On 2021-11-13 7:15 am, Aaron Hill wrote:
It makes perfect sense that it could be generalized to accept any
music.
Continuing my trend for hastily written/researched code, consider the
attached. There is almost certainly an easier way of doing things, and
who knows what I have broken in the process.
For reference, here is what the user would be able to do:
%%%%
\fixed c' {
\time 3/4 | g4 a b
\time 7/8 | g4 a b8 a b
\time \kieren 5 8 | g4 a8 b a
\time \kieren 3 4. | g4 a8 b4. a
\time \kieren 2 { 8[ 8.] } | g4 a16 b a b8.
\bar "||"
\break
\override Score.TimeSignature.style = #'kieren
\time 3/4 | g4 a b
\time 7/8 | g4 a b8 a b
\time \kieren 5 8 | g4 a8 b a
\time \kieren 3 4. | g4 a8 b4. a
\time \kieren 2 { 8[ 8.] } | g4 a16 b a b8.
\bar "|."
}
%%%%
Cosmetically, I do not like the alignment in some in the fractions. I
believe the dot should have no effect on the horizontal alignment of the
note head with the number, but I am out of time to refine further. I
suspect \markup \score might not be the best tool for the job in the
long run, though it certainly allows for very permissive ly:music? as a
denominator. (I should test with \tuplets...)
P.S. Kieren: I apologize if my naming things "kieren" in the code
offends. Hopefully, you would consider it an honor for the feature to
carry your name, as you are certainly the strong voice for its
inclusion.
-- Aaron Hill
\version "2.22.0"
kieren =
#(define-scheme-function
(scalar rhythm)
(index? ly:music?)
(cons scalar rhythm))
#(define (kieren-fraction? arg)
(and (pair? arg)
(index? (car arg))
(ly:music? (cdr arg))))
%% Borrowed non-exported procedure in define-music-properties.scm
#(define (music-property-description symbol type? description)
(if (not (equal? #f (object-property symbol 'music-doc)))
(ly:error (_ "symbol ~S redefined") symbol))
(set-object-property! symbol 'music-type? type?)
(set-object-property! symbol 'music-doc description)
symbol)
#(set! all-music-properties (cons
(music-property-description 'kieren-fraction kieren-fraction? "...")
all-music-properties))
%% Borrowed non-exported procedure in define-context-properties.scm
#(define (translator-property-description symbol type? description)
(if (not (and
(symbol? symbol)
(procedure? type?)
(string? description)))
(throw 'init-format-error))
(if (not (equal? #f (object-property symbol 'translation-doc)))
(ly:error (_ "symbol ~S redefined") symbol))
(set-object-property! symbol 'translation-type? type?)
(set-object-property! symbol 'translation-doc description)
(set! all-translation-properties (cons symbol all-translation-properties))
symbol)
#(translator-property-description 'kieren-fraction kieren-fraction? "...")
%% Borrowed non-exported procedure in define-grob-properties.scm
#(define (define-grob-property symbol type? description)
(if (not (equal? (object-property symbol 'backend-doc) #f))
(ly:error (_ "symbol ~S redefined") symbol))
(set-object-property! symbol 'backend-type? type?)
(set-object-property! symbol 'backend-doc description)
symbol)
#(set! all-user-grob-properties (cons
(define-grob-property 'kieren-fraction kieren-fraction? "...")
all-user-grob-properties))
%% Adapted non-exported procedure in define-music-callbacks.scm
#(define (make-kieren-time-signature-set music)
"Set context properties for a time signature."
(let* ((num (ly:music-property music 'numerator))
(den (ly:music-property music 'denominator))
(structure (ly:music-property music 'beat-structure))
(kieren-fraction (ly:music-property music 'kieren-fraction))
(fraction (cons num den)))
(list (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)
(ly:context-set-property!
context 'kieren-fraction kieren-fraction))))
'Timing)
;; (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.
(descend-to-context
(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)))))
'Score))))
#(assoc-set!
(ly:assoc-get 'TimeSignatureMusic music-descriptions)
'elements-callback
make-kieren-time-signature-set)
#(define (time-fraction? arg)
(or (fraction? arg)
(kieren-fraction? arg)))
time =
#(define-music-function (beat-structure fraction)
((number-list? '()) time-fraction?)
(_i "Set @var{fraction} as time signature, with optional
number list @var{beat-structure} before it.")
(if (kieren-fraction? fraction)
(let* ((scalar (car fraction))
(music (cdr fraction))
(moment (ly:music-length music))
(numerator (ly:moment-main-numerator moment))
(denominator (ly:moment-main-denominator moment)))
(make-music 'TimeSignatureMusic
'numerator (* scalar numerator)
'denominator denominator
'beat-structure beat-structure
'kieren-fraction (cons scalar music)))
;; Simple time signature.
(make-music 'TimeSignatureMusic
'numerator (car fraction)
'denominator (cdr fraction)
'beat-structure beat-structure)))
Kieren_time_translator =
#(lambda (ctxt)
(make-engraver
(acknowledgers
((time-signature-interface trans grob source)
(ly:grob-set-property! grob 'kieren-fraction
(ly:context-property ctxt 'kieren-fraction))))))
#(define-markup-command
(kieren-time layout props numerator denominator)
(index? ly:music?)
(interpret-markup layout props #{
\markup
\override #'(baseline-skip . 0)
\center-column {
\line \number { #(number->string numerator) }
\score {
\new RhythmicStaff { \cadenzaOn \stemDown #denominator }
\layout {
\context {
\RhythmicStaff
\remove Clef_engraver
\remove Time_signature_engraver
\omit StaffSymbol
}
indent = 0
}
}
} #}))
#(define (kieren-time-signature::print grob)
(define (default-kieren-time-from-fraction fraction)
(let* ((numerator (car fraction))
(denominator (cdr fraction))
(duration (ly:make-duration (ly:intlog2 denominator))))
(cons numerator #{ { $duration } #})))
(if (eq? 'kieren (ly:grob-property grob 'style 'default))
(let* ((fraction (ly:grob-property grob 'fraction))
(kieren-fraction
(ly:grob-property grob 'kieren-fraction
(default-kieren-time-from-fraction fraction)))
(numerator (car kieren-fraction))
(denominator (cdr kieren-fraction)))
(grob-interpret-markup grob
(markup #:kieren-time numerator denominator)))
(ly:time-signature::print grob)))
\layout {
\context {
\Score
\consists \Kieren_time_translator
\override TimeSignature.stencil = #kieren-time-signature::print
}
indent = 0
}
\fixed c' {
\time 3/4 | g4 a b
\time 7/8 | g4 a b8 a b
\time \kieren 5 8 | g4 a8 b a
\time \kieren 3 4. | g4 a8 b4. a
\time \kieren 2 { 8[ 8.] } | g4 a16 b a b8.
\bar "||"
\break
\override Score.TimeSignature.style = #'kieren
\time 3/4 | g4 a b
\time 7/8 | g4 a b8 a b
\time \kieren 5 8 | g4 a8 b a
\time \kieren 3 4. | g4 a8 b4. a
\time \kieren 2 { 8[ 8.] } | g4 a16 b a b8.
\bar "|."
}
