(define-public (music-filter pred? music)
"Filter out music expressions that do not satisfy @var{pred?}."
- (define (inner-music-filter pred? music)
+ (define (inner-music-filter music)
"Recursive function."
(let* ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element))
(as (ly:music-property music 'articulations))
- (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) as)))
+ (filtered-as (filter ly:music? (map inner-music-filter as)))
(filtered-e (if (ly:music? e)
- (inner-music-filter pred? e)
+ (inner-music-filter e)
e))
- (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
+ (filtered-es (filter ly:music? (map inner-music-filter es))))
(if (not (null? e))
(set! (ly:music-property music 'element) filtered-e))
(if (not (null? es))
(set! (ly:music-property music 'elements) filtered-es))
(if (not (null? as))
(set! (ly:music-property music 'articulations) filtered-as))
- ;; if filtering emptied the expression, we remove it completely.
+ ;; if filtering invalidated 'element, we remove the music unless
+ ;; there are remaining 'elements in which case we just hope and
+ ;; pray.
(if (or (not (pred? music))
- (and (eq? filtered-es '()) (not (ly:music? e))
- (or (not (eq? es '()))
- (ly:music? e))))
+ (and (null? filtered-es)
+ (not (ly:music? filtered-e))
+ (ly:music? e)))
(set! music '()))
music))
- (set! music (inner-music-filter pred? music))
+ (set! music (inner-music-filter music))
(if (ly:music? music)
music
(make-music 'Music))) ;must return music.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; repeats.
-(define-public (unfold-repeats music)
- "Replace all repeats with unfolded repeats."
- (let ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element)))
- (if (music-is-of-type? music 'repeated-music)
- (set! music (make-music 'UnfoldedRepeatedMusic music)))
- (if (pair? es)
- (set! (ly:music-property music 'elements)
- (map unfold-repeats es)))
- (if (ly:music? e)
- (set! (ly:music-property music 'element)
- (unfold-repeats e)))
- music))
+(define-public (unfold-repeats types music)
+ "Replace repeats of the types given by @var{types} with unfolded repeats.
+If @var{types} is an empty list, @code{repeated-music} is taken, unfolding all."
+ (let* ((types-list
+ (if (or (null? types) (not (list? types)))
+ (list types)
+ types))
+ (repeat-types-alist
+ '((volta . volta-repeated-music)
+ (percent . percent-repeated-music)
+ (tremolo . tremolo-repeated-music)
+ (() . repeated-music)))
+ (repeat-types-hash (alist->hash-table repeat-types-alist)))
+ (for-each
+ (lambda (type)
+ (let ((repeat-type (hashq-ref repeat-types-hash type)))
+ (if repeat-type
+ (let ((es (ly:music-property music 'elements))
+ (e (ly:music-property music 'element)))
+ (if (music-is-of-type? music repeat-type)
+ (set! music (make-music 'UnfoldedRepeatedMusic music)))
+ (if (pair? es)
+ (set! (ly:music-property music 'elements)
+ (map (lambda (x) (unfold-repeats types x)) es)))
+ (if (ly:music? e)
+ (set! (ly:music-property music 'element)
+ (unfold-repeats types e))))
+ (ly:warning "unknown repeat-type ~a, ignoring." type))))
+ types-list)
+ music))
(define-public (unfold-repeats-fully music)
"Unfolds repeats and expands the resulting @code{unfolded-repeated-music}."
(and (music-is-of-type? m 'unfolded-repeated-music)
(make-sequential-music
(ly:music-deep-copy (make-unfolded-set m)))))
- (unfold-repeats music)))
+ (unfold-repeats '() music)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; property setting music objs.
(number-pair? offsets)))
(coord-translate arg offsets))
((and (number-pair-list? arg) (number-pair-list? offsets))
- (map
- (lambda (x y) (coord-translate x y))
- arg offsets))
+ (map coord-translate arg offsets))
(else arg)))
(define-public (grob-transformer property func)
pure or unpure values. @var{func} is called with the respective grob
as first argument and the default value (after resolving all callbacks)
as the second."
- (define (worker self container-part grob . rest)
+ (define (worker self caller grob . rest)
(let* ((immutable (ly:grob-basic-properties grob))
;; We need to search the basic-properties alist for our
;; property to obtain values to offset. Our search is
(target (find-value-to-offset property self immutable))
;; if target is a procedure, we need to apply it to our
;; grob to calculate values to offset.
- (vals (cond ((procedure? target) (target grob))
- ;; Argument lists for a pure procedure pulled
- ;; from an unpure-pure-container may be
- ;; different from a normal procedure, so we
- ;; need a different code path and calling
- ;; convention for procedures pulled from an
- ;; container as opposed to from the property
- ((ly:unpure-pure-container? target)
- (let ((part (container-part target)))
- (if (procedure? part)
- (apply part grob rest)
- part)))
- (else target))))
+ (vals (apply caller target grob rest)))
(func grob vals)))
;; return the container named `self'. The container self-reference
;; seems like chasing its own tail but gets dissolved by
;; define/lambda separating binding and referencing of "self".
(define self (ly:make-unpure-pure-container
(lambda (grob)
- (worker self ly:unpure-pure-container-unpure-part grob))
+ (worker self ly:unpure-call grob))
(lambda (grob . rest)
- (apply worker self ly:unpure-pure-container-pure-part
- grob rest))))
+ (apply worker self ly:pure-call grob rest))))
self)
(define-public (offsetter property offsets)
projects / lilypond.git / blobdiff