[racket] big-bang is slow to render on screen?

The attached file is from a vignette that I have been working on ("Programming with Class"). It simulates 'big-bang' without a lot of the student protections and the machinery needed to make it compatible with the stepper etc. It also cuts out some of the software engineering playing I did (but which turned out to be useful over the years). 

The fragment below runs your program (as far as I can tell) like the original. Could you please measure this new version of your 'funny' machine? 

Thanks -- Matthias

#lang racket

;;; Run this file with `racket test-big-bang.rkt`
;;; then type quickly "asdf" to trigger several successive to-draw events.
;;; Drawing the scene is fast, but rendering it on-screen is very slow?

(require 2htdp/image
         2htdp/planetcute
         "bb.rkt")

(define elt-width (image-width grass-block))
(define elt-height (image-height grass-block))
(define elt-height/2 (/ elt-height 2))

(define view-width 800)
(define view-height 400)
(define window-width view-width)
(define window-height (+ view-height elt-height))

(define grid-size 10)

(define (stack-rows . col-picts)
  (for/fold ([img empty-image])
    ([cp col-picts])
    (underlay/align/offset 
     "center" "bottom"
     img 0 elt-height/2 cp)))

(define (client-draw-all)
  (apply stack-rows
         (for/list ([i grid-size])
           (apply beside/align "bottom" 
                  (for/list ([j grid-size])
                    grass-block)))))

(define t0 (current-milliseconds))
(define (print-time str)
  (printf "~a at ~a\n" str (- (current-milliseconds) t0)))

;; uncomment if you want to compare old and new 
#;
(define (main2)
  (local-require 2htdp/universe)
  (big-bang 
   '()
   (to-draw (λ(w)
              (print-time "to-draw")
              (display "to-draw: ")
              (time (client-draw-all)))
            window-width window-height)
   (on-key (λ(w k)(print-time (format "on-key ~a" k))))))

(define (main)
    (send (new world% 
               [state0 10]
               ;; -------------------------------------------------------
               ;; from Laurent's code 
               [to-draw 
                (λ(w)
                  (print-time "to-draw")
                  (display "to-draw: ")
                  (time (client-draw-all)))]
               [on-key (λ(w k)(print-time (format "on-key ~a" k)))]
               ;; -------------------------------------------------------
               [width window-width]
               [height window-height]
               [on-mouse #f])
          start))


-------------- next part --------------
A non-text attachment was scrubbed...
Name: bb.rkt
Type: application/octet-stream
Size: 5171 bytes
Desc: not available
URL: <http://lists.racket-lang.org/users/archive/attachments/20140422/e1b9c0ab/attachment.obj>