;;;ToggleCheckChords

(define-once ToggleCheckChords::Active #f)

(if (not ToggleCheckChords::Active)
  (let ((PedalDown #f)(changecount -1))
    (define (GetNoteOn)
      (let* ( (midi (d-GetMidi))
	  (velocity (bit-extract midi 16 24))
	  (note (bit-extract midi 8 16))
	  (command (bit-extract midi 0 8)))
      (cond
	      ((and (= command #xB0) (= note #x40) (= velocity #x7F));;PedalDown
		(set! PedalDown #t)
		(disp "Short Octave Enabled")
		(GetNoteOn))
	      ((and (= command #xB0) (= note #x40) (= velocity 0));;PedalUp
		(set! PedalDown #f)
		(disp "Split Sharp Enabled")
		(GetNoteOn))
		
	      ((= command #x90)
		(if (and PedalDown (= note 40))
		  (set! note 36))
		(if (and PedalDown (= note 42))
		  (set! note 38))
		(if (and PedalDown (= note 44))
		  (set! note 40))
	      note)
	      ((= command #x80)
	      (GetNoteOn))
	      (else #f))))
	(define (move-cursor thetime)
	   (if (d-NextNote)
			(let ((next (d-GetMidiOnTime))) ;(disp "thetime " thetime " and next " next "\n")
					(if (> next (+ .0001 thetime))
						(d-PrevNote)))))
	(define (list-notes notes)
		(define thelist notes)
		(define result "")
		(while (not (null? thelist)) 
			(set! result (string-append result " " (d-GetNoteForMidiKey (car thelist))))
			(set! thelist (cdr thelist)))
		result)
	(define (same-position current-position new-position)
		(= (list-ref current-position 3)(list-ref new-position 3))
		(= (list-ref current-position 2)(list-ref new-position 2))
		(= (list-ref current-position 1)(list-ref new-position 1))
		(= (list-ref current-position 0)(list-ref new-position 0)))
    (define start (d-GetMidiOnTime))
	(define current-position (GetPosition))
;;;;;;;; start of the code
    (set! ToggleCheckChords::Active #t)
    (d-CursorToLowestNote)
	(d-JumpDownOctave)
    (let re-start ((startnote #f))
		(if (Note?)
			(begin
				(if (not (= changecount (d-Changecount)))
					(d-RecreateTimebase))
				(set! changecount (d-Changecount))

				(d-PlayMidiNote 71 255 9 127)
				(usleep 200000)
				(set! start (- (d-GetMidiOnTime) 0.0001))
				  ;(disp "(Re-)Starting at " (GetPosition) " at time " start " with startnote" startnote "\n")
				(d-InputFilterNames (_ "Checking Chords Filter"))
				(d-SetBackground #xD0E0E0)
				(d-RewindMidi start)
				(let nextchord ()
					(define thetime #f)
					(define midiNotes (d-NextMidiNotes 0.001))
					(define Notes (car midiNotes))
					(define InitialNotes (reverse Notes))
					(set! thetime (cdr midiNotes)) ;(disp "Notes " midiNotes "\n")
					(move-cursor thetime)
					(set! current-position (GetPosition))
					;(disp "Current position " current-position "\n")
					
					(d-RefreshDisplay)
					(if (not (null? Notes))	  
					  (let nextnote ()
						(define note #f)
						(define new-position #f)
						(set! note (if startnote startnote (GetNoteOn)))
						(set! startnote #f)
						(set! new-position (GetPosition))
						
						(if (not (and (= changecount (d-Changecount))
								(same-position current-position new-position)))
							(re-start note)
							(if note
							  (if (member note Notes)
								(begin
								  (PlayNote (number->string note) 500 "127")
								  (set! Notes (delq note Notes))
								  (if (null? Notes)
									  (begin (d-InfoDialog "")(nextchord))
									  (nextnote)))
								(let ((chord (> (length InitialNotes) 1)))
								  (d-InfoDialog (string-append (_ "Note played was ") (d-GetNoteForMidiKey note) (_ "\nExpecting ") 
									(if chord (_ "(one of)") "")(list-notes Notes) (_ "\nPlease play ") (if chord (_ "entire chord:")
										(_ "note")) (list-notes (reverse InitialNotes))))
								  (d-PutMidi 0);get rid of any other wrong notes that may have been input at the same time
								  ;(disp "While Notes were " Notes "so " (member note Notes) "\n")
								  (set! Notes InitialNotes)
								  (d-PlayMidiNote 41 255 9 127)
								  (set! startnote #f)
								  (nextnote)))))))))))))
(d-InfoDialog (_ "Finished"))   
(d-InputFilterNames (_ "No active MIDI Filter"))
(set! ToggleCheckChords::Active #f)
(d-PutMidi 0);to swallow up any remaining notes
(d-SetMidiCapture #f)	
(d-SetBackground #xFFFFFF)
