;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
(ly:in-event-class? x 'note-event))
(filter f? (events vs)))
+(define-method (rest-and-skip-events (vs <Voice-state>))
+ (define (f? x)
+ (or (ly:in-event-class? x 'rest-event)
+ (ly:in-event-class? x 'skip-event)))
+ (filter f? (events vs)))
+
(define-method (previous-voice-state (vs <Voice-state>))
(let ((i (slot-ref vs 'vector-index))
(v (slot-ref vs 'state-vector)))
(helper 0 '()))
+(define recording-group-functions
+ ;;Selected parts from @var{toplevel-music-functions} not requiring @code{parser}.
+ (list
+ (lambda (music) (expand-repeat-chords! '(rhythmic-event) music))
+ expand-repeat-notes!))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (recording-group-emulate music odef)
"Interpret @var{music} according to @var{odef}, but store all events
(ly:add-listener new-context-listener
(ly:context-events-below global) 'AnnounceNewContext)
(ly:add-listener mom-listener (ly:context-event-source global) 'Prepare)
- (ly:interpret-music-expression (make-non-relative-music music) global)
+ (ly:interpret-music-expression
+ (make-non-relative-music
+ (fold (lambda (x m) (x m)) music recording-group-functions))
+ global)
context-list))
-(define-public (make-part-combine-music parser music-list direction)
+(define-public (make-part-combine-music parser music-list direction chord-range)
(let* ((m (make-music 'PartCombineMusic))
(m1 (make-non-relative-music (context-spec-music (first music-list) 'Voice "one")))
(m2 (make-non-relative-music (context-spec-music (second music-list) 'Voice "two")))
(set! (ly:music-property m 'split-list)
(if (and (assoc "one" evs1) (assoc "two" evs2))
(determine-split-list (reverse! (assoc-get "one" evs1) '())
- (reverse! (assoc-get "two" evs2) '()))
+ (reverse! (assoc-get "two" evs2) '())
+ chord-range)
'()))
m))
-(define-public (determine-split-list evl1 evl2)
- "@var{evl1} and @var{evl2} should be ascending."
+(define-public (determine-split-list evl1 evl2 chord-range)
+ "@var{evl1} and @var{evl2} should be ascending. @var{chord-range} is a pair of numbers (min . max) defining the distance in steps between notes that may be combined into a chord or unison."
(let* ((pc-debug #f)
- (chord-threshold 8)
(voice-state-vec1 (make-voice-states evl1))
(voice-state-vec2 (make-voice-states evl2))
- (result (make-split-state voice-state-vec1 voice-state-vec2)))
+ (result (make-split-state voice-state-vec1 voice-state-vec2))
+ (chord-min-diff (car chord-range))
+ (chord-max-diff (cdr chord-range)))
;; Go through all moments recursively and check if the events of that
;; moment contain a part-combine-force-event override. If so, store its
(define (analyse-forced-combine result-idx prev-res)
(define (get-forced-event x)
- (if (ly:in-event-class? x 'part-combine-force-event)
- (cons (ly:event-property x 'forced-type) (ly:event-property x 'once))
- #f))
+ (and (ly:in-event-class? x 'part-combine-force-event)
+ (cons (ly:event-property x 'forced-type)
+ (ly:event-property x 'once))))
(define (part-combine-events vs)
(if (not vs)
'()
(if (< result-idx (vector-length result))
(let* ((now-state (vector-ref result result-idx)) ; current result
;; Extract all part-combine force events
- (ev1 (part-combine-events (car (voice-states now-state))))
- (ev2 (part-combine-events (cdr (voice-states now-state))))
- (evts (append ev1 ev2))
+ (evts (if (synced? now-state)
+ (append
+ (part-combine-events (car (voice-states now-state)))
+ (part-combine-events (cdr (voice-states now-state))))
+ '()))
;; result is (once-state permament-state):
(state (fold forced-result (cons 'automatic prev-res) evts))
;; Now let once override permanent changes:
(prev (configuration prev-ss)))
(if (symbol? prev)
(put prev))))
- (map copy-one-state (span-state vs)))
+ (for-each copy-one-state (span-state vs)))
(define (analyse-notes now-state)
(let* ((vs1 (car (voice-states now-state)))
(if (and (= (length pitches1) (length pitches2)))
(if (and (pair? pitches1)
(pair? pitches2)
- (or
- (< chord-threshold (ly:pitch-steps
- (ly:pitch-diff (car pitches1)
- (car pitches2))))
-
- ;; voice crossings:
- (> 0 (ly:pitch-steps (ly:pitch-diff (car pitches1)
- (car pitches2))))
- ))
+ ; Is the interval outside of chord-range?
+ (let ((diff (ly:pitch-steps
+ (ly:pitch-diff (car pitches1)
+ (car pitches2)))))
+ (or (< diff chord-min-diff)
+ (> diff chord-max-diff)
+ )))
(put 'apart)
;; copy previous split state from spanner state
(begin
(let* ((now-state (vector-ref result result-idx))
(vs1 (car (voice-states now-state)))
(vs2 (cdr (voice-states now-state))))
- (if (and (equal? (configuration now-state) 'chords)
- vs1 vs2)
- (let ((notes1 (note-events vs1))
- (notes2 (note-events vs2)))
- (cond ((and (= 1 (length notes1))
+
+ (define (analyse-silence)
+ (let ((rests1 (if vs1 (rest-and-skip-events vs1) '()))
+ (rests2 (if vs2 (rest-and-skip-events vs2) '())))
+ (cond
+
+ ;; multi-measure rests (probably), which the
+ ;; part-combine iterator handles well
+ ((and (synced? now-state)
+ (= 0 (length rests1))
+ (= 0 (length rests2)))
+ (set! (configuration now-state) 'unisilence))
+
+ ;; equal rests or equal skips, but not one of each
+ ((and (synced? now-state)
+ (= 1 (length rests1))
+ (= 1 (length rests2))
+ (equal? (ly:event-property (car rests1) 'class)
+ (ly:event-property (car rests2) 'class))
+ (equal? (ly:event-property (car rests1) 'duration)
+ (ly:event-property (car rests2) 'duration)))
+ (set! (configuration now-state) 'unisilence))
+
+ ;; rests of different durations or mixed with
+ ;; skips or multi-measure rests
+ ((synced? now-state)
+ ;; TODO When one part has a rest and the other has a
+ ;; multi-measure rest, tell the part-combine
+ ;; iterator to route the part with the rest to the
+ ;; shared voice. Until there is a way to do this,
+ ;; we print them both; it does not look very good,
+ ;; but failing to print the rest is misleading.
+ ;;
+ ;; Maybe do something similar for skips; route
+ ;; the rest to the shared voice and the skip to
+ ;; the voice for its part.
+ (set! (configuration now-state) 'apart-silence))
+
+ ;; TODO At a multi-measure rest, return to unisilence
+ ;; even after having been apart. The results are not
+ ;; good now because of the deficiency mentioned
+ ;; above.
+ )))
+
+ (if (or vs1 vs2)
+ (let ((notes1 (if vs1 (note-events vs1) '()))
+ (notes2 (if vs2 (note-events vs2) '())))
+ ; Todo: What about a2 chords, e.g. string multi-stops?
+ ; Sort and compare notes1 and notes2?
+ (cond ((and (equal? (configuration now-state) 'chords)
+ (= 1 (length notes1))
(= 1 (length notes2))
(equal? (ly:event-property (car notes1) 'pitch)
(ly:event-property (car notes2) 'pitch)))
(set! (configuration now-state) 'unisono))
((and (= 0 (length notes1))
(= 0 (length notes2)))
- (set! (configuration now-state) 'unisilence)))))
+ (analyse-silence)))))
(analyse-a2 (1+ result-idx)))))
(define (analyse-solo12 result-idx)
projects / lilypond.git / blobdiff