(load "/usr/local/slisp/station.lsp")(defvar audio-choice-num nil)(defvar preferred-audio (list '("eng" "en") '("wel" "cym") '("gae") '("und")))(defvar preferred-audio-format nil)(defvar unlock-file nil)(defvar with-freesat nil)(defvar with-hk-tuner nil)(defvar with-dvbs-cont nil)(defmacro get-track-pid (track)
`(first ,track))(defmacro get-track-tag (track)
`(second ,track))(defmacro get-track-audio-format (track)
`(first (third ,track)))(defmacro get-track-audio-lang (track)
`(second (third ,track)))(defmacro get-track-audio-type (track)
`(third (third ,track)))(defmacro get-track-audio-adpid (track)
`(fourth (third ,track)))(defmacro set-track-audio-adpid (track val)
`(setf (nth 3 (nth 2 ,track)) ,val))(defmacro tag2pid (tag lst)
`(first (find-if #'(lambda (x)(eq ,tag (second x)))
,lst)))(defun get-preferred-priority (preferred lang)(let ((pri))(setf pri (position-if #'(lambda (x)(find-if #'(lambda (y)(string-equal lang y))
x))
preferred))(if pri
pri
(length preferred))))(defun get-format-priority (preferred format)(if (member format preferred)
0
1))(defun append-audio-track (track lst)(when (or (not audio-choice-num) (< (length lst) audio-choice-num))(let ((pos nil))(setf pos (position-if #'(lambda (x)(or (< (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format x)))(when (= (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format x)))(or (< (get-track-audio-type track) (get-track-audio-type x))(and (= (get-track-audio-type track) (get-track-audio-type x))(< (get-preferred-priority preferred-audio (get-track-audio-lang track))(get-preferred-priority preferred-audio (get-track-audio-lang x))))))))
lst))(if (not pos)(setf-cdr (last lst) (cons track nil))(setf-nthcdr pos lst (cons (nth pos lst) (nthcdr (1+ pos) lst)))(setf-nth pos lst track)))))(defun child-lock-p (key)(and (eq (svl-get-data (get-signal-source-svl key) 'child_lock) 1)(not (file-close (file-open unlock-file 'read)))))(defun pmt-parser (pmt key)(if (or (not pmt) (child-lock-p key))(progn
(set-video-pid 'video nil)(set-audio-pid 'audio nil))(let ((header) (firstlp) (secondlp) (esheader) (esdesclp)(stype) (espid) (tag) (track) (lang) (type)(vlist nil) (alist nil) (calist nil))(setf header (first pmt))(setf firstlp (second pmt))(setf secondlp (third pmt))(mapcar #'(lambda (eslp)(setf esheader   (first eslp))(setf esdesclp (second eslp))(setf stype (first esheader))(setf espid (+ (* (logand (second esheader) #x1F) #x100)(third esheader)))(setf tag -1)(setf lang (copy-string "---"))(setf type 0)(setf info-desc nil)(mapcar #'(lambda (desc)(when (eq (+ 2 (second desc)) (length desc))(case (first desc)(#x52
(setf tag (third desc)))(#x0a
(setf-char lang 0 (nth 2 desc))(setf-char lang 1 (nth 3 desc))(setf-char lang 2 (nth 4 desc))(setf type (nth 5 desc))))))
esdesclp)(case stype
((#x01 #x02)(setf track (list espid tag nil))(if vlist
(setf-cdr (last vlist) (cons track nil))(setf vlist (cons track nil))))((#x03 #x04)(setf track (list espid tag (list stype lang type -1)))(if alist
(append-audio-track track alist)(setf alist (cons track nil)))))(if calist
(setf-cdr (last calist) (cons (list espid 0) nil))(setf calist (cons (list espid 0) nil))))
secondlp)(set-video-pid 'video (if (assoc (get-video-pid 'video) vlist)(get-video-pid 'video)(get-track-pid (car vlist))))(set-audio-pid 'audio (if (assoc (get-audio-pid 'audio) alist)(get-audio-pid 'audio)(get-track-pid (car alist)))))))(defun digital-ts-tune (src onid tsid physical_ch)(let ((tsl-key) (dev))(if (get-signal-source-devices src)
nil
(my-device-open 'video 0)(my-device-open 'audio 0)(my-device-open 'psi 0)(my-device-open 'tsport 0)(my-device-open (get-signal-source-tuner src) (get-signal-source-no src))(init-tuner-object (get-signal-source-tuner src))(when with-dvbs-cont
(my-device-open 'stuner 1)(mapcar #'(lambda (x)(tuner-setup 'stuner
:satellite (nth 0 x)
:dish-low (nth 1 x)
:dish-high (nth 2 x)
:dish-tone-en (nth 3 x)))
dish-param)(init-tuner-object 'stuner))(init-section-object 'pat)(init-section-object 'pmt)(init-psi-object 'psi #'pmt-parser)(init-video-object 'video)(init-audio-object 'audio)(set-signal-source-devices src (list (get-signal-source-tuner src) 'stuner 'video 'audio 'audio-desc 'psi 'tsport))(set-tuning-tuner 'stuner)(set-tuning-tsl-key (get-tuner-tsl-key 'stuner))(setup-node (get-signal-source-node src)))(setf tsl-key (svl-create-key "TSL"
:physical_ch physical_ch
:onid onid
:tsid tsid))(tsl-query tsl-key 'ntype 'ya_nid)(set-signal-source-svl src nil)(set-signal-source-tsl src tsl-key)(set-tuning-tsl-key tsl-key)(set-tuning-tsid tsid)(set-tuning-svcid nil)(select-channel)))(defvar tuning-tuner 'tuner)(defun set-tuning-tuner (dev)(setf tuning-tuner dev))(defun get-tuning-tuner ()
tuning-tuner)(defmacro which-tuner (tsl-key)
`(if (eq (tsl-get-data ,tsl-key 'ntype) 1) 'stuner 'tuner))(defun my-select-channel ()(if (tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key (get-tuning-tuner)))(if (eq (get-tuning-svcid) (get-psi-svcid 'psi))(make-event 'psi-update)(set-psi-valid 'psi nil)(set-psi-error 'psi nil)(make-event 'psi-invalid)(search-svcid-in-pat (get-tuning-svcid))(make-event 'service-change))(set-psi-valid 'psi nil)(set-psi-error 'psi nil)(make-event 'psi-invalid)(make-event 'tuner-req)))(defvar dish-param nil)(defmacro dish-setup (sat low high tone-en)
`(setf dish-param (cons (list ,sat ,low ,high ,tone-en) dish-param)))(register-node 'my-tuner-freq-valid
#'(lambda ()(tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key (get-tuning-tuner))))
#'(lambda ()(set-tuning-tuner (which-tuner (get-tuning-tsl-key)))(set-tuner-tsl-key (get-tuning-tuner) (get-tuning-tsl-key))(eval-events (list 'tuner-req 'tuner-change)))
#'(lambda ()
nil))(register-node 'my-tuner-connect
#'(lambda ()(tuner-status (get-tuning-tuner)))
#'(lambda ()(unless (tuner-connect (get-tuning-tuner)
:tsl (get-tuner-tsl-key (get-tuning-tuner)))(set-tuner-tsl-key (get-tuning-tuner) (tuner-tsl-key (get-tuning-tuner))))(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 ()
nil))(init-signal-source-object 'dig)(tuner-config 'tuner "ttuner")(if with-hk-tuner
(progn
(tsport-config 'tsport "FE_IN2")(set-signal-source-no 'dig 1))(tsport-config 'tsport "FE_IN1")(set-signal-source-no 'dig 0))(set-signal-source-tuner 'dig 'tuner)(if (or with-freesat with-dvbs-cont)(progn
(register-device 'stuner
"tuner"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(set-owner 'stuner t)(when (eq (get-tuning-tuner) 'stuner)(make-event 'tuner-req)))(LOST
(set-owner 'stuner nil))(TUNER_LOCK
(make-event (list 'tuner-lock 'stuner)))(TUNER_UNLOCK
(make-event (list 'tuner-unlock 'stuner)))(TUNER_BADSIGNAL
(make-event (list 'tuner-badsignal 'stuner)))(PROPERTY_CHANGE
(when (eq (get-tuning-tuner) 'stuner)(set-tuning-tsl-key (tuner-tsl-key 'stuner))(unless (eq (get-tuning-tsid) (tsl-get-data (get-tuning-tsl-key) 'tsid))(set-tuning-tsid (tsl-get-data (get-tuning-tsl-key) 'tsid))(set-tuning-svcid nil))(mapcar #'(lambda (x)(when (eq 'tuner (get-signal-source-tuner (car x)))(set-signal-source-tsl (car x) (get-tuning-tsl-key))(unless (get-tuning-svcid)(set-signal-source-svl (car x) nil))))
signal-source-list)(enter-tuning-transition)(my-select-channel))))))(tuner-config 'stuner "stuner")(tsport-config 'tsport (list "FE_IN1" "FE_IN2"))(append-t
'my-tuner-freq-valid
'my-tuner-connect
'my-tsport-connect
'psi-valid
'parse-pmt
'video-pid-valid
'video-play)(append-t
'my-tsport-connect
'pat-request
'tsid-check
'pmt-pid-valid
'pmt-request)(append-t
'parse-pmt
'audio-pid-valid
'audio-play)(node-key 'my-tuner-freq-valid 'dig)(set-signal-source-node 'dig 'my-tuner-freq-valid))(append-t
'tuner-freq-valid
'tuner-connect
'tsport-connect
'psi-valid
'parse-pmt
'video-pid-valid
'video-play)(append-t
'tsport-connect
'pat-request
'tsid-check
'pmt-pid-valid
'pmt-request)(append-t
'parse-pmt
'audio-pid-valid
'audio-play)(node-key 'tuner-freq-valid 'dig)(set-signal-source-node 'dig 'tuner-freq-valid))(defun satellite-ts-tune (src ntype freq)(let ((tsl-key))(if (get-signal-source-devices src)
nil
(my-device-open 'video 0)(my-device-open 'audio 0)(my-device-open 'psi 0)(my-device-open 'tsport 0)(my-device-open (get-signal-source-tuner src) (get-signal-source-no src))(init-tuner-object (get-signal-source-tuner src))(when with-freesat
(my-device-open 'stuner 1)(mapcar #'(lambda (x)(tuner-setup 'stuner
:satellite (nth 0 x)
:dish-low (nth 1 x)
:dish-high (nth 2 x)
:dish-tone-en (nth 3 x)))
dish-param)(init-tuner-object 'stuner))(init-section-object 'pat)(init-section-object 'pmt)(init-psi-object 'psi #'pmt-parser)(init-video-object 'video)(init-audio-object 'audio)(set-signal-source-devices src (list (get-signal-source-tuner src) 'stuner 'video 'audio 'audio-desc 'psi 'tsport))(set-tuning-tuner 'stuner)(set-tuning-tsl-key (get-tuner-tsl-key 'stuner))(eval-node (get-signal-source-node src)))(setf tsl-key (svl-create-key "TSL"
:freq freq
:ntype ntype))(set-signal-source-svl src nil)(set-signal-source-tsl src tsl-key)(set-tuning-tsl-key tsl-key)(set-tuning-tsid nil)(my-select-channel)))(defun c-program-on (sym arg)(digital-ts-tune 'dig (first arg) (second arg) (fourth arg)))(defun c-program-on-satellite (ntype freq)(satellite-ts-tune 'dig ntype freq))(defun c-program-off ()(cancel-node (get-signal-source-node 'dig))(mapcar #'(lambda (x)(my-device-close x))(get-signal-source-devices 'dig))(set-signal-source-devices 'dig nil)(set-signal-source-svl 'dig nil)(set-signal-source-tsl 'dig nil))(defun set-unlock-file (name)(setf unlock-file name))(defun set-afc-vol (val0 val1 val2)(setf afc-vol (list val0 val1 val2)))(defun set-step-width-1way (val)(setf step-width-1way val))(defun ch-blank-on ()(setf ch-blank t))(defun ch-blank-off ()(setf ch-blank nil))(defun set-rf-mv-detect (t-or-nil)(setf rf-mv-detect t-or-nil))(defun set-preferred-audio (pref)(setf preferred-audio pref))(defun set-preferred-audio-format (format)(setf with-ac3 t)(when (or (eq format 'mpeg) (eq format 'ac3))(if (eq format 'mpeg)(setf preferred-audio-format (list #x03 #x04))(setf preferred-audio-format (list #x81)))))
