(define MelodicDictation::Scale (cons "F# G# A# B C#" "fis' gis' ais' b' cis''")) (define MelodicDictation::NumberOfNotes 5) (define MelodicDictation::notelist '()) (define MelodicDictation::Melody '()) (define MelodicDictation::CurrentNoteNum 0) (define MelodicDictation::ArpTimer 0) (let ((time (gettimeofday))) (set! *random-state* (seed->random-state (+ (car time) (cdr time))))) (define (MelodicDictation::gotoEnd) (d-CursorRight) (if (d-NextObject) (MelodicDictation::gotoEnd) (d-CursorRight))) (define (MelodicDictation::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 (MelodicDictation::CreateNewMelody) (set! MelodicDictation::notelist (string-split (cdr MelodicDictation::Scale) #\space)) (set! MelodicDictation::Melody '()) (let loop ( (i 0) ) (if (= MelodicDictation::NumberOfNotes i) #t (begin (set! MelodicDictation::CurrentNoteNum (random (length MelodicDictation::notelist))) (set! MelodicDictation::Melody (append MelodicDictation::Melody (list (list-ref MelodicDictation::notelist MelodicDictation::CurrentNoteNum)))) (loop (+ i 1)))))) (define (MelodicDictation::PlayScaleNote note) (let ( (newnote "") ) (set! newnote (number->string (MelodicDictation::lilyname->midikey note))) (d-OneShotTimer MelodicDictation::ArpTimer (string-append "(PlayNote " "\"" newnote "\"" " 1000)")) (set! MelodicDictation::ArpTimer (+ MelodicDictation::ArpTimer 1000)))) (define (MelodicDictation::PlayScaleNoteNow note) (let ( (newnote "") ) (set! newnote (number->string (MelodicDictation::lilyname->midikey note))) (d-OneShotTimer 0 (string-append "(PlayNote " "\"" newnote "\"" " 1000)")))) (define (MelodicDictation::PlayScale notelist) (set! MelodicDictation::ArpTimer 0) (map MelodicDictation::PlayScaleNote notelist)) (define (MelodicDictation::NewMelody) (MelodicDictation::CreateNewMelody)) (define (MelodicDictation::help) (d-InfoDialog "When you click on the New Melody button a new melody will be created. Click on the Play Melody button to hear this melody. Dictate what you hear on the staff. Press the Play Scale button to hear the available notes.")) ;;;;main procedure to call for MelodicDictation (define (MelodicDictation::MelodicDictations Scale) (CreateButton "MelodicDictation::GameScore" "New Melody") (d-SetDirectiveTagActionScript "MelodicDictation::GameScore" "(MelodicDictation::NewMelody)") (CreateButton "MelodicDictation::GameHelp" "Help") (d-SetDirectiveTagActionScript "MelodicDictation::GameHelp" "(MelodicDictation::help)") (CreateButton "MelodicDictation::play_melody" "Play Melody") (d-SetDirectiveTagActionScript "MelodicDictation::play_melody" "(MelodicDictation::PlayScale MelodicDictation::Melody)" ) (CreateButton "MelodicDictation::play_scale" "Play Scale") (d-SetDirectiveTagActionScript "MelodicDictation::play_scale" "(MelodicDictation::PlayScale MelodicDictation::notelist)") ) (MelodicDictation::MelodicDictations MelodicDictation::Scale)