suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

checking keystrokes properly in universe

Browse Source 
svn: r15743
This commit is contained in:
Matthias Felleisen 2009-08-15 01:25:02 +00:00
parent fd813e111e
commit ae0822ac9f
1 changed files with 37 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/2htdp/universe.ss
View File

@ -232,7 +232,43 @@
(check-arg 'mouse=? (mouse-event? m) 'MouseEvent "second" m) (check-arg 'mouse=? (mouse-event? m) 'MouseEvent "second" m)
(string=? k m)) (string=? k m))
(define (key-event? k) (string? k)) (define KEYS
'("left"
"right"
"up"
"down"
"release"
"start"
"cancel"
"clear"
"shift"
"control"
"menu"
"pause"
"capital"
"prior"
"next"
"end"
"home"
"escape"
"select"
"print"
"execute"
"snapshot"
"insert"
"help"
"numpad0" "numpad1" "numpad2" "numpad3" "numpad4"
"numpad5" "numpad6" "numpad7" "numpad8" "numpad9"
"numpad-enter" "multiply" "add" "separator" "subtract" "decimal" "divide"
"f1" "f2" "f3" "f4" "f5" "f6" "f7" "f8" "f9" "f10" "f11" "f12" "f13"
"f14" "f15" "f16" "f17" "f18" "f19" "f20" "f21" "f22" "f23" "f24"
"numlock"
"scroll"
"wheel-up"
"wheel-down"))
(define (key-event? k)
(and (string? k) (or (= (string-length k) 1) (member k KEYS))))
(define (key=? k m) (define (key=? k m)
(check-arg 'key=? (key-event? k) 'KeyEvent "first" k) (check-arg 'key=? (key-event? k) 'KeyEvent "first" k)