From 6b3f8d920a2b2db66aaf6531cceb3185b0893070 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 7 Aug 2017 13:41:01 -0400 Subject: [PATCH] Key debouncer --- .../syndicate/examples/actor/double-click.rkt | 24 +++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/racket/syndicate/examples/actor/double-click.rkt b/racket/syndicate/examples/actor/double-click.rkt index 94c54c1..db6fbc8 100644 --- a/racket/syndicate/examples/actor/double-click.rkt +++ b/racket/syndicate/examples/actor/double-click.rkt @@ -1,8 +1,10 @@ #lang syndicate/actor +;; Demonstrates debouncer-like functionality. (require syndicate/big-bang) (require/activate syndicate/big-bang/timestate) +(struct key-down (key) #:prefab) (struct click-event (description) #:prefab) (spawn #:name 'button @@ -21,7 +23,7 @@ (on-start (wait-for-initial-press)) (assert (outbound (window name 10 10 0 - (seal (overlay (text "Click me" 22 "white") + (seal (overlay (text "Click me" 20 "white") (rectangle 140 50 "solid" "red"))))))) (spawn #:name 'status @@ -32,7 +34,25 @@ (on (asserted (later-than (clear-time))) (status 'waiting)) (assert (outbound (window 'status 10 60 0 - (seal (text (format "~a" (status)) 22 "black")))))) + (seal (text (format "~a" (status)) 20 "black")))))) + +(spawn #:name 'key-down-listener + (on (message (inbound (key-event $k _))) + (react (assert (key-down k)) + (stop-when (message (inbound (release-event k _))))))) + +(spawn #:name 'key-debouncer + (field [status 'no-key]) + + (on (asserted (key-down $k)) + (react (stop-when (retracted (key-down k))) + (stop-when-timeout 500 (status `(down ,k))))) + (on (retracted (key-down $k)) + (react (stop-when (asserted (key-down k))) + (stop-when-timeout 500 (status `(up ,k))))) + + (assert (outbound (window 'key-debouncer 10 90 0 + (seal (text (format "~a" (status)) 20 "black")))))) (module+ main (current-ground-dataspace