From 11eb0bcd6f2600c89382f8640b9186a650faae69 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Thu, 10 Jun 2021 13:34:18 +0200
Subject: [PATCH] drivers/racket-event.rkt

---
 syndicate/drivers/racket-event.rkt | 30 ++++++++++++++++++++++++++++++
 syndicate/schemas/racket-event.prs |  3 +++
 2 files changed, 33 insertions(+)
 create mode 100644 syndicate/drivers/racket-event.rkt
 create mode 100644 syndicate/schemas/racket-event.prs

diff --git a/syndicate/drivers/racket-event.rkt b/syndicate/drivers/racket-event.rkt
new file mode 100644
index 0000000..4be61ef
--- /dev/null
+++ b/syndicate/drivers/racket-event.rkt
@@ -0,0 +1,30 @@
+#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))))))))))
diff --git a/syndicate/schemas/racket-event.prs b/syndicate/schemas/racket-event.prs
new file mode 100644
index 0000000..36985a7
--- /dev/null
+++ b/syndicate/schemas/racket-event.prs
@@ -0,0 +1,3 @@
+version 1 .
+
+RacketEvent = <racket-event @source #!any @event #!any>.