(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.
(cons #f (not (or (equal? acc key-acc)
(and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
-(define-public (set-accidentals-properties extra-natural
- auto-accs auto-cauts
- context)
- (context-spec-music
- (make-sequential-music
- (append (if (boolean? extra-natural)
- (list (make-property-set 'extraNatural extra-natural))
- '())
- (list (make-property-set 'autoAccidentals auto-accs)
- (make-property-set 'autoCautionaries auto-cauts))))
- context))
-
-(define-public (set-accidental-style style . rest)
- "Set accidental style to @var{style}. Optionally take a context
-argument, e.g. @code{'Staff} or @code{'Voice}. The context defaults
-to @code{Staff}, except for piano styles, which use @code{GrandStaff}
-as a context."
- (let ((context (if (pair? rest)
- (car rest) 'Staff))
- (pcontext (if (pair? rest)
- (car rest) 'GrandStaff)))
- (cond
+(define-session-public accidental-styles
+ ;; An alist containing specification for all accidental styles.
+ ;; Each accidental style needs three entries for the context properties
+ ;; extraNatural, autoAccidentals and autoCautionaries.
+ ;; An optional fourth entry may specify a default context for the accidental
+ ;; style, for use with the piano styles.
+ `(
;; accidentals as they were common in the 18th century.
- ((equal? style 'default)
- (set-accidentals-properties #t
- `(Staff ,(make-accidental-rule 'same-octave 0))
- '()
- context))
+ (default #t
+ (Staff ,(make-accidental-rule 'same-octave 0))
+ ())
;; accidentals from one voice do NOT get canceled in other voices
- ((equal? style 'voice)
- (set-accidentals-properties #t
- `(Voice ,(make-accidental-rule 'same-octave 0))
- '()
- context))
- ;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century.
- ;; This includes all the default accidentals, but accidentals also needs canceling
- ;; in other octaves and in the next measure.
- ((equal? style 'modern)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- '()
- context))
+ (voice #t
+ (Voice ,(make-accidental-rule 'same-octave 0))
+ ())
+ ;; accidentals as suggested by Kurt Stone in
+ ;; ‘Music Notation in the 20th century’.
+ ;; This includes all the default accidentals, but accidentals also need
+ ;; canceling in other octaves and in the next measure.
+ (modern #f
+ (Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ ())
;; the accidentals that Stone adds to the old standard as cautionaries
- ((equal? style 'modern-cautionary)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- context))
- ;; same as modern, but accidentals different from the key signature are always
- ;; typeset - unless they directly follow a note of the same pitch.
- ((equal? style 'neo-modern)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- '()
- context))
- ((equal? style 'neo-modern-cautionary)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- context))
- ((equal? style 'neo-modern-voice)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- '()
- context))
- ((equal? style 'neo-modern-voice-cautionary)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0))
- `(Voice ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- context))
+ (modern-cautionary #f
+ (Staff ,(make-accidental-rule 'same-octave 0))
+ (Staff ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)))
+ ;; same as modern, but accidentals different from the key signature are
+ ;; always typeset - unless they directly follow a note of the same pitch.
+ (neo-modern #f
+ (Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule)
+ ())
+ (neo-modern-cautionary #f
+ (Staff ,(make-accidental-rule 'same-octave 0))
+ (Staff ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule))
+ (neo-modern-voice #f
+ (Voice ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule
+ Staff
+ ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule)
+ ())
+ (neo-modern-voice-cautionary #f
+ (Voice ,(make-accidental-rule 'same-octave 0))
+ (Voice ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule
+ Staff
+ ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule))
+
;; Accidentals as they were common in dodecaphonic music with no tonality.
;; Each note gets one accidental.
- ((equal? style 'dodecaphonic)
- (set-accidentals-properties #f
- `(Staff ,(lambda (c p bn mp) '(#f . #t)))
- '()
- context))
+ (dodecaphonic #f
+ (Staff ,(lambda (c p bn mp) '(#f . #t)))
+ ())
;; As in dodecaphonic style with the exception that immediately
;; repeated notes (in the same voice) don't get an accidental
- ((equal? style 'dodecaphonic-no-repeat)
- (set-accidentals-properties #f
- `(Staff ,dodecaphonic-no-repeat-rule)
- '()
- context))
+ (dodecaphonic-no-repeat #f
+ (Staff ,dodecaphonic-no-repeat-rule)
+ ())
;; Variety of the dodecaphonic style. Each note gets an accidental,
;; except notes that were already handled in the same measure.
- ((equal? style 'dodecaphonic-first)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-dodecaphonic-rule 'same-octave 0))
- '()
- context))
+ (dodecaphonic-first #f
+ (Staff ,(make-accidental-dodecaphonic-rule 'same-octave 0))
+ ())
;; Multivoice accidentals to be read both by musicians playing one voice
- ;; and musicians playing all voices.
- ;; Accidentals are typeset for each voice, but they ARE canceled across voices.
- ((equal? style 'modern-voice)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- '()
- context))
- ;; same as modernVoiceAccidental eccept that all special accidentals are typeset
- ;; as cautionaries
- ((equal? style 'modern-voice-cautionary)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0))
- `(Voice ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- context))
- ;; stone's suggestions for accidentals on grand staff.
- ;; Accidentals are canceled across the staves in the same grand staff as well
- ((equal? style 'piano)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- GrandStaff
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- '()
- pcontext))
- ((equal? style 'piano-cautionary)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- GrandStaff
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- pcontext))
-
- ;; same as modern, but cautionary accidentals are printed for all sharp or flat
- ;; tones specified by the key signature.
- ((equal? style 'teaching)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'same-octave 1)
- ,teaching-accidental-rule)
- context))
+ ;; and musicians playing all voices. Accidentals are typeset for each
+ ;; voice, but they ARE canceled across voices.
+ (modern-voice #f
+ (Voice ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ Staff
+ ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ ())
+ ;; same as modernVoiceAccidental except that all special accidentals
+ ;; are typeset as cautionaries
+ (modern-voice-cautionary #f
+ (Voice ,(make-accidental-rule 'same-octave 0))
+ (Voice ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ Staff
+ ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)))
+
+ ;; Stone's suggestions for accidentals on grand staff.
+ ;; Accidentals are canceled across the staves
+ ;; in the same grand staff as well
+ (piano #f
+ (Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ GrandStaff
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ ()
+ GrandStaff)
+ (piano-cautionary #f
+ (Staff ,(make-accidental-rule 'same-octave 0))
+ (Staff ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ GrandStaff
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ GrandStaff)
+
+ ;; same as modern, but cautionary accidentals are printed for all
+ ;; non-natural tones specified by the key signature.
+ (teaching #f
+ (Staff ,(make-accidental-rule 'same-octave 0))
+ (Staff ,(make-accidental-rule 'same-octave 1)
+ ,teaching-accidental-rule))
;; do not set localAlterations when a note alterated differently from
;; localAlterations is found.
;; remembered for the duration of a measure.
;; accidentals not being remembered, causing accidentals always to
;; be typeset relative to the time signature
- ((equal? style 'forget)
- (set-accidentals-properties '()
- `(Staff ,(make-accidental-rule 'same-octave -1))
- '()
- context))
+ (forget ()
+ (Staff ,(make-accidental-rule 'same-octave -1))
+ ())
;; Do not reset the key at the start of a measure. Accidentals will be
;; printed only once and are in effect until overridden, possibly many
;; measures later.
- ((equal? style 'no-reset)
- (set-accidentals-properties '()
- `(Staff ,(make-accidental-rule 'same-octave #t))
- '()
- context))
- (else
- (ly:warning (_ "unknown accidental style: ~S") style)
- (make-sequential-music '())))))
+ (no-reset ()
+ (Staff ,(make-accidental-rule 'same-octave #t))
+ ())
+ ))
+
+(define-public (set-accidental-style style . rest)
+ "Set accidental style to @var{style}. Optionally take a context
+argument, e.g. @code{'Staff} or @code{'Voice}. The context defaults
+to @code{Staff}, except for piano styles, which use @code{GrandStaff}
+as a context."
+ (let ((spec (assoc-get style accidental-styles)))
+ (if spec
+ (let ((extra-natural (first spec))
+ (auto-accs (second spec))
+ (auto-cauts (third spec))
+ (context (cond ((pair? rest) (car rest))
+ ((= 4 (length spec)) (fourth spec))
+ (else 'Staff))))
+ (context-spec-music
+ (make-sequential-music
+ (append (if (boolean? extra-natural)
+ (list (make-property-set 'extraNatural extra-natural))
+ '())
+ (list (make-property-set 'autoAccidentals auto-accs)
+ (make-property-set 'autoCautionaries auto-cauts))))
+ context))
+ (begin
+ (ly:warning (_ "unknown accidental style: ~S") style)
+ (make-sequential-music '())))))
(define-public (invalidate-alterations context)
"Invalidate alterations in @var{context}.
(map (lambda (x) (ly:music-property x 'pitch))
(event-chord-notes event-chord)))
+(define-public (music-pitches music)
+ "Return a list of all pitches from @var{music}."
+ ;; Opencoded for efficiency.
+ (reverse!
+ (let loop ((music music) (pitches '()))
+ (let ((p (ly:music-property music 'pitch)))
+ (if (ly:pitch? p)
+ (cons p pitches)
+ (let ((elt (ly:music-property music 'element)))
+ (fold loop
+ (if (ly:music? elt)
+ (loop elt pitches)
+ pitches)
+ (ly:music-property music 'elements))))))))
+
(define-public (event-chord-reduce music)
"Reduces event chords in @var{music} to their first note event,
retaining only the chord articulations. Returns the modified music."
projects / lilypond.git / blobdiff