2
(define ChordComparison::Major (cons "Major" "c e g"))
3
(define ChordComparison::Minor (cons "Minor" "c ees g"))
4
(define ChordComparison::Augmented (cons "Augmented" "c e gis"))
5
(define ChordComparison::Diminished (cons "Diminished" "c ees ges"))
6
(define ChordComparison::Major7 (cons "Major7" "c e g b"))
7
(define ChordComparison::Dominant7 (cons "Dominant7" "c e g bes"))
8
(define ChordComparison::Minor7 (cons "Minor7" "c ees g bes"))
9
(define ChordComparison::HalfDiminished7 (cons "HalfDiminished7" "c ees ges bes"))
10
(define ChordComparison::Diminished7 (cons "Diminished7" "c ees ges beses"))
13
(define ChordComparison::ChordPossibilities (list ChordComparison::Major ChordComparison::Minor))
15
(define ChordComparison::HighestNote 80)
16
(define ChordComparison::LowestNote 55)
17
(define ChordComparison::ChordChordComparison::LowestNote 60)
18
(define ChordComparison::ChordQuality 0)
19
(define ChordComparison::score 0)
23
(let ((time (gettimeofday)))
25
(seed->random-state (+ (car time)
28
(define (ChordComparison::lilyname->midikey lilyname)
30
(naturual_notenum '(0 2 4 5 7 9 11))
38
(modulo (- (char->integer char) 99) 7)))
41
(if (< x (string-length lilyname))
43
(if (= x 0) (set! notename (notename (string-ref lilyname x))))
46
(if (equal? #\i (string-ref lilyname x))
47
(set! accidental (+ accidental 1)))
48
(if (equal? #\e (string-ref lilyname x))
49
(set! accidental (- accidental 1)))
50
(if (equal? #\' (string-ref lilyname x))
51
(set! octave (+ octave 12)))
52
(if (equal? #\, (string-ref lilyname x))
53
(set! octave (- octave 12)))))
59
(set! notenum (list-ref naturual_notenum notename))
60
(+ (+ octave notenum) accidental)
65
(define (ChordComparison::midinum->lilyname num)
69
(sharplist '("c" "cis" "d" "dis" "e" "f" "fis" "g" "gis" "a" "ais" "b"))
71
(set! octave (- (quotient num 12) 4))
72
(set! notename (list-ref sharplist (remainder num 12)))
74
(set! OctaveString (string-pad "" (abs octave) #\'))
75
(set! OctaveString (string-pad "" (abs octave) #\,)))
76
(string-append notename OctaveString)
79
(define (ChordComparison::showscore)
80
(d-DirectivePut-score-display "ChordComparison::GameScore" (string-append "<b>Score: </b>" (number->string ChordComparison::score))))
82
(define (ChordComparison::GetRandom)
83
(set! ChordComparison::ChordChordComparison::LowestNote (random ChordComparison::HighestNote))
84
(if (> ChordComparison::LowestNote ChordComparison::ChordChordComparison::LowestNote)
85
(ChordComparison::GetRandom) ))
87
(define (ChordComparison::GetChordQuality)
88
(car (list-ref ChordComparison::ChordPossibilities ChordComparison::ChordQuality)))
90
(define (ChordComparison::GetChordSpelling)
91
(cdr (list-ref ChordComparison::ChordPossibilities ChordComparison::ChordQuality)))
93
(define (ChordComparison::GetNewChord)
94
(ChordComparison::GetRandom)
95
(set! ChordComparison::ChordQuality (random (length ChordComparison::ChordPossibilities))))
97
(define (ChordComparison::GetIntervalList)
105
(- (ChordComparison::lilyname->midikey lilystring) 48)))
106
(set! ChordNoteList (string-split (ChordComparison::GetChordSpelling) #\space))
107
(set! IntervalList (map SetOctave ChordNoteList))
111
(define (ChordComparison::PlayChord note)
112
(PlayNote (number->string (+ ChordComparison::ChordChordComparison::LowestNote note)) 1000))
114
(define (ChordComparison::Play)
115
(map ChordComparison::PlayChord (ChordComparison::GetIntervalList)))
117
(define (ChordComparison::OfferChord)
118
(ChordComparison::showscore)
119
(ChordComparison::GetNewChord)
121
(ChordComparison::Play))
123
(if (not (defined? 'Transpose::init))
125
(d-LoadCommand "/MainMenu/EditMenu/Transpose/SetTransposeIntervalFromNote")
126
(d-InitializeScript "SetTransposeIntervalFromNote")))
128
(define (ChordComparison::TransposeChord lilyname)
129
(set! Transpose::Note lilyname)
130
(Transpose::SetTransposeInterval Transpose::Note)
131
(Transpose::TransposeNote))
133
(define (ChordComparison::PlaceNotes)
136
(d-ChangeChordNotes (ChordComparison::GetChordSpelling))
137
(ChordComparison::TransposeChord (ChordComparison::midinum->lilyname ChordComparison::ChordChordComparison::LowestNote)))
139
;TODO perhaps inherit this from EducationGames
140
(define (ChordComparison::PlaceAnswerStatus gfx)
142
(d-DirectivePut-note-minpixels "ChordComparison::tick" 30)
143
(d-DirectivePut-note-gx "ChordComparison::tick" -15)
144
(d-DirectivePut-note-gy "ChordComparison::tick" 40)
145
(d-DirectivePut-note-graphic "ChordComparison::tick" gfx)))
147
;;;;;;;;; callback when user chooses a chord
148
(define (ChordComparison::chordchosen chord)
149
(ChordComparison::PlaceNotes)
150
(let gotoEnd () (if (d-NextObject) (gotoEnd)))
151
(if (string=? (ChordComparison::GetChordQuality) chord)
153
(set! ChordComparison::score (+ ChordComparison::score 1))
154
(ChordComparison::PlaceAnswerStatus "CheckMark")
157
(set! ChordComparison::score (- ChordComparison::score 1))
158
(ChordComparison::PlaceAnswerStatus "CrossSign")
160
(ChordComparison::OfferChord))
162
(define (ChordComparison::createbuttons chord)
163
(CreateButton (string-append "ChordComparison::" (car chord)) (string-append " <span font_desc=\"32\" foreground=\"blue\">" (car chord) "</span>"))
164
(d-SetDirectiveTagActionScript (string-append "ChordComparison::" (car chord)) (string-append "(ChordComparison::chordchosen \"" (car chord) "\")")))
166
;;;;main procedure to call for ChordComparison
167
(define (ChordComparison::ChordComparison chordlist)
169
(set! ChordComparison::ChordPossibilities chordlist)
170
(CreateButton "ChordComparison::GameScore" "<span font_desc=\"32\">Click to start</span>")
171
(d-SetDirectiveTagActionScript "ChordComparison::GameScore" "(ChordComparison::OfferChord)")
173
(map ChordComparison::createbuttons ChordComparison::ChordPossibilities)
175
(CreateButton "ChordComparison::replay" "<span font_desc=\"32\">Re-Play</span>")
176
(d-SetDirectiveTagActionScript "ChordComparison::replay" "(ChordComparison::Play)" )