[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Scrolling graphics under Win<2K>?



Hello, and thanks to the DrScheme developers for some great software.

I have noticed an odd difference in the scrolling behavior of the MrEd 
canvas% object under M$ Win<2K>,
as opposed to the X-Windows implementation.  

When scrolling a graphical display, the M$Win window blanks out, and is 
not repainted until the scrollbar
is released, whereas under X-windows the window scrolls smoothly.  I was 
wondering, is this a known
discrepancy, and is there a work-around to allow smooth scrolling of 
graphics under M$Win?  Many thanks
for any help.

Here is some code which will serve to illustrate the behavior (the 
bitmap scrolls smoothly under
X-windows, but not under M$Win):

(define bitmap-canvas%
  (class canvas% (frame backing)
    (inherit init-auto-scrollbars)
    (rename (get-canvas-dc get-dc))
    (private (dc (make-object bitmap-dc% backing)))
    (override (get-dc (lambda () dc)))
    (override
      (on-paint
       (lambda () (send (get-canvas-dc) draw-bitmap backing 0 0))))
    (sequence
      (super-init frame '(hscroll vscroll))
      (init-auto-scrollbars
       (send backing get-width)
       (send backing get-height)
       0.5 0.5))))

(define gray-brush
  (let ((gray-brushes
         (do ((x (make-vector 256)) (i 0 (+ i 1)))
           ((> i 255) x)
           (vector-set! x i
                        (make-object brush%
                          (make-object color% i i i) 'solid)))))
    (lambda (shade) (vector-ref gray-brushes shade))))

(define no-pen (make-object pen% "BLACK" 0 'transparent))

(thread
 (lambda ()
   (let* ((frame (make-object frame% "Testing!" #f 256 400))
          (bmp (make-object bitmap% 256 2048 #f))
          (canvas (make-object bitmap-canvas% frame bmp))
          (dc (send canvas get-dc)))
     (send frame show #t)
     (send dc set-pen no-pen)
     (time
      (do ((j 0 (+ j 2))) ((>= j 2048) (send canvas on-paint))
        (when (= (modulo j 64) 0) (send canvas on-paint))
        (do ((i 0 (+ i 2))) ((>= i 256) #t)
          (let ((g (gray-brush (+ (quotient i 2) (random 128)))))
            (send dc set-brush g)
            (send dc draw-rectangle i j 2 2))))))))