misc-deps
/
lux
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

better mouse state

This commit is contained in:
Jay McCarthy 2014-11-19 22:17:56 -05:00
parent 5eccb25379
commit d3f6562266
2 changed files with 30 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
chaos/gui/mouse.rkt
View File

@ -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)]))

19
examples/spin.rkt
View File

@ -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)))))