better mouse state

chaos/gui/mouse.rkt

@@ -1,17 +1,12 @@
 #lang racket/base
 (require (for-syntax racket/base
                      racket/syntax)
-         racket/match
          racket/class
          racket/gui/base
-         racket/generic
+         racket/contract/base)
-         racket/contract/base
-         data/queue
-         lux/chaos)
 
 (struct mouse-state
-  (_
+  (x y
-   x y
    left? right? middle?
    shift? control? meta? alt?
    mod3? mod4? mod5?)
@@ -29,50 +24,22 @@
 (define-syntax-rule (set-mouse-states ms me (id ...))
   (begin (set-mouse-state ms me id) ...))
 
-(struct gui/mouse (ms g)
+(define (mouse-event? x)
-        #:methods gen:chaos
+  (is-a? x mouse-event%))
-        [(define/generic super-fps chaos-fps)
-         (define/generic super-yield chaos-yield)
-         (define/generic super-inputs chaos-inputs)
-         (define/generic super-output! chaos-output!)
-         (define/generic super-label! chaos-label!)
-         (define/generic super-swap! chaos-swap!)
-         (define (chaos-fps c)
-           (super-fps (gui/mouse-g c)))
-         (define (chaos-yield c e)
-           (super-yield (gui/mouse-g c) e))
-         (define (chaos-inputs c)
-           (define ms (gui/mouse-ms c))
-           (define inner (super-inputs (gui/mouse-g c)))
-           (define q (make-queue))
-           (for ([e inner])
-             (match e
-               [(? (λ (x) (is-a? x mouse-event%)) me)
-                (set-mouse-state-x! ms (send me get-x))
-                (set-mouse-state-y! ms (send me get-y))
-                (set-mouse-states
-                 ms me
-                 (left right middle shift control meta alt mod3 mod4 mod5))]
-               [_
-                (enqueue! q e)]))
-           (enqueue! q ms)
-           (in-queue q))
-         (define (chaos-output! c o)
-           (super-output! (gui/mouse-g c) o))
-         (define (chaos-label! c l)
-           (super-label! (gui/mouse-g c) l))
-         (define (chaos-swap! c t)
-           (super-swap! (gui/mouse-g c) t))])
 
-(define (make-gui/mouse g)
+(define (mouse-state-update! ms me)
-  (define ms
+  (set-mouse-state-x! ms (send me get-x))
-    (mouse-state (gensym) 0 0 #f #f #f #f #f #f #f #f #f #f))
+  (set-mouse-state-y! ms (send me get-y))
-  (gui/mouse ms g))
+  (set-mouse-states
+   ms me
+   (left right middle shift control meta alt mod3 mod4 mod5)))
+
+(define (make-mouse-state)
+  (mouse-state 0 0 #f #f #f #f #f #f #f #f #f #f))
 (provide
  (contract-out
   [struct mouse-state
-    ([_ symbol?]
+    ([x exact-integer?]
-     [x exact-integer?]
      [y exact-integer?]
      [left? boolean?]
      [right? boolean?]
@@ -84,6 +51,10 @@
      [mod3? boolean?]
      [mod4? boolean?]
      [mod5? boolean?])]
-  [make-gui/mouse
+  [mouse-event?
-   (-> chaos?
+   (-> any/c boolean?)]
-       chaos?)]))
+  [make-mouse-state
+   (-> mouse-state?)]
+  [mouse-state-update!
+   (-> mouse-state? (is-a?/c mouse-event%)
+       any)]))

examples/spin.rkt

@@ -11,30 +11,29 @@
 (define COLORS
   '("red" "orange" "yellow" "green" "blue" "indigo" "violet"))
 
-(struct spin (color frame x y)
+(struct spin (ms color frame)
         #:methods gen:word
         [(define (word-label s ft)
            (lux-standard-label "Spin!" ft))
          (define (word-tick w es)
-           (match-define (spin color f x y) w)
+           (match-define (spin ms color f) w)
            (define closed? #f)
            (for ([e es])
              (match e
                ['close
                 (set! closed? #t)]
-               [(? mouse-state? ms)
+               [(? mouse-event? me)
-                (set! x (mouse-state-x ms))
+                (mouse-state-update! ms me)]
-                (set! y (mouse-state-y ms))]
                [(? (λ (x) (is-a? x key-event%)) ke)
                 (set! color (fxmodulo (fx+ 1 color) (length COLORS)))]))
+           (define x (mouse-state-x ms))
+           (define y (mouse-state-y ms))
            (match closed?
              [#t
               (values #f w)]
              [#f
-              (values (spin color (fxmodulo (fx+ f 1) 360) x y)
+              (values (spin ms color (fxmodulo (fx+ f 1) 360))
                       (lambda (width height dc)
-                        (set! x (fxmin width (fxmax x 0)))
-                        (set! y (fxmin height (fxmax y 0)))
                         (send dc set-background (list-ref COLORS color))
                         (send dc clear)
                         (send dc set-rotation (* (/ f 360) 2 3.14))
@@ -43,5 +42,5 @@
 
 (module+ main
   (call-with-chaos
-   (make-gui/mouse (make-gui 60.0))
+   (make-gui 60.0)
-   (λ () (fiat-lux (spin 0 0 400 300)))))
+   (λ () (fiat-lux (spin (make-mouse-state) 0 0)))))