;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
-;; (use-modules (ice-9 optargs))
+(use-modules (ice-9 optargs))
;;; ly:music-property with setter
;;; (ly:music-property my-music 'elements)
(inner-music-filter pred? e)
e))
(filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
- (set! (ly:music-property music 'element) filtered-e)
- (set! (ly:music-property music 'elements) filtered-es)
- (set! (ly:music-property music 'articulations) filtered-as)
+ (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 (or (not (pred? music))
(and (eq? filtered-es '()) (not (ly:music? e))
(use-modules (ice-9 pretty-print))
(define*-public (display-scheme-music obj #:optional (port (current-output-port)))
"Displays `obj', typically a music expression, in a friendly fashion,
-which often can be read back in order to generate an equivalent expression.
-
-Returns `obj'.
-"
+which often can be read back in order to generate an equivalent expression."
(pretty-print (music->make-music obj) port)
- (newline port)
- obj)
+ (newline port))
;;;
;;; Scheme music expression --> Lily-syntax-using string translator
(define (first-note-duration music)
"Finds the duration of the first NoteEvent by searching depth-first
through MUSIC."
- (if (memq 'note-event (ly:music-property music 'types))
+ ;; NoteEvent or a non-expanded chord-repetition
+ ;; We just take anything that actually sports an announced duration.
+ (if (ly:duration? (ly:music-property music 'duration))
(ly:music-property music 'duration)
(let loop ((elts (if (ly:music? (ly:music-property music 'element))
(list (ly:music-property music 'element))
(set! (ly:music-property r 'repeat-count) (max times 1))
(set! (ly:music-property r 'elements) talts)
(if (and (equal? name "tremolo")
- (or (pair? (ly:music-property main 'elements))
- (ly:music? (ly:music-property main 'element))))
+ (pair? (extract-named-music main '(EventChord NoteEvent))))
;; This works for single-note and multi-note tremolos!
(let* ((children (if (music-is-of-type? main 'sequential-music)
;; \repeat tremolo n { ... }
- (length (extract-named-music main 'EventChord))
+ (length (extract-named-music main '(EventChord
+ NoteEvent)))
;; \repeat tremolo n c4
1))
;; # of dots is equal to the 1 in bitwise representation (minus 1)!
beats to be distinguished."
(let* ((durs (map (lambda (elt)
(duration-of-note elt))
- (extract-named-music music 'EventChord)))
+ (extract-named-music music '(EventChord NoteEvent
+ RestEvent SkipEvent))))
(first-dur (car durs)))
(if (every (lambda (d) (equal? d first-dur)) durs)
(let ((ts (ly:music-property m 'types)))
(memq 'separator ts)))
+;;; expanding repeat chords
+(define-public (copy-repeat-chord original-chord repeat-chord duration
+ event-types)
+ "Copies all events in @var{event-types} (be sure to include
+@code{rhythmic-events}) from @var{original-chord} over to
+@var{repeat-chord} with their articulations filtered as well. Any
+duration is replaced with the specified @var{duration}."
+ ;; First remove everything from event-types that can already be
+ ;; 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))
+ ;; 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))))
+
+(define-public (expand-repeat-chords! event-types music)
+ "Walks through @var{music} and fills repeated chords (notable by
+having a duration in @code{duration}) with the notes from their
+respective predecessor chord."
+ (let loop ((music music) (last-chord #f))
+ (if (music-is-of-type? music 'event-chord)
+ (let ((chord-repeat (ly:music-property music 'duration)))
+ (cond
+ ((not (ly:duration? chord-repeat))
+ music)
+ (last-chord
+ (set! (ly:music-property music 'duration) '())
+ (copy-repeat-chord last-chord music chord-repeat event-types)
+ music)
+ (else
+ (ly:music-warning music (_ "Bad chord repetition"))
+ #f)))
+ (let ((elt (ly:music-property music 'element)))
+ (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord)
+ (ly:music-property music 'elements)))))
+ music)
+
;;; splitting chords into voices.
(define (voicify-list lst number)
"Make a list of Musics.
(define-public toplevel-music-functions
(list
+ (lambda (music parser) (expand-repeat-chords!
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music))
(lambda (music parser) (voicify-music music))
(lambda (x parser) (music-map music-check-error x))
(lambda (x parser) (music-map precompute-music-length x))
`(Staff ,(make-accidental-rule 'same-octave 0))
'()
context))
- ;; accidentals from one voice do NOT get cancelled in other voices
+ ;; 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 cancelling
+ ;; 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
context))
;; 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 cancelled across 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 'same-octave 1))
context))
;; stone's suggestions for accidentals on grand staff.
- ;; Accidentals are cancelled across the staves in the same grand staff as well
+ ;; 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)
(ly:music-property (car evs) 'pitch))))
(define-public (duration-of-note event-chord)
- (let ((evs (filter (lambda (x)
- (music-has-type x 'rhythmic-event))
- (ly:music-property event-chord 'elements))))
-
- (and (pair? evs)
- (ly:music-property (car evs) 'duration))))
+ (cond
+ ((pair? event-chord)
+ (or (duration-of-note (car event-chord))
+ (duration-of-note (cdr event-chord))))
+ ((ly:music? event-chord)
+ (let ((dur (ly:music-property event-chord 'duration)))
+ (if (ly:duration? dur)
+ dur
+ (duration-of-note (ly:music-property event-chord 'elements)))))
+ (else #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (extract-named-music music music-name)
"Return a flat list of all music named @var{music-name} from @var{music}."
- (let ((extracted-list
- (if (ly:music? music)
- (if (eq? (ly:music-property music 'name) music-name)
- (list music)
- (let ((elt (ly:music-property music 'element))
- (elts (ly:music-property music 'elements)))
- (if (ly:music? elt)
- (extract-named-music elt music-name)
- (if (null? elts)
- '()
- (map (lambda(x)
- (extract-named-music x music-name ))
- elts)))))
- '())))
- (flatten-list extracted-list)))
+ (if (not (list? music-name))
+ (set! music-name (list music-name)))
+ (if (ly:music? music)
+ (if (memq (ly:music-property music 'name) music-name)
+ (list music)
+ (let ((arts (ly:music-property music 'articulations)))
+ (append-map!
+ (lambda (x) (extract-named-music x music-name))
+ (if (pair? arts)
+ arts
+ (cons (ly:music-property music 'element)
+ (ly:music-property music 'elements))))))
+ '()))
+
+(define-public (extract-typed-music music type)
+ "Return a flat list of all music with @var{type} from @var{music}."
+ (if (ly:music? music)
+ (if (music-is-of-type? music type)
+ (list music)
+ (let ((arts (ly:music-property music 'articulations)))
+ (append-map!
+ (lambda (x) (extract-typed-music x type))
+ (if (pair? arts)
+ arts
+ (cons (ly:music-property music 'element)
+ (ly:music-property music 'elements))))))
+ '()))
(define-public (event-chord-notes event-chord)
"Return a list of all notes from @var{event-chord}."