Ends of barlines are hidden in staff lines.

[lilypond.git] / scm / part-combiner.scm

diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index ad828b85b203cb00facb99d81133501f550b3247..c492701c9142087bb6c44ac65deabf1a41d0a224 100644 (file)
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;

-;;;; Copyright (C) 2004--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2011 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
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by


@@ -54,7 +54,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-class <Split-state> ()
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-class <Split-state> ()

+  ;; The automatically determined split configuration

   (configuration #:init-value '() #:accessor configuration)
   (configuration #:init-value '() #:accessor configuration)

+  ;; Allow overriding split configuration, takes precedence over configuration
+  (forced-configuration #:init-value #f #:accessor forced-configuration)

   (when-moment #:accessor when #:init-keyword #:when)
   ;; voice-states are states starting with the Split-state or later
   ;;
   (when-moment #:accessor when #:init-keyword #:when)
   ;; voice-states are states starting with the Split-state or later
   ;;


@@ -197,8 +200,9 @@ Voice-state objects
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define-public (recording-group-emulate music odef)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define-public (recording-group-emulate music odef)

-  "Interprets music according to odef, but stores all events in a chronological
-list, similar to the Recording_group_engraver in 2.8 and earlier"
+  "Interpret @var{music} according to @var{odef}, but store all events
+in a chronological list, similar to the @code{Recording_group_engraver} in
+LilyPond version 2.8 and earlier."

   (let*
      ((context-list '())
       (now-mom (ly:make-moment 0 0))
   (let*
      ((context-list '())
       (now-mom (ly:make-moment 0 0))


@@ -256,13 +260,63 @@ list, similar to the Recording_group_engraver in 2.8 and earlier"
     m))
 
 (define-public (determine-split-list evl1 evl2)
     m))
 
 (define-public (determine-split-list evl1 evl2)

-  "EVL1 and EVL2 should be ascending"
+  "@var{evl1} and @var{evl2} should be ascending."

   (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)))
 
   (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)))
 

+    ;; Go through all moments recursively and check if the events of that
+    ;; moment contain a part-combine-force-event override. If so, store its
+    ;; value in the forced-configuration field, which will override. The
+    ;; previous configuration is used to determine non-terminated settings.
+    (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))
+      (define (part-combine-events vs)
+       (if (not vs)
+           '()
+           (filter-map get-forced-event (events vs))))
+      ;; end part-combine-events
+
+      ;; forced-result: Take the previous config and analyse whether
+      ;; any change happened.... Return new once and permanent config
+      (define (forced-result evt state)
+       ;; sanity check, evt should always be (new-state . once)
+       (if (not (and (pair? evt) (pair? state)))
+           state
+           (if (cdr evt)
+               ;; Once-event, leave permanent state unchanged
+               (cons (car evt) (cdr state))
+               ;; permanent change, leave once state unchanged
+               (cons (car state) (car evt)))))
+      ;; end forced-combine-result
+
+      ;; body of analyse-forced-combine:
+      (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))
+                ;; result is (once-state permament-state):
+                (state (fold forced-result (cons 'automatic prev-res) evts))
+                ;; Now let once override permanent changes:
+                (force-state (if (equal? (car state) 'automatic)
+                                 (cdr state)
+                                 (car state))))
+           (set! (forced-configuration (vector-ref result result-idx))
+                 force-state)
+           ;; For the next moment, ignore the once override (car stat)
+           ;; and pass on the permanent override, stored as (cdr state)
+           (analyse-forced-combine (1+ result-idx) (cdr state)))))
+    ;; end analyse-forced-combine
+
+

     (define (analyse-time-step result-idx)
       (define (put x . index)
        "Put the result to X, starting from INDEX backwards.
     (define (analyse-time-step result-idx)
       (define (put x . index)
        "Put the result to X, starting from INDEX backwards.


@@ -409,7 +463,7 @@ Only set if not set previously.
            (previous-voice-state vs)))
 
       (define (try-solo type start-idx current-idx)
            (previous-voice-state vs)))
 
       (define (try-solo type start-idx current-idx)

-       "Find a maximum stretch that can be marked as solo. Only set
+       "Find a maximum stretch that can be marked as solo.  Only set

 the mark when there are no spanners active.
 
       return next idx to analyse.
 the mark when there are no spanners active.
 
       return next idx to analyse.


@@ -444,7 +498,7 @@ the mark when there are no spanners active.
            start-idx))
 
       (define (analyse-moment result-idx)
            start-idx))
 
       (define (analyse-moment result-idx)

-       "Analyse 'apart starting at RESULT-IDX. Return next index. "
+       "Analyse 'apart starting at RESULT-IDX.  Return next index."

        (let* ((now-state (vector-ref result result-idx))
               (vs1 (current-voice-state now-state 1))
               (vs2 (current-voice-state now-state 2))
        (let* ((now-state (vector-ref result result-idx))
               (vs1 (current-voice-state now-state 1))
               (vs2 (current-voice-state now-state 2))


@@ -488,14 +542,25 @@ the mark when there are no spanners active.
          (display "***\n")
          (display result)
          (display "***\n")))
          (display "***\n")
          (display result)
          (display "***\n")))

+
+    ;; Extract all forced combine strategies, i.e. events inserted by
+    ;; \partcombine(Apart|Automatic|SoloI|SoloII|Chords)[Once]
+    ;; They will in the end override the automaically determined ones.
+    ;; Initial state for both voices is no override
+    (analyse-forced-combine 0 #f)
+    ;; Now go through all time steps in a loop and find a combination strategy
+    ;; based only on the events of that one moment (i.e. neglecting longer
+    ;; periods of solo/apart, etc.)

     (analyse-time-step 0)
     ;; (display result)
     (analyse-time-step 0)
     ;; (display result)

+    ;; Check for unisono or unisilence moments

     (analyse-a2 0)
     ;;(display result)
     (analyse-solo12 0)
     ;; (display result)
     (set! result (map
     (analyse-a2 0)
     ;;(display result)
     (analyse-solo12 0)
     ;; (display result)
     (set! result (map

-                 (lambda (x) (cons (when x) (configuration x)))
+                 ;; forced-configuration overrides, if it is set
+                 (lambda (x) (cons (when x) (or (forced-configuration x) (configuration x))))

                  (vector->list result)))
     (if #f ;; pc-debug
         (display result))
                  (vector->list result)))
     (if #f ;; pc-debug
         (display result))


@@ -506,10 +571,27 @@ the mark when there are no spanners active.
 
 (define-public (add-quotable parser name mus)
   (let* ((tab (eval 'musicQuotes (current-module)))
 
 (define-public (add-quotable parser name mus)
   (let* ((tab (eval 'musicQuotes (current-module)))

-        (context-list (recording-group-emulate (context-spec-music mus 'Voice)
-                                               (ly:parser-lookup parser 'partCombineListener))))
-    (if (pair? context-list)
-       (hash-set! tab name
-                  ;; cdr : skip name string
-                  (list->vector (reverse! (cdar context-list)
-                                          '()))))))
+         (voicename (get-next-unique-voice-name))
+         ;; recording-group-emulate returns an assoc list (reversed!), so
+         ;; hand it a proper unique context name and extract that key:
+         (ctx-spec (context-spec-music mus 'Voice voicename))
+         (listener (ly:parser-lookup parser 'partCombineListener))
+         (context-list (reverse (recording-group-emulate ctx-spec listener)))
+         (raw-voice (assoc voicename context-list))
+         (quote-contents (if (pair? raw-voice) (cdr raw-voice) '())))
+
+    ;; If the context-specced quoted music does not contain anything, try to
+    ;; use the first child, i.e. the next in context-list after voicename
+    ;; That's the case e.g. for \addQuote "x" \relative c \new Voice {...}
+    (if (null? quote-contents)
+        (let find-non-empty ((current-tail (member raw-voice context-list)))
+          ;; if voice has contents, use them, otherwise check next ctx
+          (cond ((null? current-tail) #f)
+                ((and (pair? (car current-tail))
+                      (pair? (cdar current-tail)))
+                 (set! quote-contents (cdar current-tail)))
+                (else (find-non-empty (cdr current-tail))))))
+
+    (if (not (null? quote-contents))
+        (hash-set! tab name (list->vector (reverse! quote-contents '())))
+        (ly:music-warning mus (ly:format (_ "quoted music `~a' is empty") name)))))