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

(defun my-debug-print (lis))

(defvar tuner-no nil)(defvar partial-device-no "memout1")(defvar req-freq nil)(defvar req-symbol-rate nil)(defvar req-satellite nil)(defvar req-polarisation nil)(defvar req-band-width nil)(defvar req-plp-id nil)(defvar req-modulation nil)(defvar current-dtype nil)(defvar tuning-transition nil)(defvar dish-param-list (list nil nil nil nil))(defvar new-transfer-pids nil)

(defvar bad-signal-status nil)(defvar no-signal-status nil)

(defvar with-freesat nil)(defvar with-dvb-s-cont nil)

(defvar need-send-available nil)


(defvar TSL_DELIVERY_DVB_TERRESTRIAL 11)(defvar partial-list nil)



(defmacro set-partial-pids (sym x)
`(setf (nth 1 (assoc ,sym partial-list)) ,x))(defmacro get-partial-pids (sym)
`(nth 1 (assoc ,sym partial-list)))(defmacro set-partial-cp (sym x)
`(when (assoc ,sym partial-list)(setf (nth 2 (assoc ,sym partial-list)) ,x)))(defmacro get-partial-cp (sym)
`(nth 2 (assoc ,sym partial-list)))

(register-device 'tuner
"tuner"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tuner nil))(AVAILABLE
(set-owner 'tuner t))(TUNER_LOCK
(make-event (list 'tuner-lock 'tuner)))(TUNER_UNLOCK
(write-bytes msg-pipe SC_RES_TUNER_UNLOCK 4
(if tuner-no tuner-no 0))(make-event (list 'tuner-unlock 'tuner)))(TUNER_DISCONNECT
(make-event (list 'tuner-disconnect 'tuner)))(TUNER_LNB_SHORT
(make-event (list 'tuner-short-lnb 'tuner)))(PROPERTY_CHANGE
))))(register-device 'tsport
"tsport"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tsport nil))(AVAILABLE
(set-owner 'tsport t)(make-event 'tsport-available))(SOURCE_CHANGE
(make-event 'tsport-change)))))

(register-device 'partial
"partial"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'partial nil))(AVAILABLE
(set-owner 'partial t)))))

(register-node 'bad-signal-check
#'(lambda ()(eq (tuner-status 'tuner) 'TUNER_BADSIGNAL))
#'(lambda ()(eval-events (list 'tuner-lock 'tuner-badsignal)))
#'(lambda ()
nil))(register-node 'bad-signal
#'(lambda ()
t)
#'(lambda ()(send-bad-signal t))
#'(lambda ()(send-bad-signal nil)(enter-tuning-transition)))(register-node 'no-signal
#'(lambda ()
t)
#'(lambda (key)(unless tuning-transition
(send-no-signal key t))(eval-events (list 'exit-tuning-transition)))
#'(lambda (key)(send-no-signal key nil)(enter-tuning-transition)))

(register-node 'dvb-available
#'(lambda ()
t)
#'(lambda (key)(when need-send-available
(enter-tuning-transition)(write-bytes msg-pipe SC_RES_AVAILABLE 0)(setf need-send-available nil))(unless (eq (get-tuning-svcid) (get-psi-svcid 'psi))(when (psi-invalidate 'psi)(set-psi-valid 'psi nil)(setf new-svcid nil)))(eval-events 'new-reserve))
#'(lambda ()(setf need-send-available t)(cancel-timer 'tuning-timeout)(setf tuning-transition nil)))

(register-node 'my-tuner-freq-valid
#'(lambda ()(or (and (eq current-dtype 'tsl-delivery-dvb-s)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-freq) req-freq)(eq (get-tuning-satellite) req-satellite)(eq (get-tuning-polarisation) req-polarisation)(eq (get-tuning-symbol-rate) req-symbol-rate))(and (eq current-dtype 'tsl-delivery-dvb-t)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-freq) req-freq)(eq (get-tuning-band-width) req-band-width))(and (eq current-dtype 'tsl-delivery-dvb-t2)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-freq) req-freq)(eq (get-tuning-band-width) req-band-width)(eq (get-tuning-plp-id) req-plp-id))(and (eq current-dtype 'tsl-delivery-dvb-c)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-freq) req-freq)(eq (get-tuning-symbol-rate) req-symbol-rate)(eq (get-tuning-modulation) req-modulation))))
#'(lambda ()(set-tuning-tuner 'tuner)(set-tuning-freq req-freq)(set-tuning-dtype current-dtype)(case current-dtype
(tsl-delivery-dvb-s
(set-tuning-satellite req-satellite)(set-tuning-polarisation req-polarisation)(set-tuning-symbol-rate req-symbol-rate))

(tsl-delivery-dvb-t
(set-tuning-band-width req-band-width))

(tsl-delivery-dvb-t2
(set-tuning-band-width req-band-width)(set-tuning-plp-id req-plp-id))

(tsl-delivery-dvb-c
(set-tuning-symbol-rate req-symbol-rate)(set-tuning-modulation req-modulation))(otherwise
))(eval-events (list 'tuner-req 'tuner-change)))
#'(lambda ()
nil))

(register-node 'my-tuner-connect
#'(lambda ()(tuner-status (get-tuning-tuner)))
#'(lambda ()(my-debug-print (list "tuner-connect for " current-dtype))(case current-dtype
(tsl-delivery-dvb-s
(tuner-connect (get-tuning-tuner)
:system "DVB-S"
:symbol-rate (get-tuning-symbol-rate)
:polarization (get-tuning-polarisation)
:lnb (get-tuning-satellite)
:freq (get-tuning-freq)))(tsl-delivery-dvb-t
(tuner-connect (get-tuning-tuner)
:system "DVB-T"
:freq (get-tuning-freq)
:band-width (get-tuning-band-width)))(tsl-delivery-dvb-t2
(tuner-connect (get-tuning-tuner)
:system "DVB-T2"
:freq (get-tuning-freq)
:band-width (get-tuning-band-width)
:plp-id  (get-tuning-plp-id)))(tsl-delivery-dvb-c
(tuner-connect (get-tuning-tuner)
:system "DVB-C"
:freq (get-tuning-freq)
:symbol-rate (get-tuning-symbol-rate)
:modulation (get-tuning-modulation))))(eval-events (list (list 'tuner-lock (get-tuning-tuner))(list 'tuner-unlock (get-tuning-tuner))(list 'tuner-disconnect (get-tuning-tuner)))))
#'(lambda ()(tuner-disconnect (get-tuning-tuner))))(register-node 'my-tsport-connect
#'(lambda ()(device-source-p 'tsport (get-tuning-tuner)))
#'(lambda ()(tsport-connect 'tsport (get-tuning-tuner))(eval-events (list 'tsport-available 'tsport-change)))
#'(lambda ()(tsport-disconnect 'tsport)))

(register-node 'my-bad-signal-check
#'(lambda ()(eq (tuner-status (get-tuning-tuner)) 'TUNER_BADSIGNAL))
#'(lambda ()(eval-events (list (list 'tuner-lock (get-tuning-tuner))(list 'tuner-badsignal (get-tuning-tuner)))))
#'(lambda ()
nil))

(register-node 'partial-start
#'(lambda ()(my-debug-print (list "PARTIAL-START EVAL (get-partial-pids 'partial)"
(get-partial-pids 'partial)
"(device-source-p 'partial 'tsport)"
(device-source-p 'partial 'tsport)
"(partial-status 'partial)"
(partial-status 'partial)))(and (get-partial-pids 'partial)(device-source-p 'partial 'tsport)(partial-status 'partial)))
#'(lambda ()(set-partial-pids 'partial new-transfer-pids)(if (get-partial-pids 'partial)(progn
(my-debug-print (list "partial-start"
(get-partial-pids 'partial)))(partial-enable 'partial 'tsport)(partial-start 'partial
:pmt nil
:pat nil
:pids (get-partial-pids 'partial))(write-bytes msg-pipe SC_RES_PARTIAL_START 4 1))(partial-stop 'partial)(write-bytes msg-pipe SC_RES_PARTIAL_START 4 0))(eval-events (list 'partial-req)))
#'(lambda ()
nil))

(defun init-partial-object (sym)(unless (assoc sym partial-list)(setf partial-list (cons (list sym nil nil) partial-list)))(set-partial-pids sym nil)(set-partial-cp sym nil))

(defun enter-tuning-transition ()(unless tuning-transition
(setf tuning-transition t)(set-timer #'(lambda ()(setf tuning-transition nil)(make-event 'exit-tuning-transition))
'tuning-timeout
nil
1
4000)))(defun send-bad-signal (status)(unless (eq bad-signal-status status)(when (boundp 'SC_RES_BAD_SIGNAL)(write-bytes msg-pipe SC_RES_BAD_SIGNAL 4 (if status 1 0)))(setf bad-signal-status status)))(defun send-no-signal (key status)(unless (eq no-signal-status status)(when (boundp 'SC_RES_NO_SIGNAL)(write-bytes msg-pipe SC_RES_NO_SIGNAL 4 (if status 1 0)))(setf no-signal-status status)))

(defun with-dvb-sat-p ()
with-dvb-s-cont)

(defvar tuning-tuner 'tuner)(defun set-tuning-tuner (dev)(setf tuning-tuner dev))(defun get-tuning-tuner ()
tuning-tuner)

(defun my-select-channel ()(set-psi-valid 'psi nil)(set-psi-error 'psi nil)

(case current-dtype
(tsl-delivery-dvb-s
(unless (and (eq (get-tuning-freq) req-freq)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-satellite) req-satellite)(eq (get-tuning-polarisation) req-polarisation)(eq (get-tuning-symbol-rate) req-symbol-rate))(make-event 'tuner-req)))

(tsl-delivery-dvb-t
(unless (and (eq (get-tuning-freq) req-freq)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-band-width) req-band-width))(make-event 'tuner-req)))

(tsl-delivery-dvb-t2
(unless (and (eq (get-tuning-freq) req-freq)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-band-width) req-band-width)(eq (get-tuning-plp-id) req-plp-id))(make-event 'tuner-req)))

(tsl-delivery-dvb-c
(unless (and (eq (get-tuning-freq) req-freq)(eq (get-tuning-dtype) current-dtype)(eq (get-tuning-symbol-rate) req-symbol-rate)(eq (get-tuning-modulation) req-modulation))(make-event 'tuner-req)))(otherwise
))

(unless (equal (get-partial-pids 'partial) new-transfer-pids)(make-event 'partial-req)))

(defun new-signal-source (sym)(init-signal-source-object sym))(defun destroy-signal-source (sym)(init-node (get-signal-source-node sym))(free-signal-source-object sym))

(defvar init-tuner nil)(defvar init-append nil)

(defun use-digital-tuner (src no)(unless init-tuner
(setf init-tuner t)(set-signal-source-dev src 'digital)(set-signal-source-no src tuner-no)(set-signal-source-tuner src 'tuner)(if (with-dvb-sat-p)(tuner-config 'tuner (list "ttuner" "stuner"))(tuner-config 'tuner (list "ttuner"))))

(unless init-append
(setf init-append t)(append-t
'dvb-available
'my-tuner-freq-valid
'my-tuner-connect
'my-tsport-connect
'partial-start)

(append-t
'my-tuner-connect
'my-bad-signal-check
'bad-signal)

(append-nil
'my-tuner-connect
'no-signal)

(node-key 'dvb-available src)(set-signal-source-node src 'dvb-available)))




(defun satips-tuning-start (delivery-type arg pids)(setf current-dtype delivery-type)(setf new-transfer-pids pids)(when (or (eq (length arg) 3)(eq (length arg) 5))(my-debug-print (list "SATIP_SERVER" arg "PIDS" pids))(digital-program-on 'digital arg)))

(defun satips-tuning-stop-inner (src)(setf tuning-transition t)(cancel-node (get-signal-source-node src))(setf tuning-transition nil)(append-t 'dvb-pipe nil)(init-node (get-signal-source-pipe src))(when (get-signal-source-devices src)(mapcar #'(lambda (x)(my-device-close x))(get-signal-source-devices src)))(set-signal-source-devices src nil)(set-signal-source-request src nil))

(defun satips-tuning-stop ()(satips-tuning-stop-inner 'digital))

(defun satips-set-pidfilter (addpids delpids)(my-debug-print (list "satips-set-pidfilter addpids" addpids "delpids" delpids))(let ((tmp-pids))(setf tmp-pids (copy-list new-transfer-pids))

(when delpids
(mapcar #'(lambda (pid)(when (find pid tmp-pids)(if (= (car tmp-pids) pid)(setf tmp-pids (cdr tmp-pids))(delete pid tmp-pids))))
delpids))

(when addpids
(mapcar #'(lambda (pid)(unless (find pid tmp-pids)(if tmp-pids
(setf-cdr (last tmp-pids) (cons pid nil))(setf tmp-pids (cons pid nil)))))
addpids))

(unless (eq new-transfer-pids tmp-pids)(satips-request-partial tmp-pids))))

(defun digital-program-on (src arg)(setf tuning-transition nil)(setf need-send-available nil)

(let ((dev) (dish-param) (port)(fe nil) (sat-src nil) (freq nil) (pol nil)(sr nil)(bw nil) (plp nil))

(case current-dtype
(tsl-delivery-dvb-s
(setf req-freq (first arg))(setf fe (second arg))(setf req-satellite (third arg))(setf req-polarisation (fourth arg))(setf req-symbol-rate (fifth arg)))

(tsl-delivery-dvb-t
(setf req-freq (first arg))(setf req-band-width (second arg)))

(tsl-delivery-dvb-t2
(setf req-freq (first arg))(setf req-band-width (second arg))(setf req-plp-id (third arg)))

(tsl-delivery-dvb-c
(setf req-freq (first arg))(setf req-symbol-rate (second arg))(setf req-modulation (third arg)))(otherwise
))

(setf port (list nil nil nil nil))(if (eq tuner-no 1)(setf (nth 0 port) "FE_IN2")(setf (nth 0 port) "FE_IN1"))

(if (get-signal-source-devices src)(progn
(enter-tuning-transition)(my-select-channel))

(tsport-config 'tsport port)(if (eq tuner-no 1)(my-device-open 'tsport "tsi2")(my-device-open 'tsport "tsi0"))

(if (eq tuner-no 1)(my-device-open 'psi 2)(my-device-open 'psi 0))

(my-device-open (get-signal-source-tuner src) (get-signal-source-no src))(init-tuner-object (get-signal-source-tuner src))

(when (with-dvb-sat-p)(do ((i 0 (1+ i)))((>= i 4))(when (nth i dish-param-list)(setf dish-param (nth i dish-param-list))(when (device-open-p 'tuner)(tuner-setup 'tuner
:satellite i
:dish-low (nth 0 dish-param)
:dish-high (nth 1 dish-param)
:dish-tone-en (nth 2 dish-param))))))

(if (eq tuner-no 1)(my-device-open 'partial partial-device-no)(my-device-open 'partial 5))(init-partial-object 'partial)

(let* ((resources (list (get-signal-source-tuner src) 'psi 'tsport))(devices (nconc (copy-list resources) (list 'partial))))(set-signal-source-devices src devices)(resource-node 'dvb-pipe resources))

(node-key 'dvb-pipe src)(append-t
'dvb-pipe
(get-signal-source-node src))(set-signal-source-pipe src 'dvb-pipe)(set-tuning-tuner 'tuner)(eval-node (get-signal-source-pipe src)))))

(defun dish-setup (sat low high tone-en)(let ((dish-param (nth sat dish-param-list)))(unless (and (eq low (nth 0 dish-param))(eq high (nth 1 dish-param))(eq tone-en (nth 2 dish-param)))(setf (nth sat dish-param-list) (list low high tone-en))(when (with-dvb-sat-p)(when (device-open-p 'tuner)(tuner-setup 'tuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'tuner)))))))

(defvar tuning-symbol-rate nil)(defun set-tuning-symbol-rate (symbol-rate)(setf tuning-symbol-rate symbol-rate))(defun get-tuning-symbol-rate ()
tuning-symbol-rate)

(defvar tuning-satellite nil)(defun set-tuning-satellite (satellite)(setf tuning-satellite satellite))(defun get-tuning-satellite ()
tuning-satellite)

(defvar tuning-polarisation nil)(defun set-tuning-polarisation (pol)(setf tuning-polarisation pol))(defun get-tuning-polarisation ()
tuning-polarisation)

(defvar tuning-band-width nil)(defun set-tuning-band-width (bw)(setf tuning-band-width bw))(defun get-tuning-band-width ()
tuning-band-width)

(defvar tuning-plp-id nil)(defun set-tuning-plp-id (plp-id)(setf tuning-plp-id plp-id))(defun get-tuning-plp-id ()
tuning-plp-id)

(defvar tuning-modulation nil)(defun set-tuning-modulation (modulation)(setf tuning-modulation modulation))(defun get-tuning-modulation ()
tuning-modulation)

(defvar tuning-dtype nil)(defun set-tuning-dtype (dtype)(setf tuning-dtype dtype))(defun get-tuning-dtype ()
tuning-dtype)

(defun satips-request-partial (pids)(my-debug-print "satips-request-partial")(setf new-transfer-pids pids)(make-event 'partial-req))

(new-signal-source 'digital)(use-digital-tuner 'digital 0)

