(load "/usr/local/slisp/station.lsp")

(defvar tsl-key nil)
(defvar req-tsl-key nil)

(defvar DEFAULT-DELAY 0)
(defvar delay-time DEFAULT-DELAY)

(defvar msg-fd nil)
(defvar msg-available-status nil)
(defvar msg-lock-status nil)
(defvar available nil)

(defun send-available-status ()
  (when (and msg-fd msg-available-status)
    (if available
	(write-bytes msg-fd msg-available-status 4 1)
      (write-bytes msg-fd msg-available-status 4 0))))

(defun send-tuner-lock (key)
  (if key
      (write-bytes msg-fd msg-lock-status 12
		   (tsl-get-data key 'freq)
		   (tsl-get-data key 'onid)
		   (tsl-get-data key 'tsid))
    (when tsl-key
      (write-bytes msg-fd msg-lock-status 0)))
  (setf tsl-key key))

(register-node 'delay-available
	       #'(lambda ()
		   (eq delay-time 0))
	       #'(lambda ()
		   (when (> delay-time 0)
		     (set-timer #'(lambda (arg)
				    (setf delay-time 0)
				    (make-event 'delay-finish))
				'available-delay-timer
				nil
				1
				delay-time))
		   (eval-events (list 'delay-finish)))
	       #'(lambda ()
		   (cancel-timer 'available-delay-timer)
		   (setf delay-time DEFAULT-DELAY)))

(register-node 'ts-action
	       #'(lambda ()
		   t)
	       #'(lambda ()
		   (setf available t)
		   (send-available-status)
		   (when (and req-tsl-key (not (tsl-equal tsl-key req-tsl-key)))
		     (tsport-connect 'tsport 'tuner)
		     (when (tuner-connect 'tuner
					  :tsl req-tsl-key)
		       (send-tuner-lock nil)))
		   (eval-events (list 'tuner-req)))
	       #'(lambda ()
		   (setf req-tsl-key nil)
		   (setf available nil)
		   (send-available-status)
		   t))

(defun tstune (freq onid tsid)
  (setf req-tsl-key (svl-create-key "TSL"
				    :freq freq
				    :onid onid
				    :tsid tsid))
  (when (and (tsl-equal (get-tuner-tsl-key 'tuner) req-tsl-key)
	     (tuner-status 'tuner))
    (send-tuner-lock (get-tuner-tsl-key 'tuner)))
  (make-event 'tuner-req))

(tuner-config 'tuner "ttuner")
(my-device-open 'tuner 0)
(my-device-open 'tsport 0)
(init-tuner-object 'tuner)
(set-tuner-hook 'tuner #'(lambda (sig)
			   (case sig
			     (TUNER_LOCK
			      (set-tuner-tsl-key 'tuner (tuner-tsl-key 'tuner))
			      (if (tsl-equal (get-tuner-tsl-key 'tuner) req-tsl-key)
				  (send-tuner-lock (get-tuner-tsl-key 'tuner))
				(send-tuner-lock nil)))
			     (TUNER_UNLOCK
			      (send-tuner-lock nil)))))

(resource-node 'ts-pipe (list 'tuner 'tsport))

(append-t
 'ts-pipe
 'delay-available
 'ts-action)

(eval-node 'ts-pipe)
