(load "/usr/local/slisp/station.lsp")(defvar decode-p t)(defvar tuning-transition nil)(defvar audio-transition nil)(defvar open-sesami nil)(defvar ch-blank t)(defvar fm-first 0)(defvar category #x0c)(defvar invalid-dvb-channel-status nil)(defvar bad-signal-status nil)(defvar no-signal-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 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 audio-choice-list nil)(defvar subtitle-choice-list nil)(defvar teletext-choice-list nil)(defvar mheg-track-list nil)(defvar scramble-p nil)(defvar preferred-audio nil)(defvar preferred-subtitle nil)(defvar preferred-teletext nil)(defvar with-ac3 nil)(defvar with-ac3-plus nil)(defvar with-hd nil)(defvar with-ad nil)(defvar with-freesat nil)(defvar with-dvb-s-cont nil)(defvar preferred-audio-format nil)(defvar mpeg-vol nil)(defvar unlock-file nil)(defvar ad-pid -1)(defvar ad-qlink nil)(defvar av-prio 200)(defvar av-tmp-prio av-prio)(defvar qlink-src nil)(defvar qlink-select nil)(defvar direct-tv-rec nil)(defvar dish-param-list (list nil nil nil nil))(set-pat-monitor-period 60000)(set-pmt-monitor-period 60000)(defun enter-tuning-transition ()(unless tuning-transition
(setf tuning-transition t)(my-device-priority 'video av-tmp-prio)(my-device-priority 'audio av-tmp-prio)(when (device-open-p 'audio-desc)(my-device-priority 'audio-desc av-tmp-prio))(set-timer #'(lambda ()(setf tuning-transition nil)(my-device-priority 'video av-prio)(my-device-priority 'audio av-prio)(when (device-open-p 'audio-desc)(my-device-priority 'audio-desc av-prio))(make-event 'exit-tuning-transition))
'tuning-timeout
nil
1
3000)))(defun send-invalid-dvb-channel (status)(unless (eq invalid-dvb-channel-status status)(when (boundp 'msg-invalid-dvb-channel)(write-bytes msg-fd msg-invalid-dvb-channel 4 (if status 1 0)))(setf invalid-dvb-channel-status status)))(defun send-bad-signal (status)(unless (eq bad-signal-status status)(when (boundp 'msg-bad-signal)(write-bytes msg-fd msg-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 'msg-no-signal)(write-bytes msg-fd msg-no-signal 4 (if status 1 0)))(setf no-signal-status status)))(defun send-no-service (key status)(unless (eq no-service-status status)(when (boundp 'msg-no-service)(write-bytes msg-fd msg-no-service 4 (if status 1 0)))(setf no-service-status status)))(defun send-encrypted (status)(unless (eq encrypted-status status)(when (boundp 'msg-encrypted)(write-bytes msg-fd msg-encrypted 4 (if status 1 0)))(setf encrypted-status status)))(defun send-video-encrypted (status)(setf video-encrypted status)(send-encrypted (if (or video-encrypted audio-encrypted) t nil)))(defun send-audio-encrypted (status)(setf audio-encrypted status)(send-encrypted (if (or video-encrypted audio-encrypted) t nil)))(defun send-playing-video (info)(unless (equal playing-video info)(when (boundp 'msg-playing-video)(write-bytes msg-fd msg-playing-video 4 (if info info -1)))(setf playing-video info)))(defun send-playing-audio (info)(unless (equal playing-audio info)(when (boundp 'msg-playing-audio)(write-bytes msg-fd msg-playing-audio 12 (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))(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)(when (boundp 'msg-mpx)(write-bytes msg-fd msg-mpx 4 mpx))(setf detected-mpx mpx))))(defmacro dual-mono-p (sym)
`(and (device-open-p ,sym) (eq (audio-channel ,sym) 7)))(defmacro get-track-pid (track)
`(first ,track))(defmacro get-track-tag (track)
`(second ,track))(defmacro get-track-video-codec (track)
`(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 get-track-audio-adpid (track)
`(fifth (third ,track)))(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)(if (member format preferred)
0
(if (and with-ac3-plus (eq format #x82))
1
(if (and with-hd (eq format #x11))
2
(if (and with-ac3 (eq format #x81))
3
4)))))(defmacro ad-by-multiaudio-p (track)
`(and (string= "NAR" (get-track-audio-lang ,track))(eq 0 (get-track-audio-type ,track))))(defun append-audio-track (track lst)(when (or (not audio-choice-num) (< (length lst) audio-choice-num))(let ((pos nil))(if (and with-ad (eq (get-tuning-tuner) 'stuner) (ad-by-multiaudio-p track))(progn
(if ad-qlink
(setf pos 0)(setf pos nil)))(setf pos (position-if #'(lambda (x)(or (and with-ad (not ad-qlink) (ad-by-multiaudio-p 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 append-subtitle-track (track lst)(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 create-audio-choice-list (sym alist)(let ((new-list nil) (dual-pid 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)))(setf track (copy-audio-track x))(set-track-audio-dualmode track 0)(if new-list
(append-audio-track track new-list)(setf new-list (cons track nil)))(setf track (copy-audio-track x))(set-track-audio-dualmode track 1)(append-audio-track track new-list)(setf track (copy-audio-track x))(set-track-audio-dualmode track 2)(append-audio-track track new-list)))
alist)
new-list))(defun send-audio-choice-list (lst)(unless (equal audio-choice-list lst)(when (boundp 'msg-audio)(if lst
(write-bytes msg-fd msg-audio (* (length lst) 28) lst)(write-bytes msg-fd msg-audio 0)))(setf audio-choice-list lst)))(defun send-subtitle-choice-list (lst)(unless (equal subtitle-choice-list lst)(when (boundp 'msg-subtitle)(if lst
(write-bytes msg-fd msg-subtitle (* (length lst) 24) lst)(write-bytes msg-fd msg-subtitle 0)))(setf subtitle-choice-list lst)))(defun send-teletext-choice-list (lst)(unless (equal teletext-choice-list lst)(when (boundp 'msg-teletext)(if lst
(write-bytes msg-fd msg-teletext (* (length lst) 24) lst)(write-bytes msg-fd msg-teletext 0)))(setf teletext-choice-list lst)))(defun send-mheg-launch (lst)(when (boundp 'msg-mheg)(unless (equal mheg-track-list lst)(if (and mheg-track-list lst)(progn
(write-bytes msg-fd msg-mheg 4 0)(write-bytes msg-fd msg-mheg 4 1))(write-bytes msg-fd msg-mheg 4 (if lst 1 0)))(setf mheg-track-list lst))))(defun child-lock-p (key)(and (eq (svl-get-data (get-signal-source-svl key) 'child_lock) 1)(not open-sesami)))(defun tv-service-p (key)(eq (svl-get-data (get-signal-source-svl key) 'stype) 1))(defun with-dvb-sat-p ()(or with-freesat with-dvb-s-cont))(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))))(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)(if (or (not pmt) (not (get-signal-source-svl key)) (child-lock-p key))(progn
(send-audio-choice-list nil)(send-subtitle-choice-list nil)(send-teletext-choice-list nil)(send-mheg-launch nil)(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 nil)(vlist nil) (alist nil) (slist nil) (tlist nil) (mlist nil) (calist nil) (ad-list nil))(setf scramble-p nil)(setf header (first pmt))(setf firstlp (second pmt))(setf secondlp (third pmt))(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)(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
(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)))((#x56 #x59 #x66 #x6a #x7a)(setf info-desc desc)))))
esdesclp)(case stype
((#x01 #x02 #x1b)(unless (and (eq stype #x1b) (not with-hd))(setf track (list espid tag stype))(if vlist
(setf-cdr (last vlist) (cons track nil))(setf vlist (cons track nil)))))((#x03 #x04 #x0f #x11 #x81)(unless (or (and (eq stype #x11) (not with-hd))(and (eq stype #x81) (not with-ac3)))(setf track (list espid tag (list stype lang type -1 -1)))(if (and with-ad (eq type 3) (or (eq stype #x03) (eq stype #x04)))(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))))))(#x06
(when info-desc
(case (first info-desc)(#x6a
(when with-ac3
(setf track (list espid tag (list #x81 lang type -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)))))(#x7a
(when with-ac3-plus
(setf track (list espid tag (list #x82 lang type -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)(eq (nth 4 info-desc) #x01)(eq (nth 5 info-desc) #x01))(setf auto-start t))(setf track (list espid 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)(setf track (assoc (get-video-pid 'video) vlist))(unless track
(setf track (car vlist)))(when (and (eq pcrpid #x1fff) (> (length vlist) 1))(set-video-pcr 'video (get-track-pid 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)(string= (get-track-audio-lang x) (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))(setf track (assoc (get-audio-pid 'audio) alist))(unless track
(ad-stop)(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 'audio mpeg-vol)(set-audio-volume 'audio 100)))(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))))(send-audio-choice-list (create-audio-choice-list 'audio alist))(send-subtitle-choice-list slist)(send-teletext-choice-list tlist)(send-mheg-launch mlist))))(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 ()(and ad-qlink (>= ad-pid 0) (eq (get-tuning-tuner) 'tuner)))
#'(lambda ()(when with-ad
(when (eq (mo-prop-asrc-type qlink-prop) 0)(tvp-load 'tvp)(setf (mo-prop-asrc-no qlink-prop) (if (and ad-qlink (>= ad-pid 0)) 1 0))(monitorout-set qlink-select qlink-prop)(tvp-sync 'tvp))(audio-unmute 'audio))(eval-events (list 'ad-valid-check)))
#'(lambda ()(when with-ad
(audio-mute 'audio))))(register-node 'audio-desc-play
#'(lambda ()
t)
#'(lambda ()(audio-play 'audio-desc
:psi 'psi
:pcr (get-audio-pcr 'audio)
:pid ad-pid))
#'(lambda ()(audio-stop 'audio-desc)))(register-node 'decode-on
#'(lambda ()
decode-p)
#'(lambda ()(eval-events (list 'decode-on 'decode-off)))
#'(lambda ()
nil))(register-node 'dvb-channel
#'(lambda ()(<= (tsl-get-data (get-tuning-tsl-key) 'ntype) 3))
#'(lambda ())
#'(lambda ()))(register-node 'no-dvb-channel
#'(lambda ()
t)
#'(lambda ()(send-invalid-dvb-channel t))
#'(lambda ()(send-invalid-dvb-channel nil)))(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)))(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 'pat-timeout
#'(lambda ()
t)
#'(lambda (key)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key t))(eval-events (list 'exit-tuning-transition)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(register-node 'no-pmt
#'(lambda ()
t)
#'(lambda (key)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key t))(eval-events (list 'exit-tuning-transition)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(register-node 'pmt-timeout
#'(lambda ()
t)
#'(lambda (key)(when (and (not tuning-transition) (get-signal-source-svl key))(send-no-service key t))(eval-events (list 'exit-tuning-transition)))
#'(lambda (key)(send-no-service key nil)(enter-tuning-transition)))(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 #x1fff)))
#'(lambda ()(send-playing-video nil)))(register-node 'no-audio
#'(lambda ()
t)
#'(lambda (key)(when (tv-or-radio-service-p key)(send-playing-audio (list #x1fff -1 -1))))
#'(lambda ()(send-playing-audio nil)))(register-node 'back-to-default-prio
#'(lambda ()
t)
#'(lambda (key)(unless (get-video-result 'video)(video-unmute 'video))(my-device-priority 'video av-prio)(my-device-priority 'audio av-prio)(when (device-open-p 'audio-desc)(my-device-priority 'audio-desc av-prio))(eval-events (list 'tmp-finish)))
#'(lambda ()))(defun decode-on ()(setf decode-p t)(make-event 'decode-on))(defun decode-off ()(setf decode-p nil)(make-event 'decode-off))(defvar need-send-available nil)(register-node 'dvb-available
#'(lambda ()
t)
#'(lambda (key)(when need-send-available
(enter-tuning-transition)(write-bytes msg-pipe 1 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)))(cp-create 'cp
:input qlink-src)(tvp-load 'tvp)(unless (cp-ref 'cp "analog-ex-video")(monitorout-mute qlink-select))(setf (mo-prop-asrc-no qlink-prop) (if (and with-ad (audio-status 'audio-desc)) 1 0))(monitorout-set qlink-select qlink-prop)(when (cp-ref 'cp "analog-ex-video")(monitorout-unmute qlink-select))(tvp-sync 'tvp)(eval-events 'new-reserve))
#'(lambda ()(setf need-send-available t)(cancel-timer 'tuning-timeout)(setf tuning-transition nil)))(defun digital-program-on (src sym onid l-tsid svcid phys-ch prio)(monitor-stop)(setf tuning-transition nil)(setf need-send-available nil)(let ((svl-key) (tsl-key) (dev) (dish-param))(setf svl-key (svl-create-key sym
:onid onid
:tsid l-tsid
:svcid svcid
:physical_ch phys-ch))(svl-query svl-key 'stype 'child_lock)(setf tsl-key (svl-create-key "TSL"
:physical_ch phys-ch
:onid onid
:tsid l-tsid))(tsl-query tsl-key 'ntype 'ya_nid)(set-signal-source-svl src svl-key)(set-signal-source-tsl src tsl-key)(set-signal-source-request src svl-key)(set-tuning-tsl-key tsl-key)(set-tuning-tsid l-tsid)(set-tuning-svcid svcid)(if (get-signal-source-devices src)(progn
(enter-tuning-transition)(my-select-channel)(make-event 'new-reserve))(device-priority 'video av-tmp-prio)(my-device-open 'video 0)(device-priority 'audio av-tmp-prio)(my-device-open 'audio 0)(when with-ad
(device-priority 'audio-desc av-tmp-prio)(my-device-open 'audio-desc 1))(device-priority 'psi prio)(my-device-open 'psi 0)(if (device-open-p 'tsport)(my-device-priority 'tsport prio)(device-priority 'tsport prio)(my-device-open 'tsport 0))(if (device-open-p (get-signal-source-tuner src))(my-device-priority (get-signal-source-tuner src) prio)(device-priority (get-signal-source-tuner src) prio)(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)(if (device-open-p 'stuner)(my-device-priority 'stuner prio)(device-priority 'stuner prio)(my-device-open 'stuner 1)(init-tuner-object 'stuner)(do ((i 0 (1+ i)))((>= i 4))(when (nth i dish-param-list)(setf dish-param (nth i dish-param-list))(tuner-setup 'stuner
:satellite i
:dish-low (nth 0 dish-param)
:dish-high (nth 1 dish-param)
:dish-tone-en (nth 2 dish-param))))))(init-section-object 'pat)(init-section-object 'pmt)(init-psi-object 'psi #'pmt-parser)(init-video-object 'video)(init-audio-object 'audio)(if (with-dvb-sat-p)(progn
(if with-ad
(set-signal-source-devices src (list 'tuner 'stuner 'video 'audio 'audio-desc 'psi 'tsport))(set-signal-source-devices src (list 'tuner 'stuner 'video 'audio 'psi 'tsport)))(resource-node 'dvb-pipe (list 'tuner 'stuner 'psi 'tsport)))(if with-ad
(set-signal-source-devices src (list (get-signal-source-tuner src) 'video 'audio 'audio-desc 'psi 'tsport))(set-signal-source-devices src (list (get-signal-source-tuner src) 'video 'audio 'psi 'tsport)))(resource-node 'dvb-pipe (list (get-signal-source-tuner src) 'psi 'tsport)))(setf tvp-resource (tvp-devlist 'tvp tvp-devs nil))(node-key 'dvb-pipe src)(append-t
'dvb-pipe
'tvp-available
(get-signal-source-node src))(set-signal-source-pipe src 'dvb-pipe)(set-tuning-tuner (which-tuner (get-tuning-tsl-key)))(eval-node (get-signal-source-pipe src)))(unless need-send-available
1)))(register-node 'analog-available
#'(lambda ()
t)
#'(lambda (key)(let ((dev) (prop))(tvp-load 'tvp)(when (child-lock-p key)(monitorout-mute qlink-select))(monitorout-set qlink-select qlink-prop)(unless direct-tv-rec
(setf prop (atnr-property atnr-prop))(setf (atnr-prop-tune-vmute prop) (if ch-blank 1 0))(setf (atnr-prop-tune-type prop) "normal")(setf (atnr-prop-tune-param0-vfreq prop) (tsl-get-data (get-signal-source-tsl key) 'freq))(setf (atnr-prop-tune-param0-offset prop) (+ (tsl-get-data (get-signal-source-tsl key) 'offset)(svl-get-data (get-signal-source-svl key) 'mt_offset)))(setf (atnr-prop-wnd-srch-mode prop) 0)(setf (atnr-prop-mpx-stmono prop) (svl-get-data (get-signal-source-svl key) 'stereo_mono))(setf (atnr-prop-mpx-bilingual prop) (svl-get-data (get-signal-source-svl key) 'AB))(setf (atnr-prop-mpx-sif prop) (svl-get-data (get-signal-source-svl key) 'SIF))(setf (atnr-prop-mpx-fm-first prop) fm-first)(setf (atnr-prop-mpx-judge-mode prop) 0)(setf (atnr-prop-scan-mode prop) 0)(atnr-set (get-signal-source-tuner key) prop))(unless (child-lock-p key)(monitorout-unmute qlink-select))(tvp-sync 'tvp))(when need-send-available
(write-bytes msg-pipe 1 0)(setf need-send-available nil))(eval-events (list 'new-reserve)))
#'(lambda ()(setf need-send-available t)))(defun analog-program-on (src sym pos nicam prio)(setf need-send-available nil)(when nicam
(setf fm-first (if (eq nicam 0) 1 0)))(let ((svl-key) (tsl-key))(setf svl-key (svl-create-key sym
:major_channel pos))(svl-query svl-key 'physical_ch 'offset '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 'offset)(set-signal-source-svl src svl-key)(set-signal-source-tsl src tsl-key)(set-signal-source-request src svl-key)(if (find (get-signal-source-tuner src) tvp-devs)(progn
(make-event (list (get-signal-source-tuner src) 'request))(make-event 'new-reserve))(setf tvp-devs (cons (get-signal-source-tuner src) tvp-devs))(setf tvp-resource (tvp-devlist 'tvp tvp-devs nil))(append-t
'tvp-available
(get-signal-source-node src))(set-signal-source-pipe src 'tvp-available)(eval-node (get-signal-source-pipe src)))(unless need-send-available
1)))(defun ch-blank-on ()(setf ch-blank t))(defun ch-blank-off ()(setf ch-blank nil))(defun set-rf-mv-detect (t-or-nil))(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 (and (or with-freesat with-dvb-s-cont)(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)))(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 'tuner-controlable
#'(lambda ()(tuner-controlable (get-tuning-tuner)))
#'(lambda ()(eval-events (list (list 'tuner-controlable (get-tuning-tuner)))))
#'(lambda ()))(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))(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))(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))(defun use-digital-tuner (src no)(set-signal-source-dev src 'digital)(tuner-config 'tuner "ttuner")(set-signal-source-no src no)(set-signal-source-tuner src 'tuner)(register-device 'tuner
"tuner"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tuner nil))(AVAILABLE
(set-owner 'tuner t)(monitor-start))(TUNER_LOCK
(make-event (list 'tuner-lock 'tuner)))(TUNER_UNLOCK
(make-event (list 'tuner-unlock 'tuner)))(TUNER_DISCONNECT
(make-event (list 'tuner-disconnect 'tuner)))(TUNER_CONTROLABLE
(make-event (list 'tuner-controlable 'tuner)))(PROPERTY_CHANGE
(monitor-start)))))(register-device 'tsport
"tsport"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tsport nil))(AVAILABLE
(set-owner 'tsport t)(monitor-start))(SOURCE_CHANGE
(monitor-start)))))(tuner-config 'tuner "ttuner")(when (with-dvb-sat-p)(register-device 'stuner
"tuner"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(set-owner 'stuner t)(monitor-start))(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
(monitor-start)))))(tuner-config 'stuner "stuner"))(tsport-config 'tsport (list "FE_IN1" "FE_IN2"))(append-t
'dvb-available
'my-tuner-freq-valid
'tuner-controlable
'dvb-channel
'my-tuner-connect
'my-tsport-connect
'decode-on
'psi-valid
'parse-pmt
'video-pid-valid
'video-play
'video-play-monitor)(when with-freesat
(append-t
'my-tsport-connect
'monitor-on
'f-pat-request
'f-pmt-pid-valid
'f-pmt-request))(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-t
'pat-request
'pat-monitor)(append-t
'parse-pmt
'audio-pid-valid
'audio-play)(append-t
'parse-pmt
'audio-desc-valid
'audio-desc-play)(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)(node-key 'dvb-available src)(set-signal-source-node src 'dvb-available))(defun use-analog-tuner (src no)(set-signal-source-no src no)(case no
(0
(set-signal-source-tuner src 'tvp-atnr0)(node-key 'analog-available src)(set-signal-source-node src 'analog-available))))(setf tvp-resource 'LOST)(setf tvp-devs nil)(register-device 'tvp
"tvp"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(setf tvp-resource sig)(make-event 'tvp-change-owner))(LOST
(setf tvp-resource sig)(make-event 'tvp-change-owner))(DEVICE_AVAILABLE
(make-event 'new-reserve)))))(register-device 'tvp-atnr0
"atnr0"
(get-default-prio)
#'(lambda (sig)(case sig
)))(register-node 'tvp-available
#'(lambda ()(eq tvp-resource 'AVAILABLE))
#'(lambda ()(eval-events (list 'tvp-change-owner)))
#'(lambda ()))(setf qlink-prop (monitorout-property mo-prop))(setf (mo-prop-asrc-sync-mode qlink-prop) 0)(setf (mo-prop-vsrc-sync-mode qlink-prop) 0)(setf (mo-prop-amute qlink-prop) 0)(setf (mo-prop-vmute qlink-prop) 0)(defun monitorout-set-src (type no)(setf (mo-prop-asrc-type qlink-prop) type)(setf (mo-prop-asrc-no qlink-prop) no)(setf (mo-prop-vsrc-type qlink-prop) type)(setf (mo-prop-vsrc-no qlink-prop) no)(setf qlink-src (tvp-source type no)))(defun c-input-on-for-direct-tv-rec (qlink pri)(device-open 'tvp nil)(c-program-off-inner 'digital)(c-program-off-inner 'analog)(setf tvp-devs (list qlink))(setf qlink-select qlink)(device-priority 'tvp pri)(tvp-devlist 'tvp tvp-devs nil)(tvp-load 'tvp)(monitorout-set qlink qlink-prop)(when (tvp-sync 'tvp)
1))(defun c-program-on (sym arg qlink prio nicam-first)(device-open 'tvp nil)(setf tvp-devs (cons qlink (delete qlink-select tvp-devs)))(setf qlink-select qlink)(device-priority 'tvp prio)(setf av-tmp-prio prio)(setf direct-tv-rec nil)(if (and (string= sym "ANALOG") (eq (length arg) 1))(progn
(c-program-off-inner 'digital)(analog-program-on 'analog sym (first arg) nicam-first prio))(when (eq (length arg) 4)(c-program-off-inner 'analog)(digital-program-on 'digital sym (first arg) (second arg) (third arg) (fourth arg) prio))))(defun c-program-on-for-direct-tv-rec (sym qlink prio)(let ((svl-key))(device-open 'tvp nil)(setf tvp-devs (cons qlink (delete qlink-select tvp-devs)))(setf qlink-select qlink)(device-priority 'tvp prio)(setf av-tmp-prio av-prio)(setf direct-tv-rec t)(if (string= sym "ANALOG")(progn
(c-program-off-inner 'digital)(setf svl-key (svl-load "analog-svl"))(let ((tmp ch-blank))(setf ch-blank nil)(analog-program-on 'analog sym (svl-get-data svl-key 'major_channel) nil prio)(setf ch-blank tmp)))(c-program-off-inner 'analog)(setf svl-key (svl-load "digital-svl"))(digital-program-on 'digital sym (svl-get-data svl-key 'onid) (svl-get-data svl-key 'tsid) (svl-get-data svl-key 'svcid) prio))))(defun c-program-off-inner (src)(when (get-signal-source-devices src)(mapcar #'(lambda (x)(device-priority x (if (and monitor-prio (monitor-p) (find x monitor-devices)) monitor-prio 40)))(get-signal-source-devices src)))(setf tuning-transition t)(cancel-node (get-signal-source-node src))(setf tuning-transition nil)(append-t 'tvp-available nil)(init-node (get-signal-source-pipe src))(when (get-signal-source-devices src)(mapcar #'(lambda (x)(unless (and (monitor-p) (find x monitor-devices))(my-device-close x)))(get-signal-source-devices src)))(when (find (get-signal-source-tuner src) tvp-devs)(setf tvp-devs (delete (get-signal-source-tuner src) tvp-devs))(tvp-devlist 'tvp tvp-devs nil))(set-signal-source-devices src nil)(set-signal-source-svl src nil)(set-signal-source-tsl src nil)(set-signal-source-request src nil)(when (eq src 'digital)(monitor-start)))(defun c-program-off ()(c-program-off-inner 'digital)(c-program-off-inner 'analog)(device-close 'tvp)(setf tvp-devs nil))(defun set-preferred-audio (pref)(setf preferred-audio pref)(send-audio-choice-list (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 (create-audio-choice-list 'audio audio-track-list)))(defun set-hd-feature (on-off)(setf with-hd on-off)(make-event 'psi-update))(my-device-open 'cp  nil)(init-cp-object 'cp)(set-cp-hook 'cp #'(lambda (sig)(when (and qlink-src (device-open-p qlink-select))(cp-create 'cp
:input qlink-src)(if (cp-ref 'cp "analog-ex-video")(monitorout-unmute qlink-select)(monitorout-mute qlink-select)))))(defun set-open-sesami (on-off)(setf open-sesami (if (eq on-off 0) nil t))(my-select-channel)(make-event 'new-reserve))(defun ad-enable (t-or-nil)(setf with-ad t)(setf ad-qlink t-or-nil)(make-event 'ad-valid-check))(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)(tuner-setup 'stuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlock 'stuner))))))(defun use-scart0-device (sym)(register-device sym
"scart0"
(get-default-prio)
#'(lambda (sig dev)(case sig
(AVAILABLE
(set-owner dev t))(LOST
(set-owner dev nil))))))(defun use-scart1-device (sym)(register-device sym
"scart1"
(get-default-prio)
#'(lambda (sig dev)(case sig
(AVAILABLE
(set-owner dev t))(LOST
(set-owner dev nil))))))(defun use-scart2-device (sym)(register-device sym
"scart2"
(get-default-prio)
#'(lambda (sig dev)(case sig
(AVAILABLE
(set-owner dev t))(LOST
(set-owner dev nil))))))(defvar monitor-devices (if (with-dvb-sat-p) (list 'tuner 'stuner 'tsport) (list 'tuner 'tsport)))(defvar monitor-node nil)(defvar monitor-svl nil)(defvar monitor-tsl nil)(defvar monitor-prio nil)(defmacro monitor-p ()
`(and monitor-svl monitor-tsl))(defun monitor-start ()(when (monitor-p)(unless (get-signal-source-devices 'digital)(let ((avail t))(mapcar #'(lambda (x) (setf avail (and avail (owner-p x)))) monitor-devices)(if avail
(set-tuning-tsl-key monitor-tsl)(if (and (with-dvb-sat-p) (device-source-p 'tsport 'stuner))(set-tuning-tsl-key (tuner-tsl-key 'stuner))(set-tuning-tsl-key (tuner-tsl-key 'tuner)))))(unless monitor-node
(append-t 'my-tsport-connect nil)(when with-freesat
(append-t 'my-tsport-connect 'monitor-on))(setf monitor-node 'my-tuner-freq-valid))(eval-node monitor-node))(make-event 'monitor-req)))(defun monitor-request (prio sym onid tsid svcid)(setf monitor-svl (svl-create-key sym
:onid onid
:tsid tsid
:svcid svcid))(svl-query svl-key 'physical_ch)(setf monitor-tsl (svl-create-key "TSL"
:physical_ch (svl-get-data monitor-svl 'physical_ch)
:onid onid
:tsid tsid))(unless (eq monitor-prio prio)(setf monitor-prio prio)(unless (get-signal-source-devices 'digital)(if (device-open-p 'tuner)(my-device-priority 'tuner monitor-prio)(device-priority 'tuner monitor-prio)(my-device-open 'tuner 0)(init-tuner-object 'tuner))(when with-freesat
(if (device-open-p 'stuner)(my-device-priority 'stuner monitor-prio)(device-priority 'stuner monitor-prio)(my-device-open 'stuner 1)(init-tuner-object 'stuner)))(if (device-open-p 'tsport)(my-device-priority 'tsport monitor-prio)(device-priority 'tsport monitor-prio)(my-device-open 'tsport 0))))(monitor-start))(defun monitor-stop ()(when monitor-node
(cancel-node monitor-node)(append-t 'my-tsport-connect 'decode-on)(setf monitor-node nil)(setf monitor-prio nil)(mapcar #'(lambda (x) (my-device-close x)) monitor-devices)))(defun monitor-cancel ()(when (monitor-p)(setf pfeit-pp-pid nil)(setf monitor-svl nil)(setf monitor-tsl nil)(make-event 'monitor-req)(monitor-stop)))(when with-freesat
(defvar f-pmt-list nil)(defvar f-pmt-svcid nil)(defvar f-pmt-pid nil)(defvar pfeit-pp-pid nil)(register-section 'f-pat
#'(lambda (data)(let ((ptr) (svcid nil) (pid nil))(setf f-pmt-list nil)(mapcar #'(lambda (sec)(setf ptr (nthcdr 8 sec))(do ((x 8 (+ x 4)))((> x (length sec)))(setf svcid (+ (* (first ptr) #x100) (second ptr)))(unless (eq svcid 0)(setf pid (+ (* (logand (third ptr) #x1F) #x100) (fourth ptr)))(if (and (tsl-equal monitor-tsl (get-tuning-tsl-key))(eq (svl-get-data monitor-svl 'svcid) svcid))(setf f-pmt-list (cons (list svcid pid) f-pmt-list))(if f-pmt-list
(unless (assoc svcid f-pmt-list)(setf-cdr (last f-pmt-list) (cons (list svcid pid) nil)))(setf f-pmt-list (cons (list svcid pid) nil)))))(setf ptr (nthcdr 4 ptr))))
data)(setf f-pmt-svcid (first (nth 0 f-pmt-list)))(setf f-pmt-pid (second (nth 0 f-pmt-list)))(set-section-valid 'f-pat t)(make-event 'f-pat-valid)(make-event 'f-pmt-req))))(register-section 'f-pmt
#'(lambda (data)(let ((ptr) (len) (stype) (espid) (tag nil) (pid nil) (private))(mapcar #'(lambda (sec)(setf ptr (nthcdr 12 sec))(setf len (+ (* (logand (nth 10 sec) #xF) #x100) (nth 11 sec)))(setf private nil)(do ((x 0))((>= x len))(case (car ptr)(#x5F
(when (and (eq (nth 1 ptr) 4)(eq (nth 2 ptr) #x46)(eq (nth 3 ptr) #x53)(eq (nth 4 ptr) #x41)(eq (nth 5 ptr) #x54))(setf private t)))(#xD0
(do ((y 0))((or (>= y (nth 1 ptr)) tag))(when (eq (nth (+ 2 y) ptr) 2)(setf tag (nth (+ 3 y) ptr)))(setf y (+ y 2))))(otherwise
))(setf x (+ x 2 (nth 1 ptr)))(setf ptr (nthcdr (+ 2 (nth 1 ptr)) ptr)))(unless private
(setf tag nil))(do ((z 0))((or (>= 4 (length ptr)) pid))(setf stype (nth 0 ptr))(setf espid (+ (* (logand (nth 1 ptr) #x1F) #x100) (nth 2 ptr)))(setf len (+ (* (logand (nth 3 ptr) #xF) #x100) (nth 4 ptr)))(setf ptr (nthcdr 5 ptr))(if (not (eq stype 5))(setf ptr (nthcdr len ptr))(setf private nil)(do ((x 0))((or (>= x len) (and private pid)))(case (car ptr)(#x5F
(when (and (eq (nth 1 ptr) 4)(eq (nth 2 ptr) #x46)(eq (nth 3 ptr) #x53)(eq (nth 4 ptr) #x41)(eq (nth 5 ptr) #x54))(setf private t)))(#xD1
(unless tag
(do ((y 0))((or (>= y (nth 1 ptr)) pid))(when (eq (nth (+ 2 y) ptr) 2)(setf pid espid))(setf y (+ y 1)))))(#x52
(when (and tag (eq tag (nth 2 ptr)))(setf pid espid)(setf private t)))(otherwise))(setf x (+ x 2 (nth 1 ptr)))(setf ptr (nthcdr (+ 2 (nth 1 ptr)) ptr)))(unless private
(setf pid nil)))))
data)(when (and pid (not (eq pid pfeit-pp-pid)))(setf pfeit-pp-pid pid)(write-bytes msg-pipe 20 4 pfeit-pp-pid)))(set-section-valid 'f-pmt t)))(init-section-object 'f-pat)(set-section-pid 'f-pat 0)(setf (nth 0 (get-section-filter 'f-pat)) 0)(setf (nth 0 (get-section-mask 'f-pat)) 0)(init-section-object 'f-pmt)(setf (nth 0 (get-section-filter 'f-pmt)) 2)(setf (nth 0 (get-section-mask 'f-pmt)) 2)(register-node 'monitor-on
#'(lambda ()(and (monitor-p)(eq (get-tuning-tuner) 'stuner)(eq (tsl-get-data (get-tuning-tsl-key) 'ya_nid) #x3b)))
#'(lambda ()(eval-events (list 'monitor-req)))
#'(lambda ()))(register-node 'f-pat-request
#'(lambda ()(get-section-valid 'f-pat))
#'(lambda ()(unless (get-section-valid 'f-pat)(section-open 'f-pat)(section-disable 'f-pat)(section-filter 'f-pat
:type "version"
:source 'tsport
:pid (get-section-pid 'f-pat)
:length (get-section-length 'f-pat)
:filter (get-section-filter 'f-pat)
:mask (get-section-mask 'f-pat)
:elength (get-section-elength 'f-pat)
:efilter (get-section-efilter 'f-pat)
:emask (get-section-emask 'f-pat))(section-enable 'f-pat))(eval-events (list 'f-pat-valid)))
#'(lambda ()(section-close 'f-pat)(set-section-valid 'f-pat nil)))(register-node 'f-pmt-pid-valid
#'(lambda ()(and f-pmt-pid f-pmt-svcid
(eq f-pmt-pid (get-section-pid 'f-pmt))(eq (/ f-pmt-svcid #x100) (nth 3 (get-section-filter 'f-pmt)))(eq (logand f-pmt-svcid #xFF) (nth 4 (get-section-filter 'f-pmt)))))
#'(lambda ()(when f-pmt-pid
(set-section-pid 'f-pmt f-pmt-pid))(when f-pmt-svcid
(setf (nth 3 (get-section-filter 'f-pmt)) (/ f-pmt-svcid #x100))(setf (nth 3 (get-section-mask 'f-pmt)) 0)(setf (nth 4 (get-section-filter 'f-pmt)) (logand f-pmt-svcid #xFF))(setf (nth 4 (get-section-mask 'f-pmt)) 0))(eval-events (list 'f-pmt-req)))
#'(lambda ()(setf f-pmt-pid nil)(setf f-pmt-svcid nil)))(register-node 'f-pmt-request
#'(lambda ()(get-section-valid 'f-pmt))
#'(lambda ()(unless (get-section-valid 'f-pmt)(section-open 'f-pmt)(section-disable 'f-pmt)(section-filter 'f-pmt
:type "version"
:source 'tsport
:pid (get-section-pid 'f-pmt)
:length (get-section-length 'f-pmt)
:filter (get-section-filter 'f-pmt)
:mask (get-section-mask 'f-pmt)
:elength (get-section-elength 'f-pmt)
:efilter (get-section-efilter 'f-pmt)
:emask (get-section-emask 'f-pmt))(section-enable 'f-pmt)(set-timer #'(lambda (arg)(if (get-section-valid 'f-pmt)(progn
(set-section-valid 'f-pmt nil)(make-event 'f-pmt-valid))(let ((pair))(setf pair (cadr (member-if #'(lambda (x)(and (eq (first x) f-pmt-svcid)(eq (second x) f-pmt-pid)))
f-pmt-list)))(unless pair
(setf pair (nth 0 f-pmt-list)))(setf f-pmt-svcid (first pair))(setf f-pmt-pid (second pair))(make-event 'f-pmt-req))))
'f-pmt-monitor
nil
1
5000))(eval-events (list 'f-pmt-valid)))
#'(lambda ()(cancel-timer 'f-pmt-monitor)(section-close 'f-pmt)(set-section-valid 'f-pmt nil))))(new-signal-source 'digital)(new-signal-source 'analog)(use-digital-tuner 'digital 0)(use-analog-tuner 'analog 0)
