double-click "debouncing" example
This commit is contained in:
parent
4f8bc6e5af
commit
61b683fc94
|
@ -0,0 +1,25 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
;; Big-bang specific timestate implementation with compatible protocol.
|
||||||
|
|
||||||
|
(provide (struct-out later-than)
|
||||||
|
stop-when-timeout
|
||||||
|
sleep)
|
||||||
|
|
||||||
|
(require syndicate/big-bang)
|
||||||
|
(require (only-in syndicate/drivers/timestate
|
||||||
|
later-than later-than? struct:later-than later-than-msecs))
|
||||||
|
|
||||||
|
(define-syntax-rule (stop-when-timeout relative-msecs body ...)
|
||||||
|
(let ((deadline (+ (current-inexact-milliseconds) relative-msecs)))
|
||||||
|
(stop-when (asserted (later-than deadline)) body ...)))
|
||||||
|
|
||||||
|
(define (sleep sec)
|
||||||
|
(let ((deadline (+ (current-inexact-milliseconds) (* sec 1000.0))))
|
||||||
|
(until (asserted (later-than deadline)))))
|
||||||
|
|
||||||
|
(spawn #:name 'big-bang-timestate-driver
|
||||||
|
(during (observe (later-than $deadline))
|
||||||
|
(field [ready? #f])
|
||||||
|
(assert #:when (ready?) (later-than deadline))
|
||||||
|
(on (message (inbound (tick-event)))
|
||||||
|
(ready? (>= (current-inexact-milliseconds) deadline)))))
|
|
@ -0,0 +1,40 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
|
||||||
|
(require syndicate/big-bang)
|
||||||
|
(require/activate syndicate/big-bang/timestate)
|
||||||
|
|
||||||
|
(struct click-event (description) #:prefab)
|
||||||
|
|
||||||
|
(spawn #:name 'button
|
||||||
|
(define name 'clickable)
|
||||||
|
|
||||||
|
(define (wait-for-initial-press)
|
||||||
|
(react (stop-when (message (inbound (mouse-event _ _ name "button-down")))
|
||||||
|
(send! (click-event 'first-click))
|
||||||
|
(react (stop-when (message (inbound (mouse-event _ _ name "button-down")))
|
||||||
|
(send! (click-event 'double-click))
|
||||||
|
(wait-for-initial-press))
|
||||||
|
(stop-when-timeout 500
|
||||||
|
(send! (click-event 'single-click))
|
||||||
|
(wait-for-initial-press))))))
|
||||||
|
|
||||||
|
(on-start (wait-for-initial-press))
|
||||||
|
|
||||||
|
(assert (outbound (window name 10 10 0
|
||||||
|
(seal (overlay (text "Click me" 22 "white")
|
||||||
|
(rectangle 140 50 "solid" "red")))))))
|
||||||
|
|
||||||
|
(spawn #:name 'status
|
||||||
|
(field [status 'waiting] [clear-time (current-inexact-milliseconds)])
|
||||||
|
(on (message (click-event $description))
|
||||||
|
(status description)
|
||||||
|
(clear-time (+ (current-inexact-milliseconds) 1000)))
|
||||||
|
(on (asserted (later-than (clear-time)))
|
||||||
|
(status 'waiting))
|
||||||
|
(assert (outbound (window 'status 10 60 0
|
||||||
|
(seal (text (format "~a" (status)) 22 "black"))))))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(current-ground-dataspace
|
||||||
|
(big-bang-dataspace #:width 160
|
||||||
|
#:height 120)))
|
Loading…
Reference in New Issue