[racket-dev] gui responsiveness

(moved to dev)

On Linux, the attached program shows terrible responsiveness when 
dragging points around on the graph.  Can anyone else on Linux reproduce 
this behavior?


The patch below dramatically improves the responsiveness by forcing the 
eventspace to process medium-level events (mouse movement) before 
refresh events.  Without the patch, each mouse drag causes a paint.  
With it, multiple mouse drags are processed before a paint.


I'm unsure about this fix.  Windows doesn't show the problem (I don't 
have a mac to test), so I think it's just a GTK issue.

My guess is that the gui layer is relying on the native libraries to 
coalesce multiple refresh requests (but this is not working with GTK).  
Can anyone confirm this?

Thanks,
Dave



diff -ru 
racket-6.0_clean/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt 
racket-6.0/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt
--- racket-6.0_clean/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt 
2014-02-18 12:27:43.000000000 -0500
+++ racket-6.0/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt 
2014-04-16 09:41:16.810993955 -0400
@@ -300,8 +300,8 @@
(lambda (_) #f))
                                             (or (first hi peek?)
(timer-first-ready timer peek?)
-                                               (first refresh peek?)
                                                 (first med peek?)
+                                               (first refresh peek?)
                                                 (and (not peek?)
                                                      sync?
                                                      ;; before going 
with low-priority events,

-------------- next part --------------
#lang racket/gui

(require plot
         (lib "plot/private/no-gui/plot2d-utils.rkt")
         (lib "plot/private/plot2d/plot-area.rkt"))

(define data
  (vector (list 1 1)
          (list 3 4)))

(define *area* #f)

(define (draw-screen canvas dc)
  (define renderer-tree
    (points data #:size 10))
  
  (define x 0)
  (define y 0)
  (define width 400)
  (define height 400)
  
  (define x-min 0)
  (define x-max 10)
  (define y-min 0)
  (define y-max 10)
  
  ; this shamefully ripped out of the plot code for plot/dc
  ; so we can access the area object
  (define renderer-list (get-renderer-list renderer-tree))
  (define bounds-rect (get-bounds-rect renderer-list x-min x-max y-min y-max))
  (define-values (x-ticks x-far-ticks y-ticks y-far-ticks)
    (get-ticks renderer-list bounds-rect))
  
  (define area (make-object 2d-plot-area%
                 bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks dc x y width height))
  (plot-area area renderer-list)
  (set! *area* area))

(define frame
  (new frame%
       (label "Interactive Plot")
       (width 400)
       (height 400)))

(define drag-point #f)
(define dragx #f)
(define dragy #f)

(define my-canvas
    (class canvas%
      (define/override (on-event event)
        (define x (send event get-x))
        (define y (send event get-y))
        (cond
          ((send event button-down? 'left)
           (set! drag-point #f)  ; just in case we missed the button-up?
           (define cur (send *area* dc->plot (vector x y)))
           (for (((d i) (in-indexed data)))
             (when (and
                    ((abs (- (first d) (vector-ref cur 0))) . < . 0.5)
                    ((abs (- (second d) (vector-ref cur 1))) . < . 0.5))
               (set! drag-point i)))
           (set! dragx x)
           (set! dragy y))
          ((send event dragging?)
           (when (and *area* drag-point)
             (define prev (send *area* dc->plot (vector dragx dragy)))
             (define cur (send *area* dc->plot (vector x y)))
             (define dx (- (vector-ref cur 0) (vector-ref prev 0)))
             (define dy (- (vector-ref cur 1) (vector-ref prev 1)))
             ;(printf "change ~v\n" (list dx dy))
             (vector-set! data drag-point
                          (list (+ (first (vector-ref data drag-point)) dx)
                                (+ (second (vector-ref data drag-point)) dy)))
             (send this refresh))
           (set! dragx x)
           (set! dragy y))))
      (super-new)))
  
(define canvas
  (new my-canvas
       (parent frame)
       (paint-callback draw-screen)))

(send frame show #t)