From: hanwen <hanwen>
Date: Sat, 24 Jan 2004 00:38:44 +0000 (+0000)
Subject: (determine-split-list): analysis has
X-Git-Tag: release/2.1.15~17
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0df2742eb4283ace1c671a54034961e39cd23219;p=lilypond.git

(determine-split-list): analysis has
global effect: a difference halfway a phrase makes the entire
phrase be typeset as apart.
---

diff --git a/ChangeLog b/ChangeLog
index 6448ea29e5..2d8e13a48d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2004-01-24  Han-Wen Nienhuys   <hanwen@xs4all.nl>
+
+	* scm/music-functions.scm (determine-split-list): analysis has
+	global effect: a difference halfway a phrase makes the entire
+	phrase be typeset as apart.
+
+2004-01-23  Han-Wen Nienhuys   <hanwen@xs4all.nl>
+
+	* ly/performer-init.ly: add Devnull.
+
+	* Documentation/user/refman.itely (Font selection): remove paper20
+	ref.
+	
 2004-01-22  Jan Nieuwenhuizen  <janneke@gnu.org>
 
 	* scripts/convert-ly.py (1.9.0): Handle phrasing slur.
diff --git a/Documentation/user/refman.itely b/Documentation/user/refman.itely
index 2dafbd0c0f..88eeef73cf 100644
--- a/Documentation/user/refman.itely
+++ b/Documentation/user/refman.itely
@@ -7769,22 +7769,22 @@ A property tweak of modifies a local copy of the object definition.
 After such a tweak, the definition is independent of the objects in
 enclosing contexts. For example
 
-@lilypond
-  \property Voice.Stem \set #'neutral-direction = #1
-  b'8
+@lilypond[verbatim,fragment]
+  \property Voice.Stem \set #'direction = #1
+  a'4
   \property Staff.Stem \set #'thickness = #4.0
-  b'16
-  \new Voice { b'32 }
+  a'8
+  \new Voice { a'32 }
 @end lilypond
 
-In this fragment, @code{neutral-direction} is tweaked. As a result,
-the current @internalsref{Voice} gets a private version of the
+In this fragment, @code{direction} is tweaked. As a result, the
+current @internalsref{Voice} gets a private version of the
 @internalsref{Stem} object. The following tweak modifies the
 definition at @internalsref{Staff} level. Since it a different
-definition, the thickness of the @code{b'16} is unaffected.  For the
-third note, a new Voice is created, which inherits the new definition,
-including the changed thickness, but excluding the new neutral
-direction.
+definition, the thickness of the first @code{b'16} is unaffected.  For
+the third note, a new Voice is created, which inherits the new
+definition, including the changed thickness, but excluding the new
+neutral direction.
 
 
 
@@ -8095,8 +8095,8 @@ The following commands set @code{fontSize} for the current voice.
 
 @seealso
 
-Init files: @file{ly/paper20.ly} contains hints how new fonts may be
-added to LilyPond.
+Init files: @file{ly/declarations-init.ly} contains hints how new
+fonts may be added to LilyPond.
 
 @refbugs
 
diff --git a/THANKS b/THANKS
index 45cc9324c1..a34e55b3f6 100644
--- a/THANKS
+++ b/THANKS
@@ -11,6 +11,8 @@ Reuben Thomas
 Thomas Willhalm
 Werner Lemberg
 Nicolas Sceaux 
+Nick Busigin
+
 
 Release 2.0
 ***********
diff --git a/input/regression/new-part-combine.ly b/input/regression/new-part-combine.ly
index f258691e60..1e315e6e36 100644
--- a/input/regression/new-part-combine.ly
+++ b/input/regression/new-part-combine.ly
@@ -14,8 +14,8 @@ theMusic = \context Staff \notes { c4 d8-. }
 
 
 
-vone = \notes \relative a' { g2 g    g  g4 g f' c c( c)  }
-vtwo = \notes \relative a' { f2 f4 f f2 g4 g c, f f  f   }
+vone = \notes \relative a' { g2 g    g  g4 g f' c c( c) c c  c ~ c }
+vtwo = \notes \relative a' { f2 f4 f f2 g4 g c, f f  f  f f~ f ~ f }
 
 \score {
    \newpartcombine \vone \vtwo
diff --git a/input/regression/part-combine-global.ly b/input/regression/part-combine-global.ly
new file mode 100644
index 0000000000..b39d9e03f0
--- /dev/null
+++ b/input/regression/part-combine-global.ly
@@ -0,0 +1,34 @@
+
+
+\header { texidoc=
+
+	  "The analysis of the part combiner is non-local:
+in the following example, the decision for using separate voices in
+the 1st measure is made on the 2nd note, but influences the 1st note.
+
+In the 2nd measure, the pattern without the tie, leads to combined
+voices.
+  
+"
+    }
+\version "1.9.8"
+
+vone =\notes
+
+%%%%%%%%%%%%%%  0   1   2   3  
+\relative c'' {
+    \time 2/4
+    a8[ a]  a8[ a] |
+    a8[ a]  a8[ a]
+}
+
+vtwo =\notes
+\relative c' {
+    \time 2/4
+    f8[ f]~ f8[ f] |
+    f8[ f]  f8[ f]
+}
+
+\score {
+    \newpartcombine \vone \vtwo
+    }
diff --git a/lily/new-part-combine-iterator.cc b/lily/new-part-combine-iterator.cc
index 3bfcb5dcaa..48a8039e35 100644
--- a/lily/new-part-combine-iterator.cc
+++ b/lily/new-part-combine-iterator.cc
@@ -261,7 +261,8 @@ New_pc_iterator::process (Moment m)
 	solo2 ();
       else
 	{
-	  String s =  "Unknown split directive: " + ly_symbol2string (tag);
+	  String s =  "Unknown split directive: "
+	    + (gh_symbol_p (tag) ? ly_symbol2string (tag) : String ("not a symbol")); 
 	  programming_error (s);
 	}
     }
diff --git a/ly/performer-init.ly b/ly/performer-init.ly
index 0d21c2d45f..e35ecdf74f 100644
--- a/ly/performer-init.ly
+++ b/ly/performer-init.ly
@@ -73,6 +73,7 @@
 	\accepts TabStaff
 	\accepts Lyrics 
 	\accepts StaffGroup
+	\accepts Devnull
 	\accepts ChoirStaff
 	\accepts RhythmicStaff
 	\accepts ChordNames
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 4ee6dcd4a9..74f42bc1f0 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -835,6 +835,10 @@ Rest can contain a list of beat groupings
 ;; stack traces result in core dumps.
 ;; therefore we retain debugging code.
 ;;
+
+;;
+;; todo: this is too hairy.
+;;
 (define-public (determine-split-list evl1 evl2)
   "EVL1 and EVL2 should be ascending"
   
@@ -854,41 +858,77 @@ Rest can contain a list of beat groupings
 	  (uniq-list
 	  (merge (map car evl1) (map car evl2) ly:moment<?)))))
 
-  (define (analyse-events i1 i2 ri
-			  active1
-			  active2)
-
-    (define (analyse-span-events active evs)
-      (define (analyse-span-event active ev)
-	(let*
-	    ((name (ly:get-mus-property ev 'name))
-	     (key (cond
-		   ((equal? name 'SlurEvent) 'slur)
-		   ((equal? name 'PhrasingSlurEvent) 'tie)
-		   ((equal? name 'Beam) 'beam)
-		   (else #f)))
-	     (sp (ly:get-mus-property ev 'span-direction)))
-
-	   (if (and (symbol? key) (ly:dir? sp))
-	       ((if (= sp STOP) delete! cons) key active)
-	       active))
-	)
+  (define (analyse-time-step i1 i2 ri
+			     active1
+			     active2)
 
-      (if (pair? evs)
-	  (analyse-span-events
-	   (analyse-span-event active (car evs))
-	   (cdr evs))
+    (define (analyse-tie-start active ev)
+      (if (equal? (ly:get-mus-property ev 'name) 'TieEvent)
+	  (acons 'tie ri active)
 	  active
 	  ))
     
+    (define (analyse-tie-end active ev)
+      (if (equal? (ly:get-mus-property ev 'name) 'NoteEvent)
+	  (assoc-remove!  active 'tie)
+	  active) )
+    (define (active<? a b)
+      (cond
+       ((symbol<? (car a) (car b)) #t)
+       ((symbol<? (car b) (car b)) #f)
+       (else
+	(< (cdr a) (cdr b)))
+       ))
+    
+    (define (analyse-span-event active ev)
+      (let*
+	  ((name (ly:get-mus-property ev 'name))
+	   (key (cond
+		       ((equal? name 'SlurEvent) 'slur)
+		       ((equal? name 'PhrasingSlurEvent) 'tie)
+		       ((equal? name 'BeamEvent) 'beam)
+		       ((equal? name 'CrescendoEvent) 'cresc)
+		       ((equal? name 'DecrescendoEvent) 'decr)
+		       (else #f)) )
+	   (sp (ly:get-mus-property ev 'span-direction))
+	   )
+
+	(if (and (symbol? key) (ly:dir? sp))
+	    (if (= sp STOP)
+		(assoc-remove! active key)
+		(acons key ri active))
+	    active)
+	))
+
+    (define (analyse-events active evs)
+      (define (helper analyzer active evs)
+	(if (pair? evs)
+	    (helper analyzer (analyzer active (car evs)) (cdr evs))
+	    active
+	    ))
+      (sort
+       (helper analyse-span-event
+	       (helper analyse-tie-start
+		       (helper analyse-tie-end active evs) evs) evs)
+       active<?))
+    
     (define (get-note-evs v i)
       (define (f? x)
 	(equal? (ly:get-mus-property  x 'name) 'NoteEvent))
       (filter f? (map car (what v i))))
     
     (define (put x . index)
-      (set-cdr! (vector-ref result (if (pair? index)
-				       (car index) ri)) x) )
+      "Put the result to X, starting from INDEX backwards."
+      (let
+	  ((i (if (pair? index) (car index) ri)))
+
+	(if (and (<= 0 i) (not (symbol? (what result i))))
+	    (begin
+	      (set-cdr! (vector-ref result i) x)
+	      (put x (1- i))
+	    ))
+	))
+	
 
 ;    (display (list i1 i2 ri active1 active2 (vector-length ev1) (vector-length ev2) (vector-length result)  "\n"))
     (cond
@@ -902,13 +942,12 @@ Rest can contain a list of beat groupings
 	   (m1 (when ev1 i1))
 	   (m2 (when ev2 i2))
 ;	   (x (display "oked"))
-	   (new-active1
-	    (sort
-	     (analyse-span-events active1 (map car (what ev1 i1)))
-	     symbol<?))
-	   (new-active2
-	    (sort (analyse-span-events active2 (map car (what ev2 i2)))
-		  symbol<?)))
+	   (evs1 (map car (what ev1 i1)))
+	   (evs2 (map car (what ev2 i2)))
+	   
+	   (new-active1 (analyse-events active1 evs1))
+	   (new-active2 (analyse-events active2 evs2))
+	   )
 	
 	(if (not (or (equal? m1 (when result ri))
 		     (equal? m2 (when result ri))))
@@ -917,20 +956,18 @@ Rest can contain a list of beat groupings
 	       (list "<? M1,M2 != result :"
 		     m1 m2 (when result ri)))
 	      (scm-error "boem")))
-	
+
 	(cond
 	 ((ly:moment<? m1 m2)
 	  (put 'apart)
 	  (if (> ri 0) (put 'apart (1- ri)))
-	  (analyse-events (1+ i1) i2 (1+ ri) new-active1 new-active2))
+	  (analyse-time-step (1+ i1) i2 (1+ ri) new-active1 new-active2))
 	 ((ly:moment<? m2 m1)
 	  (put 'apart)
 	  (if (> ri 0) (put 'apart (1- ri)))
-	  (analyse-events i1 (1+ i2) (1+ ri) new-active1 new-active2))
+	  (analyse-time-step i1 (1+ i2) (1+ ri) new-active1 new-active2))
 	 (else
-	  (if (or (not (equal? active1 active2)) (not (equal? new-active2 new-active1)))
-	      (put 'apart)
-
+	  (if (and (equal? active1 active2) (equal? new-active2 new-active1))
 	      (let*
 		  ((notes1 (get-note-evs ev1 i1))
 		   (pitches1 (sort
@@ -940,27 +977,36 @@ Rest can contain a list of beat groupings
 			      (map (lambda (x) (ly:get-mus-property x 'pitch)) notes2) ly:pitch<?))
 		   )
 		(cond
-		 ((equal? pitches1 pitches2) (put 'unisono))
 		 ((= (length notes1) 0) (put 'solo2))
 		 ((= (length notes2) 0) (put 'solo1))
 		 ((> (length notes1) 1) (put 'apart))
 		 ((> (length notes2) 1) (put 'apart))
 		 (else
-		  (let* (
-;			 (bla (display (list (length pitches1) (length pitches2))))
-			 (diff (ly:pitch-diff (car pitches1) (car pitches2))))
-		    (if (< (ly:pitch-steps diff) chord-threshold)
-			(put 'chords)
-			(put 'apart))
-		    ))))
-	      )
-	  (analyse-events (1+ i1) (1+ i2) (1+ ri) new-active1 new-active2))
+		  (if (< chord-threshold (ly:pitch-steps
+			  (ly:pitch-diff (car pitches1) (car pitches2))))
+			(put 'apart)
+
+
+			;; copy previous split state from spanner state
+			(begin
+			  (map (lambda (key-idx)
+				 (let*
+				     ((idx (cdr key-idx))
+				      (prev (what result  idx))
+				      )
+				   (if (symbol? prev)
+				       (put prev))
+				   )) (append active1 active2))
+			  (if (and (null? new-active1) (null? new-active2))
+			      (put 'chords ri)))
+		    
+		    ))) )
+	      ;; active states different: 
+	      (put 'apart) )
+	  (analyse-time-step (1+ i1) (1+ i2) (1+ ri) new-active1 new-active2))
 	 )))))
 
 
-   (analyse-events 0 0  0 '() '())
+   (analyse-time-step 0 0  0 '() '())
+;   (display result)
    (vector->list result))
-
-
-
-; (determine-split-list '((1 . 2) (3 . 4)) '((1 . 2) (3 . 4)))