31 lines
1.2 KiB
Racket
31 lines
1.2 KiB
Racket
|
#lang syndicate
|
||
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||
|
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||
|
|
||
|
;; Generic Racket events.
|
||
|
|
||
|
(provide (all-from-out syndicate/schemas/gen/racket-event)
|
||
|
spawn-racket-event-driver)
|
||
|
|
||
|
(require syndicate/driver-support)
|
||
|
(require syndicate/schemas/gen/racket-event)
|
||
|
(require syndicate/schemas/gen/dataspace-patterns)
|
||
|
|
||
|
(define-logger syndicate/drivers/racket-event)
|
||
|
|
||
|
(define (spawn-racket-event-driver ds)
|
||
|
(at ds
|
||
|
(during/spawn (Observe (:pattern (RacketEvent ,(DLit $embedded-event) ,_)) _)
|
||
|
#:name (embedded-value embedded-event)
|
||
|
(define event (embedded-value embedded-event))
|
||
|
(on-start (log-syndicate/drivers/racket-event-debug "started listening: ~v" event))
|
||
|
(on-stop (log-syndicate/drivers/racket-event-debug "stopped listening: ~v" event))
|
||
|
(linked-thread
|
||
|
#:name (list event 'thread)
|
||
|
(lambda (facet)
|
||
|
(let loop ()
|
||
|
(sync (handle-evt event
|
||
|
(lambda args
|
||
|
(turn! facet (lambda () (send! ds (RacketEvent event args))))
|
||
|
(loop))))))))))
|