creating delayed reactor
This commit is contained in:
1
main.rkt
1
main.rkt
@@ -27,4 +27,5 @@
|
||||
webview-set-loglevel
|
||||
webview-version
|
||||
webview-info
|
||||
webview-delayed-reactor
|
||||
)
|
||||
|
||||
@@ -127,6 +127,8 @@
|
||||
webview-quit
|
||||
webview-exit
|
||||
|
||||
webview-delayed-reactor
|
||||
|
||||
;test
|
||||
)
|
||||
|
||||
@@ -1019,6 +1021,32 @@
|
||||
(define (webview-info)
|
||||
(rkt-webview-info))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; delayed reactor
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define/contract (webview-delayed-reactor seconds value-callback)
|
||||
(-> number? procedure? procedure?)
|
||||
(let ((value-set-at -1)
|
||||
(value 'none)
|
||||
(wait-thread #f)
|
||||
(ms (* seconds 1000))
|
||||
)
|
||||
(λ (val)
|
||||
(set! value val)
|
||||
(set! value-set-at (current-milliseconds))
|
||||
(when (eq? wait-thread #f)
|
||||
(thread (λ ()
|
||||
(let loop () ((vsa value-set-at))
|
||||
(sleep seconds)
|
||||
(let ((cms (current-milliseconds)))
|
||||
(if (>= (- cms vsa) ms)
|
||||
(begin
|
||||
(set! wait-thread #f)
|
||||
(value-callback value))
|
||||
(loop)))))))
|
||||
)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Quitting and waiting
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
Reference in New Issue
Block a user