path: root/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass

<?xml version="1.0"?>
<Denemo>
  <merge>
    <title>A Denemo Keymap</title>
    <author>AT, JRR, RTS</author>
    <map>
      <row>
        <after>ToggleImmediatePlayback</after>
        <action>ConvertMidiForBass</action>
        <scheme>;;;;;;;; DenemoConvert

(define (DenemoConvert)
(define MidiNoteStarts (make-vector 256 #f))

(defstruct note name start duration)
(define Notes '())

(if (d-RewindRecordedMidi)
    (let loop ((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)	
			(loop 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)
			(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 ()
;;;;;;; we have at least one note in the Notes list, define to procs to create a denemo chord and add a note to it
		    (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)))))))
;;;;;;;;;;;;;; end of defining procs
		    
;;; notes has been set up by pre-pending so it is backwards...	    
		    (set! Notes (reverse Notes))
     
                    ;;;;;; take the Notes and seek out bass notes, remove them and form chords, insert chords in staff above
		    (let () ;;;no loop here we drive it via the loopforbasskey
                      ;;;;;;;;;;; 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)

                      ;;;;;;;Step through notes in current (bass) staff, placing chords in (empty) staff above
		    
				(let loopforbasskey ()

;;;;;;;;;;;;; copy non-notes to the empty staff above and stop with the cursor on the first bass note
				(let loop ()
                                  ;;;;first copy anything that are not a bass note to the staff above
				  (if (or (Rest?) (Tupletmarker?))
				      (begin 
					(d-SetMark) (d-Copy) (d-PushPosition)(d-MoveToStaffUp) (GoToMeasureEnd)(d-Paste)(d-PopPosition))
				      (begin
					(if (and (not (Note?)) (d-NextObject))
					    (loop)))))

;;;;;;;;;;;;; cursor is on the first/next bass note (if any)
				(if (Note?)  
				    (let  ((bass-key (d-GetNoteAsMidi)) (bass-duration (d-GetDurationInTicks))) ;;;midi number and duration of current note
				      ;; now loop through the Notes list looking for a note the same MIDI key number, which should be before ticks move on too much... once found, consecutive notes are taken to make a chord or chords for the bass note, an
				      (define notes-belonging '());the notes belonging to the bass note
				      (define bass-note #f);a bass note (list) selected from Notes

;;;;;;;;;;;;;;;;;; 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)
					(let loop ((index 0))
					  (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)) ;;so we loop with same index
							)
						      (set! index (+ 1 index)))
						  (loop index)))))

					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)) (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))
					    (if (&gt; (length chords) (+ 1 index))
						(let ((chord1 (list-ref chords index))
						      (chord2 #f)
						      (duration #f))
						 
							(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 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")
					  (if (&gt; (length Notes) index)
						 (if (= bass-key (note.name (car (list-ref Notes index))))
						     (begin
						       (set! bass-note (list-ref Notes index))
						       (set! Notes (delq bass-note Notes))
						       )
						     (loopgetbassnote (+ index 1)))))
                                           ;;;; if bass-note then that note should have been removed from Notes, next get chord notes
                                        (set! notes-belonging '())
					(if bass-note					    
					      (let loop ((index 0))
						(if (&gt; (length Notes) index)
						    (let ( (next-note (list-ref Notes index)))
						    (if (contains (car bass-note) (car next-note))
							(begin
							  (set! notes-belonging (cons*  next-note notes-belonging))
							  (set! Notes (delq next-note Notes))
							  (loop index)))))))
;;;;;;;;;;;;;;;;;;; finished creating notes-belonging, all these notes are now removed from Notes
					      
					     
					      (if (&gt; (length notes-belonging) 0)
						  (begin
						    (d-PushPosition)
						    (d-StaffUp)
						    (GoToMeasureEnd)
;(disp "notes-belonging looks like this: " notes-belonging "\n")
						    (insert-chords notes-belonging bass-duration)
;(disp "insert-chords finished\n")
						    (d-PopPosition)
                                                    (if (d-NextObject)
							(loopforbasskey)
						    (d-WarningDialog "finished bass staff")))
						  
						  (begin
						  (d-WarningDialog "found no notes for a bass-note")
						  (disp "Bass note with no accompanying chord" bass-note))));;;if there is a note in the bass clef



					    (d-WarningDialog "No more bass notes")))))

		(begin
		  (d-WarningDialog "The Notes list is empty"))))))
				    
	
		(format #t "No notes found in recording\n")))


;;;;;;;;;;;;;;;;;;;;;;;;
(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>
    </map>
  </merge>
</Denemo>