2021-06-10 11:34:18 +00:00
|
|
|
#lang syndicate
|
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
2023-01-16 14:57:29 +00:00
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021-2023 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-06-10 11:34:18 +00:00
|
|
|
|
|
|
|
;; Generic Racket events.
|
|
|
|
|
2021-07-01 07:40:52 +00:00
|
|
|
(provide (all-from-out syndicate/schemas/racketEvent))
|
2021-06-10 11:34:18 +00:00
|
|
|
|
|
|
|
(require syndicate/driver-support)
|
2021-07-01 07:40:52 +00:00
|
|
|
(require syndicate/schemas/racketEvent)
|
|
|
|
(require syndicate/schemas/dataspacePatterns)
|
2021-06-10 11:34:18 +00:00
|
|
|
|
|
|
|
(define-logger syndicate/drivers/racket-event)
|
|
|
|
|
2021-06-17 12:57:06 +00:00
|
|
|
(provide-service [ds]
|
|
|
|
(at ds
|
|
|
|
(during/spawn (Observe (:pattern (RacketEvent ,(DLit $embedded-event) ,_)) _)
|
|
|
|
#:name (embedded-value embedded-event)
|
|
|
|
(define event (embedded-value embedded-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))))))))))
|