(ly:duration? obj)
`(ly:make-duration ,(ly:duration-log obj)
,(ly:duration-dot-count obj)
- ,(car (ly:duration-factor obj))
- ,(cdr (ly:duration-factor obj))))
+ ,(ly:duration-scale obj)))
(;; note pitch
(ly:pitch? obj)
`(ly:make-pitch ,(ly:pitch-octave obj)
The number of dots in the shifted music may not be less than zero."
(let ((d (ly:music-property music 'duration)))
(if (ly:duration? d)
- (let* ((cp (ly:duration-factor d))
+ (let* ((cp (ly:duration-scale d))
(nd (ly:make-duration
(+ shift (ly:duration-log d))
(max 0 (+ dot (ly:duration-dot-count d)))
- (car cp)
- (cdr cp))))
+ cp)))
(set! (ly:music-property music 'duration) nd)))
music))
;; found in the repeated chord. We don't need to look for
;; articulations on individual events since they can't actually get
;; into a repeat chord given its input syntax.
- (for-each (lambda (e)
- (for-each (lambda (x)
- (set! event-types (delq x event-types)))
- (ly:music-property e 'types)))
- (ly:music-property repeat-chord 'elements))
+
+ (define (keep-element? m)
+ (any (lambda (t) (music-is-of-type? m t))
+ event-types))
+ (define origin (ly:music-property repeat-chord 'origin #f))
+ (define (set-origin! l)
+ (if origin
+ (for-each (lambda (m) (set! (ly:music-property m 'origin) origin)) l))
+ l)
+
+ (for-each
+ (lambda (field)
+ (for-each (lambda (e)
+ (for-each (lambda (x)
+ (set! event-types (delq x event-types)))
+ (ly:music-property e 'types)))
+ (ly:music-property repeat-chord field)))
+ '(elements articulations))
+
;; now treat the elements
(set! (ly:music-property repeat-chord 'elements)
- (append!
- (filter-map
- (lambda (m)
- (and (any (lambda (t) (music-is-of-type? m t)) event-types)
- (begin
- (set! m (ly:music-deep-copy m))
- (if (pair? (ly:music-property m 'articulations))
- (set! (ly:music-property m 'articulations)
- (filter
- (lambda (a)
- (any (lambda (t) (music-is-of-type? a t))
- event-types))
- (ly:music-property m 'articulations))))
- (if (ly:duration? (ly:music-property m 'duration))
- (set! (ly:music-property m 'duration) duration))
- m)))
- (ly:music-property original-chord 'elements))
- (ly:music-property repeat-chord 'elements))))
+ (let ((elts
+ (set-origin! (ly:music-deep-copy
+ (filter keep-element?
+ (ly:music-property original-chord
+ 'elements))))))
+ (for-each
+ (lambda (m)
+ (let ((arts (ly:music-property m 'articulations)))
+ (if (pair? arts)
+ (set! (ly:music-property m 'articulations)
+ (set-origin! (filter! keep-element? arts))))
+ (if (ly:duration? (ly:music-property m 'duration))
+ (set! (ly:music-property m 'duration) duration))))
+ elts)
+ (append! elts (ly:music-property repeat-chord 'elements))))
+ (let ((arts (filter keep-element?
+ (ly:music-property original-chord
+ 'articulations))))
+ (if (pair? arts)
+ (set! (ly:music-property repeat-chord 'articulations)
+ (append!
+ (set-origin! (ly:music-deep-copy arts))
+ (ly:music-property repeat-chord 'articulations))))))
+
(define-public (expand-repeat-chords! event-types music)
"Walks through @var{music} and fills repeated chords (notable by
(defmacro-public define-syntax-function (type args signature . body)
"Helper macro for `ly:make-music-function'.
Syntax:
- (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type arg2-type ...)
+ (define-syntax-function result-type? (parser location arg1 arg2 ...) (arg1-type arg2-type ...)
...function body...)
argX-type can take one of the forms @code{predicate?} for mandatory
(if (vector? (ly:music-property quote-music 'quoted-events))
(let* ((dir (ly:music-property quote-music 'quoted-voice-direction))
- (clef (ly:music-property quote-music 'quoted-music-clef))
- (main-voice (if (eq? 1 dir) 1 0))
- (cue-voice (if (eq? 1 dir) 0 1))
+ (clef (ly:music-property quote-music 'quoted-music-clef #f))
+ (main-voice (case dir ((1) 1) ((-1) 0) (else #f)))
+ (cue-voice (and main-voice (- 1 main-voice)))
(main-music (ly:music-property quote-music 'element))
(return-value quote-music))
- (if (or (eq? 1 dir) (eq? -1 dir))
-
- ;; if we have stem dirs, change both quoted and main music
- ;; to have opposite stems.
- (begin
- (set! return-value
- ;; cannot context-spec Quote-music, since context
- ;; for the quotes is determined in the iterator.
- (make-sequential-music
- (list
- (if (null? clef)
- (make-music 'Music)
- (make-cue-clef-set clef))
- (context-spec-music (make-voice-props-override cue-voice) 'CueVoice "cue")
- quote-music
- (context-spec-music (make-voice-props-revert) 'CueVoice "cue")
- (if (null? clef)
- (make-music 'Music)
- (make-cue-clef-unset)))))
- (set! main-music
- (make-sequential-music
- (list
- (make-voice-props-override main-voice)
- main-music
- (make-voice-props-revert))))
- (set! (ly:music-property quote-music 'element) main-music)))
-
- return-value)
+ (if main-voice
+ (set! (ly:music-property quote-music 'element)
+ (make-sequential-music
+ (list
+ (make-voice-props-override main-voice)
+ main-music
+ (make-voice-props-revert)))))
+
+ ;; if we have stem dirs, change both quoted and main music
+ ;; to have opposite stems.
+
+ ;; cannot context-spec Quote-music, since context
+ ;; for the quotes is determined in the iterator.
+
+ (make-sequential-music
+ (delq! #f
+ (list
+ (and clef (make-cue-clef-set clef))
+
+ ;; Need to establish CueVoice context even in #CENTER case
+ (context-spec-music
+ (if cue-voice
+ (make-voice-props-override cue-voice)
+ (make-music 'Music))
+ 'CueVoice "cue")
+ quote-music
+ (and cue-voice
+ (context-spec-music
+ (make-voice-props-revert) 'CueVoice "cue"))
+ (and clef (make-cue-clef-unset))))))
quote-music))
(define-public ((quote-substitute quote-tab) music)
(check-pitch-against-signature context pitch barnum laziness octaveness))
(define (key-entry-notename entry)
- "Return the pitch of an entry in localKeySignature. The entry is either of the form
- '(notename . alter) or '((octave . notename) . (alter barnum . measurepos))."
- (if (number? (car entry))
- (car entry)
- (cdar entry)))
+ "Return the pitch of an @var{entry} in @code{localKeySignature}.
+The @samp{car} of the entry is either of the form @code{notename} or
+of the form @code{(octave . notename)}. The latter form is used for special
+key signatures or to indicate an explicit accidental.
+
+The @samp{cdr} of the entry is either a rational @code{alter} indicating
+a key signature alteration, or of the form
+@code{(alter . (barnum . measurepos))} indicating an alteration caused by
+an accidental in music."
+ (if (pair? (car entry))
+ (cdar entry)
+ (car entry)))
(define (key-entry-octave entry)
- "Return the octave of an entry in localKeySignature (or #f if the entry does not have
- an octave)."
+ "Return the octave of an entry in @code{localKeySignature}
+or @code{#f} if the entry does not have an octave.
+See @code{key-entry-notename} for details."
(and (pair? (car entry)) (caar entry)))
(define (key-entry-bar-number entry)
- "Return the bar number of an entry in localKeySignature (or #f if the entry does not
- have a bar number)."
- (and (pair? (car entry)) (caddr entry)))
+ "Return the bar number of an entry in @code{localKeySignature}
+or @code {#f} if the entry does not have a bar number.
+See @code{key-entry-notename} for details."
+ (and (pair? (cdr entry)) (caddr entry)))
(define (key-entry-measure-position entry)
- "Return the measure position of an entry in localKeySignature (or #f if the entry does
- not have a measure position)."
- (and (pair? (car entry)) (cdddr entry)))
+ "Return the measure position of an entry in @code{localKeySignature}
+or @code {#f} if the entry does not have a measure position.
+See @code{key-entry-notename} for details."
+ (and (pair? (cdr entry)) (cdddr entry)))
(define (key-entry-alteration entry)
"Return the alteration of an entry in localKeySignature.
For convenience, returns @code{0} if entry is @code{#f}."
(if entry
- (if (number? (car entry))
+ (if (number? (cdr entry))
(cdr entry)
(cadr entry))
0))
(let* ((entry (car keysig))
(entryoct (key-entry-octave entry))
(entrynn (key-entry-notename entry))
- (oct (ly:pitch-octave pitch))
(nn (ly:pitch-notename pitch)))
(if (and (equal? nn entrynn)
- (or (and accept-global (not entryoct))
- (and accept-local (equal? oct entryoct))))
+ (or (not entryoct)
+ (= entryoct (ly:pitch-octave pitch)))
+ (if (key-entry-bar-number entry)
+ accept-local
+ accept-global))
entry
(find-pitch-entry (cdr keysig) pitch accept-global accept-local)))))
(entry (find-pitch-entry keysig pitch #t #t)))
(if (not entry)
(cons #f #f)
- (let* ((global-entry (find-pitch-entry keysig pitch #f #f))
- (key-acc (key-entry-alteration global-entry))
- (acc (ly:pitch-alteration pitch))
- (entrymp (key-entry-measure-position entry))
+ (let* ((entrymp (key-entry-measure-position entry))
(entrybn (key-entry-bar-number entry)))
- (cons #f (not (or (equal? acc key-acc)
- (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
+ (cons #f (not (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
(define-public (set-accidentals-properties extra-natural
auto-accs auto-cauts
(set! (ly:context-property context 'localKeySignature)
(map-in-order
(lambda (entry)
- (let* ((localalt (key-entry-alteration entry))
- (localoct (key-entry-octave entry)))
+ (let* ((localalt (key-entry-alteration entry)))
(if (or (accidental-invalid? localalt)
- (not localoct)
+ (not (key-entry-bar-number entry))
(= localalt
(key-entry-alteration
(find-pitch-entry
keysig
- (ly:make-pitch localoct
+ (ly:make-pitch (key-entry-octave entry)
(key-entry-notename entry)
0)
#t #t))))
"Return a list of all pitches from @var{event-chord}."
(map (lambda (x) (ly:music-property x 'pitch))
(event-chord-notes event-chord)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; The following functions are all associated with the crossStaff
+; function
+
+(define (close-enough? x y)
+ "Values are close enough to ignore the difference"
+ (< (abs (- x y)) 0.0001))
+
+(define (extent-combine extents)
+ "Combine a list of extents"
+ (if (pair? (cdr extents))
+ (interval-union (car extents) (extent-combine (cdr extents)))
+ (car extents)))
+
+(define ((stem-connectable? ref root) stem)
+ "Check if the stem is connectable to the root"
+ ; The root is always connectable to itself
+ (or (eq? root stem)
+ (and
+ ; Horizontal positions of the stems must be almost the same
+ (close-enough? (car (ly:grob-extent root ref X))
+ (car (ly:grob-extent stem ref X)))
+ ; The stem must be in the direction away from the root's notehead
+ (positive? (* (ly:grob-property root 'direction)
+ (- (car (ly:grob-extent stem ref Y))
+ (car (ly:grob-extent root ref Y))))))))
+
+(define (stem-span-stencil span)
+ "Connect stems if we have at least one stem connectable to the root"
+ (let* ((system (ly:grob-system span))
+ (root (ly:grob-parent span X))
+ (stems (filter (stem-connectable? system root)
+ (ly:grob-object span 'stems))))
+ (if (<= 2 (length stems))
+ (let* ((yextents (map (lambda (st)
+ (ly:grob-extent st system Y)) stems))
+ (yextent (extent-combine yextents))
+ (layout (ly:grob-layout root))
+ (blot (ly:output-def-lookup layout 'blot-diameter)))
+ ; Hide spanned stems
+ (map (lambda (st)
+ (set! (ly:grob-property st 'transparent) #t))
+ stems)
+ ; Draw a nice looking stem with rounded corners
+ (ly:round-filled-box (ly:grob-extent root root X) yextent blot))
+ ; Nothing to connect, don't draw the span
+ #f)))
+
+(define ((make-stem-span! stems trans) root)
+ "Create a stem span as a child of the cross-staff stem (the root)"
+ (let ((span (ly:engraver-make-grob trans 'Stem '())))
+ (ly:grob-set-parent! span X root)
+ (set! (ly:grob-object span 'stems) stems)
+ ; Suppress positioning, the stem code is confused by this weird stem
+ (set! (ly:grob-property span 'X-offset) 0)
+ (set! (ly:grob-property span 'stencil) stem-span-stencil)))
+
+(define-public (cross-staff-connect stem)
+ "Set cross-staff property of the stem to this function to connect it to
+other stems automatically"
+ #t)
+
+(define (stem-is-root? stem)
+ "Check if automatic connecting of the stem was requested. Stems connected
+to cross-staff beams are cross-staff, but they should not be connected to
+other stems just because of that."
+ (eq? cross-staff-connect (ly:grob-property-data stem 'cross-staff)))
+
+(define (make-stem-spans! ctx stems trans)
+ "Create stem spans for cross-staff stems"
+ ; Cannot do extensive checks here, just make sure there are at least
+ ; two stems at this musical moment
+ (if (<= 2 (length stems))
+ (let ((roots (filter stem-is-root? stems)))
+ (map (make-stem-span! stems trans) roots))))
+
+(define-public (Span_stem_engraver ctx)
+ "Connect cross-staff stems to the stems above in the system"
+ (let ((stems '()))
+ (make-engraver
+ ; Record all stems for the given moment
+ (acknowledgers
+ ((stem-interface trans grob source)
+ (set! stems (cons grob stems))))
+ ; Process stems and reset the stem list to empty
+ ((process-acknowledged trans)
+ (make-stem-spans! ctx stems trans)
+ (set! stems '())))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following is used by the alterBroken function.
+
+(define-public ((value-for-spanner-piece arg) grob)
+ "Associate a piece of broken spanner @var{grob} with an element
+of list @var{arg}."
+ (let* ((orig (ly:grob-original grob))
+ (siblings (ly:spanner-broken-into orig)))
+
+ (define (helper sibs arg)
+ (if (null? arg)
+ arg
+ (if (eq? (car sibs) grob)
+ (car arg)
+ (helper (cdr sibs) (cdr arg)))))
+
+ (if (>= (length siblings) 2)
+ (helper siblings arg)
+ (car arg))))