Add new command: toggle-blinker.HEADmaster

3 files changed, 114 insertions, 43 deletions

diff --git a/src/mqtt-client.rkt b/src/mqtt-client.rkt
new file mode 100644
index 0000000..dfe0a1f
--- /dev/null
+++ b/src/mqtt-client.rkt
@@ -0,0 +1,34 @@
+#lang racket/base
+
+(require racket/place)
+(require racket/match)
+(require mqtt-client)
+(require (file "utils.rkt"))
+
+(provide main)
+
+(define (main c)
+  (displayln "MQTT WORKER")
+  (match (place-channel-get c)
+    [(list host username password client-name topic-name)
+     (mqtt/with-client (host client-name)
+       (mqtt/with-connection (#:keep-alive-interval 20
+                              #:clean-session       #t
+                              #:username            username
+                              #:password            password)
+
+
+         (mqtt/with-qos ('qos-1)
+           (mqtt/subscribe topic-name)
+           (let loop ()
+             (mqtt/with-message-recv (topic payload)
+               (displayln (format "Message \"~a\" recieved on topic \"~a\"" payload topic))
+               (let* ((payload (bytes->string/utf-8 payload))
+                      (payload=? (lambda (what)
+                                   (string=? payload
+                                             what))))
+                 (when (or (payload=? "toggle")
+                           (payload=? "toggle-blinker"))
+                   (place-channel-put c (string->symbol payload)))))
+             (loop)))))]))
+
diff --git a/src/smart-relay.rkt b/src/smart-relay.rkt
index 270780a..2ce045f 100644
--- a/src/smart-relay.rkt
+++ b/src/smart-relay.rkt
@@ -1,48 +1,38 @@
-(module smart-relay racket/base
-  (require mqtt-client)
-  (provide main)
+#lang racket/base
 
-  (define (make-send-to-dev data)
-    (lambda (dev)
-      (with-output-to-file dev
-        #:exists 'truncate
-        #:mode 'binary
-        (lambda ()
-          (write-bytes data)))))
+(require racket/place)
+(require racket/match)
+(require (file "utils.rkt"))
 
-  (define send-message-on
-    (make-send-to-dev (bytes  #xA0 #x01 #x01 #xA2)))
-  (define send-message-off
-    (make-send-to-dev (bytes  #xA0 #x01 #x00 #xA1)))
+(provide main)
 
-  (define (make-toggle-relay dev)
-    (let ((turn-on? #t))
-      (lambda ()
-        (displayln (format "Relay on ~a toggled" dev))
-        (if turn-on?
-            (send-message-on dev)
-            (send-message-off dev))
-        (set! turn-on? (not turn-on?)))))
+(define (main #:host        [host        "localhost"]
+              #:username    [username    #f]
+              #:password    [password    #f]
+              #:client-name [client-name "smart-relay"]
+              #:topic-name  [topic-name  "hsp/bobma/smart-relay"]
+              #:relay-dev   [relay-dev   "/dev/ttyUSB0"])
+  (define toggle-relay
+    (make-toggle-relay relay-dev))
 
-  (define (main #:host        [host        "localhost"]
-                #:username    [username    #f]
-                #:password    [password    #f]
-                #:client-name [client-name "smart-relay"]
-                #:topic-name  [topic-name  "hsp/bobma/smart-relay"]
-                #:relay-dev   [relay-dev   "/dev/ttyUSB0"])
-    (define toggle-relay (make-toggle-relay relay-dev))
-    (mqtt/with-client (host client-name)
-      (mqtt/with-connection (#:keep-alive-interval 20
-                             #:clean-session       #t
-                             #:username            username
-                             #:password            password)
+  (define toggle-blinker-relay
+    (make-toggle-blinker-relay toggle-relay))
 
-        (mqtt/subscribe topic-name)
-        (let loop ()
-          (mqtt/with-message-recv (topic payload)
-            (displayln (format "Message \"~a\" recieved on topic \"~a\"" payload topic))
-            (cond
-              ((string=? (bytes->string/utf-8 payload)
-                         "toggle")
-               (toggle-relay))))
-          (loop))))))
+  (define (make-mqtt-worker)
+    (let ((mqtt-worker (dynamic-place (string->path "mqtt-client.rkt") 'main)))
+     (place-channel-put mqtt-worker (list host
+                                          username
+                                          password
+                                          client-name
+                                          topic-name))
+     mqtt-worker))
+
+  (define mqtt-worker (make-mqtt-worker))
+
+  (let loop ()
+    (match (place-channel-get mqtt-worker)
+      ['toggle
+       (toggle-relay)]
+      ['toggle-blinker
+       (toggle-blinker-relay)])
+    (loop)))
diff --git a/src/utils.rkt b/src/utils.rkt
new file mode 100644
index 0000000..eaac52a
--- /dev/null
+++ b/src/utils.rkt
@@ -0,0 +1,47 @@
+#lang racket/base
+
+(require racket/place)
+
+(provide make-toggle-relay)
+(provide make-toggle-blinker-relay)
+
+(define (make-send-to-dev data)
+  (lambda (dev)
+    (with-output-to-file dev
+      #:exists 'truncate
+      #:mode 'binary
+      (lambda ()
+        (write-bytes data)))))
+
+(define send-message-on
+  (make-send-to-dev (bytes  #xA0 #x01 #x01 #xA2)))
+
+(define send-message-off
+  (make-send-to-dev (bytes  #xA0 #x01 #x00 #xA1)))
+
+(define (make-toggle-relay dev)
+  (let ((turn-on? #t))
+    (lambda ()
+      (displayln (format "Relay on ~a toggled" dev))
+      (if turn-on?
+          (send-message-on dev)
+          (send-message-off dev))
+      (set! turn-on? (not turn-on?)))))
+
+(define (make-toggle-blinker-relay toggle-relay
+                                   #:delay [delay 3])
+  (let ((blinker-thread #f))
+    (lambda ()
+      (if (and (thread? blinker-thread)
+               (not (thread-dead? blinker-thread)))
+          (if (thread-running? blinker-thread)
+              (thread-suspend blinker-thread)
+              (thread-resume blinker-thread))
+          (set! blinker-thread
+                (thread
+                 (lambda ()
+                   (let loop ()
+                     (toggle-relay)
+                     (sleep delay)
+                     (loop))))))
+      blinker-thread)))