Merge branch 'master' of ssh://git.sv.gnu.org/srv/git/denemo

1 files changed, 153 insertions, 26 deletions

diff --git a/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass b/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass
index 7e003cde..c4fe670f 100644
--- a/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass
+++ b/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass
@@ -7,10 +7,11 @@
       <row>
         <after>ToggleImmediatePlayback</after>
         <action>ConvertMidiForBass</action>
-        <scheme>;;;;;;;; DenemoConvertFromBass
+        <scheme>;;;;;;;; DenemoConvert
 
-(define (DenemoConvertFromBass)
+(define (DenemoConvert)
 (define MidiNoteStarts (make-vector 256 #f))
+
 (defstruct note name start duration)
 (define Notes '())
 
@@ -35,6 +36,120 @@
 			(vector-set! MidiNoteStarts note tick)
 			(loop note tick)
 		)))))
+	  (begin         ;;;;;; finished processing the notes
+	    (if (&gt; (length Notes) 0)
+		(let ()
+		    (define (add-note note)
+		      (if (Note? note)
+			  (begin
+			  (eval-string (string-append "(d-InsertNoteInChord \"" (d-GetNoteForMidiKey (note.name note)) "\")")))
+			  (format #t "\tNo note to add note ~a ~a to\n" (note.name note) (note.duration note))))
+		    
+		    (define (insert-note name dur)
+		      (let ((base (duration::GuessBaseNoteInTicks dur)))
+(format #t "have ~a ~a \n" base dur)
+			(if base
+			    (begin
+			      (if (&gt; (- dur base) (- (* 2 base) dur))
+				  (set! base (* base 2)))
+			      (begin 
+				;(format #t "Create note ~a ~a\n"  (d-GetNoteForMidiKey name)   (duration::ticks-&gt;denemo base))
+				(eval-string (string-append  "(d-Insert" (duration::ticks-&gt;denemo base)")"))
+				(d-PutNoteName (d-GetNoteForMidiKey name)))))))
+		    
+	    
+		    (set! Notes (reverse Notes))
+     
+;;;;;; change the list of Notes into a list of chords
+		    (let loop ((index 0))
+
+;;;;;;;;;;; overlap decides if two notes should be a chord	 
+		      (define (overlap n1 n2)
+			(if (list? n1)
+			    (set! n1 (car n1)))
+			(&lt; (abs (- (note.start n1) (note.start n2))) 50))
+;;;;;;;;;;;;;;;;;; end of overlap
+		      
+					;(format #t "Number of notes ~a\n" index)	      
+		      (let ((note1 (list-ref Notes index))
+			    (note2 #f))
+			(if (&gt; (length Notes) (+ 1 index))
+			    (begin
+			      (set! note2 (list-ref Notes (+ 1 index)))
+			      (if (overlap note1 (car note2))
+				  (begin
+				    (list-set! Notes index (cons (car note2) note1))
+				    (set! Notes (delq note2 Notes)))
+				  (begin
+					;(list-set! Notes index (list note1))
+				    (set! index (+ index 1))))
+			      (loop index))))) ;;;;;;; end of changing Notes to list of chords
+
+
+;;;loop through the chords, getting a good duration value, the duration from one to the next and inserting
+		    (let loop ((index 0))
+		      (if (&gt; (length Notes) (+ 1 index))
+			  (let ((chord1 (list-ref Notes index))
+				(chord2 #f)
+				(duration #f))
+			    (if (&gt; (length Notes) (+ 1 index))
+			     (begin
+			      (set! chord2 (list-ref Notes (+ 1 index)))
+			      (set! duration (- (note.start (car chord2)) (note.start (car chord1))))
+			      (format #t "With duration ~a\n" duration)
+			      (insert-note (note.name (car chord1)) duration)
+			       (for-each  add-note (cdr chord1))
+			       (set! index (+ index 1))
+			       (loop index))
+			     (insert-note (note.name (car chord1)) (note.duration (car chord1)))))))
+	    
+		    (format #t "End of processing\n"))))));;;;;if rewind succeeded
+		(format #t "No notes found in recording\n")))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;
+(if (d-RewindRecordedMidi)
+    (let loop ((note #f)(tick 0))
+      (set! note (d-GetRecordedMidiNote))
+      (if note
+	  (begin
+	    (set! tick (d-GetRecordedMidiOnTick))
+	    (if tick
+	      (begin
+		(format #t "I have a note ~a ~a at ~a ticks\n" note (if (&lt; tick 0) "Off" "On") tick)
+		(loop note tick)
+		))))))
+;;;;;;;;
+;;;;;;;; DenemoConvertFromBass
+
+(define (DenemoConvertFromBass)
+(define MidiNoteStarts (make-vector 256 #f))
+(defstruct note name start duration)
+(define Notes '())
+
+(if (d-RewindRecordedMidi)
+    (let looprecordednotes ((note #f)(tick 0))
+      (set! note (d-GetRecordedMidiNote))
+      (if note
+	  (begin
+	    (set! tick (d-GetRecordedMidiOnTick))
+	    (if (&lt; tick 0)
+		(let ((on (vector-ref MidiNoteStarts note)))
+		  (if on
+		      (begin 
+			(set! Notes (cons (list (make-note 'name note 'start on 'duration (- (- tick) on))) Notes))
+			(vector-set! MidiNoteStarts note #f)	
+			(looprecordednotes note tick))
+		      (format #t "An off with no On\n")))
+		(let ((on (vector-ref MidiNoteStarts note)))
+		  (if on
+		      (format #t "An on when already on\n")
+		      (begin
+			(vector-set! MidiNoteStarts note tick)
+			(looprecordednotes note tick)
+		)))))
 	  (begin         ;;;;;; finished generating Notes as a list of lists each with one note struct in it
 	    (if (&gt; (length Notes) 0)
 		(let ()
@@ -96,9 +211,7 @@
 ;;;;;;;;;;;;;;;;;; three procs: make-chords takes a list which has each note in a separate list and puts all the (consecutive) ones that overlap into a single list, that is it turns a sequence of list-of-note into a list-of-notes which represents a chord. It returns the list.
 		      
 				      (define (make-chords notes)
-(disp "make-chords with " notes "\n")
 					(let loop ((index 0))
-					  (disp "Now looping with index " index "and notes " notes "\n")
 					  (let ((note1 (list-ref notes index))
 						(note2 #f))
 					    (if (&gt; (length notes) (+ 1 index))
@@ -107,53 +220,67 @@
 						  (if (overlap note1 (car note2))
 						      (begin
 							(list-set! notes index (cons (car note2) note1))
-	(disp "notes is" notes "\nwe will delete " note2 "\n") ;;at this point note2 is in the chord and in the list
 							(set! notes (delq note2 notes)) ;;so we loop with same index
-							(disp "notes has become" notes "\n")
 							)
 						      (set! index (+ 1 index)))
 						  (loop index)))))
-						  (disp "and so we return " notes "\n")
+
 					notes)	
 ;;;;;;; insert-chord takes a list of note structs and puts a chord in the staff above with those notes.		
 				      (define (insert-chord chord duration)
 						(insert-note (note.name (car chord)) duration)
 							(for-each  add-note (cdr chord)))
 
-;;;;;;; insert-chords takes a list of lists of note structs and the duration of the denemo bass note they have been assigned to. It inserts a chord for each of the lists assigning durations to fit the bass note.		
-				      (define (insert-chords notes bass-duration)
-(disp "insert-chords called with " notes "\n")				   
-					(let ((chords (make-chords notes)))
+                                       ;;;;;;; insert-chords takes a list of lists of note structs and the duration of the denemo bass note they have been assigned to. It inserts a chord for each of the lists assigning durations to fit the bass note.		
+	(define (insert-chords notes bass-duration)
+                                        ;(disp "insert-chords called with " notes "\n")				   
+					(let ((chords (make-chords notes)) (remaining bass-duration))
 				    ;;;loop through the chords, getting a good duration value, the duration from one to the next and inserting
 					  (let loop ((index 0))
-(disp "length " (length chords) "\n")
 					    (if (&gt; (length chords) (+ 1 index))
 						(let ((chord1 (list-ref chords index))
 						      (chord2 #f)
 						      (duration #f))
 						 
-							(set! chord2 (list-ref chords (+ 1 index)))
-							(set! duration (- (note.start (car chord2)) (note.start (car chord1))))
+							(set! chord2 (list-ref chords (+ 1 index)));;move this into the init
+							(set! duration (- (note.start (car chord1)) (note.start (car chord2))))
+							(set! remaining (- remaining duration))
 							(format #t "With duration ~a\n" duration)
 							(insert-chord chord1 duration)
 							(loop (+ index 1)))	     
 						(begin
-						  (if (= (length chords) 1)
-						     (insert-chord (list-ref chords 0) bass-duration)
+						  (if (= (length chords) (+ 1 index))
+						      (begin
+							
+							(insert-chord (list-ref chords 0) remaining))
 						     (d-WarningDialog "We have no chord")))))))
+
+
+ (define (contains n1 n2)
+(let (
+      (n1.end (+ (note.start n1) (note.duration n1)))
+      (n2.end (+ (note.start n2) (note.duration n2))))
+     
+
+   (disp "I test "	
+	  (&lt; (/ (- n2.end n1.end) (note.duration n2)) 0.5)
+	 " instead " 
+	(&lt; (abs (- (note.start n1) (note.start n2))) 50) "\n" )
+   (&lt; (/ (- n2.end n1.end) (note.duration n2)) 0.5)))
+
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;; now the actual processing to loop through Notes finding an equivalent to bass-key and processing the notes belong. These are removed from Notes and then the outer loop to move on in the bass staff is taken.				      
 
 ;;; first loop through Notes from the start (previous chords have been deleted) and seek the bass-note				      
 					(let loopgetbassnote ((index 0))
-(disp "now index " index "bass-key " bass-key "\n")
+;(disp "now index " index "bass-key " bass-key "\n")
 					  (if (&gt; (length Notes) index)
 						 (if (= bass-key (note.name (car (list-ref Notes index))))
 						     (begin
-						       (disp "started " index " with " Notes "\n")
 						       (set! bass-note (list-ref Notes index))
 						       (set! Notes (delq bass-note Notes))
-						       (disp "removed " bass-note "from Notes\n")
-						       (disp "now " Notes "\n")
 						       )
 						     (loopgetbassnote (+ index 1)))))
                                            ;;;; if bass-note then that note should have been removed from Notes, next get chord notes
@@ -162,8 +289,7 @@
 					      (let loop ((index 0))
 						(if (&gt; (length Notes) index)
 						    (let ( (next-note (list-ref Notes index)))
-						    (disp "next note is " next-note "\n should not be" (eq? next-note bass-note) "otherwise bass note is still there at " index "\n")
-						    (if (overlap bass-note (car next-note))
+						    (if (contains (car bass-note) (car next-note))
 							(begin
 							  (set! notes-belonging (cons*  next-note notes-belonging))
 							  (set! Notes (delq next-note Notes))
@@ -176,9 +302,9 @@
 						    (d-PushPosition)
 						    (d-StaffUp)
 						    (GoToMeasureEnd)
-(disp "notes-belonging looks like this: " notes-belonging "\n")
+;(disp "notes-belonging looks like this: " notes-belonging "\n")
 						    (insert-chords notes-belonging bass-duration)
-(disp "insert-chords finished\n")
+;(disp "insert-chords finished\n")
 						    (d-PopPosition)
                                                     (if (d-NextObject)
 							(loopforbasskey)
@@ -198,8 +324,9 @@
 	
 		(format #t "No notes found in recording\n")))
 
-(DenemoConvertFromBass)
-;;;;;;;;;;;;;;;;;;;;;;;;</scheme>
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+(DenemoConvertFromBass)</scheme>
         <label>Convert MIDI chords over Bass</label>
         <tooltip>Takes a MIDI recording over a bass line and inserts the chords by matching the bass notes. Each chord must include the bass note.</tooltip>
       </row>