[plt-scheme] Problems with draw-bitmap (?)

From: Robert Bruce Findler (robby at cs.uchicago.edu)
Date: Mon Mar 3 18:23:57 EST 2003

I'm not sure of the organization of your code, so I went ahead and
coded up something myself. You may want to look at that, since it seems
like you code is going to base the animation speed somehow on the
number of refreshes.

That aside, it appears that refresh is the culprit. According to the
docs, refresh queues a call to on-paint (and implicitly that's all it
does), but when I call refresh it seems to be queueing a callback that
erases the screen and then calls on-paint, which causes an occasional
flicker in the code below (still, nothing like the buffer-less flicker).

Hope that helps.

Robby

(module m mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss")
           (lib "thread.ss"))
  
  ;; step-time : number
  ;; controls the speed of the animation
  (define step-time 0.01)
  
  ;; bitmap-size : positive-integer
  ;; controls the size of the animation & offscreen buffer
  (define bitmap-size 100)
  
  ;; drawing-mutex : semaphore
  ;; ensure that we don't both draw the bitmap
  ;; to the screen at the same time as we are
  ;; updating the bitmap. this is fairly
  ;; brute fore approach and double buffering
  ;; would make this work better. 
  (define drawing-mutex (make-semaphore 1))
  
  ;; animate : -> any
  ;; drives the animation
  (define (animate)
    (update-state-variables)
    (with-semaphore 
     drawing-mutex
     (lambda ()
       (draw-animation bdc)))
    
    ;; queue-callback enqueues an event
    ;; in the event queue that runs the
    ;; thunk. This makes sure that
    ;; we don't inadvertently mess
    ;; with (or rely on) the state
    ;; of the canvas while we are on
    ;; this other animation thread.
    ;; (the clip region, in particular)
    (queue-callback
     (lambda ()
       (send ani-canvas on-paint)
       (send buf-canvas on-paint)))
    
    (sleep step-time)
    (animate))

  ;; state variables for animation
  (define sign 1)
  (define step 50)
  
  ;; offscreen buffer and its drawing context
  (define bm (make-object bitmap% bitmap-size bitmap-size))
  (define bdc (make-object bitmap-dc% bm))
  
  ;; update-state-variables : -> void
  ;; changes the state variables to the next state
  (define (update-state-variables)
    (set! step (+ step sign))
    (cond
      [(= step 0) 
       (set! sign 1)]
      [(= step bitmap-size)
       (set! sign -1)]))
  
  ;; draw-animation : dc<%> -> void
  ;; draws the current-step in the animation
  (define (draw-animation dc)
    (send dc clear)
    (sleep (/ step-time 2)) ;; simulate lots of drawing work
    (send dc set-brush (send the-brush-list find-or-create-brush "black" 'solid))
    (send dc draw-ellipse 
          (quotient step 2)
          (quotient step 2)
          (quotient step 2)
          (quotient step 2)))
  
  (define f 
    (instantiate frame% ()
      (label "frame")))
  
  (define ani-canvas (instantiate canvas% ()
                       (parent f)
                       (min-width bitmap-size)
                       (min-height bitmap-size)
                       (paint-callback
                        (lambda (b dc)
                          (with-semaphore 
                           drawing-mutex
                           (lambda ()
                             (send dc draw-bitmap bm 0 0)))))))
  
  (define buf-canvas (instantiate canvas% ()
                       (parent f)
                       (min-width bitmap-size)
                       (min-height bitmap-size)
                       (paint-callback
                        (lambda (b dc) (draw-animation dc)))))
  (send f show #t)
  (thread animate))

At Mon, 03 Mar 2003 23:42:42 +0200, Katsmall the Wise wrote:
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
> 
> I was told to use double-buffering so that animations won't flicker, so 
> here's what I did:
> 
> I turned
> 
> (define/override (on-paint)
>   (debug "on-paint: clearing screen\n")
>   (send (get-dc) clear)
>   (set! the-log (draw-on-dc (get-dc) the-log))
>   (void))
> 
> Into
> 
> (define bmp (make-object bitmap% 10 10 #f))
> (define bmp-dc (instantiate bitmap-dc% ()))
> (send bmp-dc set-bitmap bmp)
> (define/override (on-paint)
>   (debug "on-paint: clearing screen\n")
>   (send bmp-dc clear)
>   (set! the-log (draw-on-dc bmp-dc the-log))
>   (send (get-dc) draw-bitmap bmp 0 0)
>   (void))
> 
> The first one worked, the second one doesn't.
> the-log is a variable that says what to draw, draw-on-dc gets a dc, 
> draws the-log into it, and returns the-log (sometimes changed - in case 
> of an exception (bad log))
> 
> What is wrong with the change?
> 
> Katsmall the Wise
> kela_bit at netvision.net.il
> 
> 



Posted on the users mailing list.