;automatically generated by extract_all.sh
;;;;;;;;;;;;; Midi Commands By Nils Gey 01/2010
;MenuCommand or another script call the procedure by (ChangeXXX::Set optional values) and this calls the parent function. Three steps but this avoids redundancy and makes it most easy for the user who must not be let in direct contact with midi bytes
;Either the values are given directly or the script will pop up a dialog to ask for more information which will be the cause if the command is called as menuversion.

;Parent function. Builds the executed function
(define* (ChangeMidi::Parent DirectiveName DirectiveDisplayName Bytes UserValue #:optional (Flags #f)) 

 (define (realAction)
   (d-Directive-standalone DirectiveName)
  (if Flags
   (d-DirectivePut-standalone-override DirectiveName Flags))
   (d-DirectivePut-standalone-midibytes DirectiveName (string-append Bytes " " (number->string (- (abs UserValue) 1 ))))
   (d-DirectivePut-standalone-minpixels DirectiveName 20) 
   (d-DirectivePut-standalone-display DirectiveName (string-append DirectiveDisplayName (number->string (abs UserValue) )))
   (d-DirectivePut-standalone-ty DirectiveName -20)
   (d-RefreshDisplay)
  )
  
(if  (and (number? UserValue)(> (abs UserValue) 0) )
  (realAction)
  (display (string-append "Wrong value: "UserValue ". " DirectiveName " parameter must be a non-negative number. Start with 1, not with 0.\n")))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;


;;Change the Channel of a staff
(define* (ChangeChannel::Set #:optional (UserValue (string->number (d-GetUserInput "Change Midi Channel" "Please enter a channel number. Normally 1-16" "1"))))
(define override (logior DENEMO_OVERRIDE_CHANNEL DENEMO_OVERRIDE_STEP) )
(ChangeMidi::Parent "ChannelChange" "chan" "" UserValue override)
)

;;Change the Program of the current channel/staff
(define* (ChangeProgram::Set #:optional (UserValue (string->number (d-GetUserInput "Change Midi Program Number" "Please enter a program number. Normally 1-128" "1"))))
(ChangeMidi::Parent "ProgramChange" "prog" "0xC$" UserValue)
)

;;Change the Volume of a channel/staff
(define* (ChangeVolume::Set #:optional (UserValue (string->number (d-GetUserInput "Change Midi Volume" "Please enter a volume value. Normally 1-128. 1 means off" "100"))))
(ChangeMidi::Parent "VolumeChange" "vol" "0xB$ 0x07" UserValue)
)

;;Generic 0xB Control Change - User can give the midi bytes, too. 
(define* (ChangeGeneric::Set #:optional (UserBytes (d-GetUserInput "Generic Control Change" "Please enter the controller number in hex (0x01 for modwheel) or decimal (1 for modwheel)" "0x01") ) (UserValue (string->number (d-GetUserInput "Enter Databyte Value" "Please enter the databyte pedal value. Normally 1-128." "65"))))
(ChangeMidi::Parent "GenericChange" UserBytes (string-append "0xB$ " UserBytes) UserValue)
)

;;Number 1 - Change the Modwheel value of a channel/staff
(define* (ChangeModwheel::Set #:optional (UserValue (string->number (d-GetUserInput "Change Modwheel Value" "Please enter a modwheel value. Normally 1-128. 1 means off" "100"))))
(ChangeMidi::Parent "ModwheelChange" "mod" "0xB$ 0x01" UserValue)
)

;;Number 2 - Breath Controller Todo: 14-bit coarse/fine resolution. 0x000 to 0x3FFF where 0/1 is minimum.
;(define* (ChangeVolume::Set #:optional (UserValue (string->number (d-GetUserInput "Breath Controller Value" "Please enter a breath pressure value. Normally 1-128. 1 means off" "100"))))
;(ChangeMidi::Parent "BreathControlChanger" "mod" "0xB$ 0x02" UserValue)
;)

;;Number 8 - Balance. Typically used for a stereo signal tweak without changing the pan itself. Like a CD player. 
(define* (ChangeBalance::Set #:optional (UserValue (string->number (d-GetUserInput "Change Balance Value" "Please enter a balance value. Normally 1-128. 65 is center,  1 is leftmost emphasis and 128 is rightmost emphasis" "65"))))
(ChangeMidi::Parent "BalanceChange" "bal" "0xB$ 0x08" UserValue)
)

;;Number 10 - Pan. Where in the stereo field the channel sound will be placed.
(define* (ChangePan::Set #:optional (UserValue (string->number (d-GetUserInput "Change Pan Value" "Please enter a pan value. Normally 1-128. 65 is center,  1 is hard left and 128 is hard right" "65"))))
(ChangeMidi::Parent "PanChange" "pan" "0xB$ 0xA" UserValue)
)

;;Number 11 - Expression. Aka "Sub Volume" or "Percent Volume". The "real" volume. Use Volume as initial value for each staff/channel and change further cresc/desc with expression. 
(define* (ChangeExpression::Set #:optional (UserValue (string->number (d-GetUserInput "Change Expression Value" "Please enter an expression value. Normally 1-128. 65 is 50%,  1 is 0% and 128 is 100% of Volume." "128"))))
(ChangeMidi::Parent "ExpressionChange" "expr" "0xB$ 0xB" UserValue)
)

;;Number 64 - Hold Pedal On/Off (Right Piano Pedal)
(define* (ChangeHoldPedal::Set #:optional (UserValue (string->number (d-GetUserInput "Hold Pedal Value" "Please enter a hold pedal value. Normally 1-128. 1 to 64 is off, 65 to 128 is on" "1"))))
(ChangeMidi::Parent "HoldPedalChange" "hold" "0xB$ 0x40" UserValue)
)

;;Number 65 - Portamento On/Off
(define* (ChangePortamento::Set #:optional (UserValue (string->number (d-GetUserInput "Portamento Value" "Please enter a portamento value. Normally 1-128. 1 to 64 is off, 65 to 128 is on" "1"))))
(ChangeMidi::Parent "PortamentoChange" "port" "0xB$ 0x41" UserValue)
)
;;Number 5 - Portamento Time. Slides between 2 notes. Todo: 14-bit coarse/fine resolution. 0x000 to 0x3FFF where 0/1 the slowest rate. 

;;Number 66 - Sustenuto Pedal On/Off (Middle Grand Piano Pedal). All Notes active (without an note off yet) are taken.
(define* (ChangeHoldPedal::Set #:optional (UserValue (string->number (d-GetUserInput "Sustenuto Pedal Value" "Please enter a sustenuto pedal value. Normally 1-128. 1 to 64 is off, 65 to 128 is on" "1"))))
(ChangeMidi::Parent "SustenutoPedalChange" "hold" "0xB$ 0x42" UserValue)
)

;;Number 67 - Soft Pedal On/Off (Left Piano Pedal). Lowers the volume of any notes played.
(define* (ChangeSoftPedal::Set #:optional (UserValue (string->number (d-GetUserInput "Soft Pedal Value" "Please enter a soft pedal value. Normally 1-128. 1 to 64 is off, 65 to 128 is on" "1"))))
(ChangeMidi::Parent "SoftPedalChange" "hold" "0xB$ 0x43" UserValue)
)

;;Number 68 - Legato Pedal On/Off. Skips the attack portion of the VCA's envelope. For phrasing like wind or brass or guitar hammer-on.
(define* (ChangeLegatoPedal::Set #:optional (UserValue (string->number (d-GetUserInput "Legato Pedal Value" "Please enter a legato pedal value. Normally 1-128. 1 to 64 is off, 65 to 128 is on" "1"))))
(ChangeMidi::Parent "LegatoPedalChange" "hold" "0xB$ 0x44" UserValue)
)

;;Number 69 - Hold Pedal 2 On/Off. Longer release time but notes will fade out eventually.
(define* (ChangeHold2Pedal::Set #:optional (UserValue (string->number (d-GetUserInput "Hold2/Release Pedal Value" "Please enter a hold2/release pedal value. Normally 1-128. 1 to 64 is off, 65 to 128 is on" "1"))))
(ChangeMidi::Parent "Hold2PedalChange" "hold" "0xB$ 0x45" UserValue)
)
(define (ChangePrintDuration number duration)
	(define stringnumber (number->string number))
	(if (Note?) (begin
		(AttachDirective "note" "prefix"  (cons "Duration" "") (string-append "\\tweak #'duration-log #" stringnumber " "))
		(AttachDirective "note" "graphic" (cons "Duration" "") (string-append "noteheads.s" stringnumber) DENEMO_OVERRIDE_GRAPHIC)	
		;(AttachDirective "note" "midibytes" (cons "Duration" "") DENEMO_OVERRIDE_DURATION) 
	)))
(define (MovementBookTitles::Do field lilyfield initial help)
	(d-LilyPondInclude "book-titling.ily")
	(d-LilyPondInclude "simplified-book-titling.ily")
	(let ((chapter (d-DirectiveGet-movementcontrol-display field)))
  (if (not chapter)
    (set! chapter initial))
  (set! chapter (d-GetUserInput initial help chapter))
  (if chapter
   (begin
     (d-SetSaved #f)
     (if (string-null? chapter)
				(d-DirectiveDelete-movementcontrol field)
      	(begin 
      		(d-DirectivePut-movementcontrol-display field  chapter)
      		(d-DirectivePut-movementcontrol-override field  (logior DENEMO_OVERRIDE_TAGEDIT DENEMO_OVERRIDE_GRAPHIC))
					(d-DirectivePut-movementcontrol-prefix field (string-append "\\" lilyfield " \\markup { \\with-url #'\"scheme:(d-" field   ")\" "  "\"" chapter "\"}\n"))))))))

(define (BookTitles::Do field lilyfield initial help)
	(define tag (string-append "Book" field))
	(d-LilyPondInclude "book-titling.ily")
	(d-LilyPondInclude "simplified-book-titling.ily")
	(let ((chapter (if help (d-DirectiveGet-scoreheader-display tag) initial)))
  (if (not chapter)
    (set! chapter initial))
    (if help
 	 (set! chapter (d-GetUserInput initial help chapter #f)))
  (if chapter
   (begin
     (d-SetSaved #f)
     (if (string-null? chapter)
  	(d-DirectiveDelete-scoreheader tag)
      	(begin 
      		(d-DirectivePut-scoreheader-display tag  chapter)
      		(d-DirectivePut-scoreheader-override tag  (logior DENEMO_OVERRIDE_TAGEDIT DENEMO_OVERRIDE_GRAPHIC))
      		(d-DirectivePut-scoreheader-postfix tag (string-append lilyfield " = \\markup { \\with-url #'\"scheme:(d-Book" field   ")\" "  "\"" chapter "\"}\n"))))))))
(define (SlurToCurrentChord)
 (if (d-PrevChord)
  (begin
    (if (Note?)
      (begin ;;; there is a note before, if it is end slur then remove that, else start slur
	(if (d-IsSlurEnd)
	  (begin
	    (d-ToggleEndSlur))
	  (begin ;;; there is a note before it is to be the start of the slurred notes	    
	    (d-ToggleBeginSlur)))
	(d-NextChord)
	(d-ToggleEndSlur))
	(begin ;;; there is a rest before
	  (d-NextChord)))
	(d-MoveCursorRight))))
(load "split.scm") 
 ;;;;;;;;;;; dynamics init.scm
 (define* (Dynamics::Put graphic lily   #:optional (midi-vol #f))
(d-DirectivePut-chord-graphic "Dynamic"  graphic)
(d-DirectivePut-chord-gx "Dynamic"  -10)
(d-DirectivePut-chord-gy "Dynamic"  50)
(d-DirectivePut-chord-postfix "Dynamic"  lily)
(d-DirectivePut-chord-minpixels  "Dynamic" 20)
(if (string? midi-vol)
(begin
  (d-DirectivePut-chord-override "Dynamic" (logior DENEMO_OVERRIDE_VOLUME DENEMO_OVERRIDE_STEP))
  (d-DirectivePut-chord-midibytes "Dynamic" midi-vol)))
(d-RefreshDisplay))(define-once ToggleTripleting::InsideTriplet #t)
(use-modules (ice-9 rdelim))

;; set the random seed up using time of day
(let ((time (gettimeofday)))
  (set! *random-state*
          (seed->random-state (+ (car time)
	                         (cdr time)))))

(define (EducationGames::gotoEnd)
    (d-CursorRight)
    (if (d-NextObject)
      (EducationGames::gotoEnd) 
      (d-CursorRight)))

(define (EducationGames::gotoLastObject)
  (d-CursorRight)
    (if (d-NextObject)
        (ChordComparison::gotoLastObject)))


(define EducationGames::shiftup
  (lambda (n)
    (if (> n 0) (begin
		  (d-CursorUp)
		  (EducationGames::shiftup (- n 1))))))

(define EducationGames::shiftdown
  (lambda (n)
    (if (> n 0) (begin
		  (d-CursorDown)
		  (EducationGames::shiftdown (- n 1))))))

(define (EducationGames::PlaceAnswerStatus gfx)
  (begin
    (d-DirectivePut-note-minpixels "EducationGames::tick" 30)
    (d-DirectivePut-note-gx "EducationGames::tick" -10)
    (d-DirectivePut-note-gy "EducationGames::tick" 40)
    (d-DirectivePut-note-graphic "EducationGames::tick" gfx)))

;;; Returns a lilypond string when givin a integer middle_c_offset
;;; 0 returns c' 1, returns d', -1 returns b
(define (EducationalGames::middle_c_offset->lily num)
  (let (
  	(octave 0)
	(note 0)
	(anotenames '("c" "d" "e" "f" "g" "a" "b"))
	(lily "")
	(pad 0)
	)

  (if (>= num 0) 
    (set! octave (+  (quotient num 7) 1))
    (set! octave (quotient (+ num 1) 7))
    ) 
  (set! note (modulo num 7))
  (set! lily (list-ref anotenames note))
  (set! pad (+ (abs octave) 1))
  (if (> octave 0)
    (string-pad-right lily pad #\')
    (string-pad-right lily pad #\,))
  ))


;;;; Read File ;;;;

(define (EducationGames::ScoreboardFile game_name)
    (string-append (d-LocateDotDenemo) "/" game_name "_scoreboard")
    )

(define EducationGames::ReadScoreboard
 (lambda (scoreboard_file)
  (let ( (load_scoretable 0)
  	 (in_port 0)
	 (scoretable '())
	 (higherscore 0))
  (set! in_port (open-input-file scoreboard_file))

  (set! load_scoretable
    (lambda ()
      (let ( (line "") 
          (uname 0) 
   	  (uscore 0) )
	(set! line (read-line in_port))
      (if  (not (eof-object? line))
        (begin
	  (set! line (string-split line #\:))
	  (set! uname (car line))
	  (set! uscore (string->number (cadr line)))
	  (set! scoretable (acons uname uscore scoretable))
	  (load_scoretable))))))

  (set! higherscore
    (lambda (paira pairb)
      (> (cdr paira) (cdr pairb))))
  (load_scoretable)
  ;sort table
  (set! scoretable (sort scoretable higherscore))
  scoretable
   )))

(define EducationGames::Scoreboard_Pretty_Print
  (lambda (scoreboard_file)
    (let ( (loop 0) 
            (output_string "") )
    (set! loop
      (lambda (score)
        (set! output_string (string-append output_string (string-pad-right (car score) 15 #\space)
    			"\t\t" 
			(number->string (cdr score)) 
			"\n"))
			))
    (map loop (EducationGames::ReadScoreboard scoreboard_file))
    output_string
    )))

;;;; Write File ;;;;
(define EducationGames::Write_Scoreboard_File
  (lambda (scoreboard_file score)
    (let ( (scorefile 0)
  	   (write_user_score 0)
	   (scoretable '())
	   (getusername 0)
	   (TopTen? 0)
	   (OnlyTenInList 0)
	   (AboveLowestScore? 0)
  	  )
    (set! write_user_score 
      (lambda (score)
        (display (car score) scorefile)
        (write-char #\: scorefile)
        (display (cdr score) scorefile)
        (newline scorefile)
        ))
    (set! getusername
      (lambda ()
        (let ( (username "") )
	(set! username 
	  (d-GetUserInput "****Congratulations!!!!****" "Your score has made it to the top 10!!!\nEnter your name here\n" ""))
	username
	)))
    (set! AboveLowestScore?
      (lambda ()
        (let ( (findlowest 0) 
	       (lowest 0) )
	(set! findlowest
	  (lambda (uscore)
	    (if (< (cdr uscore) score)
	       (set! lowest (cdr uscore)))))
	(map findlowest scoretable)
	(> score lowest)
	))) 
    (set! TopTen?
      (lambda ()
        (or 
	 (< (length scoretable) 10)
	  (AboveLowestScore?))
      ))
    (set! OnlyTenInList
      (lambda (lst)
        (let ( (list_truncate 0) 
	       (TheList '()) )
	    (set! list_truncate
	      (lambda (n)
		(if (< (length TheList) 10)
		  (set! TheList (append TheList (cons n '())))
		  )))

	    (map list_truncate lst)
	    TheList
	    )))
     (if (file-exists? scoreboard_file)
       (set! scoretable (EducationGames::ReadScoreboard scoreboard_file)))
     (display "TopTen? =")
     (display (TopTen?))
     (newline)
     (if (TopTen?)
      (begin
        (set! scorefile (open-output-file scoreboard_file))
        (set! scoretable (acons (getusername) score scoretable))
        ;;truncate scoretable

	(set! scoretable (OnlyTenInList scoretable))
	(map write_user_score scoretable)
        (close-output-port scorefile)#t)#f)

     )))

(define (EducationGames::GetAcceptableKeyInput acceptable_list)
  (let (
        (input 0)
        (getinput 0)
        )

  (set! getinput
        (lambda ()
          (set! input (d-GetKeypress))
          (if (not (or (boolean? input) (member input acceptable_list)))
                (getinput))
          ))
  (getinput)
  input
  ))

(define (EducationGames::Chime)
  (d-PlayMidiKey #xF03001)
  (d-PlayMidiKey #xF02A01)
  (d-PlayMidiKey #xF04001))




(define ChordComparison::Major (cons "Major" "c e g"))
(define ChordComparison::Minor (cons "Minor" "c ees g"))
(define ChordComparison::Augmented (cons "Augmented" "c e gis"))
(define ChordComparison::Diminished (cons "Diminished" "c ees ges"))
(define ChordComparison::Major7 (cons "Major7" "c e g b"))
(define ChordComparison::Dominant7 (cons "Dominant7" "c e g bes"))
(define ChordComparison::Minor7 (cons "Minor7" "c ees g bes"))
(define ChordComparison::HalfDiminished7 (cons "HalfDiminished7" "c ees ges bes"))
(define ChordComparison::Diminished7 (cons "Diminished7" "c ees ges beses"))


(define ChordComparison::ChordPossibilities (list ChordComparison::Major ChordComparison::Minor))

(define ChordComparison::HighestNote 80)
(define ChordComparison::LowestNote 55)
(define ChordComparison::ChordChordComparison::LowestNote 60)
(define ChordComparison::ChordQuality 0)
(define ChordComparison::ArpTimer 0)
(define TransposedChordNotes '())
(define ChordComparison::score 0)



(let ((time (gettimeofday)))
  (set! *random-state*
    (seed->random-state (+ (car time)
      (cdr time)))))

(define (ChordComparison::gotoEnd)
  (d-CursorRight)
  (if (d-NextObject)
    (ChordComparison::gotoEnd) 
    (d-CursorRight)))

(define (ChordComparison::gotoLastObject)
  (d-CursorRight)
  (if (d-NextObject)
    (ChordComparison::gotoLastObject)))

(define (ChordComparison::lilyname->midikey lilyname)
  (let (
  		(naturual_notenum '(0 2 4 5 7 9 11))
  		(accidental 0) 
  		(octave 48) 
  		(notename 0) 
  		(notenum 0) 
  		(loop 0))
      (set! notename
	(lambda (char)
          (modulo (- (char->integer char) 99) 7)))
      (set! loop 
        (lambda (x)
          (if (< x (string-length lilyname))
	    (begin
	      (if (= x 0) (set! notename (notename (string-ref lilyname x))))
	      (if (> x 0) 
	        (begin
		  (if (equal? #\i (string-ref lilyname x))
		    (set! accidental (+ accidental 1)))
		  (if (equal? #\e (string-ref lilyname x))
		    (set! accidental (- accidental 1)))
		  (if (equal? #\' (string-ref lilyname x))
		    (set! octave (+ octave 12)))
		  (if (equal? #\, (string-ref lilyname x))
		    (set! octave (- octave 12)))))
		(loop (+ 1 x)))
			  );end of if
		      )
		    );end of loop
	      (loop 0)
    (set! notenum (list-ref naturual_notenum notename))
    (+ (+ octave notenum) accidental)      
	    );end of let
	  )


(define (ChordComparison::midinum->lilyname num)
  (let ( 	(octave 0) 
  		(notename "")
  		(OctaveString "")
  		(sharplist '("c" "cis" "d" "dis" "e" "f" "fis" "g" "gis" "a" "ais" "b"))
  				)
  (set! octave (- (quotient num 12) 4))
  (set! notename (list-ref sharplist (remainder num 12)))
  (if (> octave 0)
    (set! OctaveString (string-pad "" (abs octave) #\'))
    (set! OctaveString (string-pad "" (abs octave) #\,)))
  (string-append notename OctaveString)
))

(define (ChordComparison::showscore)
 (d-DirectivePut-score-display "ChordComparison::GameScore" (string-append "<b>Score: </b>" (number->string ChordComparison::score))))

(define (ChordComparison::GetRandom)
  (set! ChordComparison::ChordChordComparison::LowestNote (random ChordComparison::HighestNote))
  (if (> ChordComparison::LowestNote ChordComparison::ChordChordComparison::LowestNote)
    (ChordComparison::GetRandom) ))

(define (ChordComparison::GetChordQuality)
  (car (list-ref ChordComparison::ChordPossibilities ChordComparison::ChordQuality)))
  
(define (ChordComparison::GetChordSpelling)
  (cdr (list-ref ChordComparison::ChordPossibilities ChordComparison::ChordQuality)))

(define (ChordComparison::GetNewChord)
  (ChordComparison::GetRandom)  
  (set! ChordComparison::ChordQuality (random (length ChordComparison::ChordPossibilities))))

(define (ChordComparison::GetIntervalList)
 (let (
 	(SetOctave 0)
	(IntervalList 0)
	(ChordNoteList '())
 	)
(set! SetOctave 
  (lambda (lilystring)
    (- (ChordComparison::lilyname->midikey lilystring) 48)))
  (set! ChordNoteList (string-split (ChordComparison::GetChordSpelling) #\space))
  (set! IntervalList (map SetOctave ChordNoteList))
  IntervalList
  ))

(define (ChordComparison::PlayChord note)
  (PlayNote (number->string (+ ChordComparison::ChordChordComparison::LowestNote note)) 1000))

(define (ChordComparison::Play)  
  (map ChordComparison::PlayChord (ChordComparison::GetIntervalList)))

(define (ChordComparison::ArpegChord note)
  (let ( (newnote "") )
    (set! newnote (number->string (+ ChordComparison::ChordChordComparison::LowestNote note)))
    (d-OneShotTimer ChordComparison::ArpTimer (string-append "(PlayNote " "\"" newnote "\"" " 1000)"))
    )
  (set! ChordComparison::ArpTimer (+ ChordComparison::ArpTimer 1000)))

(define (ChordComparison::PlayArpeggio)
  (map ChordComparison::ArpegChord (ChordComparison::GetIntervalList))
  (set! ChordComparison::ArpTimer 0))

(define (ChordComparison::OfferChord)
  (ChordComparison::showscore)
  (ChordComparison::GetNewChord)
  (usleep 10000)
  (ChordComparison::Play))


;;; Initialize Transpose routines.
(if (not (defined? 'Transpose::init))
    (define Transpose::init #f))
(if (not Transpose::init)
    (begin
;;;; public variables
      (define Transpose::SetTransposeInterval 0)
      (define Transpose::TransposeNote 0)
      (define Transpose::TransposeNoteList 0)
      (define Transpose::Note "b,")
      (define Transpose::Interval "c b,")

;;;;;;;;;;; private variables
					;original note
      (define Transpose::original-pitch '(0 0 0))
					;transposition amount
      (define Transpose::original-delta '(0 0 0))

      (define Transpose::transpose-origin '(0 0 0))
      (define Transpose::transpose-delta '(0 0 0))
;;;;;;;;;; code

      (define (Transpose::SetTransposeInterval note)
	    (begin
	      (set! Transpose::transpose-delta (Transpose::lilyname->pitch note)) 
	      (Transpose::get-delta)))

      (define (Transpose::get-interval-from-selection)
	(let ((first-note "")
	      (second-note ""))
	  (set! first-note (d-GetNote))
	  (NextChordInSelection)
	  (set! second-note (d-GetNote))
	  (string-append first-note " " second-note)
	  ))

      (define (Transpose::GetTransposeInterval)
	(d-GetUserInput "Setting a Transposition Interval" 
	   "Enter a note, a space, and the note you wish this to transpose to" "c d"))

      (define Transpose::pitch->lilyname
        (lambda (pitch)
  	  (let ((octave->text 0)(accidental->text 0)(pitch->text 0))
    	    (begin
              (set! octave->text
                (lambda (octave_num)
                  (let ((octave_string "")
                        (apply_octave 0))
                    (set! apply_octave
                      (lambda (string value)
                        (begin
                          (if (< value 0)
                            (begin
                              (set! octave_string (string-append octave_string ","))
                              (apply_octave string (+ value 1))))
                          (if (> value 0)
                            (begin
                              (set! octave_string (string-append octave_string "'"))
                              (apply_octave string (- value 1))))
                        )))
                        (apply_octave octave_string octave_num)
                 	octave_string
           	   )))

		(set! accidental->text
		  (lambda (accidental_num)
		  (let ((accidental_string "")
			(apply_accidental 0))
		    (set! apply_accidental
		      (lambda (string value)
			(begin
			  (if (> value 0)
			    (begin
			      (set! accidental_string (string-append accidental_string "is"))
			      (apply_accidental string (- value 1))))
			   (if (< value 0)
			    (begin
			      (set! accidental_string (string-append accidental_string "es"))
			      (apply_accidental string (+ value 1))))
			 )))
		         (apply_accidental accidental_string accidental_num)
			 accidental_string
		   )))

		(set! pitch->text
		  (lambda (pitch_num)
		   (let ((pitch_string ""))
		    (set! pitch_string (integer->char (+ (modulo (+ pitch_num 2) 7) 97)))
		    (string pitch_string)
		    )))
		
		(string-append
		  (pitch->text (cadr pitch))
		  (accidental->text (caddr pitch))
		  (octave->text (car pitch)))

	     )
	     )))

      (define Transpose::lilyname->pitch
	(lambda (lilyname)
	  (let ((accidental 0) (octave 0) (notename 0) (loop 0))
	    (begin
	      (set! notename 
		    (lambda (char)
		      (modulo (- (char->integer char) 99) 7)
		      ))
	      (set! loop 
		    (lambda (x)
		      (if (< x (string-length lilyname))
			  (begin
			    (if (= x 0) (set! notename (notename (string-ref lilyname x))))
			    (if (> x 0) 
				(begin
				  (if (equal? #\i (string-ref lilyname x))
				      (set! accidental (+ accidental 1)))
				  (if (equal? #\e (string-ref lilyname x))
				      (set! accidental (- accidental 1)))
				  (if (equal? #\' (string-ref lilyname x))
				      (set! octave (+ octave 1)))
				  (if (equal? #\, (string-ref lilyname x))
				      (set! octave (- octave 1)))))
			    (loop (+ 1 x))
			    )
			  );end of if
		      )
		    );end of loop
	      (loop 0)
	      )
	    `(,octave ,notename ,accidental)

	    );end of let
	  ))
      ;;;;copied from chord-name.scm in lilypond-1.6.5

      (define Transpose::semitone-vec (list->vector '(0 2 4 5 7 9 11)))

      (define Transpose::semitone 
	(lambda (pitch)
	  (+ (* (car pitch) 12)
	     (vector-ref Transpose::semitone-vec (modulo (cadr pitch) 7))
	     (caddr pitch))))

      (define Transpose::transpose 
	(lambda (pitch delta)
	  (let ((simple-octave (+ (car pitch) (car delta)))
		(simple-notename (+ (cadr pitch) (cadr delta))))
	    (let ((octave (+ simple-octave (quotient simple-notename 7)))
		  (notename (modulo simple-notename 7)))
	      (let ((accidental (- (+ (Transpose::semitone pitch) (Transpose::semitone delta))
				   (Transpose::semitone `(,octave ,notename 0)))))
		`(,octave ,notename ,accidental))))))

      (define Transpose::get-delta
	(lambda ()
	  (begin
	    (set! Transpose::original-delta (Transpose::transpose Transpose::transpose-origin Transpose::transpose-delta)))))
      
      ;check to see if this is really needed
      (define Transpose::transposed 
        (lambda ()
	  (begin
	    (Transpose::transpose Transpose::original-pitch 
			      Transpose::original-delta ))))

      ;This is in use by the Edit->Transpose->Transpose Selection script.
      (define Transpose::TransposeNote 
        (lambda ()
	  (let ( (numofnotes 0) 
	  	 (notelist '())
		 (eachnote 0)
		 (process_notelist 0)
		 (transposed_notelist ""))

	    (begin
	      (set! process_notelist
		(lambda (note)
		  (set! Transpose::original-pitch (Transpose::lilyname->pitch note))
		        (set! transposed_notelist 
		        (string-append transposed_notelist (Transpose::pitch->lilyname(Transpose::transposed))))
			(set! transposed_notelist (string-append transposed_notelist " "))
		      ))
	      (set! notelist (d-GetNotes))
	      (if (string? notelist)
		  (set! notelist (string-split (d-GetNotes) #\space))
		  (set! notelist '()))
	      (set! numofnotes (length notelist))
	      ;(display "numofnotes = ")
	      ;(display numofnotes)
	      ;(newline)
	      (if (= numofnotes 1)
	        (begin
	    	  (set! Transpose::original-pitch (Transpose::lilyname->pitch (d-GetNotes)))
	          (d-ChangeChordNotes (Transpose::pitch->lilyname(Transpose::transposed)))))	  
	      (if (> numofnotes 1)
	        (begin
		  (map process_notelist notelist)
		  (d-ChangeChordNotes transposed_notelist)
		  )) 
	    ))))
     
      (define Transpose::TransposeNoteList 
        (lambda (string_of_notes)
	  (let ( (numofnotes 0) 
	  	 (outputlist '())
		 (eachnote 0)
		 (process_notelist 0)
		 (transposed_notelist ""))

	    (begin
	      (set! process_notelist
		(lambda (note)
		  (set! Transpose::original-pitch (Transpose::lilyname->pitch note))
		        (set! transposed_notelist 
		        (string-append transposed_notelist (Transpose::pitch->lilyname(Transpose::transposed))))
			(set! transposed_notelist (string-append transposed_notelist " "))
		      ))

	      (set! outputlist (string-split string_of_notes #\space))
	      (set! numofnotes (length outputlist))
	      (display "numofnotes = ")
	      (display numofnotes)
	      (newline)
	      (if (= numofnotes 1)
	        (begin
	    	  (set! Transpose::original-pitch (Transpose::lilyname->pitch string_of_notes))
	          (set! transposed_notelist (string-append (Transpose::pitch->lilyname(Transpose::transposed))))
		  ))	  
	      (if (> numofnotes 1)
		  (map process_notelist outputlist))
		  transposed_notelist
	    ))))

      (define Transpose::init #t)))



(define (ChordComparison::TransposeChord notestring lilyname)
  (set! Transpose::Note lilyname)
    (Transpose::SetTransposeInterval Transpose::Note)
  (set! TransposedChordNotes (string-split (Transpose::TransposeNoteList notestring) #\space))
  )
  ;(set! TransposedChordNotes (Transpose::TransposeNoteList notestring)))

(define (ChordComparison::AddNoteToChord notes)
  (ChordComparison::gotoLastObject)
  (d-ChangeChordNotes notes))

(define (ChordComparison::DrawAnimatedArpeggio)
  (let ( (addnotes 0)
         (tindex 0)
         (currentnotes "")
       )
  (set! addnotes
    (lambda (note)
      (begin
        (set! currentnotes (string-append currentnotes " " note))
        (d-OneShotTimer tindex (string-append "(ChordComparison::AddNoteToChord " "\"" currentnotes "\"" ")"))
	(if (not (string=? note ""))
          (d-OneShotTimer tindex (string-append "(PlayNote " "\"" (number->string (ChordComparison::lilyname->midikey note)) "\"" " 1000)")))
        (set! tindex (+ tindex 1000))
	            )))
  (set! tindex 0)
  (ChordComparison::gotoEnd)
  (d-CursorToNote (list-ref TransposedChordNotes 0))
  (d-Insert0)
  (map addnotes TransposedChordNotes)
				))

;TODO perhaps inherit this from EducationGames
(define (ChordComparison::PlaceAnswerStatus gfx)
  (begin
    (d-DirectivePut-note-minpixels "ChordComparison::tick" 30)
    (d-DirectivePut-note-gx "ChordComparison::tick" -10)
    (d-DirectivePut-note-gy "ChordComparison::tick" 40)
    (d-DirectivePut-note-graphic "ChordComparison::tick" gfx)))

;;;;;;;;; callback when user chooses a chord
(define (ChordComparison::chordchosen chord)
  (ChordComparison::TransposeChord (ChordComparison::GetChordSpelling)
    (ChordComparison::midinum->lilyname ChordComparison::ChordChordComparison::LowestNote))
  (ChordComparison::DrawAnimatedArpeggio)
  (ChordComparison::gotoEnd)
  (if  (string=? (ChordComparison::GetChordQuality) chord)
    (begin
      (set! ChordComparison::score (+ ChordComparison::score 1))
      (ChordComparison::PlaceAnswerStatus "CheckMark")
      )
    (begin
      (set! ChordComparison::score (- ChordComparison::score 1))
      (ChordComparison::PlaceAnswerStatus "CrossSign")
  ))
  (d-OneShotTimer (* 1000 (length TransposedChordNotes)) "(ChordComparison::OfferChord)")
  )

(define (ChordComparison::createbuttons chord)
  (CreateButton (string-append "ChordComparison::" (car chord))  (string-append " <span font_desc=\"22\" foreground=\"blue\">" (car chord)  "</span>"))
    (d-SetDirectiveTagActionScript  (string-append "ChordComparison::" (car chord)) (string-append "(ChordComparison::chordchosen \"" (car chord) "\")")))

;;;;main procedure to call for ChordComparison
(define (ChordComparison::ChordComparison chordlist) 

  (set! ChordComparison::ChordPossibilities chordlist)
  (CreateButton "ChordComparison::GameScore" "<span font_desc=\"22\">Click to start</span>")
  (d-SetDirectiveTagActionScript "ChordComparison::GameScore" "(ChordComparison::OfferChord)")

  (map ChordComparison::createbuttons ChordComparison::ChordPossibilities)

  (CreateButton "ChordComparison::replay" "<span font_desc=\"22\">Re-Play</span>")
  (d-SetDirectiveTagActionScript "ChordComparison::replay" "(ChordComparison::Play)" )

  (CreateButton "ChordComparison::play_arpeggio" "<span font_desc=\"22\">Arpeggio</span>")
  (d-SetDirectiveTagActionScript "ChordComparison::play_arpeggio" "(ChordComparison::PlayArpeggio)" )
)


(define IdentifyScaleNote::Scale (cons "F# G# A# B C#" "fis' gis' ais' b' cis''"))
(define IdentifyScaleNote::notelist '())
(define IdentifyScaleNote::buttonlist '())
(define IdentifyScaleNote::ArpTimer 0)
(define IdentifyScaleNote::score 0)
(define IdentifyScaleNote::CurrentNote "")
(define IdentifyScaleNote::CurrentNoteNum 0)
(define IdentifyScaleNote::NoteIndex 0)

(let ((time (gettimeofday)))
  (set! *random-state*
    (seed->random-state (+ (car time)
      (cdr time)))))

(define (IdentifyScaleNote::gotoEnd)
  (d-CursorRight)
  (if (d-NextObject)
    (IdentifyScaleNote::gotoEnd)
    (d-CursorRight)))

(define (IdentifyScaleNote::lilyname->midikey lilyname)
  (let (
                (naturual_notenum '(0 2 4 5 7 9 11))
                (accidental 0)
                (octave 48)
                (notename 0)
                (notenum 0)
                (loop 0))
      (set! notename
        (lambda (char)
          (modulo (- (char->integer char) 99) 7)))
      (set! loop
        (lambda (x)
          (if (< x (string-length lilyname))
            (begin
              (if (= x 0) (set! notename (notename (string-ref lilyname x))))
              (if (> x 0)
                (begin
                  (if (equal? #\i (string-ref lilyname x))
                    (set! accidental (+ accidental 1)))
                  (if (equal? #\e (string-ref lilyname x))
                    (set! accidental (- accidental 1)))
                  (if (equal? #\' (string-ref lilyname x))
                    (set! octave (+ octave 12)))
                  (if (equal? #\, (string-ref lilyname x))
                    (set! octave (- octave 12)))))
                (loop (+ 1 x)))
                          );end of if
                      )
                    );end of loop
              (loop 0)
    (set! notenum (list-ref naturual_notenum notename))
    (+ (+ octave notenum) accidental)
            );end of let
          )

(define (IdentifyScaleNote::NewNote)
   (set! IdentifyScaleNote::CurrentNoteNum (random (length IdentifyScaleNote::notelist)))
  (set! IdentifyScaleNote::CurrentNote (list-ref IdentifyScaleNote::notelist IdentifyScaleNote::CurrentNoteNum))
  )

(define (IdentifyScaleNote::showscore)
 (d-DirectivePut-score-display "IdentifyScaleNote::GameScore" (string-append "<b>Score: </b>" (number->string IdentifyScaleNote::score))))

(define (IdentifyScaleNote::PlayScaleNote note)
  (let ( (newnote "") )
    (set! newnote (number->string (IdentifyScaleNote::lilyname->midikey note)))
  (d-OneShotTimer IdentifyScaleNote::ArpTimer (string-append "(PlayNote " "\"" newnote "\"" " 1000)"))
  (set! IdentifyScaleNote::ArpTimer (+ IdentifyScaleNote::ArpTimer 1000))))

(define (IdentifyScaleNote::PlayScaleNoteNow note)
  (let ( (newnote "") )
    (set! newnote (number->string (IdentifyScaleNote::lilyname->midikey note)))
  (d-OneShotTimer 0 (string-append "(PlayNote " "\"" newnote "\"" " 1000)"))
  			))

(define (IdentifyScaleNote::PlayScale)
  (set! IdentifyScaleNote::ArpTimer 0)
  (map IdentifyScaleNote::PlayScaleNote IdentifyScaleNote::notelist)
 )

(define (IdentifyScaleNote::DrawNote)
  (d-CursorToNote IdentifyScaleNote::CurrentNote)
  (d-Insert0)
  (d-ChangeChordNotes IdentifyScaleNote::CurrentNote)
)

;TODO perhaps inherit this from EducationGames
(define (IdentifyScaleNote::PlaceAnswerStatus gfx)
  (begin
    (d-DirectivePut-note-minpixels "IdentifyScaleNote::tick" 30)
    (d-DirectivePut-note-gx "IdentifyScaleNote::tick" -10)
    (d-DirectivePut-note-gy "IdentifyScaleNote::tick" 40)
    (d-DirectivePut-note-graphic "IdentifyScaleNote::tick" gfx)))

(define (IdentifyScaleNote::OfferChord)
  (IdentifyScaleNote::showscore)
  (IdentifyScaleNote::NewNote)
  (set! IdentifyScaleNote::ArpTimer 0)
  (IdentifyScaleNote::PlayScaleNote IdentifyScaleNote::CurrentNote)
)

(define (IdentifyScaleNote::Go)
  (IdentifyScaleNote::showscore)
  (IdentifyScaleNote::PlayScale)
  (IdentifyScaleNote::NewNote)
  (set! IdentifyScaleNote::ArpTimer (+ IdentifyScaleNote::ArpTimer 1000))
  (IdentifyScaleNote::PlayScaleNote IdentifyScaleNote::CurrentNote)
)

(define (IdentifyScaleNote::notechosen NoteListPosition)
  (IdentifyScaleNote::DrawNote)
  (IdentifyScaleNote::gotoEnd)
  (if  (= IdentifyScaleNote::CurrentNoteNum (string->number NoteListPosition))
    (begin
      (set! IdentifyScaleNote::score (+ IdentifyScaleNote::score 1))
      (IdentifyScaleNote::PlaceAnswerStatus "CheckMark")
      )
    (begin
      (set! IdentifyScaleNote::score (- IdentifyScaleNote::score 1))
      (IdentifyScaleNote::PlaceAnswerStatus "CrossSign")
  	))
  (d-OneShotTimer 1000  "(IdentifyScaleNote::OfferChord)")
  )

(define (IdentifyScaleNote::createbutton note)
  (CreateButton (string-append "IdentifyScaleNote::" note)  (string-append " <span font_desc=\"22\" foreground=\"blue\">" note  "</span>"))
     (d-SetDirectiveTagActionScript  (string-append "IdentifyScaleNote::" note) (string-append "(IdentifyScaleNote::notechosen \"" (number->string IdentifyScaleNote::NoteIndex) "\")"))
     (set! IdentifyScaleNote::NoteIndex (+ IdentifyScaleNote::NoteIndex 1))
    )
  
(define (IdentifyScaleNote::help)
  (d-InfoDialog "After listening to the scale, there will be a random scale note played. You are determine which note was sounded.")
)
  
;;;;main procedure to call for IdentifyScaleNote
(define (IdentifyScaleNote::IdentifyScaleNotes Scale) 

  (set! IdentifyScaleNote::Scale Scale)
 
  (set! IdentifyScaleNote::buttonlist (string-split (car IdentifyScaleNote::Scale) #\space))
  (set! IdentifyScaleNote::notelist (string-split (cdr IdentifyScaleNote::Scale) #\space))

  (CreateButton "IdentifyScaleNote::GameScore" "<span font_desc=\"22\">Click to start</span>")
  (d-SetDirectiveTagActionScript "IdentifyScaleNote::GameScore" "(IdentifyScaleNote::Go)")

  (CreateButton "IdentifyScaleNote::GameHelp" "<b>Help</b>")
  (d-SetDirectiveTagActionScript "IdentifyScaleNote::GameHelp" "(IdentifyScaleNote::help)")

  (map IdentifyScaleNote::createbutton IdentifyScaleNote::buttonlist)

  (CreateButton "IdentifyScaleNote::replay" "<span font_desc=\"22\">Re-Play</span>")
  (d-SetDirectiveTagActionScript "IdentifyScaleNote::replay" "(IdentifyScaleNote::PlayScaleNoteNow IdentifyScaleNote::CurrentNote)" )

  (CreateButton "IdentifyScaleNote::play_scale" "<span font_desc=\"22\">Play Scale</span>")
  (d-SetDirectiveTagActionScript "IdentifyScaleNote::play_scale" "(IdentifyScaleNote::PlayScale)" )
)
(define (Navigation::CursorUpN n) 
  (begin (if (> n 0) (begin (d-CursorUp) (Navigation::CursorUpN (- n 1))))
    (if (< n 0) (begin (d-CursorDown) (Navigation::CursorUpN (+ n 1))))))