I have finally taken the time to design a controller for an object that allows the use of multiple arrow keys. Two insights: it is doable and it is a truly insightful exercise on state machines. Most of the 'bullet' points at the top of the program came about because I designed and explored. BUT, the program is quite complex. If you think about it for a moment, that's no surprise however. It is working with nine possible states: no arrow pressed, one of four cardinal arrows pressed, two keys pressed simultaneously.
I think "Brown" kids should be able to design this kind of function w/o a problem. For "non-Brown" kids, I suspect we would have to wait until they have a solid handle of a lot of design ideas. QUESTION: should I incorporate this into the docs? Into HtDP/2e (part 1 is already extremely long). -- Matthias (require 2htdp/universe) (require 2htdp/image) ;; ----------------------------------------------------------------------------- ;; PROGRAM PURPOSE: move a red circle while one or two arrow keys are pressed ;; ----------------------------------------------------------------------------- ;; move only when one or two arrow keys are pressed ;; when a third arrow key is pressed, ignore it ;; when a single arrow key is pressed and a contradictory arrow is pressed, ;; ignore it too ;; This program is a nine-state state machine with respect to the direction ;; in which the object is moving. ;; Boolean -> World (define (move-by-arrows debug?) (big-bang WORLD0 (on-key key-handler) (on-release release-handler) (on-tick move) (to-draw render) (state debug?))) ;; ----------------------------------------------------------------------------- ;; Data Definitions & Constant Definitions ;; Cardinal is one of: ;; -- "left" ;; -- "right" ;; -- "up" ;; -- "down" ;; interpretation: the four cardinal directions as strings and keyevents (define-struct world (dir posn)) ;; World is: (world Direction Posn) ;; the current direction and the current position of the circle ;; Direction is one of: (Yes, I mean these 10 definitions) (define BLANK (make-posn 0 0)) (define LEFT (make-posn -1 0)) (define RIGHT (make-posn +1 0)) (define UP (make-posn 0 -1)) (define DOWN (make-posn 0 +1)) (define DOWNLEFT (make-posn -1 +1)) (define DOWNRIGHT (make-posn +1 +1)) (define UPLEFT (make-posn -1 -1)) (define UPRIGHT (make-posn +1 -1)) ;; the direction as determined by a sequence of 0, 1, or 2 keys held down ;; physical constants (define SIZE 300) (define MID (/ SIZE 2)) (define WORLD0 (make-world BLANK (make-posn MID MID))) ;; graphical constants (define DOT (circle 3 "solid" "red")) (define MT (empty-scene SIZE SIZE)) ;; ----------------------------------------------------------------------------- ;; World KeyEvent -> World ; combine current direction and KeyEvent to create new direction (check-expect (key-handler (make-world UP (make-posn 0 0)) "left") (make-world UPLEFT (make-posn 0 0))) (check-expect (key-handler (make-world DOWNRIGHT (make-posn 0 0)) "left") (make-world DOWNRIGHT (make-posn 0 0))) (check-expect (key-handler (make-world UP (make-posn 0 0)) "down") (make-world UP (make-posn 0 0))) (check-expect (key-handler (make-world DOWNRIGHT (make-posn 0 0)) "down") (make-world DOWNRIGHT (make-posn 0 0))) (define (key-handler ws key) (if (cardinal? key) (make-world (key-proper (world-dir ws) key) (world-posn ws)) ws)) ;; KeyEvent -> Boolean (define (cardinal? key) (cond [(string=? "left" key) true] [(string=? "right" key) true] [(string=? "up" key) true] [(string=? "down" key) true] [else false])) ;; Direction Cardinal -> Direction (check-expect (key-proper UP "left") UPLEFT) (check-expect (key-proper DOWNRIGHT "left") DOWNRIGHT) (check-expect (key-proper RIGHT "up") UPRIGHT) ;; Direction Cardinal -> Direction (define (key-proper ws key) (cond [(equal? BLANK ws) (cond [(string=? "left" key) LEFT] [(string=? "right" key) RIGHT] ;; arbitrary decision [(string=? "up" key) UP] [(string=? "down" key) DOWN])] [(equal? LEFT ws) (cond [(string=? "left" key) ws] [(string=? "right" key) ws] ;; arbitrary decision [(string=? "up" key) UPLEFT] ;; (string-append key ws) wouldn't be typable [(string=? "down" key) DOWNLEFT])] [(equal? RIGHT ws) (cond [(string=? "left" key) ws] ;; arbitrary decision [(string=? "right" key) ws] [(string=? "up" key) UPRIGHT] [(string=? "down" key) DOWNRIGHT])] [(equal? UP ws) (cond [(string=? "left" key) UPLEFT] [(string=? "right" key) UPRIGHT] [(string=? "up" key) ws] [(string=? "down" key) ws])] ;; arbitrary decision [(equal? DOWN ws) (cond [(string=? "left" key) DOWNLEFT] [(string=? "right" key) DOWNRIGHT] [(string=? "up" key) ws] [(string=? "down" key) ws])] [(equal? UPLEFT ws) ws] [(equal? UPRIGHT ws) ws] [(equal? DOWNLEFT ws) ws] [(equal? DOWNRIGHT ws) ws])) ;; ----------------------------------------------------------------------------- ;; World KeyEvent -> World (check-expect (release-handler (make-world UP (make-posn 0 0)) "left") (make-world UP (make-posn 0 0))) (check-expect (release-handler (make-world LEFT (make-posn 0 0)) "left") (make-world BLANK (make-posn 0 0))) (check-expect (release-handler (make-world DOWNRIGHT (make-posn 0 0)) "down") (make-world RIGHT (make-posn 0 0))) (define (release-handler ws key) (if (cardinal? key) (make-world (release-proper (world-dir ws) key) (world-posn ws)) ws)) ;; Direction Cardinal -> Direction (define (release-proper ws card) (cond [(equal? BLANK ws) ws] ;; IF hold down several keys, release in some order [(equal? LEFT ws) (if (string=? "left" card) BLANK ws)] [(equal? RIGHT ws) (if (string=? "right" card) BLANK ws)] [(equal? UP ws) (if (string=? "up" card) BLANK ws)] [(equal? DOWN ws) (if (string=? "down" card) BLANK ws)] [(equal? UPLEFT ws) (cond [(string=? "left" card) UP] [(string=? "right" card) ws] [(string=? "up" card) LEFT] [(string=? "down" card) ws])] [(equal? UPRIGHT ws) (cond [(string=? "left" card) ws] [(string=? "right" card) UP] [(string=? "up" card) RIGHT] [(string=? "down" card) ws])] [(equal? DOWNLEFT ws) (cond [(string=? "left" card) DOWN] [(string=? "right" card) ws] [(string=? "up" card) ws] [(string=? "down" card) LEFT])] [(equal? DOWNRIGHT ws) (cond [(string=? "left" card) ws] [(string=? "right" card) DOWN] [(string=? "up" card) ws] [(string=? "down" card) RIGHT])])) ;; ----------------------------------------------------------------------------- ;; World -> World (check-expect (move WORLD0) WORLD0) (define (move ws) (make-world (world-dir ws) (posn+ (world-posn ws) (world-dir ws)))) ;; ----------------------------------------------------------------------------- ;; Posn Posn -> Posn (define (posn+ p q) (make-posn (+ (posn-x p) (posn-x q)) (+ (posn-y p) (posn-y q)))) ;; ----------------------------------------------------------------------------- ; World -> Image (define (render ws) (place-image DOT (posn-x (world-posn ws)) (posn-y (world-posn ws)) MT)) _________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/dev