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

Demonstrate nesting

This commit is contained in:
Jay McCarthy 2014-11-19 22:55:32 -05:00
parent edeb5189cf
commit 7204b221ee
3 changed files with 38 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
chaos/gui.rkt
View File

@ -6,7 +6,7 @@
data/queue data/queue
lux/chaos) lux/chaos)
(struct gui (events-box fps drawer frame refresh!) (struct gui (depth-box events-box fps drawer frame refresh!)
#:methods gen:chaos #:methods gen:chaos
[(define (chaos-fps c) [(define (chaos-fps c)
(gui-fps c)) (gui-fps c))
@ -22,7 +22,15 @@
(set-box! (gui-drawer c) o) (set-box! (gui-drawer c) o)
((gui-refresh! c))) ((gui-refresh! c)))
(define (chaos-label! c l) (define (chaos-label! c l)
(send (gui-frame c) set-label l))]) (send (gui-frame c) set-label l))
(define (chaos-swap! c t)
(define db (gui-depth-box c))
(define og (unbox db))
(set-box! db (add1 og))
(begin0 (t)
(if (zero? og)
(send (gui-frame c) show #f)
(set-box! db og))))])
(define (make-gui fps (define (make-gui fps
#:mode [mode 'draw] #:mode [mode 'draw]
@ -75,9 +83,12 @@
(define (refresh!) (define (refresh!)
(send c refresh)) (send c refresh))
(send f center)
(send f show #t) (send f show #t)
(gui events-box fps drawer f refresh!)) (define depth-box (box 0))
(gui depth-box events-box fps drawer f refresh!))
(provide (provide
(contract-out (contract-out

6
chaos/gui/key.rkt
View File

@ -43,6 +43,9 @@
(define (key-state-set? ks kc) (define (key-state-set? ks kc)
(hash-ref (key-state-keys ks) kc #f)) (hash-ref (key-state-keys ks) kc #f))
(define (key-state-set?! ks kc)
(begin0 (key-state-set? ks kc)
(hash-set! (key-state-keys ks) kc #f)))
(provide (provide
(contract-out (contract-out
@ -63,5 +66,8 @@
(-> key-state? (is-a?/c key-event%) (-> key-state? (is-a?/c key-event%)
any)] any)]
[key-state-set? [key-state-set?
(-> key-state? (or/c char? key-code-symbol?)
boolean?)]
[key-state-set?!
(-> key-state? (or/c char? key-code-symbol?) (-> key-state? (or/c char? key-code-symbol?)
boolean?)])) boolean?)]))

26
examples/spin.rkt
View File

@ -11,12 +11,12 @@
(define COLORS (define COLORS
'("red" "orange" "yellow" "green" "blue" "indigo" "violet")) '("red" "orange" "yellow" "green" "blue" "indigo" "violet"))
(struct spin (ks ms color frame) (struct spin (layer ks ms color frame)
#:methods gen:word #:methods gen:word
[(define (word-label s ft) [(define (word-label s ft)
(lux-standard-label "Spin!" ft)) (lux-standard-label "Spin!" ft))
(define (word-tick w es) (define (word-tick w es)
(match-define (spin ks ms color f) w) (match-define (spin layer ks ms color f) w)
(define closed? #f) (define closed? #f)
(for ([e es]) (for ([e es])
(match e (match e
@ -28,25 +28,33 @@
(key-state-update! ks ke)])) (key-state-update! ks ke)]))
(define x (mouse-state-x ms)) (define x (mouse-state-x ms))
(define y (mouse-state-y ms)) (define y (mouse-state-y ms))
(when (key-state-set? ks #\space) (when (key-state-set?! ks #\space)
(set! color (fxmodulo (fx+ 1 color) (length COLORS)))) (set! color (fxmodulo (fx+ 1 color) (length COLORS))))
(match closed? (when (key-state-set?! ks #\return)
(spin-it! (add1 layer)))
(match (or closed?
(key-state-set?! ks 'escape))
[#t [#t
(values #f w)] (values #f w)]
[#f [#f
(values (spin ks ms color (fxmodulo (fx+ f 1) 360)) (values (spin layer ks ms color (fxmodulo (fx+ f 1) 360))
(lambda (width height dc) (lambda (width height dc)
(send dc set-background (list-ref COLORS color)) (send dc set-background (list-ref COLORS color))
(send dc clear) (send dc clear)
(send dc set-rotation (* (/ f 360) 2 3.14)) (send dc set-rotation (* (/ f 360) 2 3.14))
(send dc set-origin x y) (send dc set-origin x y)
(send dc draw-text "Spinning!" 0 0)))]))]) (send dc draw-text (format "~a: Spinning!" layer) 0 0)))]))])
(module+ main (define (spin-it! layer)
(define s (define s
(spin (make-key-state) (spin layer
(make-key-state)
(make-mouse-state) (make-mouse-state)
0 0)) 0 0))
(fiat-lux s))
(module+ main
(call-with-chaos (call-with-chaos
(make-gui 60.0) (make-gui 60.0)
(λ () (fiat-lux s)))) (λ ()
(spin-it! 0))))