simulation: send events to radio, messages to devices

1 files changed, 43 insertions, 35 deletions

diff --git a/simulation.scm b/simulation.scm
index 01f31a1..c667750 100644
--- a/simulation.scm
+++ b/simulation.scm
@@ -20,6 +20,12 @@
   (let ((now (gettimeofday)))
     (format #t "~a~a - ~?~%" (car now) (cdr now) f data)))
 
+(define-record-type <event>
+  (make-event type data)
+  event?
+  (type event-type)
+  (data event-data))
+
 (define-record-type <message>
   (make-message id device-id channel-n uplink? body)
   message?
@@ -29,6 +35,11 @@
   (uplink? message-uplink?)
   (body message-body))
 
+(define-record-type <device>
+  (make-device channel thunk)
+  device?
+  (channel device-channel)
+  (thunk device-thunk))
 
 (define (rand-time)
   (random 20))
@@ -50,9 +61,10 @@
     (define current-message 0)
     (forever
       (sleep (rand-time))
-      (put-message upstream-chn (make-message current-message id channel #t 'data-start))
-      (sleep time-on-air)
-      (put-message upstream-chn (make-message current-message id channel #t 'data-end))
+      (let ((message (make-message current-message id channel #t 'data)))
+        (put-message upstream-chn (make-event 'start message))
+        (sleep time-on-air)
+        (put-message upstream-chn (make-event 'end message)))
       (set! current-message (1+ current-message))
       (sleep receive-delay-1)
       (atomic-box-set! listening? #t)
@@ -107,40 +119,36 @@
 
   (lambda ()
     (forever
-      (let ((msg (get-message in)))
-        (match (message-body msg)
-          ('data-start
-           (set! started (cons msg started)))
-          ('data-end
-           (set! started
-             (remove! (lambda (x)
-                        (and (= (message-id msg) (message-id x))
-                             (= (message-device-id msg) (message-device-id x)))) started))
-           (if (interference? msg started)
-             (ll "Interference!!!!!!")
-             (if (message-uplink? msg)
-               (hash-for-each (lambda (k gateway)
-                                (put-message (device-channel gateway)
-                                             (make-message (message-id msg)
-                                                           (message-device-id msg)
-                                                           (message-channel-n msg)
-                                                           #t
-                                                           'data)))
-                              gateways)
-               (put-message
-                 (device-channel (hash-ref end-devices (message-device-id msg)))
-                 (make-message (message-id msg)
-                               (message-device-id msg)
-                               (message-channel-n msg)
-                               #f
-                               'ack))))))))))
+      (let ((ev (get-message in)))
+        (match (event-type ev)
+          ('start
+           (let ((msg (event-data ev)))
+             (ll "Device ~a started ~a of message ~a"
+                 (message-device-id msg)
+                 (message-body msg)
+                 (message-id msg))
+             (set! started (cons msg started))))
+          ('end
+           (let ((msg (event-data ev)))
+             (ll "Device ~a finished ~a of message ~a"
+                 (message-device-id msg)
+                 (message-body msg)
+                 (message-id msg))
+             (set! started
+               (remove! (lambda (x)
+                          (and (= (message-id msg) (message-id x))
+                               (= (message-device-id msg) (message-device-id x)))) started))
+             (if (interference? msg started)
+               (ll "Interference!!!!!!")
+               (if (message-uplink? msg)
+                 (hash-table-walk gateways
+                                  (lambda (k gateway)
+                                    (put-message (device-channel gateway) msg)))
+                 (put-message
+                   (device-channel (hash-ref end-devices (message-device-id msg)))
+                   msg))))))))))
 
 
-(define-record-type <device>
-  (make-device channel thunk)
-  device?
-  (channel device-channel)
-  (thunk device-thunk))
 
 
 (define (run-simulation)