[racket-dev] multiple key-press

Looks like it would make a nice, involved exercise if you told the
students what the right world type should be.

Did you consider making the world be a list of keys and a posn
(inserting and removing from the list in the key handler and
"interpreting" the list of keys in the tick handler)?

Robby

On Friday, July 30, 2010, Matthias Felleisen <matthias at ccs.neu.edu> wrote:
>
> 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
>