diff --git a/chaos/gui/mouse.rkt b/chaos/gui/mouse.rkt index 9784242..0e50860 100644 --- a/chaos/gui/mouse.rkt +++ b/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 - data/queue - lux/chaos) + racket/contract/base) (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) - #:methods gen:chaos - [(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 (mouse-event? x) + (is-a? x mouse-event%)) -(define (make-gui/mouse g) - (define ms - (mouse-state (gensym) 0 0 #f #f #f #f #f #f #f #f #f #f)) - (gui/mouse ms g)) +(define (mouse-state-update! ms 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))) + +(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 - (-> chaos? - chaos?)])) + [mouse-event? + (-> any/c boolean?)] + [make-mouse-state + (-> mouse-state?)] + [mouse-state-update! + (-> mouse-state? (is-a?/c mouse-event%) + any)])) diff --git a/examples/spin.rkt b/examples/spin.rkt index 5ab3404..14fe629 100644 --- a/examples/spin.rkt +++ b/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) - (set! x (mouse-state-x ms)) - (set! y (mouse-state-y ms))] + [(? mouse-event? me) + (mouse-state-update! ms me)] [(? (λ (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)) - (λ () (fiat-lux (spin 0 0 400 300))))) + (make-gui 60.0) + (λ () (fiat-lux (spin (make-mouse-state) 0 0)))))