(load "/usr/local/slisp/station.lsp")(load "/usr/local/slisp/tvp.lsp")(defvar decode-p t)(defvar tuning-transition nil)(defvar video-transition nil)(defvar audio-transition nil)(defvar ch-blank t)(defvar fm-first 0)(defvar mpx-mode 0)(defvar mpx-skip 0)(defvar category #x0c)(defvar invalid-dvb-channel-status nil)(defvar bad-signal-status nil)(defvar no-signal-status nil)(defvar short-lnb-status nil)(defvar no-service-status nil)(defvar encrypted-status nil)(defvar video-encrypted nil)(defvar audio-encrypted nil)(defvar playing-video nil)(defvar playing-audio nil)(defvar detected-mpx nil)(defvar video-choice-num nil)(defvar audio-choice-num nil)(defvar subtitle-choice-num nil)(defvar teletext-choice-num nil)(defvar audio-track-list nil)(defvar subtitle-track-list nil)(defvar teletext-track-list nil)(defvar changed-audio-track nil)(defvar video-choice-list nil)(defvar audio-choice-list nil)(defvar subtitle-choice-list nil)(defvar teletext-choice-list nil)(defvar mheg-track-list nil)(defvar mheg-auto-start 0)(defvar mheg-ndt-p nil)(defvar scramble-p nil)(defvar pmt-ver nil)(defvar colorimetry 601)(defvar is-aus nil)(defvar is-uk nil)(defvar is-nz nil)(defvar is-hk nil)(defvar is-nordic nil)(defvar with-ttx-sttl nil)(defvar pmt-parsed nil)(defvar last-video-pid -1)(defvar last-audio-pid -1)(defvar preferred-audio nil)(defvar preferred-subtitle nil)(defvar preferred-teletext nil)(defvar preferred-common-lang nil)(defvar with-ac3 nil)(defvar with-ac3-plus nil)(defvar with-ad nil)(defvar with-hd nil)(defvar with-freesat nil)(defvar preferred-audio-format nil)(defvar mpeg-vol nil)(defvar unlock-file nil)(defvar ad-enable nil)(defvar ad-pid -1)(defvar ad-vol nil)(defvar ad-speaker nil)(defvar ad-earphone nil)(defvar ad-force-stop nil)(defvar is-saso nil)(defvar freq-temp nil)(defvar saso-freq-min 1344)(defvar saso-freq-max 27690)(defvar freq-param-min nil)(defvar freq-param-max nil)(defvar freq-wnd-min nil)(defvar freq-wnd-max nil)(defvar rf-mv-detect t)(defvar tmp-priority 600)(defvar current-network 0)(defvar req-network 0)(defvar dish-param nil)(defvar dish-param-1 nil)(defvar dish-param-2 nil)(defvar dish-param-3 nil)(defvar dish-param-4 nil)(set-pat-monitor-period 60000)(set-pmt-monitor-period 60000)(defun change-priority (prio)(my-device-priority 'tuner prio)(my-device-priority 'stuner prio)(my-device-priority 'tsport prio)(my-device-priority 'psi prio)(my-device-priority 'video prio)(my-device-priority 'audio prio)(when with-ad
(my-device-priority 'audio-desc prio)))(defun enter-tuning-transition ()(unless tuning-transition
(setf tuning-transition t)(change-priority tmp-priority)(set-timer #'(lambda ()(setf tuning-transition nil)(change-priority (get-default-prio))(make-event 'exit-tuning-transition))
'tuning-timeout
nil
1
3000)))(defun send-invalid-dvb-channel (key status)(unless (eq invalid-dvb-channel-status status)(unless tuning-transition
(write-bytes msg-fd msg-invalid-dvb-channel key 4 (if status 1 0))(setf invalid-dvb-channel-status status))))(defun send-bad-signal (key status)(unless (eq bad-signal-status status)(write-bytes msg-fd msg-bad-signal key 4 (if status 1 0))(setf bad-signal-status status)))(defun send-no-signal (key status)(unless (eq no-signal-status status)(write-bytes msg-fd msg-no-signal key 4 (if status 1 0))(setf no-signal-status status)))(defun send-short-lnb (key status)(unless (eq short-lnb-status status)(write-bytes msg-fd msg-short-lnb key 4 (if status 1 0))(setf short-lnb-status status)))(defun send-no-service (key status)(unless (eq no-service-status status)(write-bytes msg-fd msg-no-service key 4 (if status 1 0))(setf no-service-status status)))(defun send-encrypted (key status)(unless (eq encrypted-status status)(write-bytes msg-fd msg-encrypted key 4 (if status 1 0))(setf encrypted-status status)))(defun send-video-encrypted (key status)(setf video-encrypted status)(send-encrypted key (if (or video-encrypted audio-encrypted) t nil)))(defun send-audio-encrypted (key status)(setf audio-encrypted status)(send-encrypted key (if (or video-encrypted audio-encrypted) t nil)))(defun send-playing-video (key info)(unless (equal playing-video info)(write-bytes msg-fd msg-playing-video key 4 (if info info -1))(setf playing-video info)))(defun send-playing-audio (key info)(unless (equal playing-audio info)(write-bytes msg-fd msg-playing-audio key 16 (if (and info (nth 0 info))(list (nth 0 info)(if (nth 1 info)(nth 1 info)
-1)(if (nth 2 info)(nth 2 info)
-1)(if (nth 3 info)(nth 3 info)
-1))(list -1 -1 -1 "---")))(setf playing-audio info)))(defun send-detected-mpx (x)(let ((mpx))(setf mpx (if x x 0))(unless (eq detected-mpx mpx)(write-bytes msg-fd msg-mpx 0 4 mpx)(setf detected-mpx mpx))))(defmacro dual-mono-p (sym)
`(eq (audio-channel ,sym) 7))(defmacro hd-format-p (fmt)
`(> (nth 1 ,fmt) 576))(defmacro ad-by-multiaudio-p (track)
`(and (string-equal "NAR" (get-track-audio-lang ,track))(or (eq 0 (get-track-audio-type ,track))(eq 3 (get-track-audio-type ,track)))))(defmacro get-track-pid (track)
`(first ,track))(defmacro get-track-tag (track)
`(second ,track))(defmacro get-track-video-codec (track)
`(first (third ,track)))(defmacro set-track-video-pcr (track val)
`(setf (nth 1 (nth 2 ,track)) ,val))(defmacro get-track-video-pcr (track)
`(second (third ,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-dualmode (track)
`(fourth (third ,track)))(defmacro set-track-audio-dualmode (track val)
`(setf (nth 3 (nth 2 ,track)) ,val))(defmacro set-track-audio-language (track lang)
`(setf (nth 1 (nth 2 ,track)) ,lang))(defmacro get-track-audio-adpid (track)
`(fifth (third ,track)))(defun get-adpid-list (alist)(mapcan #'(lambda (lst)(list (get-track-audio-adpid lst)))
alist))(defmacro set-track-audio-adpid (track val)
`(setf (nth 4 (nth 2 ,track)) ,val))(defun copy-audio-track (track)(list (get-track-pid track) (get-track-tag track)(list (get-track-audio-format track)(copy-string (get-track-audio-lang track))(get-track-audio-type track)(get-track-audio-dualmode track)(get-track-audio-adpid track))))(defmacro get-track-subtitle-lang (track)
`(first (third ,track)))(defmacro get-track-subtitle-type (track)
`(second (third ,track)))(defmacro get-track-subtitle-composition-id (track)
`(third (third ,track)))(defmacro get-track-subtitle-ancillary-id (track)
`(fourth (third ,track)))(defmacro get-track-teletext-lang (track)
`(first (third ,track)))(defmacro get-track-teletext-type (track)
`(second (third ,track)))(defmacro get-track-teletext-magazine-number (track)
`(third (third ,track)))(defmacro get-track-teletext-page-number (track)
`(fourth (third ,track)))(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)(let* ((mpeg-list        (list #x03 #x04))(srch-format      (if (member format mpeg-list) #x03 format))(prio-format-list (if (or is-nz (and is-aus with-hd))(if (member #x11 preferred)(list #x82 #x11 #x03 #x81)(list #x82 #x81 #x11 #x03))(if is-nordic
(list #x11 #x82 #x81 #x03)(list #x82 #x11 #x81 #x03))))(prio-format      (position srch-format prio-format-list)))(if (member format preferred)
0
(1+ prio-format))))(defun get-audio-type-priority (type)(if (eq type 0)
0
(if (eq type 1)
1
2)))(defun get-subtitle-type-priority (type)(if (eq type #x10)
0
(if (eq type #x11)
1
(if (eq type #x12)
2
(if (eq type #x13)
3
4)))))(defun set-preferred-common-lang (alist slist)(let ((alang-group) (slang-group) (cmn-lang))(if (not (and alist slist))(setf preferred-common-lang nil)(setf alang-group (find-if #'(lambda (x)(find-if #'(lambda (y)(find-if #'(lambda (z)(string-equal (get-track-audio-lang z) y))
alist))
x))
preferred-audio))(setf slang-group (find-if #'(lambda (x)(find-if #'(lambda (y)(find-if #'(lambda (z)(string-equal (get-track-subtitle-lang z) y))
slist))
x))
preferred-subtitle))(setf preferred-common-lang (if (and alang-group slang-group)
nil
(if (find-if #'(lambda (y)(find-if #'(lambda (z)(string-equal (get-track-subtitle-lang z) y))
slist))
alang-group)
alang-group
(if (find-if #'(lambda (y)(find-if #'(lambda (z)(string-equal (get-track-audio-lang z) y))
alist))
slang-group)
slang-group
(if (or alang-group slang-group)
nil
(setf cmn-lang (get-track-audio-lang (find-if #'(lambda (x)(find-if #'(lambda (y)(string-equal (get-track-subtitle-lang y) (get-track-audio-lang x)))
slist))
alist)))(if cmn-lang
(list cmn-lang)
nil)))))))))(defun append-video-track (track lst)(when (or (not video-choice-num) (< (length lst) video-choice-num))(setf-cdr (last lst) (cons track nil))))(defun append-audio-track (track lst)(if (eq is-uk t)(progn
(when (or (not audio-choice-num) (< (length lst) audio-choice-num))(let ((pos nil) (und (list (list "und"))) (nar (list (list "nar"))))(do ((loopcount 0 (+ loopcount 1)))((> loopcount (- (length lst) 1)) loopcount)(if (= 0 (get-preferred-priority preferred-audio (get-track-audio-lang (nth loopcount lst))))(setf und nil)))(if (and (eq with-freesat t) (eq current-network 3))(setf nar nil))(if (and (eq current-network 2) (ad-by-multiaudio-p track))(progn
(if ad-enable
(setf pos 0)(setf pos nil)))(setf pos (position-if #'(lambda (x)(or (and (not ad-enable) (ad-by-multiaudio-p x))(and (not (ad-by-multiaudio-p x))(or (< (get-preferred-priority preferred-audio (get-track-audio-lang track))(get-preferred-priority preferred-audio (get-track-audio-lang x)))(< (get-preferred-priority und (get-track-audio-lang track))(get-preferred-priority und (get-track-audio-lang x)))(< (get-preferred-priority nar (get-track-audio-lang track))(get-preferred-priority nar (get-track-audio-lang x)))(when (and
(= (get-preferred-priority preferred-audio (get-track-audio-lang track))(get-preferred-priority preferred-audio (get-track-audio-lang x)))(= (get-preferred-priority und (get-track-audio-lang track))(get-preferred-priority und (get-track-audio-lang x)))(= (get-preferred-priority nar (get-track-audio-lang track))(get-preferred-priority nar (get-track-audio-lang x))))(or (< (get-audio-type-priority (get-track-audio-type track))(get-audio-type-priority (get-track-audio-type x)))(and (= (get-audio-type-priority (get-track-audio-type track))(get-audio-type-priority (get-track-audio-type x)))(< (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format 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)))))(if is-nz
(when (or (not audio-choice-num) (< (length lst) audio-choice-num))(let ((pos nil) (preferred-lang preferred-audio))(when preferred-common-lang
(setf preferred-lang (cons preferred-common-lang preferred-audio)))(setf pos (position-if #'(lambda (x)(or (< (get-preferred-priority preferred-lang (get-track-audio-lang track))(get-preferred-priority preferred-lang (get-track-audio-lang x)))(when (= (get-preferred-priority preferred-lang (get-track-audio-lang track))(get-preferred-priority preferred-lang (get-track-audio-lang x)))(or (< (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format x)))(and (= (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format x)))(< (get-audio-type-priority (get-track-audio-type track))(get-audio-type-priority (get-track-audio-type 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))))(when (or (not audio-choice-num) (< (length lst) audio-choice-num))(let ((pos nil))(setf pos (position-if #'(lambda (x)(or (< (get-preferred-priority preferred-audio (get-track-audio-lang track))(get-preferred-priority preferred-audio (get-track-audio-lang x)))(when (= (get-preferred-priority preferred-audio (get-track-audio-lang track))(get-preferred-priority preferred-audio (get-track-audio-lang x)))(or (< (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format x)))(and (= (get-format-priority preferred-audio-format (get-track-audio-format track))(get-format-priority preferred-audio-format (get-track-audio-format x)))(< (get-audio-type-priority (get-track-audio-type track))(get-audio-type-priority (get-track-audio-type 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 append-subtitle-track (track lst)(if (eq is-uk t)(progn
(when (or (not subtitle-choice-num) (< (length lst) subtitle-choice-num))(let ((pos nil) (und (list (list "und"))))(do ((loopcount 0 (+ loopcount 1)))((> loopcount (- (length lst) 1)) loopcount)(if (= 0 (get-preferred-priority preferred-subtitle (get-track-subtitle-lang (nth loopcount lst))))(setf und nil)))(setf pos (position-if #'(lambda (x)(or	 (< (get-preferred-priority preferred-subtitle (get-track-subtitle-lang track))(get-preferred-priority preferred-subtitle (get-track-subtitle-lang x)))(< (get-preferred-priority und (get-track-subtitle-lang track))(get-preferred-priority und (get-track-subtitle-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)))))(if (eq is-nz t)(progn
(when (or (not subtitle-choice-num) (< (length lst) subtitle-choice-num))(let ((pos nil) (preferred-lang preferred-subtitle))(when preferred-common-lang
(setf preferred-lang (cons preferred-common-lang preferred-subtitle)))(setf pos (position-if #'(lambda (x)(or	(< (get-preferred-priority preferred-lang (get-track-subtitle-lang track))(get-preferred-priority preferred-lang (get-track-subtitle-lang x)))(and (= (get-preferred-priority preferred-lang (get-track-subtitle-lang track))(get-preferred-priority preferred-lang (get-track-subtitle-lang x)))(< (get-subtitle-type-priority (get-track-subtitle-type track))(get-subtitle-type-priority (get-track-subtitle-type 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)))))(when (or (not subtitle-choice-num) (< (length lst) subtitle-choice-num))(let ((pos nil))(setf pos (position-if #'(lambda (x)(< (get-preferred-priority preferred-subtitle (get-track-subtitle-lang track))(get-preferred-priority preferred-subtitle (get-track-subtitle-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 append-teletext-track (track lst)(when (or (not teletext-choice-num) (< (length lst) teletext-choice-num))(let ((pos nil))(setf pos (position-if #'(lambda (x)(< (get-preferred-priority preferred-teletext (get-track-teletext-lang track))(get-preferred-priority preferred-teletext (get-track-teletext-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 append-mheg-track (track lst)(setf-cdr (last lst) (cons track nil)))(defun first-dual-mono-pos (list)(setf pos nil)(setf i 0)(mapcar #'(lambda (x)(if (eq pos nil)(if (not (eq (get-track-audio-dualmode x) -1))(setf pos i)))(setf i (1+ i)))
list)
pos)(defun create-audio-choice-list (sym alist)(let ((new-list nil) (dual-pid nil) (alist-pos 0) (new-list2 nil)(pos nil) (lang nil))(when (and (eq (get-audio-result sym) 'DECODE_SUCCESS) (dual-mono-p sym))(setf dual-pid (get-audio-pid sym)))(mapcar #'(lambda (x)(if (not (eq (get-track-pid x) dual-pid))(if new-list
(append-audio-track x new-list)(setf new-list (cons x nil)))(if (< (+ alist-pos 1) (length alist))(if (eq (nth 0 x) (nth 0 (nth (+ alist-pos 1) alist)))(set-audio-dualmode x 0)(if (not (eq alist-pos 0))(if (eq (nth 0 x) (nth 0 (nth (- alist-pos 1) alist)))(set-audio-dualmode x 1)(set-audio-dualmode x 2))(set-audio-dualmode x 2)))(if (not (eq alist-pos 0))(if (eq (nth 0 x) (nth 0 (nth (- alist-pos 1) alist)))(set-audio-dualmode x 1)(set-audio-dualmode x 2))(set-audio-dualmode x 2))))(setf alist-pos (+ alist-pos 1)))
alist)(if (eq dual-pid nil)
new-list
(progn
(mapcar #'(lambda (x)(setf pos nil)(setf lang (get-track-audio-lang x))(if new-list2
(progn
(if (eq (get-track-audio-dualmode x) -1)(setf-cdr (last new-list2) (cons x nil))(progn
(setf pos (first-dual-mono-pos new-list2))(if (eq pos nil)(setf-cdr (last new-list2) (cons x nil))(if (eq (get-track-audio-dualmode x) 2)(if (= (1+ pos) (length new-list2))(setf-cdr (last new-list2) (cons x nil))(if (eq (get-track-audio-dualmode (nth (1+ pos) new-list2)) -1)(progn
(setf-nthcdr (1+ pos) new-list2 (cons (nth (1+ pos) new-list2)(nthcdr (+ pos 2) new-list2)))(setf-nth (1+ pos) new-list2 x))(if (= (+ pos 2) (length new-list2))(setf-cdr (last new-list2) (cons x nil))(progn
(setf-nthcdr (+ pos 2) new-list2 (cons (nth (+ pos 2) new-list2)(nthcdr (+ pos 3) new-list2)))(setf-nth (+ pos 2) new-list2 x)))))(if (eq (get-track-audio-dualmode (nth pos new-list2)) 2)(if (= pos 0)(setf new-list2 (cons x new-list2))(progn
(setf-nthcdr pos new-list2 (cons (nth pos new-list2) (nthcdr (1+ pos) new-list2)))(setf-nth pos new-list2 x)))(if (= (1+ pos) (length new-list2))(setf-cdr (last new-list2) (cons x nil))(progn
(setf-nthcdr (1+ pos) new-list2 (cons (nth (1+ pos) new-list2)(nthcdr (+ pos 2) new-list2)))(setf-nth (1+ pos) new-list2 x)))))))))(setf new-list2 (cons x nil))))
new-list)
new-list2))))(defun set-audio-dualmode (track mode)(when (or (eq mode 0) (eq mode 2))(setf track (copy-audio-track track))(set-track-audio-dualmode track 0)(if new-list
(append-audio-track track new-list)(setf new-list (cons track nil))))(when (or (eq mode 1) (eq mode 2))(setf track (copy-audio-track track))(set-track-audio-dualmode track 1)(append-audio-track track new-list)(setf track (copy-audio-track track))(set-track-audio-dualmode track 2)(when (eq mode 1)(set-track-audio-language track "mix"))(append-audio-track track new-list)))(defun send-video-choice-list (key lst)(unless (equal video-choice-list lst)(if lst
(write-bytes msg-fd msg-video key (* (length lst) 16) lst)(write-bytes msg-fd msg-video key 0))(setf video-choice-list lst)))(defun send-audio-choice-list (key lst)(unless (equal audio-choice-list lst)(if lst
(write-bytes msg-fd msg-audio key (* (length lst) 28) lst)(write-bytes msg-fd msg-audio key 0))(setf audio-choice-list lst)))(defun send-subtitle-choice-list (key lst reset)(let (msg)(if (= reset 1)(setf msg msg-subtitle)(setf msg msg-subtitle-noreset))(unless (equal subtitle-choice-list lst)(if lst
(write-bytes msg-fd msg key (* (length lst) 24) lst)(write-bytes msg-fd msg key 0))(setf subtitle-choice-list lst))))(defun send-teletext-choice-list (key lst)(unless (equal teletext-choice-list lst)(if lst
(progn
(when teletext-choice-list
(write-bytes msg-fd msg-teletext key 0))(write-bytes msg-fd msg-teletext key (* (length lst) 24) lst))(write-bytes msg-fd msg-teletext key 0))(setf teletext-choice-list lst)))(defun send-pmt-parsing (key done)(unless (equal pmt-parsed done)(write-bytes msg-fd msg-pmt-parsing key 4 (if done 1 0))(setf pmt-parsed done)))(defun send-mheg-launch (key lst flg ndt)(when (and (boundp 'msg-mheg) key)(when (or (not (equal mheg-track-list lst))(not (eq flg mheg-auto-start))(and (not mheg-track-list) (not lst)))(if (eq (svl-get-data (get-signal-source-svl key) 'interactive_restriction) 1)(write-bytes msg-fd msg-mheg key 8 0 0)(if (and mheg-track-list lst)(progn
(unless ndt
(write-bytes msg-fd msg-mheg key 8 0 0))(write-bytes msg-fd msg-mheg key 8 1 flg))(write-bytes msg-fd msg-mheg key 8 (if (or lst ndt) 1 0) flg)))(setf mheg-track-list lst)(setf mheg-auto-start flg))))(defun send-mhp-launch (key tuned lst)(when (and (boundp 'msg-mhp) key)(if lst
(write-bytes msg-fd msg-mhp key (* (+ (length lst) 2) 4) tuned (length lst) lst)(write-bytes msg-fd msg-mhp key 8 tuned 0))))(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 tv-service-p (key)(eq (svl-get-data (get-signal-source-svl key) 'stype) 1))(defun tv-or-radio-service-p (key)(or (eq (svl-get-data (get-signal-source-svl key) 'stype) 1)(eq (svl-get-data (get-signal-source-svl key) 'stype) 2)))(defun pmt-parser (pmt key)(when (get-psi-svcid 'psi)(unless (eq (get-tuning-svcid) (get-psi-svcid 'psi))(set-tuning-svcid (get-psi-svcid 'psi))(unless (eq (get-tuning-svcid) (svl-get-data (get-signal-source-svl key) 'svcid))(set-signal-source-svl key nil))))(if (eq with-ttx-sttl t)(send-pmt-parsing key nil))(setf audio-track-list nil)(setf subtitle-track-list nil)(setf teletext-track-list nil)(set-video-pcr 'video nil)(set-audio-pcr 'audio nil)(setf mhp-ait-list nil)(if (or (not pmt) (not (get-signal-source-svl key)) (child-lock-p key))(progn
(setf pmt-ver nil)(send-video-choice-list key nil)(send-audio-choice-list key nil)(setf changed-audio-track nil)(send-playing-audio key nil)(send-subtitle-choice-list key nil 1)(send-teletext-choice-list key nil)(send-mheg-launch key nil 0 mheg-ndt-p)(ca-cancel 'ca)(set-video-pid 'video nil)(set-audio-pid 'audio nil)(set-video-vbipid 'video nil))(let ((header) (firstlp) (secondlp) (esheader) (esdesclp) (pcrpid)(stype) (espid) (tag) (track) (lang) (type) (info-desc) (auto-start 0) (update nil)(vlist nil) (alist nil) (slist nil) (tlist nil) (mlist nil) (calist nil) (ad-list nil)(lang-list nil) (type-list nil))(setf scramble-p nil)(setf header (first pmt))(setf firstlp (second pmt))(setf secondlp (third pmt))(unless (eq pmt-ver (nth 5 header))(when pmt-ver
(setf update t))(setf pmt-ver (nth 5 header)))(setf pcrpid (+ (* (logand (nth 8 header) #x1F) #x100)(nth 9 header)))(mapcar #'(lambda (desc)(when (eq (+ 2 (second desc)) (length desc))(case (first desc)(#x09
(setf scramble-p t)))))
firstlp)(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)(setf lang-list nil)(setf type-list nil)(mapcar #'(lambda (desc)(when (eq (+ 2 (second desc)) (length desc))(case (first desc)(#x09
(when (or (eq stype #x01) (eq stype #x02))(setf scramble-p t)))(#x52
(setf tag (third desc)))(#x0a
(let ((desclen))(setf desclen (- (second desc) 1))(when (and is-nz (> desclen 3))(setf desclen 3))(do ((loopcount 0 (+ loopcount 4)))((> loopcount desclen) loopcount)(setf lang (copy-string "---"))(setf-char lang 0 (nth (+ 2 loopcount) desc))(setf-char lang 1 (nth (+ 3 loopcount) desc))(setf-char lang 2 (nth (+ 4 loopcount) desc))(if lang-list
(setf-cdr (last lang-list) (cons lang nil))(setf lang-list (cons lang nil)))(setf type (nth (+ 5 loopcount) desc))(if type-list
(setf-cdr (last type-list) (cons type nil))(setf type-list (cons type nil))))))((#x56 #x59 #x66 #x6a #x7a)(setf info-desc desc)))))
esdesclp)(case stype
((#x01 #x02 #x1b)(unless (and (eq stype #x1b) (not (or with-hd (not (eq req-network 1)))))(setf track (list espid tag (list stype pcrpid)))(if vlist
(append-video-track track vlist)(setf vlist (cons track nil)))))((#x03 #x04 #x0f #x11 #x81)(unless lang-list
(setf lang-list (cons lang nil)))(do ((loopcount 0 (+ loopcount 1)))((> loopcount (- (length lang-list) 1)) loopcount)(unless (or (and (eq stype #x11) (not (or with-hd (not (eq req-network 1)))))(and (eq stype #x81) (not with-ac3)))(setf track (list espid tag (list stype
(nth loopcount lang-list)(if type-list
(nth loopcount type-list)
-1)
-1 -1)))(if (and with-ad (eq type 3)(or (eq stype #x03) (eq stype #x04))(not (eq key 2)))(if ad-list
(setf-cdr (last ad-list) (cons track nil))(setf ad-list (cons track nil)))(if audio-track-list
(setf-cdr (last audio-track-list) (cons track nil))(setf audio-track-list (cons track nil)))(if alist
(append-audio-track track alist)(setf alist (cons track nil)))))))(#x05
(when (eq key 1)(setf mhp-ait-list (cons espid mhp-ait-list))))(#x06
(when info-desc
(case (first info-desc)((#x6a #x7a)(let ((fmt nil))(when (and with-ac3 (eq (first info-desc) #x6a))(setf fmt #x81))(when (and with-ac3-plus (eq (first info-desc) #x7a))(setf fmt #x82))(when fmt
(unless lang-list
(setf lang-list (cons lang nil)))(do ((loopcount 0 (+ loopcount 1)))((> loopcount (- (length lang-list) 1)) loopcount)(setf track (list espid tag (list fmt
(nth loopcount lang-list)(if type-list
(nth loopcount type-list)
-1)
-1 -1)))(if audio-track-list
(setf-cdr (last audio-track-list) (cons track nil))(setf audio-track-list (cons track nil)))(if alist
(append-audio-track track alist)(setf alist (cons track nil)))))))(#x59
(if (>= (second info-desc) 8)(do ((x 0 (+ x 8)) (lp (nthcdr 2 info-desc) (setf lp (nthcdr 8 lp)))(composition-id) (ancillary-id))((>= x (second info-desc)))(setf lang (copy-string "---"))(setf-char lang 0 (nth 0 lp))(setf-char lang 1 (nth 1 lp))(setf-char lang 2 (nth 2 lp))(setf type (nth 3 lp))(setf composition-id (+ (* (nth 4 lp) #x100) (nth 5 lp)))(setf ancillary-id (+ (* (nth 6 lp) #x100) (nth 7 lp)))(setf track (list espid tag (list lang type composition-id ancillary-id)))(if subtitle-track-list
(setf-cdr (last subtitle-track-list) (cons track nil))(setf subtitle-track-list (cons track nil)))(if slist
(append-subtitle-track track slist)(setf slist (cons track nil))))(setf track (list espid tag (list (copy-string "---")  0 0 0)))(if subtitle-track-list
(setf-cdr (last subtitle-track-list) (cons track nil))(setf subtitle-track-list (cons track nil)))(if slist
(append-subtitle-track track slist)(setf slist (cons track nil)))))(#x56
(if (>= (second info-desc) 5)(do ((x 0 (+ x 5)) (lp (nthcdr 2 info-desc) (setf lp (nthcdr 5 lp)))(magazine-number) (page-number))((>= x (second info-desc)))(setf lang (copy-string "---"))(setf-char lang 0 (nth 0 lp))(setf-char lang 1 (nth 1 lp))(setf-char lang 2 (nth 2 lp))(setf type (/ (logand (nth 3 lp) #xf8) #x8))(setf magazine-number (logand (nth 3 lp) #x07))(setf page-number (nth 4 lp))(setf track (list espid tag (list lang type magazine-number page-number)))(if teletext-track-list
(setf-cdr (last teletext-track-list) (cons track nil))(setf teletext-track-list (cons track nil)))(if tlist
(append-teletext-track track tlist)(setf tlist (cons track nil))))(setf track (list espid tag (list (copy-string "---") 0 0 0)))(if teletext-track-list
(setf-cdr (last teletext-track-list) (cons track nil))(setf teletext-track-list (cons track nil)))(if tlist
(append-teletext-track track tlist)(setf tlist (cons track nil))))))))((#x0b #x0d)(when (and info-desc
(eq (nth 0 info-desc) #x66)(>= (nth 1 info-desc) 6)(eq (nth 2 info-desc) #x01)(eq (nth 3 info-desc) #x06)(or
(and
(eq (nth 4 info-desc) #x01)(eq (nth 5 info-desc) #x01))(and
(eq (nth 4 info-desc) #x01)(eq (nth 5 info-desc) #x02))(and
(eq (nth 4 info-desc) #x05)(eq (nth 5 info-desc) #x05))))(setf auto-start 1))(setf track (list tag nil))(if mlist
(append-mheg-track track mlist)(setf mlist (cons track nil)))))(if calist
(setf-cdr (last calist) (cons (list espid 0) nil))(setf calist (cons (list espid 0) nil))))
secondlp)(when is-nz
(set-preferred-common-lang audio-track-list subtitle-track-list)(setf alist nil)(mapcar #'(lambda (x)(if alist
(append-audio-track x alist)(setf alist (cons x nil))))
audio-track-list)(setf slist nil)(mapcar #'(lambda (x)(if slist
(append-subtitle-track x slist)(setf slist (cons x nil))))
subtitle-track-list))(setf track (assoc (get-video-pid 'video) vlist))(unless track
(setf track (assoc last-video-pid vlist))(unless track
(setf track (car vlist))))(when (and (eq pcrpid #x1fff) (> (length vlist) 1))(mapcar #'(lambda (x)(set-track-video-pcr x (get-track-pid x)))
vlist))(set-video-pcr 'video (get-track-video-pcr track))(set-video-pid 'video (get-track-pid track))(audio-attr 'audio (if (eq (get-track-video-codec track) #x1b) 'avc 'mpeg2))(when ad-list
(mapcar #'(lambda (x)(mapcar #'(lambda (y)(when (and (< (get-track-audio-adpid y) 0)(or
(string= (get-track-audio-lang x) (get-track-audio-lang y))(and is-uk
(or (and (string= "und" (get-track-audio-lang y))(or (string= "eng" (get-track-audio-lang x))(string= "en" (get-track-audio-lang x))))(and (string= "und" (get-track-audio-lang x))(or (string= "eng" (get-track-audio-lang y))(string= "en" (get-track-audio-lang y)))))))(or (eq (get-track-audio-format y) #x03)(eq (get-track-audio-format y) #x04)))(set-track-audio-adpid y (get-track-pid x))))
alist))
ad-list))(when (audio-status 'audio)(audio-property 'audio #'(lambda (pid)(unless (eq (get-audio-pid 'audio) pid)(set-audio-pid 'audio pid)))))(setf track (assoc (get-audio-pid 'audio) alist))(when (and update track (not (equal track changed-audio-track)))(setf changed-audio-track nil)(setf track nil))(unless track
(ad-stop)(setf track (assoc last-audio-pid alist))(unless track
(setf track (car alist))))(set-audio-pcr 'audio (get-video-pcr 'video))(set-audio-pid 'audio (get-track-pid track))(when mpeg-vol
(if (or (eq (get-track-audio-format track) #x03)(eq (get-track-audio-format track) #x04))(set-audio-volume-gain 'audio (list nil mpeg-vol))(set-audio-volume-gain 'audio (list nil 17))))(when track
(ad-play (get-track-audio-adpid track)))(unless (assoc (get-video-vbipid 'video) tlist)(set-video-vbipid 'video (get-track-pid (car tlist))))(ca-request 'ca 'psi calist)(send-video-choice-list key vlist)(send-audio-choice-list key (create-audio-choice-list 'audio alist))(send-subtitle-choice-list key slist 1)(send-teletext-choice-list key tlist)(send-mheg-launch key mlist auto-start nil)(send-mhp-launch key 1 mhp-ait-list)(if (eq with-ttx-sttl t)(send-pmt-parsing key t)))))(defun ad-play (pid)(setf ad-pid pid)(make-event 'ad-valid-check)(make-event 'ad-pid-update))(defun ad-stop ()(setf ad-pid -1)(make-event 'ad-valid-check))(register-device 'audio-desc
"audio"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(set-owner 'audio-desc t))(LOST
(set-owner 'audio-desc nil)))))(register-node 'audio-desc-valid
#'(lambda (key)(and (eq key 1) ad-enable (>= ad-pid 0) (not ad-force-stop)))
#'(lambda (src)(when with-ad
(let ((m-key))(setf m-key (get-signal-source-dev src))(if (and ad-enable (>= ad-pid 0))(progn
(set-sp-src m-key 0 (if ad-speaker 1 0))(set-hp-src m-key 0 (if ad-earphone 1 0))(set-monout-asrc m-key 0 (if ad-speaker 1 0))(set-optout-src m-key 0 (if ad-speaker 1 0)))(set-sp-src m-key 0 0)(set-hp-src m-key 0 0)(set-monout-asrc m-key 0 0)(set-optout-src m-key 0 0))(select-media (get-current-main-media) (get-current-sub-media) (get-current-frame-visual))(audio-unmute 'audio)))(eval-events (list 'ad-valid-check 'ad-output-change 'audio-available)))
#'(lambda ()(when with-ad
(audio-mute 'audio))))(register-node 'audio-desc-play
#'(lambda ()
t)
#'(lambda ()(when (assoc (get-audio-pid 'audio) audio-track-list)(my-device-priority 'audio-desc tmp-priority)(audio-play 'audio-desc
:psi 'psi
:pcr (get-audio-pcr 'audio)
:pid ad-pid)(my-device-priority 'audio-desc (get-default-prio)))(eval-events (list 'ad-pid-update 'audio-result-update)))
#'(lambda ()(audio-stop 'audio-desc)))(register-node 'audio-desc-volume
#'(lambda ()
t)
#'(lambda ()(audio-volume 'audio-desc ad-vol)(eval-events (list 'ad-volume-change)))
#'(lambda ()))(register-node 'decode-on
#'(lambda ()
decode-p)
#'(lambda ()(eval-events (list 'decode-on 'decode-off)))
#'(lambda ()
nil))(defmacro current-digital-p ()
`(<= (tsl-get-data (get-tuning-tsl-key) 'ntype) 3))(register-node 'dvb-channel
#'(lambda ()(current-digital-p))
#'(lambda ())
#'(lambda ()))(register-node 'no-dvb-channel
#'(lambda ()
t)
#'(lambda (key)(set-tuning-tsid nil)(set-tuning-svcid nil)(set-signal-source-tsl key nil)(set-signal-source-svl key nil)(unless (get-tuning-tsl-key)(send-invalid-dvb-channel key t)))
#'(lambda (key)(send-invalid-dvb-channel key nil)))(register-node 'no-tsl
#'(lambda ()
t)
#'(lambda (key)(when (digital-media-p tv-media)(when (eq (get-signal-source-tuner key) 'tuner)(if is-hk
(tuner-connect 'tuner
:freq 474000
:band-width 0
:constellation 3
:guard-interval 2)(tuner-connect 'tuner
:freq (if (eq is-aus t)
522500
(if (eq current-network 4)
362000
474000))
:band-width (if (eq is-aus t) 1 0))))(send-invalid-dvb-channel key t)))
#'(lambda (key)(send-invalid-dvb-channel key nil)))(register-node 'bad-signal-check
#'(lambda (key)(eq (tuner-status (get-signal-source-tuner key)) 'TUNER_BADSIGNAL))
#'(lambda ()(eval-events (list 'tuner-lock 'tuner-badsignal)))
#'(lambda ()
nil))(register-node 'bad-signal
#'(lambda ()
t)
#'(lambda (key)(send-bad-signal key t))
#'(lambda (key)(send-bad-signal key nil)))(register-node 'no-signal
#'(lambda ()
t)
#'(lambda (key)(unless tuning-transition
(if (and (tuner-lnb-short (get-signal-source-tuner key)) (= with-freesat t))(progn
(send-no-signal key nil)(send-short-lnb key t))(unless (eq key 0)(send-no-signal key t))))(eval-events (list (list 'tuner-short-lnb (get-signal-source-tuner key))
'exit-tuning-transition)))
#'(lambda (key)(send-short-lnb key nil)(send-no-signal key nil)(enter-tuning-transition)))(register-node 'pat-timeout
#'(lambda ()
t)
#'(lambda (key)(if (get-psi-valid 'psi)(send-no-service key nil)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key t)))(eval-events (list 'exit-tuning-transition 'psi-valid 'psi-invalid)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(register-node 'no-pmt
#'(lambda ()
t)
#'(lambda (key)(if (get-psi-valid 'psi)(send-no-service key nil)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key (if (< (get-tuning-svcid) 0) nil t))))(eval-events (list 'exit-tuning-transition 'psi-valid 'psi-invalid)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(register-node 'invalid-tsid
#'(lambda ()
t)
#'(lambda (key)(if (get-psi-valid 'psi)(send-no-service key nil)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key t)))(eval-events (list 'exit-tuning-transition 'psi-valid 'psi-invalid)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(register-node 'pmt-timeout
#'(lambda ()
t)
#'(lambda (key)(if (get-psi-valid 'psi)(send-no-service key nil)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key t)))(eval-events (list 'exit-tuning-transition 'psi-valid 'psi-invalid)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(register-node 'mheg-invalid
#'(lambda ()
t)
#'(lambda (key))
#'(lambda (key)(when (and (not tuning-transition)(get-signal-source-svl key)(not mheg-track-list))(send-mheg-launch key nil 0 nil))(eval-events (list 'exit-tuning-transition))))(register-node 'mhp-valid
#'(lambda ()
t)
#'(lambda (key))
#'(lambda (key)(send-mhp-launch key 0 nil)))(register-node 'no-video
#'(lambda ()
t)
#'(lambda (key)(when (and (tv-service-p key) (not mheg-track-list) (not (child-lock-p key)))(send-playing-video key #x1fff))(eval-events (list 'video-update)))
#'(lambda (key)(send-playing-video key nil)))(register-node 'no-audio
#'(lambda ()
t)
#'(lambda (key)(when (tv-or-radio-service-p key)(send-playing-audio key (list #x1fff -1 -1 "---"))))
#'(lambda (key)(send-playing-audio key nil)))(register-node 'back-to-default-prio
#'(lambda ()
t)
#'(lambda (key)(unless (get-video-result 'video)(video-unmute 'video))(unless (and (get-video-pid 'video) (not (video-pid 'video)))(change-priority (get-default-prio)))(eval-events (list 'video-result-update)))
#'(lambda ()))(register-node 'video-play-monitor
#'(lambda ()
t)
#'(lambda (key)(if (and (eq (get-video-result 'video) 'DECODE_ERROR)(ca-status 'ca)
scramble-p)(progn
(video-mute 'video)(set-timer #'(lambda ()(send-video-encrypted current-network t))
'encrypted-delay-timer
nil
1
10000)(send-playing-video key (get-video-pid 'video)))(cancel-timer 'encrypted-delay-timer)(if (eq (get-video-result 'video) 'DECODE_SCRAMBLE)(video-mute 'video)(video-unmute 'video))(send-video-encrypted key (if (eq (get-video-result 'video) 'DECODE_SCRAMBLE) t nil))(if (and (eq (get-video-result 'video) 'DECODE_ERROR)(or (not playing-video) (eq playing-video #x1fff)))(send-playing-video key #x1fff)(send-playing-video key (get-video-pid 'video))))(eval-events (list 'video-result-update 'ca-session-open 'ca-session-close)))
#'(lambda (key)(cancel-timer 'encrypted-delay-timer)(unless video-transition
(send-video-encrypted key nil)(send-playing-video key nil))))(register-node 'audio-play-monitor
#'(lambda ()
t)
#'(lambda (key)(if (and
(not (assoc (get-audio-pid 'audio) audio-track-list))(not (member (get-audio-pid 'audio) (get-adpid-list audio-track-list))))(send-subtitle-choice-list key nil 1)(send-audio-encrypted key (if (eq (get-audio-result 'audio) 'DECODE_SCRAMBLE) t nil))(send-audio-choice-list key (create-audio-choice-list 'audio audio-track-list))(set-preferred-subtitle preferred-subtitle))(if (eq (get-audio-result 'audio) 'DECODE_SUCCESS)(progn
(send-audio-choice-list key (create-audio-choice-list 'audio audio-track-list))(send-playing-audio key (list (get-audio-pid 'audio) (audio-channel 'audio)(if (dual-mono-p 'audio)(audio-dualmode 'audio (get-track-audio-dualmode
(assoc (get-audio-pid 'audio) audio-choice-list)))
-1)(get-track-audio-lang (first audio-choice-list)))))(if (and (eq (get-audio-result 'audio) 'DECODE_ERROR)(not playing-audio))(send-playing-audio key (list #x1fff -1 -1 "---"))(send-playing-audio key (list (get-audio-pid 'audio) -1 -1 (get-track-audio-lang (first audio-choice-list))))))(eval-events (list 'audio-result-update 'audio-channel-change)))
#'(lambda (key)(send-audio-encrypted key nil)(unless audio-transition
(send-playing-audio key nil))))(register-node 'tsport-available
#'(lambda ()(device-source-p 'tsport (get-tuning-tuner)))
#'(lambda ()(eval-events (list 'tsport-available 'tsport-change)))
#'(lambda ()
nil))(register-node 'dvb-available
#'(lambda ()
t)
#'(lambda ()(when (and decode-p
(not (svl-equal (get-signal-source-svl current-network) dvb-common-request)))(if (and (svl-get-data (get-signal-source-svl current-network) 'onid)(svl-get-data (get-signal-source-svl current-network) 'svcid)(svl-get-data (get-signal-source-svl current-network) 'tsid))(write-bytes msg-fd msg-dvb-available current-network 12
(svl-get-data (get-signal-source-svl current-network) 'onid)(svl-get-data (get-signal-source-svl current-network) 'tsid)(svl-get-data (get-signal-source-svl current-network) 'svcid))(write-bytes msg-fd msg-dvb-available current-network 12 -1 -1 -1))))
#'(lambda ()
nil))(defun decode-on ()(setf decode-p t)(make-event 'decode-on))(defun decode-off ()(my-device-priority 'video tmp-priority)(my-device-priority 'audio tmp-priority)(setf decode-p nil)(make-event 'decode-off)(unless tuning-transition
(my-device-priority 'video (get-default-prio))(my-device-priority 'audio (get-default-prio))))(defun recover-tuner (dev)(set-tuning-tsl-key (tuner-tsl-key dev))(tsl-query (get-tuning-tsl-key) 'ntype 'ya_nid)(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))(let ((mkey))(setf mkey (if (eq (tsl-get-data (get-tuning-tsl-key) 'ntype) 1)(if (eq (tsl-get-data (get-tuning-tsl-key) 'ya_nid) #x3b)
'freesat
'othersat)(if (eq (tsl-get-data (get-tuning-tsl-key) 'ntype) 3)
'cable
'digital)))(setf req-network (car (find-if #'(lambda (x)(eq (get-signal-source-dev (car x)) mkey))
signal-source-list))))(unless req-network
(setf req-network current-network))(set-signal-source-tsl req-network (get-tuning-tsl-key))(unless (get-tuning-svcid)(set-signal-source-svl req-network nil))(enter-tuning-transition)(my-select-channel))(defun recover-tsport ()(if (and (device-open-p 'stuner) (device-source-p 'tsport 'stuner) (eq (get-tuning-tuner) 'tuner))(set-tuning-tsl-key (tuner-tsl-key 'stuner))(when (device-source-p 'tsport 'tuner)(set-tuning-tsl-key (tuner-tsl-key 'tuner))))(tsl-query (get-tuning-tsl-key) 'ntype 'ya_nid)(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))(let ((mkey))(setf mkey (if (eq (tsl-get-data (get-tuning-tsl-key) 'ntype) 1)(if (eq (tsl-get-data (get-tuning-tsl-key) 'ya_nid) #x3b)
'freesat
'othersat)(if (eq (tsl-get-data (get-tuning-tsl-key) 'ntype) 3)
'cable
'digital)))(setf req-network (car (find-if #'(lambda (x)(eq (get-signal-source-dev (car x)) mkey))
signal-source-list))))(unless req-network
(setf req-network current-network))(set-signal-source-tsl req-network (get-tuning-tsl-key))(unless (get-tuning-svcid)(set-signal-source-svl req-network nil))(enter-tuning-transition)(my-select-channel))(defun digital-program-on (src disp sym onid tsid svcid video-pid audio-pid phys-ch)(setf tuning-transition nil)(setf req-network src)(setf last-video-pid video-pid)(setf last-audio-pid audio-pid)(if (and (= onid -1) (= tsid -1) (= svcid -1) (= phys-ch -1))(setf invalid-dvb-channel-status t))(let ((svl-key) (tsl-key) (m-key) (port))(setf svl-key (svl-create-key sym
:onid onid
:tsid tsid
:svcid svcid
:physical_ch phys-ch
))(svl-query svl-key 'stype 'child_lock 'interactive_restriction 'volume_correction)(setf tsl-key (svl-create-key "TSL"
:physical_ch phys-ch
:onid onid
:tsid tsid))(tsl-query tsl-key 'ntype 'ya_nid)(setf m-key (get-signal-source-dev src))(set-signal-source-svl src svl-key)(set-signal-source-tsl src tsl-key)(setf dvb-common-request svl-key)(if dvb-resource-usr-lst
(enter-tuning-transition)(my-device-open 'video 0)(my-device-open 'audio 0)(when with-ad
(my-device-open 'audio-desc 1))(my-device-open 'ca 0)(my-device-open 'psi 0)(setf port (list nil nil))(mapcar #'(lambda (x)(let (cur-src)(setf cur-src (car x))(if (eq (get-signal-source-no cur-src) 0)(setf (nth 0 port) "FE_IN1")(if (eq (get-signal-source-no cur-src) 1)(setf (nth 1 port) "FE_IN2")))(when (or (eq (get-signal-source-tuner cur-src) 'tuner)(eq (get-signal-source-tuner cur-src) 'stuner))(my-device-open (get-signal-source-tuner cur-src) (get-signal-source-no cur-src))(init-tuner-object (get-signal-source-tuner cur-src))(if (eq with-freesat t)(progn
(when (and (eq (get-signal-source-tuner cur-src) 'stuner)
dish-param)(tuner-setup 'stuner
:dish-low (nth 0 dish-param)
:dish-high (nth 1 dish-param)
:dish-tone-en (nth 2 dish-param))))(progn
(when (eq (get-signal-source-tuner cur-src) 'stuner)(when dish-param-1
(tuner-setup 'stuner
:satellite 0
:dish-low (nth 0 dish-param-1)
:dish-high (nth 1 dish-param-1)
:dish-tone-en (nth 2 dish-param-1)))(when dish-param-2
(tuner-setup 'stuner
:satellite 1
:dish-low (nth 0 dish-param-2)
:dish-high (nth 1 dish-param-2)
:dish-tone-en (nth 2 dish-param-2)))(when dish-param-3
(tuner-setup 'stuner
:satellite 2
:dish-low (nth 0 dish-param-3)
:dish-high (nth 1 dish-param-3)
:dish-tone-en (nth 2 dish-param-3)))(when dish-param-4
(tuner-setup 'stuner
:satellite 3
:dish-low (nth 0 dish-param-4)
:dish-high (nth 1 dish-param-4)
:dish-tone-en (nth 2 dish-param-4)))))))))
signal-source-list)(tsport-config 'tsport port)(my-device-open 'tsport 0)(set-tuner-hook 'tuner #'(lambda (sig)(case sig
((TUNER_CONTROLABLE AVAILABLE)(when (eq (get-tuning-tuner) 'tuner)(make-event 'tuner-req)))(TUNER_LOCK
(make-event (list 'tuner-lock 'tuner)))(TUNER_UNLOCK
(make-event (list 'tuner-unlock 'tuner)))(TUNER_BADSIGNAL
(make-event (list 'tuner-badsignal 'tuner)))(PROPERTY_CHANGE
(when (eq (get-tuning-tuner) 'tuner)(recover-tuner 'tuner)))(TUNER_SEARCH_LOCK
(if (= scan-active 1)(progn
(write-bytes msg-fd msg-dvb-search-result 1 4 my-freq)(setf scan-active 0)(tuner-connect 'tuner
:freq search-last-freq
:band-width search-last-bw))))(TUNER_SEARCH_FAIL
(if (= scan-active 1)(progn
(setf freq-pos (+ freq-pos 1))(if (< freq-pos freq-len)(scan freq-pos)(progn
(write-bytes msg-fd msg-dvb-search-result 1 4 0)(setf scan-active 0)(tuner-connect 'tuner
:freq search-last-freq
:band-width search-last-bw))))))(TUNER_DISCONNECT
(make-event (list 'tuner-disconnect 'tuner))))))(set-tuner-hook 'stuner #'(lambda (sig)(case sig
(AVAILABLE
(when (eq (get-tuning-tuner) 'stuner)(make-event 'tuner-req)))(TUNER_LOCK
(make-event (list 'tuner-lock 'stuner)))(TUNER_UNLOCK
(make-event (list 'tuner-unlock 'stuner)))(TUNER_BADSIGNAL
(make-event (list 'tuner-badsignal 'stuner)))(TUNER_LNB_SHORT
(make-event (list 'tuner-short-lnb 'stuner)))(PROPERTY_CHANGE
(when (eq (get-tuning-tuner) 'stuner)(recover-tuner 'stuner))))))(init-section-object 'pat)(init-section-object 'pmt)(when is-hk
(set-section-filter 'pat (list #xFF #x80 #xFF #xFF #xFF #x01))(set-section-mask 'pat (list #xFF #x7F #xFF #xFF #xFF #xFE))(set-section-filter 'pmt (list #xFF #x80 #xFF #xFF #xFF #x01))(set-section-mask 'pmt (list #xFF #x7F #xFF #xFF #xFF #xFE)))(init-psi-object 'psi #'pmt-parser)(init-ca-object 'ca)(init-video-object 'video)(set-video-hook 'video #'(lambda (sig)(case sig
((DECODE_SUCCESS INFO_CHANGE)(let ((vfmt) (col))(setf vfmt (video-format 'video))(when vfmt
(setf col (if (hd-format-p vfmt)
709
601))(video-set-colorimetry 'video col)(setf colorimetry col)))))))(init-audio-object 'audio)(if with-ad
(if with-freesat
(setf dvb-common-devices (list 'tuner 'stuner 'video 'audio 'audio-desc 'ca 'psi 'tsport))(setf dvb-common-devices (list 'tuner 'video 'audio 'audio-desc 'ca 'psi 'tsport)))(if with-freesat
(setf dvb-common-devices (list 'tuner 'stuner 'video 'audio 'ca 'psi 'tsport))(setf dvb-common-devices (list 'tuner 'video 'audio 'ca 'psi 'tsport))))(resource-node 'dvb-pipe dvb-common-devices)(append-t
'dvb-pipe
'tsport-available
'dvb-available)(node-key 'dvb-pipe src)(eval-node 'dvb-pipe)(setf dvb-common-pipe 'dvb-pipe)(enter-tuning-transition)(if (and with-freesat (device-source-p 'tsport 'stuner))(set-tuning-tsl-key (get-tuner-tsl-key 'stuner))(set-tuning-tsl-key (get-tuner-tsl-key 'tuner)))(set-tuning-tsid (tsl-get-data (get-tuning-tsl-key) 'tsid))(set-tuning-svcid (get-psi-svcid 'psi))(eval-node dvb-common-node))(unless (member src dvb-resource-usr-lst)(if dvb-resource-usr-lst
(setf dvb-resource-usr-lst (cons src dvb-resource-usr-lst))(setf dvb-resource-usr-lst (cons src nil))))(set-tuning-tsl-key tsl-key)(set-tuning-tsid (tsl-get-data (get-tuning-tsl-key) 'tsid))(set-tuning-svcid svcid)(when (child-lock-p src)(mheg-ndt nil))(set-tv-media m-key)(my-select-channel)(mheg-ndt nil)(cancel-timer 'fail-check)(unless (and (= onid -1) (= tsid -1) (= svcid -1))(set-timer #'(lambda (arg)(if (device-source-p 'tsport (get-tuning-tuner))(unless (tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key (get-tuning-tuner)))(recover-tuner (get-tuning-tuner)))(when (tuner-status (get-tuning-tuner))(recover-tsport))))
'fail-check
nil
1
2000))(set-sp-volume m-key nil (svl-get-data svl-key 'volume_correction) nil)(set-hp-volume m-key nil (svl-get-data svl-key 'volume_correction) nil)(if (eq disp 0)(main-digital-tune m-key)(if (eq disp 1)(sub-digital-tune m-key)))(if (and (tsl-equal (get-tuner-tsl-key (get-tuning-tuner)) tsl-key)(or (not (get-psi-valid 'psi))(eq (get-psi-svcid 'psi) svcid)))(svl-save "digital-svl" svl-key))))(defun analog-program-on (src disp sym pos nicam mode)(unless (get-signal-source-devices src)(if each-devs
(setf-cdr (last each-devs) (cons (get-signal-source-tuner src) nil))(setf each-devs (list (get-signal-source-tuner src))))(tvp-devlist 'tvp
common-devs
each-devs)(set-signal-source-devices src (list (get-signal-source-tuner src))))(when nicam
(setf fm-first (if (eq nicam 0) 1 0)))(when mode
(setf mpx-mode mode))(let ((svl-key) (tsl-key) (m-key) (prop) (colsys) (colsys_mode))(setf svl-key (svl-create-key sym
:major_channel pos))(svl-query svl-key 'physical_ch 'offset 'color_sys_mode 'color_sys 'volume_correction
'AFC 'mt_offset 'stereo_mono 'AB 'SIF 'child_lock)(setf tsl-key (svl-create-key "TSL"
:physical_ch (svl-get-data svl-key 'physical_ch)
:offset (svl-get-data svl-key 'offset)))(tsl-query tsl-key 'freq 'ntype 'last_colsys 'offset)(when (current-digital-p)(change-priority tmp-priority)(set-tuning-tsl-key tsl-key)(my-select-channel))(change-priority (get-default-prio))(setf m-key (get-signal-source-dev src))(set-signal-source-svl src svl-key)(set-signal-source-tsl src tsl-key)(when (child-lock-p src)(mute-media m-key))(setf colsys_mode (svl-get-data svl-key 'color_sys_mode))(setf colsys (if (eq colsys_mode 1)(svl-get-data svl-key 'color_sys)(tsl-get-data tsl-key 'last_colsys)))(set-ds-colsys m-key colsys_mode colsys)(set-ds-mv-det m-key (if (and rf-mv-detect (eq pos 0)) 1 0))(set-sp-volume m-key nil (svl-get-data svl-key 'volume_correction) nil)(set-hp-volume m-key nil (svl-get-data svl-key 'volume_correction) nil)(setf prop (atnr-property atnr-prop))(setf (atnr-prop-tune-vmute prop) (if ch-blank 1 0))(if (eq (svl-get-data svl-key 'AFC) 0)(progn
(setf (atnr-prop-tune-type prop) "normal")(setf (atnr-prop-tune-param0-vfreq prop) (tsl-get-data tsl-key 'freq))(setf (atnr-prop-tune-param0-offset prop) (+ (tsl-get-data tsl-key 'offset)(svl-get-data svl-key 'mt_offset)))(setf (atnr-prop-wnd-srch-mode prop) 0))(setf (atnr-prop-tune-type prop) "1point-way")(setf (atnr-prop-tune-param0-vfreq prop) (tsl-get-data tsl-key 'freq))(setf (atnr-prop-tune-param0-offset prop) (tsl-get-data tsl-key 'offset))(setf freq-temp (+ (/ (* (atnr-prop-tune-param0-vfreq prop) 100) 3125)(atnr-prop-tune-param0-offset prop)))(setf freq-param-min -20)(when (and (eq is-saso t) (> (- saso-freq-min freq-temp) -20) (<= (- saso-freq-min freq-temp) 0))(setf freq-param-min (- saso-freq-min freq-temp)))(setf freq-param-max 20)(when (and (eq is-saso t) (< (- saso-freq-max freq-temp) 20) (>= (- saso-freq-max freq-temp) 0))(setf freq-param-max (- saso-freq-max freq-temp)))(setf (atnr-prop-tune-param0-min-ofs prop) (+ (tsl-get-data tsl-key 'offset) freq-param-min))(setf (atnr-prop-tune-param0-max-ofs prop) (+ (tsl-get-data tsl-key 'offset) freq-param-max))(setf (atnr-prop-wnd-srch-mode prop) 1)(setf freq-wnd-min -32)(when (and (eq is-saso t) (> (- saso-freq-min freq-temp) -32) (<= (- saso-freq-min freq-temp) 0))(setf freq-wnd-min (- saso-freq-min freq-temp)))(setf freq-wnd-max 32)(when (and (eq is-saso t) (< (- saso-freq-max freq-temp) 32) (>= (- saso-freq-max freq-temp) 0))(setf freq-wnd-max (- saso-freq-max freq-temp)))(setf (atnr-prop-wnd-srch-min-ofs prop) (+ (tsl-get-data tsl-key 'offset) freq-wnd-min))(setf (atnr-prop-wnd-srch-max-ofs prop) (+ (tsl-get-data tsl-key 'offset) freq-wnd-max)))(setf (atnr-prop-mpx-stmono prop) (svl-get-data svl-key 'stereo_mono))(setf (atnr-prop-mpx-bilingual prop) (svl-get-data svl-key 'AB))(setf (atnr-prop-mpx-sif prop) (svl-get-data svl-key 'SIF))(setf (atnr-prop-mpx-fm-first prop) fm-first)(setf (atnr-prop-mpx-judge-mode prop) mpx-mode)(setf (atnr-prop-mpx-skip-search prop) mpx-skip)(setf (atnr-prop-scan-mode prop) 0)(if (and (eq disp 0) (get-current-main-media))(main-analog-tune m-key prop)(if (and (eq disp 1) (get-current-sub-media))(sub-analog-tune m-key prop)(stand-analog-tune m-key prop)))(setf info (atnr-info atnr-in))(atnr-get 'tvp-atnr0 info)(send-detected-mpx (if (> (atnr-in-mpx-fm info) 0)(logior #x10 (atnr-in-mpx-fm info))(atnr-in-mpx-nicam info)))(unless (child-lock-p src)(unmute-media m-key))(set-tv-media m-key)(svl-save "analog-svl" svl-key)))(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-mpx-skip (skip)(setf mpx-skip skip))(defun sync-svl ()(mapcar #'(lambda (x)(let ((src) (key) (colsys) (prop) (colsys_mode))(setf src (car x))(when (and (get-signal-source-svl src) (get-signal-source-tsl src))(setf key (get-signal-source-dev src))(when (analog-media-p key)(setf prop (get-atnr-prop key))(setf (atnr-prop-tune-vmute prop) (if ch-blank 1 0))(if (eq (svl-get-data (get-signal-source-svl src) 'AFC) 0)(progn
(setf (atnr-prop-tune-type prop) "normal")(setf (atnr-prop-tune-param0-vfreq prop) (tsl-get-data (get-signal-source-tsl src) 'freq))(setf (atnr-prop-tune-param0-offset prop) (+ (tsl-get-data (get-signal-source-tsl src) 'offset)(svl-get-data (get-signal-source-svl src) 'mt_offset)))(setf (atnr-prop-wnd-srch-mode prop) 0))(setf (atnr-prop-tune-type prop) "1point-way")(setf (atnr-prop-tune-param0-vfreq prop) (tsl-get-data (get-signal-source-tsl src) 'freq))(setf (atnr-prop-tune-param0-offset prop) (tsl-get-data (get-signal-source-tsl src) 'offset))(setf freq-temp (+ (/ (* (atnr-prop-tune-param0-vfreq prop) 100) 3125)(atnr-prop-tune-param0-offset prop)))(setf freq-param-min -20)(when (and (eq is-saso t) (> (- saso-freq-min freq-temp) -20) (<= (- saso-freq-min freq-temp) 0))(setf freq-param-min (- saso-freq-min freq-temp)))(setf freq-param-max 20)(when (and (eq is-saso t) (< (- saso-freq-max freq-temp) 20) (>= (- saso-freq-max freq-temp) 0))(setf freq-param-max (- saso-freq-max freq-temp)))(setf (atnr-prop-tune-param0-min-ofs prop) (+ (tsl-get-data (get-signal-source-tsl src) 'offset) freq-param-min))(setf (atnr-prop-tune-param0-max-ofs prop) (+ (tsl-get-data (get-signal-source-tsl src) 'offset) freq-param-max))(setf (atnr-prop-wnd-srch-mode prop) 1)(setf freq-wnd-min -32)(when (and (eq is-saso t) (> (- saso-freq-min freq-temp) -32) (<= (- saso-freq-min freq-temp) 0))(setf freq-wnd-min (- saso-freq-min freq-temp)))(setf freq-wnd-max 32)(when (and (eq is-saso t) (< (- saso-freq-max freq-temp) 32) (>= (- saso-freq-max freq-temp) 0))(setf freq-wnd-max (- saso-freq-max freq-temp)))(setf (atnr-prop-wnd-srch-min-ofs prop) (+ (tsl-get-data (get-signal-source-tsl src) 'offset) freq-wnd-min))(setf (atnr-prop-wnd-srch-max-ofs prop) (+ (tsl-get-data (get-signal-source-tsl src) 'offset) freq-wnd-max)))(setf (atnr-prop-mpx-stmono prop) (svl-get-data (get-signal-source-svl src) 'stereo_mono))(setf (atnr-prop-mpx-bilingual prop) (svl-get-data (get-signal-source-svl src) 'AB))(setf (atnr-prop-mpx-sif prop) (svl-get-data (get-signal-source-svl src) 'SIF))(when (eq key tv-media)(unless (current-digital-p)(sync-atnr key)))(if (child-lock-p src)(mute-media key)(unmute-media key)))(set-sp-volume key nil
(svl-get-data (get-signal-source-svl src) 'volume_correction) nil)(set-hp-volume key nil
(svl-get-data (get-signal-source-svl src) 'volume_correction) nil)(setf colsys_mode (svl-get-data (get-signal-source-svl src) 'color_sys_mode))(setf colsys (if (eq colsys_mode 1)(svl-get-data (get-signal-source-svl src) 'color_sys)(tsl-get-data (get-signal-source-tsl src) 'last_colsys)))(set-ds-colsys key colsys_mode colsys)(set-ds-mv-det key (if (and rf-mv-detect (eq (svl-get-data (get-signal-source-svl src) 'major_channel) 0)) 1 0)))))
signal-source-list))(defun svl-update ()(sync-svl)(select-media (get-current-main-media) (get-current-sub-media) (get-current-frame-visual)))(defvar tuning-tuner 'tuner)(defun set-tuning-tuner (dev)(setf tuning-tuner dev))(defun get-tuning-tuner ()
tuning-tuner)(defun my-select-channel ()(make-event 'network-change)(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)))(register-node 'my-tuner-freq-valid
#'(lambda ()(tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key (get-tuning-tuner))))
#'(lambda (key)(set-tuning-tuner (get-signal-source-tuner 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)))(tsl-query (get-tuner-tsl-key (get-tuning-tuner)) 'ntype 'ya_nid))(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-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
(unless (find-timer 'fail-check)(recover-tsport))(make-event 'tsport-change)))))(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))(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 'network-set
#'(lambda ()(eq current-network req-network))
#'(lambda ()(unless (eq current-network req-network)(setf current-network req-network)(node-key 'network-set current-network))(eval-events (list 'network-change)))
#'(lambda ()
nil))(register-device 'stuner
"tuner"
(get-default-prio)
#'(lambda (sig)(when (get-tuner-hook 'stuner)(funcall (get-tuner-hook 'stuner) sig))(case sig
(AVAILABLE
(set-owner 'stuner t))(LOST
(set-owner 'stuner nil)))))(defvar dvb-resource-usr-lst nil)(defvar dvb-common-devices nil)(defvar dvb-common-pipe nil)(defvar dvb-common-request nil)(setf dvb-common-node 'network-set)(append-t
'network-set
'my-tuner-freq-valid
'dvb-channel
'my-tuner-connect
'my-tsport-connect
'decode-on
'psi-valid
'parse-pmt
'video-pid-valid
'video-play
'video-play-monitor)(append-nil
'my-tuner-connect
'no-signal)(append-t
'my-tuner-connect
'my-bad-signal-check
'bad-signal)(append-nil
'my-tuner-freq-valid
'no-tsl)(append-t
'decode-on
'pat-request
'tsid-check
'pmt-pid-valid
'pmt-request
'pmt-monitor)(append-nil
'tsid-check
'invalid-tsid)(append-t
'pat-request
'pat-monitor)(append-t
'parse-pmt
'audio-pid-valid
'audio-play
'audio-play-monitor)(append-t
'parse-pmt
'audio-desc-valid
'audio-desc-play
'audio-desc-volume)(append-t
'parse-pmt
'back-to-default-prio)(append-nil
'parse-pmt
'mheg-invalid)(append-t
'parse-pmt
'mhp-valid)(append-nil
'dvb-channel
'no-dvb-channel)(append-nil
'pat-request
'pat-timeout)(append-nil
'pmt-pid-valid
'no-pmt)(append-nil
'pmt-request
'pmt-timeout)(append-nil
'video-pid-valid
'no-video)(append-nil
'audio-pid-valid
'no-audio)(defun use-digital-tuner (mkey tnr no src)(init-signal-source-object src)(set-signal-source-dev src mkey)(set-digital-media mkey)(set-signal-source-no src no)(if (string= tnr "stuner")(progn
(tuner-config 'stuner tnr)(set-signal-source-tuner src 'stuner))(progn
(tuner-config 'tuner tnr)(set-signal-source-tuner src 'tuner))))(defun use-analog-tuner (mkey tnr no src)(init-signal-source-object src)(set-signal-source-no src no)(set-signal-source-dev src mkey)(case no
(0
(set-signal-source-tuner src 'tvp-atnr0)(set-analog-media mkey 'tvp-atnr0))(1
(set-signal-source-tuner src 'tvp-atnr1)(set-analog-media mkey 'tvp-atnr1))))(defun c-program-on (src disp sym arg)(if (analog-media-p (get-signal-source-dev src))(analog-program-on src disp sym (first arg) (first (second arg)) (second (second arg)))(when (eq (length arg) 6)(digital-program-on src disp sym (first arg) (second arg) (third arg) (fourth arg) (fifth arg) (sixth arg)))))(defun c-program-off (src)(cancel-timer 'fail-check)(change-priority tmp-priority)(setf dvb-resource-usr-lst (delete-if #'(lambda (x)(eq x src))
dvb-resource-usr-lst))(when (eq dvb-resource-usr-lst nil)(cancel-node dvb-common-node)(init-node dvb-common-pipe)(mapcar #'(lambda (x)(if (find x each-devs)(progn
(setf each-devs (delete x each-devs))(tvp-devlist 'tvp
common-devs
each-devs))(my-device-close x)))
dvb-common-devices)(setf dvb-common-devices nil))(set-signal-source-svl src nil)(set-signal-source-tsl src nil))(defun change-stereo-mono (sym)(setf (atnr-prop-mpx-stmono (get-atnr-prop 'analog)) sym)(sync-atnr 'analog))(defun change-bilingual (sym)(setf (atnr-prop-mpx-bilingual (get-atnr-prop 'analog)) sym)(sync-atnr 'analog))(defun change-video (pid)(let ((track) (old-track) (sync-audio))(setf track (assoc pid video-choice-list))(setf old-track (assoc (get-video-pid 'video) video-choice-list))(when (and track old-track)(unless (eq (get-video-pid 'video) pid)(setf sync-audio (if (and (eq (get-track-video-pcr old-track) (get-track-video-pcr track))(eq (get-track-video-codec old-track) (get-track-video-codec track))(not (eq (get-track-video-codec track) #x1b)))
nil
t))(setf video-transition t)(my-device-priority 'video tmp-priority)(when sync-audio
(setf audio-transition t)(my-device-priority 'audio tmp-priority)(when with-ad
(my-device-priority 'audio-desc tmp-priority)(ad-stop))(audio-stop 'audio))(set-video-pcr 'video (get-track-video-pcr track))(set-video-pid 'video pid)(when sync-audio
(audio-attr 'audio (if (eq (get-track-video-codec track) #x1b) 'avc 'mpeg2))(set-audio-pcr 'audio (get-video-pcr 'video))(set-audio-pid 'audio (get-audio-pid 'audio))(ad-play ad-pid)(unless tuning-transition
(my-device-priority 'audio (get-default-prio))(when with-ad
(my-device-priority 'audio-desc (get-default-prio))))(setf audio-transition nil))(unless tuning-transition
(my-device-priority 'video (get-default-prio)))(setf video-transition nil)))))(defun change-audio (pid dualmode)(let ((track))(setf track (find-if #'(lambda (x)(and (eq (get-track-pid x) pid)(eq (get-track-audio-dualmode x) dualmode)))
audio-choice-list))(when track
(if (eq (get-audio-pid 'audio) pid)(send-playing-audio current-network (list (get-audio-pid 'audio) (audio-channel 'audio) (if (>= dualmode 0)(audio-dualmode 'audio dualmode)
-1) (get-track-audio-lang (first audio-choice-list))))(setf audio-transition t)(my-device-priority 'audio tmp-priority)(when with-ad
(my-device-priority 'audio-desc tmp-priority))(ad-stop)(when mpeg-vol
(if (or (eq (get-track-audio-format track) #x03)(eq (get-track-audio-format track) #x04))(set-audio-volume-gain 'audio (list nil mpeg-vol))(set-audio-volume-gain 'audio (list nil 17))))(set-audio-pid 'audio pid)(setf changed-audio-track track)(audio-dualmode 'audio dualmode)(ad-play (get-track-audio-adpid track))(unless tuning-transition
(my-device-priority 'audio (get-default-prio))(when with-ad
(my-device-priority 'audio-desc (get-default-prio))))(setf audio-transition nil)))))(defun change-teletext (pid)(when (assoc pid teletext-choice-list)(set-video-vbipid 'video pid)))(defun audio-description-force-stop (t-or-nil)(setf ad-force-stop t-or-nil)(my-device-priority 'audio-desc tmp-priority)(make-event 'ad-valid-check)(my-device-priority 'audio-desc (get-default-prio)))(defun audio-description-enable (t-or-nil)(setf with-ad t)(setf ad-enable t-or-nil)(my-device-priority 'audio-desc tmp-priority)(make-event 'ad-valid-check)(my-device-priority 'audio-desc (get-default-prio))(when (eq current-network 2)(send-audio-choice-list current-network (create-audio-choice-list 'audio audio-track-list))))(defun audio-description-volume (vol)(setf with-ad t)(setf ad-vol vol)(make-event 'ad-volume-change))(defun audio-description-speaker (t-or-nil)(setf with-ad t)(setf ad-speaker t-or-nil)(make-event 'ad-output-change))(defun audio-description-earphone (t-or-nil)(setf with-ad t)(setf ad-earphone t-or-nil)(make-event 'ad-output-change))(defun set-preferred-audio (pref)(setf preferred-audio pref)(when is-nz
(set-preferred-common-lang audio-track-list subtitle-track-list))(send-audio-choice-list current-network (create-audio-choice-list 'audio audio-track-list)))(defun set-preferred-audio-format (format)(setf preferred-audio-format (case format
('mpeg
(list #x03 #x04))('he-aac
(list #x11))('ac3
(list #x81))('ac3-plus
(list #x82))(otherwise
nil)))(send-audio-choice-list current-network (create-audio-choice-list 'audio audio-track-list)))(defun set-hd-feature (on-off)(setf with-hd on-off)(make-event 'psi-update))(defun set-preferred-subtitle (pref)(let ((slist nil))(setf preferred-subtitle pref)(when is-nz
(set-preferred-common-lang audio-track-list subtitle-track-list))(when (and subtitle-track-list (assoc (get-audio-pid 'audio) audio-track-list))(mapcar #'(lambda (x)(if slist
(append-subtitle-track x slist)(setf slist (cons x nil))))
subtitle-track-list)(send-subtitle-choice-list current-network slist 0))))(defun set-preferred-teletext (pref)(let ((tlist nil))(setf preferred-teletext pref)(when teletext-track-list
(mapcar #'(lambda (x)(if tlist
(append-teletext-track x tlist)(setf tlist (cons x nil))))
teletext-track-list)(send-teletext-choice-list current-network tlist))))(defun set-mpeg-volume (vol)(let ((track))(setf mpeg-vol vol)(setf pid (get-audio-pid 'audio))(when pid
(setf dualmode (if (dual-mono-p 'audio)(audio-dualmode 'audio nil)
-1))(setf track (find-if #'(lambda (x)(and (eq (get-track-pid x) pid)(eq (get-track-audio-dualmode x) dualmode)))
audio-choice-list))(when track
(when mpeg-vol
(if (or (eq (get-track-audio-format track) #x03)(eq (get-track-audio-format track) #x04))(set-audio-volume-gain 'audio (list nil mpeg-vol))(set-audio-volume-gain 'audio (list nil 17)))))(make-event 'audio-update))))(defun set-spdif (format)(optical-output-spdif 'tvp-optout format))(defun set-unlock-file (name)(setf unlock-file name))(defun mheg-ndt (t-or-nil)(setf mheg-ndt-p t-or-nil))(defun mheg-restart ()(let ((mlist mheg-track-list) (auto-start mheg-auto-start))(send-mheg-launch current-network nil 0 nil)(send-mheg-launch current-network mlist auto-start nil)))(defun dish-setup (low high tone-en)(unless (and (eq low (nth 0 dish-param))(eq high (nth 1 dish-param))(eq tone-en (nth 2 dish-param)))(setf dish-param (list low high tone-en))(tuner-setup 'stuner
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'stuner))))(defun dish-setup-c (sat low high tone-en)(when (eq sat 0)(unless (and (eq low (nth 0 dish-param-1))(eq high (nth 1 dish-param-1))(eq tone-en (nth 2 dish-param-1)))(setf dish-param-1 (list low high tone-en))(tuner-setup 'stuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'stuner))))(when (eq sat 1)(unless (and (eq low (nth 0 dish-param-2))(eq high (nth 1 dish-param-2))(eq tone-en (nth 2 dish-param-2)))(setf dish-param-2 (list low high tone-en))(tuner-setup 'stuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'stuner))))(when (eq sat 2)(unless (and (eq low (nth 0 dish-param-3))(eq high (nth 1 dish-param-3))(eq tone-en (nth 2 dish-param-3)))(setf dish-param-3 (list low high tone-en))(tuner-setup 'stuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'stuner))))(when (eq sat 3)(unless (and (eq low (nth 0 dish-param-4))(eq high (nth 1 dish-param-4))(eq tone-en (nth 2 dish-param-4)))(setf dish-param-4 (list low high tone-en))(tuner-setup 'stuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'stuner)))))(my-device-open 'cp  nil)(init-cp-object 'cp)(defun set-media-cp (key)(let ((prop))(setf prop (media-monitorout (get-media key)))(cp-create 'cp
:psi 'psi
:input (tvp-source (mo-prop-vsrc-type prop) (mo-prop-vsrc-no prop)))(set-monout-cp key (not (cp-ref 'cp "analog-ex-video")))(when (eq key scart0-media)(setf prop (media-monitorout (get-media scart0-media)))(cp-create 'cp
:psi 'psi
:input (tvp-source (mo-prop-vsrc-type prop) (mo-prop-vsrc-no prop)))(if (not (cp-ref 'cp "analog-ex-video"))(set-cp-mute 'tvp-scart0)(set-cp-unmute 'tvp-scart0)))(when (eq key scart1-media)(setf prop (media-monitorout (get-media scart1-media)))(cp-create 'cp
:psi 'psi
:input (tvp-source (mo-prop-vsrc-type prop) (mo-prop-vsrc-no prop)))(if (not (cp-ref 'cp "analog-ex-video"))(set-cp-mute 'tvp-scart1)(set-cp-unmute 'tvp-scart1)))(when (eq key scart2-media)(setf prop (media-monitorout (get-media scart2-media)))(cp-create 'cp
:psi 'psi
:input (tvp-source (mo-prop-vsrc-type prop) (mo-prop-vsrc-no prop)))(if (not (cp-ref 'cp "analog-ex-video"))(set-cp-mute 'tvp-scart2)(set-cp-unmute 'tvp-scart2)))(setf prop (media-opticalout (get-media key)))(cp-create 'cp
:psi 'psi
:input (tvp-source (op-prop-src-type prop) (op-prop-src-no prop))
:category (cond ((eq key 'dlna)
#x44)((or (eq key 'mpegview) (eq key 'jpegview))
#x08)(t
category))
:hdmirx 'hdmirx)(set-optout-cp key (not (cp-ref 'cp "digital-audio")))(cp-set 'cp prop)))(set-cp-hook 'cp #'(lambda (sig)(when (get-current-main-media)(set-media-cp (get-current-main-media))(sync-monitorout (get-current-main-media))(sync-opticalout (get-current-main-media))(sync-scart0 (get-current-main-media))(sync-scart1 (get-current-main-media))(sync-scart2 (get-current-main-media)))(when (get-current-sub-media)(set-media-cp (get-current-sub-media))(sync-monitorout (get-current-sub-media))(sync-opticalout (get-current-sub-media))(sync-scart0 (get-current-sub-media))(sync-scart1 (get-current-sub-media))(sync-scart2 (get-current-sub-media)))))(register-device 'hdmirx
"hdmirx"
(get-default-prio)
#'(lambda (sig)(case sig
(HDMI_CP_UPDATE
(when (get-current-main-media)(set-media-cp (get-current-main-media))(sync-monitorout (get-current-main-media))(sync-opticalout (get-current-main-media))(sync-scart0 (get-current-main-media))(sync-scart1 (get-current-main-media))(sync-scart2 (get-current-main-media)))(when (get-current-sub-media)(set-media-cp (get-current-sub-media))(sync-monitorout (get-current-sub-media))(sync-opticalout (get-current-sub-media))(sync-scart0 (get-current-sub-media))(sync-scart1 (get-current-sub-media))(sync-scart2 (get-current-sub-media)))))))(my-device-open 'hdmirx nil)(add-select-media-hook #'(lambda (new-main new-sub new-frame)(when new-main
(set-media-cp new-main))(when new-sub
(set-media-cp new-sub))))(register-device 'tvp
"tvp"
(get-default-prio)
#'(lambda (sig)(case sig
((DEVICE_AVAILABLE AVAILABLE)(when pre-emphasis
(set-pre-emphasis pre-emphasis))(sync-svl)(select-media (get-current-main-media) (get-current-sub-media) (get-current-frame-visual))))))(register-device 'tvp-ds-main
"display"
(get-default-prio)
#'(lambda (sig)))(register-device 'tvp-ds-sub
"display-sub"
(get-default-prio)
#'(lambda (sig)))(register-device 'tvp-sp
"speaker"
(get-default-prio)
#'(lambda (sig)))(register-device 'tvp-hp0
"headphone0"
(get-default-prio)
#'(lambda (sig)))(register-device 'tvp-hp1
"headphone1"
(get-default-prio)
#'(lambda (sig)))(register-device 'tvp-monout
"monitorout"
(get-default-prio)
#'(lambda (sig)))(register-device 'tvp-scart0
"scart0"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(sync-scart0 scart0-media)))))(register-device 'tvp-scart1
"scart1"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(sync-scart1 scart1-media)))))(register-device 'tvp-scart2
"scart2"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(sync-scart2 scart2-media)))))(register-device 'tvp-optout
"optical-output"
(get-default-prio)
#'(lambda (sig)))(defvar atnr0-lost nil)(register-device 'tvp-atnr0
"atnr0"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(when atnr0-lost
(let ((tmp ch-blank))(setf ch-blank nil)(sync-svl)(setf ch-blank tmp))(select-media (get-current-main-media) (get-current-sub-media) (get-current-frame-visual))))(LOST
(setf atnr0-lost t))(TUNER_CONTROLABLE
(unless (current-digital-p)(sync-atnr (get-signal-source-dev
(car (find-if #'(lambda (x)(eq 'tvp-atnr0 (get-signal-source-tuner (car x))))
signal-source-list))))))(TUNER_DETECT_MPX
(setf info (atnr-info atnr-in))(atnr-get 'tvp-atnr0 info)(send-detected-mpx (if (> (atnr-in-mpx-fm info) 0)(logior #x10 (atnr-in-mpx-fm info))(atnr-in-mpx-nicam info)))))))(register-device 'tvp-atnr1
"atnr1"
(get-default-prio)
#'(lambda (sig)))(defvar common-devs nil)(defvar each-devs nil)(defun use-tvp ()(set-tvp 'tvp)(set-main-ds 'tvp-ds-main)(set-main-sp 'tvp-sp)(set-main-hp 'tvp-hp0)(set-main-monout 'tvp-monout)(set-main-optout 'tvp-optout)(config-sp-sync-mode)(config-hp-sync-mode)(config-aout-sync-mode)(config-opt-sync-mode)(setf common-devs (list 'tvp-ds-main 'tvp-sp 'tvp-hp0 'tvp-monout 'tvp-optout))(device-open 'tvp nil)(tvp-devlist 'tvp
common-devs
each-devs))(defun use-sub-display ()(set-sub-ds 'tvp-ds-sub)(if common-devs
(setf-cdr (last common-devs) (cons 'tvp-ds-sub nil))(setf common-devs (list 'tvp-ds-sub)))(tvp-devlist 'tvp
common-devs
each-devs))(defun use-scart0 ()(set-scart0 'tvp-scart0)(if each-devs
(setf-cdr (last each-devs) (cons 'tvp-scart0 nil))(setf each-devs (list 'tvp-scart0)))(tvp-devlist 'tvp
common-devs
each-devs))(defun use-scart1 ()(set-scart1 'tvp-scart1)(if each-devs
(setf-cdr (last each-devs) (cons 'tvp-scart1 nil))(setf each-devs (list 'tvp-scart1)))(tvp-devlist 'tvp
common-devs
each-devs))(defun use-scart2 ()(set-scart2 'tvp-scart2)(if each-devs
(setf-cdr (last each-devs) (cons 'tvp-scart2 nil))(setf each-devs (list 'tvp-scart2)))(tvp-devlist 'tvp
common-devs
each-devs))(use-tvp)(use-sub-display)(use-scart0)(use-scart1)(use-scart2)(new-media 'all)(defun set-input-property (m-key c-mode color-sys sync)(when m-key
(when c-mode
(when color-sys
(set-ds-colsys m-key c-mode color-sys)))(set-ds-mv-det m-key 1)(when sync
(sync-display m-key))))(defun video-mute-on (disp)(if (eq disp 1)(mute-sub-ds)(mute-main-ds)))(defun video-mute-off (disp)(if (eq disp 1)(unmute-sub-ds)(unmute-main-ds)))(defun audio-mute-on (type)(if (eq type 1)(mute-main-hp)(mute-main-sp)))(defun audio-mute-off (type)(if (eq type 1)(unmute-main-hp)(unmute-main-sp)))(defun set-speaker-volume (rate balance)(set-sp-volume 'all rate nil balance)(sync-speaker 'all))(defun set-speaker-correct (m-key correct)(when m-key
(set-sp-volume m-key nil correct nil)(set-hp-volume m-key nil correct nil)(sync-speaker m-key)(sync-headphone m-key)))(defun set-speaker-sound (m-key lst)(set-sp-sound-menu m-key (nth 0 lst))(set-sp-bass m-key (nth 1 lst))(set-sp-treble m-key (nth 2 lst))(set-sp-surround-preset m-key (nth 3 lst))(set-sp-equalizer m-key (nth 4 lst))(set-sp-bbe m-key (nth 5 lst) (nth 6 lst))(set-sp-ai-sound m-key (nth 7 lst))(set-sp-srs-surround m-key (nth 8 lst))(set-sp-bassboost m-key (nth 9 lst))(set-sp-bass-attack m-key (nth 10 lst))(sync-speaker m-key))(defun set-earphone-volume (rate balance)(set-hp-volume 'all rate nil balance)(sync-headphone 'all))(defvar pre-emphasis nil)(defun set-pre-emphasis (flg)(setf pre-emphasis flg)(if (eq flg 1)(soundout-pre-emphasis-on 'tvp-sp)(soundout-pre-emphasis-off 'tvp-sp)))(setf monitorout-source-list (list
(list 1 'monitorout)(list 2 'av1)(list 3 'av2)(list 4 'av3)(list 5 'av4)))(defun select-monitorout-by-no (no)(second (assoc no monitorout-source-list)))(defun connect-monitorout (device)(if (eq (select-monitorout-by-no device) 'monitorout)(unmute-main-monout)(if (eq (select-monitorout-by-no device) 'av1)(unmute-scart0)(if (eq (select-monitorout-by-no device) 'av2)(unmute-scart1)(unmute-scart2)))))(defun disconnect-monitorout (device)(if (eq (select-monitorout-by-no device) 'monitorout)(mute-main-monout)(if (eq (select-monitorout-by-no device) 'av1)(mute-scart0)(if (eq (select-monitorout-by-no device) 'av2)(mute-scart1)(mute-scart2)))))(defun connect-opticalout ()(unmute-main-optout))(defun disconnect-opticalout ()(mute-main-optout))(defun set-ec-mode (key ec-mode)(let ((prop))(setf prop (media-display (get-media key)))(setf (ds-prop-src-ec-mode prop) ec-mode)))(defvar *freq-list* nil)(defvar freq-pos 0)(defvar freq-len 0)(defvar scan-active 0)(defvar search-last-freq 0)(defvar search-last-bw 0)(defun terr-digital-scan-freq-list (freq last-freq last-bw)(setf *freq-list* freq)(setf freq-pos 0)(setf search-last-freq last-freq)(setf search-last-bw last-bw)(setf freq-len (length *freq-list*))(if (> freq-len 0)(progn
(setf scan-active 1)(scan freq-pos))))(defun scan (pos)(setf my-freq (nth pos *freq-list*))(if (> my-freq 470000)(setf my-bw 0)(setf my-bw 1))(tuner-search (get-tuning-tuner)
:freq my-freq
:band-width my-bw))
