2021-06-04 13:56:03 +00:00
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-06-01 15:19:24 +00:00
|
|
|
|
2020-04-27 18:27:48 +00:00
|
|
|
#lang syndicate
|
2018-04-29 17:43:39 +00:00
|
|
|
|
|
|
|
(provide (struct-out external-event))
|
|
|
|
|
|
|
|
(message-struct external-event (descriptor values))
|
|
|
|
|
|
|
|
(spawn #:name 'external-event-relay
|
|
|
|
(during/spawn (observe (inbound (external-event $desc _)))
|
|
|
|
(define ch (make-channel))
|
|
|
|
(thread (lambda ()
|
|
|
|
(let loop ()
|
|
|
|
(sync ch
|
|
|
|
(handle-evt desc
|
|
|
|
(lambda results
|
|
|
|
(ground-send! (inbound (external-event desc results)))
|
|
|
|
(loop)))))))
|
|
|
|
(signal-background-activity! +1)
|
|
|
|
(on-stop (channel-put ch 'quit)
|
|
|
|
(signal-background-activity! -1))))
|