(define-module (simulation)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-69)
  #:use-module (ice-9 atomic)
  #:use-module (ice-9 match)
  #:use-module (fibers)
  #:use-module (fibers channels)
  #:use-module (fibers conditions)
  #:use-module (fibers operations)
  #:use-module (fibers timers))

;; TODO: put a time limit as a parameter
(define-syntax-rule (forever exp ...)
  (let loop ()
    (begin exp ...)
    (loop)))

(define (ll f . data)
  (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?
  (id message-id)
  (device-id message-device-id)
  (channel-n message-channel-n)
  (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))

(define (make-class-a id initial-channel upstream-chn downstream-chn)
  ;; Make all atomic
  (define channel initial-channel)
  (define listening? (make-atomic-box #f))

  ;; TODO: Unhardcode me
  (define time-on-air 1)
  (define rx1 1)
  (define rx2 (+ 1 rx1))
  (define receive-delay-1 1)
  (define receive-delay-2 2)
  ;(define sent-to-confirm (make-vector))

  (define (upstream)
    (define current-message 0)
    (forever
      (sleep (rand-time))
      (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)
      ;; TODO: maybe synchronization doesn't work because we do too many things
      (sleep rx1)
      (atomic-box-set! listening? #f)
      ;; (when not-answered ...)
      (sleep (- receive-delay-2 receive-delay-1))
      (atomic-box-set! listening? #t)
      (sleep rx2)
      (atomic-box-set! listening? #f)))

  (define (downstream)
    (forever
      (let ((msg (get-message downstream-chn)))
        (when (atomic-box-ref listening?)
          (ll "Device: ~a Received: ~a" id msg)
          #;(match (message-body msg)
          (('ack) (confirm X)))))))

  (lambda ()
    (spawn-fiber upstream)
    (spawn-fiber downstream)))

(define (make-gateway id upstream downstream)
  #;(define (ack-confirmed-data to channel seq-number)
    (spawn-fiber
      (sleep RX1)
      (put-message downstream (make-message to channel 'ack seq-number))))

  ;; Upstream: listen, and answer in new fibers
  (lambda ()
    (forever
      (let ((msg (get-message upstream)))
        (ll "Gateway ~a: Data #~a got from ~a"
            id
            (message-id msg)
            (message-device-id msg))))))


(define (make-radio in end-devices gateways)

  ;(define devices (hash-map ...)) ;; it needs a device-id <-> channel mapping
  ;; in: listen from devices: check collisions and power transmission
  ;; capabilities: we could check distance to other devices for this!
  ;;
  (define started '())

  (define (interference? msg started-messages)
    (any (lambda (x) (= (message-channel-n msg) (message-channel-n x)))
         started-messages))

  (lambda ()
    (forever
      (let ((ev (get-message in)))
        (match ev
          (($ <event> 'start msg)
           (ll "Device ~a started ~a of message ~a"
               (message-device-id msg)
               (message-body msg)
               (message-id msg))
           (set! started (cons msg started)))
          (($ <event> 'end msg)
           (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 (run-simulation)
  (let* ((radio-chn   (make-channel))
         (end-devices (make-hash-table))
         (gateways    (make-hash-table)))

    (for-each
      (lambda (id)
        (let ((chn (make-channel)))
          (hash-table-set!
            end-devices id
            (make-device chn (make-class-a id 1 radio-chn chn)))))
      (iota 6))

    (for-each
      (lambda (id)
        (let ((chn (make-channel)))
          (hash-table-set!
            gateways id
            (make-device chn (make-gateway id chn radio-chn)))))
      (iota 6 10))

    (spawn-fiber (make-radio radio-chn end-devices gateways))
    (hash-table-walk end-devices
                     (lambda (_ device) (spawn-fiber (device-thunk device))))
    (hash-table-walk gateways
                     (lambda (_ device) (spawn-fiber (device-thunk device))))))

(run-fibers
  run-simulation
  #:drain? #t)