box.rkt

#lang racket/gui

(define f%
  (class frame%
    (super-new)
    (define/override (on-subwindow-char recv ch)
      (match (send ch get-key-code)
        [#\q (send this show #f) #t]
        [_ (super on-subwindow-char recv ch)]))))

(define c%
  (class canvas%
    (super-new)
    (field (pos (vector 0 0))
           (dim (vector 100 100))
           (speed 10))
    (define/override (on-paint)
      (define dc (send this get-dc))
      (send dc clear)
      (send dc draw-rounded-rectangle (vector-ref pos 0) (vector-ref pos 1)
                                      (vector-ref dim 0) (vector-ref dim 1)))
    (define/override (on-char ch)
      (match (send ch get-key-code)
        [(and (or 'up 'down 'left 'right) direction) (move-box direction)]
        [_ (void)]))
    (define/private (move-box direction)
      (define x (vector-ref pos 0))
      (define y (vector-ref pos 1))
      (define-values (w h) (send this get-size))
      (apply (curry vector-set! pos)
             (match direction
               ['left (list 0 (max 0 (- x speed)))]
               ['right (list 0 (min (- w (vector-ref dim 0)) (+ x speed)))]
               ['up (list 1 (max 0 (- y speed)))]
               ['down (list 1 (min (- h (vector-ref dim 1)) (+ y speed)))]
               [_ (error 'unknown-direction)]))
      (send this refresh))))

(define frame (new f% [label "Test"]))
(define canvas (new c% [parent frame]))

(send frame show #t)
(send canvas focus)