[racket] Moving frame% blocks processing in auxiliary eventspace

Hi all,

I have some sort of blocking issue in the code below (from Ryan Culpepper's
helpful answer on SO at
http://stackoverflow.com/questions/7294117/racket-using-events-in-a-frame-window
).

When the frame has keyboard focus, the arrow keys cause the direction to be
printed in the canvas. When the on-char event is extended with a sleep (of
one second), loading up the queue with a number of left,right,up,down
key-stroke sequences causes the canvas to be updated at one second
intervals.

Since the on-char procedure queues the actual processing (i.e. the 'update
display and wait' thunk) to run in an auxiliary eventspace, the frame can
be moved and closed while key-stroke processing proceeds.

However, on Windows, moving the frame around causes the key-stroke
processing to block until the move is completed. i.e. The 'update display
and wait' code blocks until the the mouse button is released.

Anyone know, what might be causing the block, and if there any
modifications that can be made to the code so that if does not occur?

Cheers,

Kieron.

****

#lang racket/gui

(define game-canvas%
  (class canvas%
    (inherit get-width get-height refresh)

    ;; direction: one of #f, 'left, 'right, 'up, 'down
    (define direction #f)

    (define aux-eventspace (make-eventspace))

    (define/override (on-char ke)
      (parameterize ((current-eventspace aux-eventspace))
        (queue-callback
          (lambda ()
            (case (send ke get-key-code)
              ((left right up down)
                 (set! direction (send ke get-key-code))
                 (refresh))
               (else
                 (void)))
            (sleep 2)))))

    (define/private (my-paint-callback self dc)
      (let ([w (get-width)]
            [h (get-height)])
        (when direction
          (let ([dir-text (format "going ~a" direction)])
            (let-values ([(tw th _ta _td) (send dc get-text-extent
dir-text)])
              (send dc
                    draw-text
                    dir-text
                    (max 0 (/ (- w tw) 2))
                    (max 0 (/ (- h th) 2))))))))

    (super-new
      (paint-callback
        (lambda (c dc)
          (my-paint-callback c dc))))))

(define game-frame (new frame% (label "game") (width 600) (height 400)))
(define game-canvas (new game-canvas% (parent game-frame)))
(send game-frame show #t)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20120719/e4ca7027/attachment.html>