[racket-dev] multiple key-press

On Jul 30, 2010, at 4:25 PM, Robby Findler wrote:

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


It would reinforce the FSA design idea, but it will consume space. 
I'll put it on my list and see how much space I need. 


> 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)?


Yes, Paul had posted such a solution. I wanted to see what 
solution for part 1 would look like (no lists). 




> 
> 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
>>