Adding key state

README

@@ -1,4 +1 @@
 lux - a simple library for creating real-time graphical apps
-
-TODO
-xxx chaos/gui/key (take gui)

chaos/gui/key.rkt

@@ -0,0 +1,67 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     racket/syntax)
+         racket/match
+         racket/class
+         racket/gui/base
+         racket/contract/base)
+
+(struct key-state
+  (keys
+   shift? control? meta? alt?
+   mod3? mod4? mod5?)
+  #:mutable)
+
+(define-syntax (set-key-state stx)
+  (syntax-case stx ()
+    [(_ ks ke id)
+     (with-syntax ([set-key-state-id?!
+                    (format-id #'id "set-key-state-~a?!" #'id)]
+                   [get-id-down
+                    (format-id #'id "get-~a-down" #'id)])
+       (syntax/loc stx
+         (set-key-state-id?! ks (send ke get-id-down))))]))
+(define-syntax-rule (set-key-states ks ke (id ...))
+  (begin (set-key-state ks ke id) ...))
+
+(define (key-event? x)
+  (is-a? x key-event%))
+
+(define (key-state-update! ks ke)
+  (define ht (key-state-keys ks))
+  (match (send ke get-key-code)
+    ['release
+     (hash-set! ht (send ke get-key-release-code) #f)]
+    [kc
+     (hash-set! ht kc #t)])
+  (set-key-states
+   ks ke
+   (shift control meta alt mod3 mod4 mod5)))
+
+(define (make-key-state)
+  (key-state (make-hasheq) #f #f #f #f #f #f #f))
+
+(define (key-state-set? ks kc)
+  (hash-ref (key-state-keys ks) kc #f))
+
+(provide
+ (contract-out
+  [struct key-state
+    ([keys hash?]
+     [shift? boolean?]
+     [control? boolean?]
+     [meta? boolean?]
+     [alt? boolean?]
+     [mod3? boolean?]
+     [mod4? boolean?]
+     [mod5? boolean?])]
+  [key-event?
+   (-> any/c boolean?)]
+  [make-key-state
+   (-> key-state?)]
+  [key-state-update!
+   (-> key-state? (is-a?/c key-event%)
+       any)]
+  [key-state-set?
+   (-> key-state? (or/c char? key-code-symbol?)
+       boolean?)]))

examples/spin.rkt

@@ -2,21 +2,21 @@
 (require racket/match
          racket/fixnum
          racket/draw
-         racket/gui/base
          racket/class
          lux
          lux/chaos/gui
+         lux/chaos/gui/key
          lux/chaos/gui/mouse)
 
 (define COLORS
   '("red" "orange" "yellow" "green" "blue" "indigo" "violet"))
 
-(struct spin (ms color frame)
+(struct spin (ks ms color frame)
         #:methods gen:word
         [(define (word-label s ft)
            (lux-standard-label "Spin!" ft))
          (define (word-tick w es)
-           (match-define (spin ms color f) w)
+           (match-define (spin ks ms color f) w)
            (define closed? #f)
            (for ([e es])
              (match e
@@ -24,15 +24,17 @@
                 (set! closed? #t)]
                [(? mouse-event? me)
                 (mouse-state-update! ms me)]
-               [(? (λ (x) (is-a? x key-event%)) ke)
+               [(? key-event? ke)
-                (set! color (fxmodulo (fx+ 1 color) (length COLORS)))]))
+                (key-state-update! ks ke)]))
            (define x (mouse-state-x ms))
            (define y (mouse-state-y ms))
+           (when (key-state-set? ks #\space)
+             (set! color (fxmodulo (fx+ 1 color) (length COLORS))))
            (match closed?
              [#t
               (values #f w)]
              [#f
-              (values (spin ms color (fxmodulo (fx+ f 1) 360))
+              (values (spin ks ms color (fxmodulo (fx+ f 1) 360))
                       (lambda (width height dc)
                         (send dc set-background (list-ref COLORS color))
                         (send dc clear)
@@ -41,6 +43,10 @@
                         (send dc draw-text "Spinning!" 0 0)))]))])
 
 (module+ main
+  (define s 
+    (spin (make-key-state)
+          (make-mouse-state)
+          0 0))
   (call-with-chaos
    (make-gui 60.0)
-   (λ () (fiat-lux (spin (make-mouse-state) 0 0)))))
+   (λ () (fiat-lux s))))