1;;;;;;;;;;;;;;; 2;;LineOrSpace 3;; tests note name recognition. 4 5(define LineOrSpace::positionwas #t) 6(define LineOrSpace::acceptable_input (list "l" "space")) 7(define LineOrSpace::userinput #t) 8(define LineOrSpace::start (current-time)) 9(define LineOrSpace::end (current-time)) 10(define LineOrSpace::score 0) 11(define LineOrSpace::steps 0) 12(define LineOrSpace::position 6) ;in middle c offset 13(define LineOrSpace::note_highest 12) 14(define LineOrSpace::note_lowest 0) 15(define LineOrSpace::span 8) ;; how many LineOrSpace::steps of the scale to test. 16(define LineOrSpace::num-goes 30) ;; how many notes to present for the whole test 17(define LineOrSpace::input_device 1) ;0 = mouse 1 = keyboard 18 19(define (LineOrSpace::showscore) 20 (d-DirectivePut-score-display "LineOrSpace::GameScore" (string-append "<b>Score: " (object->string LineOrSpace::score) "</b> in " (object->string (- LineOrSpace::end LineOrSpace::start)) " Secs."))) 21 22(define (LineOrSpace::help) 23 (d-InfoDialog "Click on the *Spacebar* if the note is on a space and the *L* key if it is on a line.") 24) 25 26(define (LineOrSpace::GameOver) 27 (d-InfoDialog (string-append "Game Over\n" "Your Score = " (number->string LineOrSpace::score))) 28) 29 30(define (LineOrSpace::ScoreBoard) 31 (d-InfoDialog (EducationGames::Scoreboard_Pretty_Print 32 (EducationGames::ScoreboardFile "LineOrSpace"))) 33) 34 35(CreateButton "LineOrSpace::GameScore" "<span font_desc=\"12\">Score</span>") 36(d-SetDirectiveTagActionScript "LineOrSpace::GameScore" "(LineOrSpace::ScoreBoard)") 37(CreateButton "LineOrSpace::GameHelp" "<b>Help</b>") 38(d-SetDirectiveTagActionScript "LineOrSpace::GameHelp" "(LineOrSpace::help)") 39 40(define (LineOrSpace::offerNote) 41 (let ( 42 (outofrange? 0) 43 (seed 0) 44 (interval 0) 45 ) 46 (set! outofrange? 47 (lambda () 48 (or (> LineOrSpace::position LineOrSpace::note_highest) 49 (> LineOrSpace::note_lowest LineOrSpace::position)) 50 )) 51 (set! seed 52 (lambda () 53 (set! interval (random 4)) 54 (if (= (random 2) 0) 55 (set! LineOrSpace::position (+ LineOrSpace::position interval)) 56 (set! LineOrSpace::position (- LineOrSpace::position interval))) 57 (if (outofrange?) 58 (seed)) 59 )) 60 61 (seed) 62 (d-MoveToEnd) 63 (d-CursorToNote (EducationalGames::middle_c_offset->lily LineOrSpace::position)) 64 (d-Insert1) 65 (if (or (even? LineOrSpace::position) 66 (= 0 LineOrSpace::position)) 67 (set! LineOrSpace::positionwas "line") 68 (set! LineOrSpace::positionwas "space")) 69 70 (LineOrSpace::showscore) 71 )) 72 73;;;;;;;;; callback when user chooses a note 74(define (LineOrSpace::positionchosen userinput) 75 (if (> LineOrSpace::num-goes 0) 76 (begin 77 (set! LineOrSpace::end (current-time)) 78 (d-MoveToEnd) 79 (if (string=? LineOrSpace::positionwas userinput) 80 (begin 81 (set! LineOrSpace::score (+ LineOrSpace::score 1)) 82 (EducationGames::PlaceAnswerStatus "CheckMark")) 83 (begin 84 (set! LineOrSpace::score (- LineOrSpace::score 1)) 85 (EducationGames::PlaceAnswerStatus "CrossSign"))) 86 87 (if (= LineOrSpace::input_device 0) 88 (begin 89 (set! LineOrSpace::num-goes (- LineOrSpace::num-goes 1)) 90 (if (= LineOrSpace::num-goes 0) 91 (LineOrSpace::EndGame)) 92 )) 93 (if (> LineOrSpace::num-goes 0) 94 (LineOrSpace::offerNote)) 95 ))) 96 97 98;;;;;;;; the main function to run the test 99(define LineOrSpace::runtest 100 (lambda (n) 101 (if (> n 0) (begin 102 (set! LineOrSpace::userinput (EducationGames::GetAcceptableKeyInput LineOrSpace::acceptable_input)) 103 (if (string=? LineOrSpace::userinput "l") 104 (set! LineOrSpace::userinput "line")) 105 (LineOrSpace::positionchosen LineOrSpace::userinput) 106 (LineOrSpace::runtest (- n 1)))))) 107 108 109(define (LineOrSpace::createbuttons position) 110 (CreateButton (string-append "LineOrSpace::" position) (string-append " <span font_desc=\"32\" foreground=\"blue\">" position "</span>")) 111 (d-SetDirectiveTagActionScript (string-append "LineOrSpace::" position) (string-append "(LineOrSpace::positionchosen \"" position "\")"))) 112 113(define (LineOrSpace::EndGame) 114 (EducationGames::Chime) 115 (if (not 116 (EducationGames::Write_Scoreboard_File 117 (EducationGames::ScoreboardFile "LineOrSpace") LineOrSpace::score)) 118 (LineOrSpace::GameOver) 119 (LineOrSpace::ScoreBoard) 120 )) 121 122 123;;; 124(define (LineOrSpace::go) 125 (if (not (zero? LineOrSpace::score)) 126 (let ((response #f)) 127 (set! response (d-GetUserInput "Reset Score" "Do you want to reset your score" "y")) 128 (if (equal? response "y") 129 (begin 130 (set! LineOrSpace::start (current-time)) 131 (set! LineOrSpace::end (current-time)) 132 133 (set! LineOrSpace::score 0))))) 134 (d-DeletePreviousObject) 135 (if (= LineOrSpace::input_device 0) 136 (begin ;mouse 137 (LineOrSpace::createbuttons "line") 138 (LineOrSpace::createbuttons "space") 139 (EducationGames::Chime) 140 (LineOrSpace::offerNote) 141 ) 142 (begin ;keyboard 143 (EducationGames::Chime) 144 (LineOrSpace::offerNote) 145 (LineOrSpace::runtest LineOrSpace::num-goes) 146 (LineOrSpace::EndGame)) 147 ) 148 ) 149 150(CreateButton "LineOrSpace::GameScore" "<span font_desc=\"32\">Click to start</span>") 151(d-SetDirectiveTagActionScript "LineOrSpace::GameScore" "(LineOrSpace::go)") 152 153 154(define (LineOrSpace::Input_Select) 155 (if (= LineOrSpace::input_device 0) 156 (begin 157 (set! LineOrSpace::input_device 1) 158 (d-DirectivePut-score-display "LineOrSpace::SetInput" "<span font_desc=\"12\">Input:keyboard</span>") 159 ) 160 (begin 161 (set! LineOrSpace::input_device 0) 162 (d-DirectivePut-score-display "LineOrSpace::SetInput" "<span font_desc=\"12\">Input:mouse</span>") 163 ) 164 )) 165 166(CreateButton "LineOrSpace::SetInput" "<span font_desc=\"12\">Input:keyboard</span>") 167(d-SetDirectiveTagActionScript "LineOrSpace::SetInput" "(LineOrSpace::Input_Select)") 168 169