(load "/usr/local/slisp/station.lsp")(load "/usr/local/slisp/pal/option-menu.lsp")(when with-usb-hdd-rec
(load "/usr/local/slisp/pal/recording.lsp"))(defun my-debug-print (lis)(if (eq my-tuner 1)(debug-print (list "[RSV SUB  TUNER] " lis))(debug-print (list "[RSV MAIN TUNER]" lis)))(debug-print ""))(defvar force-tsport nil)(defvar wait-tsport-ci1 nil)(defvar wait-tsport-ci2 nil)(defvar request-pcr nil)(defvar my-tuner nil)(defvar record-mode 0)(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-copy-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 video-decode-status nil)(defvar detected-mpx nil)(defvar video-mon-updated nil)(defvar rsv-video-pid nil)(defvar rsv-video-pcr nil)(defvar rsv-video-key nil)(defvar last-video-pid -1)(defvar last-audio-pid -1)(defvar last-sttl-pid -1)(defvar video-choice-num 0)(defvar audio-choice-num 0)(defvar subtitle-choice-num 0)(defvar teletext-choice-num 0)(defvar audio-track-list nil)(defvar subtitle-track-list nil)(defvar subtitle-track-num 0)(defvar teletext-track-list nil)(defvar teletext-track-num 0)(defvar teletext-sttl-choice-num 0)(defvar teletext-sttl-choice-list 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 scramble-p nil)(defvar preferred-audio nil)(defvar preferred-subtitle nil)(defvar preferred-subtitle-type 0)(defvar preferred-teletext nil)(defvar preferred-common-lang nil)(defvar preferred-audio-type nil)(defvar is-aus nil)(defvar is-uk nil)(defvar is-nz nil)(defvar is-china nil)(defvar is-hk nil)(defvar is-asia nil)(defvar is-cont nil)(defvar is-nordic nil)(defvar is-hungary nil)(defvar is-finland nil)(defvar is-france nil)(defvar is-brazil nil)(defvar with-ttx-sttl nil)(defvar with-dvb-sttl t)(defvar with-last-sttl nil)(defvar use-ttx-sttl-digital nil)(defvar with-sort-sttl-list nil)(defvar with-ac3 nil)(defvar with-ac3-plus nil)(defvar with-hd nil)(defvar with-hevc nil)(defvar with-ad nil)(defvar with-freesat nil)(defvar with-dvb-s-cont nil)(defvar with-usb-hdd-rec nil)(defvar with-latin-parental nil)(defvar with-si-copy-control nil)(defvar with-dlna-dms nil)(defvar use-new-tsport nil)(defvar preferred-audio-format nil)(defvar preferred-audio-format-list nil)(defvar unlock-file nil)(defvar use-sad nil)(defvar use-transcode nil)(defvar current-network nil)(defvar ad-pid -1)(defvar ad-enable nil)(defvar is-obfuscate-svc nil)(defvar umt-version 0)(defvar reserved-prio 0)(defvar av-prio 200)(defvar direct-tv-rec nil)(defvar dish-param-list (list nil nil nil nil))(defvar dish-band-control-param nil)(defvar STTL_NONE_PREF -1)(defvar STTL_DVB_PREF 0)(defvar STTL_TELETEXT_PREF 1)(defvar PREFERRED_TYPE 0)(defvar INFERIOR_TYPE 1)(defvar EEP_SUBT_TYPE_NORMAL 0)(defvar EEP_SUBT_TYPE_IMPAIRED 1)(defvar dvb-sttl-msg 0)(defvar vbi-sttl-msg 0)(defvar subt-reset -1)(defvar subt-pid -1)(defvar subt-lang "")(defvar subt-pid-ttx -1)(defvar selected-subt STTL_NONE_PREF)(defvar pmt-parsed nil)(defvar pmt-parental-age 0)(defvar pmt-country-parental-code "---")(defvar old-pmt-parental-age 0)(defvar pmt-rec-ctrl-data nil)(defvar eit-rec-ctrl-data nil)(defvar sdt-rec-ctrl-data nil)(defvar eemi-mode nil)(defvar scramble-system-ciplus nil)(defvar record-pause nil)(defvar cur-calist nil)(defvar old-calist nil)(defvar calist-max 8)(defvar calist-vpid nil)(defvar calist-apid nil)(defvar use-ci-try-and-error nil)(defvar last-ci-slot-no 0)(defvar tsport-ci-switch-done nil)(defvar wait-stream-open nil)(defvar shunning-status nil)(defvar sdt-evt-received nil)(defvar sdt-inited nil)(defvar shunning-on t)(defvar with-tsport-ci1 nil)(defvar with-tsport-ci2 nil)(defvar with-satip nil)(defvar dvb-over-ip-pid-list nil)(defvar tmp-over-ip-pid-list nil)(defvar tuner-pids nil)(defun use-tsport-ci1 ()(my-device-priority 'tsport-ci1 reserved-prio)(setf with-tsport-ci1 t))(defun unuse-tsport-ci1 ()(my-device-priority 'tsport-ci1 1)(setf with-tsport-ci1 nil))(defun use-tsport-ci2 ()(my-device-priority 'tsport-ci2 reserved-prio)(setf with-tsport-ci2 t))(defun unuse-tsport-ci2 ()(my-device-priority 'tsport-ci2 1)(setf with-tsport-ci2 nil))(set-pat-monitor-period 60000)(set-pmt-monitor-period 60000)(defvar decode-result-ok nil)(register-node 'stream-scramble-check
#'(lambda ()(and (use-decode-for-scramble-check)(not decode-result-ok)))
#'(lambda ()(eval-events 'scramble-check-update))
#'(lambda ()(setf stream-scramble-check nil)))(register-node 'my-video-pid-valid
#'(lambda ()
rsv-video-pid)
#'(lambda ()(eval-events (list 'video-pid-invalid 'video-pid-valid)))
#'(lambda ()))(register-node 'my-video-play
#'(lambda ()(get-video-result 'video))
#'(lambda ()(unless (device-open-p 'video)(my-device-priority 'video reserved-prio)(if (eq my-tuner 1)(video-config 'video :use "RECORD2" :hint 0)(video-config 'video :use "RECORD1" :hint 0))(my-device-open 'video (list (video-openquery :error t)))(init-video-object 'video)(my-device-priority 'audio reserved-prio)(my-device-open 'audio (device-id 'video)))(set-video-pcr 'video rsv-video-pcr)(set-video-play-info 'video (svl-key-string (get-signal-source-svl rsv-video-key) 'onid 'tsid 'svcid 'physical_sh))(set-video-pid 'video rsv-video-pid)(video-play 'video
:psi 'psi
:pcr (get-video-pcr 'video)
:codec (get-video-codec 'video)
:pid (get-video-pid 'video)
:ext (get-video-ext 'video)
:info (get-video-play-info 'video))(set-video-result 'video (video-status 'video))(eval-events (list 'video-update 'video-result-fix 'video-available)))
#'(lambda ()(when (device-open-p 'video)(video-stop 'video)(setf rsv-video-pid nil)(set-video-pid 'video nil)(set-video-result 'video nil)(my-device-close 'video))(when (device-open-p 'audio)(my-device-close 'audio))))(register-node 'video-play-monitor
#'(lambda ()(eq (get-video-result 'video) 'DECODE_SUCCESS))
#'(lambda (key)(when (eq (get-video-result 'video) 'DECODE_SUCCESS)(video-stop 'video)(set-video-pid 'video nil)(setf rsv-video-pid nil)(set-video-result 'video nil)(my-device-close 'video)(when (device-open-p 'audio)(my-device-close 'audio))(cancel-timer 'stream-scramble-fix-timer)(setf decode-result-ok t)(make-event 'scramble-check-update)))
#'(lambda (key)))(register-device 'video
"video"
(get-default-prio)
#'(lambda (sig)(when (get-video-hook 'video)(funcall (get-video-hook 'video) sig))(case sig
(LOST
(set-owner 'video nil)(make-event 'video-lost))(AVAILABLE
(set-owner 'video t)(make-event 'video-available))(SOURCE_CHANGE
(make-event 'video-source-change))(DEVICE_BUSY
(make-event 'video-busy))(DECODE_SUCCESS
(send-video-decode-status SC_VIDEO_DECODE_STATUS_SUCCESS)(set-video-pid 'video nil)(setf rsv-video-pid nil)(set-video-result 'video nil)(cancel-timer 'stream-scramble-fix-timer)(setf decode-result-ok t)(make-event 'scramble-check-update)(make-event 'video-update))((DECODE_ERROR DECODE_SCRAMBLE)(if (eq sig 'DECODE_ERROR)(send-video-decode-status SC_VIDEO_DECODE_STATUS_ERROR)(send-video-decode-status SC_VIDEO_DECODE_STATUS_SCRAMBLE))(if (not (get-video-result 'video))(make-event 'video-result-fix)(set-video-result 'video (video-status 'video))(make-event 'video-update))))))(register-device 'audio
"audio"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'audio nil)(make-event 'audio-lost))(AVAILABLE
(set-owner 'audio t)(make-event 'audio-available))(SOURCE_CHANGE
(make-event 'audio-source-change))(INFO_CHANGE
(make-event 'audio-channel-change))((DECODE_SUCCESS DECODE_ERROR DECODE_SCRAMBLE)(if (not (get-audio-result 'audio))(make-event 'audio-result-fix)(set-audio-result 'audio (audio-status 'audio))(audio-property 'audio #'(lambda (pid)(unless (eq (get-audio-pid 'audio) pid)(set-audio-pid 'audio pid))))(make-event 'audio-result-update))))))(defun use-decode-for-scramble-check ()(and use-ci-try-and-error
scramble-p
(eq (ca-status 'ca-sub) 'CA_SESSION_OPEN)))(register-node 'stream-open-cond
#'(lambda ()(or (not (use-decode-for-scramble-check))
decode-result-ok
(and tsport-ci-switch-done
(not wait-stream-open))))
#'(lambda ()(eval-events (list 'scramble-check-update 'tsport-ci-switch 'delayed-stream-open)))
#'(lambda ()))(register-node 'delay-stream-open
#'(lambda ()
t)
#'(lambda ()(when (and tsport-ci-switch-done
wait-stream-open)(set-timer #'(lambda ()(setf wait-stream-open nil)(make-event 'delayed-stream-open))
'delay-stream-open-timer
nil
1
10000)))
#'(lambda ()(when (find-timer 'delay-stream-open-timer)(setf wait-stream-open nil)(cancel-timer 'delay-stream-open-timer))))(register-node 'stream-scramble-fix
#'(lambda ()(and use-ci-try-and-error stream-scramble-fixed))
#'(lambda ()(cancel-timer 'stream-scramble-fix-timer)(if (and with-dual-ci (ciplus-is-auth-running 'ca))(setf stream-scramble-fix-timeout 30000)(unless stream-scramble-fixed
(set-timer #'(lambda ()(when (and scramble-p
(not (eq (get-video-result 'video) 'DECODE_SUCCESS)))(setf stream-scramble-fixed t)(make-event 'stream-scramble-fixed))(when (device-open-p 'video)(video-stop 'video)(setf rsv-video-pid nil)(set-video-pid 'video nil)(set-video-result 'video nil)(my-device-close 'video))(when (device-open-p 'audio)(my-device-close 'audio)))
'stream-scramble-fix-timer
nil
1
stream-scramble-fix-timeout)))(eval-events (list 'stream-scramble-fixed 'ciplus-cam-status)))
#'(lambda ()(setf stream-scramble-fix-timeout 10000)(setf stream-scramble-fixed nil)(cancel-timer 'stream-scramble-fix-timer)))(register-node 'tsport-ci-switch
#'(lambda ()
t)
#'(lambda ()(when (and (eq (ca-status 'ca-sub) 'CA_SESSION_OPEN)(not tsport-ci-switch-done))(ca-select-slot (- 1 last-ci-slot-no))(setf tsport-ci-switch-done t)(setf wait-stream-open t)(make-event 'tsport-ci-switch))(eval-events (list 'ca-sub-session-open 'ciplus-cam-status)))
#'(lambda ()))(register-node 'tsport-ci-recover
#'(lambda ()
use-ci-try-and-error)
#'(lambda ()(when with-dual-ci
(when (or (eq (get-tsport-ci-dev) 'tsport-ci1)(eq (get-tsport-ci-dev) 'tsport-ci2))(if (and use-ci-try-and-error
(eq (ca-status 'ca-sub) 'CA_SESSION_OPEN))(progn
(let (failed-tsport-dev)(setf failed-tsport-dev (get-tsport-ci-dev))(when (and (eq failed-tsport-dev 'tsport-ci1)(device-open-p 'tsport-ci1))(tsport-disconnect 'tsport-ci1)(tsport-connect 'tsport-ci1 'tsport-ci1)(setf wait-tsport-ci1 t))(when (and (eq failed-tsport-dev 'tsport-ci2)(device-open-p 'tsport-ci2))(tsport-disconnect 'tsport-ci2)(tsport-connect 'tsport-ci2 'tsport-ci2)(setf wait-tsport-ci2 t)))(ca-select-slot (- 1 last-ci-slot-no))(setf tsport-ci-switch-done t)(make-event 'tsport-ci-switch))(progn
(when (device-open-p 'tsport-ci1)(tsport-disconnect 'tsport-ci1))(when (device-open-p 'tsport-ci2)(tsport-disconnect 'tsport-ci2))(if (eq (get-tsport-ci-dev) 'tsport-ci2)(tsport-connect 'tsport-ci2 'tsport-ci2)(tsport-connect 'tsport-ci1 'tsport-ci1))(setf force-tsport t)(make-event 'tsport-ci-switch)))))(eval-events (list 'ca-sub-session-open 'ciplus-shunning-updated 'ciplus-cam-status)))
#'(lambda ()))(defun set-eit-rec-ctrl-data (data)(setf eit-rec-ctrl-data data)(when (and request-pids (not pmt-rec-ctrl-data))(eval-partial-stream)))(defun set-sdt-rec-ctrl-data (data)(setf sdt-rec-ctrl-data data)(when (and request-pids (not pmt-rec-ctrl-data) (not eit-rec-ctrl-data))(eval-partial-stream)))(defun enter-tuning-transition ()(unless tuning-transition
(setf tuning-transition t)(set-timer #'(lambda ()(setf tuning-transition nil)(make-event 'exit-tuning-transition))
'tuning-timeout
nil
1
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-copy (status)(unless (eq no-copy-status status)(when (boundp 'SC_RES_NO_COPY)(write-bytes msg-pipe SC_RES_NO_COPY 4 (if status 1 0)))(setf no-copy-status status)))(defun send-eemi (eemi)(unless (eq eemi-mode eemi)(when (boundp 'SC_RES_EEMI)(write-bytes msg-pipe SC_RES_EEMI 4 (if eemi eemi 0)))(setf eemi-mode eemi)))(defun send-scramble-system-ciplus (system)(unless (eq scramble-system-ciplus system)(when (boundp 'SC_RES_SCRAMBLE_SYSTEM_CIPLUS)(write-bytes msg-pipe SC_RES_SCRAMBLE_SYSTEM_CIPLUS 4 (if system system 0)))(setf scramble-system-ciplus system)))(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-video-decode-status (status)(unless (eq video-decode-status status)(setf video-decode-status status)(when video-decode-status
(write-bytes msg-pipe SC_RES_VIDEO_DECODE_STATUS 4 video-decode-status))))(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))))(defun send-pmt-parsing (done)(unless (equal pmt-parsed done)(write-bytes msg-pipe SC_RES_PMT_PARSING 4 (if done 1 0))(setf pmt-parsed done)))(defun send-over-ip-req-pids (pids)(unless (equal tmp-over-ip-pid-list pids)(setf tmp-over-ip-pid-list pids)(if (> (length pids) 0)(write-bytes msg-pipe SC_RES_OVER_IP_REQ_PIDS (* 4 (length pids)) pids)(write-bytes msg-pipe SC_RES_OVER_IP_REQ_PIDS 4 -1))))(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-video-level (track)
`(fourth ,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)))(defmacro get-track-audio-sad-found (track)
`(first (fourth ,track)))(defmacro get-track-audio-sad-lang-present (track)
`(second (fourth ,track)))(defmacro get-track-audio-sad-lang (track)
`(third (fourth ,track)))(defmacro get-track-audio-sad-lang-if-avail (track)
`(if (and use-sad
(eq 1 (get-track-audio-sad-found ,track))(eq 1 (get-track-audio-sad-lang-present ,track)))(get-track-audio-sad-lang ,track)(get-track-audio-lang ,track)))(defmacro transcode-p ()
`(and use-transcode (> record-mode 0)))(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 get-codec-priority (codec level)(if (eq codec #x24)
-1
(if (eq codec #x1b)(+ 1 level)
0)))(defvar video-choice-num 10)(defun append-video-track (track lst)(when (or (= video-choice-num 0) (< (length lst) video-choice-num))(let ((pos nil))(setf pos (position-if #'(lambda (x)(> (get-codec-priority (get-track-video-codec track) (get-track-video-level track))(get-codec-priority (get-track-video-codec x) (get-track-video-level x))))
lst))(if (not pos)(setf-cdr (last lst) (cons track nil))(progn
(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 append-over-ip-pid (pid)(when (and (eq current-network SC_TV_OVER_IP)
pid
(not (find pid dvb-over-ip-pid-list)))(if dvb-over-ip-pid-list
(setf-cdr (last dvb-over-ip-pid-list) (cons pid nil))(setf dvb-over-ip-pid-list (cons pid nil))))
dvb-over-ip-pid-list)(defun delete-over-ip-pid (pid)(when (and (eq current-network SC_TV_OVER_IP)
pid
(find pid dvb-over-ip-pid-list))(if (= (car dvb-over-ip-pid-list) pid)(setf dvb-over-ip-pid-list (cdr dvb-over-ip-pid-list))(delete pid dvb-over-ip-pid-list)))
dvb-over-ip-pid-list)(defun send-video-choice-list (lst)(unless (equal video-choice-list lst)(when with-dlna-dms
(if lst
(write-bytes msg-pipe SC_RES_VIDEO (* (length lst) 20) lst)(write-bytes msg-pipe SC_RES_VIDEO 0)))(setf video-choice-list lst)))(defun send-audio-choice-list (lst)(unless (equal audio-choice-list lst)(when with-dlna-dms
(if lst
(write-bytes msg-pipe SC_RES_AUDIO (* (length lst) 28) lst)(write-bytes msg-pipe SC_RES_AUDIO 0)))(setf audio-choice-list lst)))(defun send-subtitle-choice-list (lst)(setf subtitle-choice-list lst))(defun send-teletext-choice-list (lst)(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)))(register-device 'cp-out
"cp"
(get-default-prio)
#'(lambda (sig)(case sig
(INFO_CHANGE
(eval-partial-stream)))))(register-device 'ca
"ca"
(get-default-prio)
#'(lambda (sig)(case sig
(CA_CIPLUS_CAM_STATUS
(when (ca-set-ciplus-cam-status 'ca)(write-bytes msg-pipe SC_RES_CIPLUS_CAM_STATUS 0)(make-event 'ciplus-cam-status)))(CA_SESSION_OPEN
(set-ca-session 'ca t)(make-event 'ca-session-open)(make-event 'ca-update))(CA_SESSION_CLOSE
(set-ca-session 'ca nil)(make-event 'ca-session-close))(CA_MODULE_EXTRACT
(make-event 'ca-module-extract)))))(register-device 'ca-sub
"ca"
(get-default-prio)
#'(lambda (sig)(case sig
(CA_SESSION_OPEN
(set-ca-session 'ca-sub t)(make-event 'ca-sub-session-open))(CA_SESSION_CLOSE
(set-ca-session 'ca-sub nil)))))(defvar content-management nil)(defun set-content-management (val)(unless (eq content-management val)(setf content-management val)(when request-pids
(eval-partial-stream))))(defun get-partial-eemi (cp-sym)(cp-ref-pid-e-emi cp-sym nil))(defun eval-partial-stream ()(let ((pids nil) (emi) (e-emi)(content-emi nil) (video nil) (vtype nil) (audio nil) (atype nil) (track nil) (cc-parental nil))(when (eq (cp-create 'cp-out
:psi 'psi
:ca 'ca
:src 'tuner
:dst 'stream-out
:info 1
:type 1
:request 1
:content-management content-management)
t)(cp-set 'cp-out 'partial)(mapcar #'(lambda (z)(if with-si-copy-control
(progn
(setf emi (if pmt-rec-ctrl-data
pmt-rec-ctrl-data
(if eit-rec-ctrl-data
eit-rec-ctrl-data
(if sdt-rec-ctrl-data
sdt-rec-ctrl-data
0)))))(setf emi (cp-ref-pid 'cp-out (car z))))(setf cc-parental (cp-ref-cc-parental 'cp-out))(if (or (eq cc-parental t) (not emi) (eq emi 3) (and (or (not content-management) (< content-management 0)) (eq emi 1)) )
nil
(setf content-emi (if (or (eq content-emi 3) (eq emi 3) (eq cc-parental t))
3
(if (or (eq content-emi 2) (eq emi 2))
2
(if (or (eq content-emi 1) (eq emi 1))
1
0))))(when (and (not video) (eq (second z) 'video))(setf video (first z)))(setf track (car audio-track-list))(when (and (not audio)(eq (first z) (get-track-pid track))(eq (second z) 'audio))(setf audio (first z)))(if pids
(setf-cdr (last pids) (cons (car z) nil))(setf pids (cons (car z) nil)))))
request-pids)(when (and (not request-pids) (not content-emi))(setf content-emi 0))(setf e-emi (get-partial-eemi 'cp-out))(send-eemi e-emi)(when (and scramble-p (or force-tsport wait-tsport-ci1 wait-tsport-ci2))(setf video nil)(setf audio nil))(unless (and video audio)(setf pids nil))(when (and use-transcode (> record-mode 0) pids)(let ((new-pids nil) (track nil) (sttl-pid nil))(setf new-pids (cons video nil))(when (and (> last-audio-pid -1)(find-if #'(lambda (pid) (eq last-audio-pid pid)) pids))(setf audio last-audio-pid))(setf-cdr (last new-pids) (cons audio nil))(when (and (> last-sttl-pid -1)(find-if #'(lambda (pid) (eq last-sttl-pid pid)) pids))(setf sttl-pid last-sttl-pid))(unless sttl-pid
(if (and subtitle-choice-list
(/= subt-pid -1)(= selected-subt STTL_DVB_PREF))(progn
(setf sttl-pid subt-pid))(if (and teletext-sttl-choice-list
(/= subt-pid-ttx -1)(= selected-subt STTL_TELETEXT_PREF))(progn
(setf sttl-pid subt-pid-ttx)))))(set-transcode-audio 'transcode audio)(set-transcode-pes 'transcode sttl-pid)(when sttl-pid
(setf-cdr (last new-pids) (cons sttl-pid nil)))(setf pids new-pids)))(when (and is-obfuscate-svc
(equal (tsl-get-data (get-tuning-tsl-key) 'ntype 'ya_nid) '(1 #x3b)))(let* ((svl-key (svl-create-key "SVL"
:onid (tsl-get-data (get-tuning-tsl-key) 'onid)
:tsid (tsl-get-data (get-tuning-tsl-key) 'tsid)
:svcid (get-tuning-svcid)
:physical_ch (tsl-get-data (get-tuning-tsl-key) 'physical_ch)))(svc-type (svl-get-data svl-key 'stype)))(if (find svc-type (list #x16 #x19))(progn
(setf vtype #x1b)(setf atype #x81))(if (find svc-type (list #x01 #x02 #x0c))(progn
(setf vtype #x02)(setf atype #x03))))))(when (transcode-p)(case record-mode
((1 3)(set-transcode-encmode 'transcode 0))((2 4)(set-transcode-encmode 'transcode 1))(otherwise
))(section-open 'pmt-enc)(section-filter 'pmt-enc
:type "version"
:source 1
:pid (get-section-pid 'pmt)
:length (get-section-length 'pmt)
:filter (get-section-filter 'pmt)
:mask (get-section-mask 'pmt)
:elength (get-section-elength 'pmt)
:efilter (get-section-efilter 'pmt)
:emask (get-section-emask 'pmt))(section-read-data 'pmt-enc 'pmt)(psi-validate 'psi-enc 'pmt-enc)(set-encode-pcr request-pcr)(set-encode-vtype vtype)(set-encode-video-pid video)(set-encode-audio-pid audio))(request-partial request-pcr video vtype audio atype content-emi (cp-ref-dtcp 'cp-out) pids (transcode-p)))))(defun hdd-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))))(when with-dlna-dms
(send-pmt-parsing nil))(setf rsv-video-pid nil)(setf rsv-video-pcr nil)(setf rsv-video-key nil)(setf subt-pid -1)(setf subt-pid-ttx -1)(setf dvb-sttl-msg 0)(setf vbi-sttl-msg 0)(setf audio-track-list nil)(send-teletext-choice-list nil)(send-subtitle-choice-list nil)(setf subtitle-track-list nil)(setf teletext-track-list nil)(setf teletext-sttl-choice-list nil)(setf subtitle-track-num 0)(setf teletext-sttl-choice-num 0)(setf pmt-parental-age 0)(setf pmt-parental-country-code "---")(setf pmt-rec-ctrl-data nil)(setf request-pcr nil)(setf cur-calist nil)(setf cur-sttl-pid -1)(setf calist-vpid nil)(setf calist-apid nil)(setf scramble-p nil)(if (or (not pmt) (not (get-signal-source-svl key)))(progn
(send-no-copy nil)(send-video-choice-list nil)(send-audio-choice-list nil)(set-eit-for-sit-filter nil nil nil)(set-sdt-for-sit-filter nil nil nil)(set-video-pid 'video-mon nil)(setf rsv-video-pid nil)(setf rsv-video-pcr nil)(setf rsv-video-key nil)(set-video-pid 'video nil)(when (transcode-p)(set-encode-video-pid nil)(psi-invalidate 'psi-enc)(section-close 'pmt-enc))(cancel-partial))(let ((header) (firstlp) (secondlp) (esheader) (esdesclp) (pcrpid)(stype) (service) (espid) (tag) (track) (lang) (type) (info-desc) (auto-start nil)(vlist nil) (slist nil) (tlist nil) (mlist nil) (calist nil) (ad-list nil) (level-idc) (ca-pid nil))(setf header (first pmt))(setf firstlp (second pmt))(setf secondlp (third pmt))(setf request-pcr (+ (* (logand (nth 8 header) #x1F) #x100)(nth 9 header)))(setf request-pids nil)(setf level-idc 0)(unless (equal (tsl-get-data (get-tuning-tsl-key) 'ntype 'ya_nid) '(1 #x3b))(set-eit-for-sit-filter #x12 #x4e (get-tuning-svcid))(set-sdt-for-sit-filter #x11 #x42 (get-tuning-tsid)))(mapcar #'(lambda (desc)(when (eq (+ 2 (second desc)) (length desc))(case (first desc)(#x09
(setf ca-pid (+ (* (logand (nth 4 desc) #x1F) #x100) (nth 5 desc)))(append-over-ip-pid ca-pid)(setf scramble-p t))(#x55
(when with-latin-parental
(detect-rating-country-code "BRA" (nth 1 desc) (nthcdr 2 desc))))(#xC1
(when with-si-copy-control
(setf pmt-rec-ctrl-data (logand (/ (third desc) 64) #x03)))))))
firstlp)(when with-latin-parental
(send-pmt-parental pmt-parental-age pmt-parental-country-code))(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 service nil)(mapcar #'(lambda (desc)(when (eq (+ 2 (second desc)) (length desc))(case (first desc)(#x09
(setf ca-pid (+ (* (logand (nth 4 desc) #x1F) #x100) (nth 5 desc)))(append-over-ip-pid ca-pid)(setf scramble-p t))(#x28
(when (eq stype #x1b)(setf level-idc (fifth desc))))(#x38
(when (eq stype #x24)(setf level-idc (nth 13 desc))(unless level-idc
(setf level-idc 0))))(#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)))((#x52 #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 level-idc request-pcr))(if vlist
(append-video-track track vlist)(setf vlist (cons track nil)))))((#x24)(when with-hevc
(setf track (list espid tag stype level-idc request-pcr))(if vlist
(append-video-track track vlist)(setf vlist (cons track nil)))))((#x03 #x04 #x0f #x11 #x81)(setf service 'audio)(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) (eq stype #x11)))(if ad-list
(setf-cdr (last ad-list) (cons track nil))(setf ad-list (cons track nil)))(if audio-track-list
(append-audio-track track audio-track-list)(setf audio-track-list (cons track nil))))))(#x05
(let ((private nil))(mapcar #'(lambda (desc)(case (first desc)(#x5F
(when (and (eq (nth 1 desc) 4)(eq (nth 2 desc) #x46)(eq (nth 3 desc) #x53)(eq (nth 4 desc) #x41)(eq (nth 5 desc) #x54))(setf private t)))(#xD1
(when (and with-freesat
(eq current-network SC_TV_FREESAT)(eq (+ 2 (nth 1 desc)) (length desc)) private)(when (and (eq (nth 1 desc) 1)(eq (nth 2 desc) #x02))(set-eit-for-sit-filter espid #xd1 (get-tuning-svcid)))(when (and (eq (nth 1 desc) 2)(eq (nth 2 desc) #x03)(eq (nth 3 desc) #x04))(set-sdt-for-sit-filter espid #x46 (get-tuning-tsid)))))))
esdesclp)))(#x06
(let ((private nil))(mapcar #'(lambda (desc)(case (first desc)(#x5F
(when (and (eq (nth 1 desc) 4)(eq (nth 2 desc) #x46)(eq (nth 3 desc) #x53)(eq (nth 4 desc) #x41)(eq (nth 5 desc) #x54))(setf private t)))(#xD1
(when (and (eq (+ 2 (nth 1 desc)) (length desc)) private)(case (nth 2 desc)(#x09
(setf is-obfuscate-svc t)(setf track (list espid tag
stype level-idc))(if vlist
(append-video-track track vlist)(setf vlist (cons track nil))))(#x0a
(setf service 'audio)))))(#x6a
(when with-ac3
(setf track (list espid tag (list #x81 lang stype -1 -1)))(if audio-track-list
(append-audio-track track audio-track-list)(setf audio-track-list (cons track nil)))(setf service 'audio)))(#x7a
(when with-ac3-plus
(setf track (list espid tag (list #x82 lang stype -1 -1)))(if audio-track-list
(append-audio-track track audio-track-list)(setf audio-track-list (cons track nil)))(setf service 'audio)))(#x52
(when is-brazil
(when (and (>= tag #x30)(<= tag #x3F))(setf service t))))(#x56
(setf service t)(when (transcode-p)(if (>= (second desc) 5)(do ((x 0 (+ x 5)) (lp (nthcdr 2 desc) (setf lp (nthcdr 5 lp)))(magazine-number) (page-number))((>= x (second 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
(append-teletext-track track teletext-track-list)(setf teletext-track-list (cons track nil))))(setf track (list espid tag (list (copy-string "---") 0 0 0)))(if teletext-track-list
(append-teletext-track track teletext-track-list)(setf teletext-track-list (cons track nil)))(if tlist
(append-teletext-track track tlist)(setf tlist (cons track nil))))))(#x59
(setf service t)(when (transcode-p)(if (>= (second desc) 8)(do ((x 0 (+ x 8)) (lp (nthcdr 2 desc) (setf lp (nthcdr 8 lp)))(composition-id) (ancillary-id))((>= x (second 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
(append-subtitle-track track subtitle-track-list)(setf subtitle-track-list (cons track nil))))(setf track (list espid tag (list (copy-string "---")  0 0 0)))(if subtitle-track-list
(append-subtitle-track track subtitle-track-list)(setf subtitle-track-list (cons track nil))))))))
esdesclp))))(if calist
(setf-cdr (last calist) (cons (list espid 0) nil))(setf calist (cons (list espid 0) nil)))(when service
(if request-pids
(setf-cdr (last request-pids) (cons (list espid service) nil))(setf request-pids (cons (list espid service) nil)))))
secondlp)(when (or (not ci-bypass-ctrl) scramble-p)(make-event 'scramble-svc))(when subtitle-track-list
(subtitle-choice))(when (and (or with-ttx-sttl use-ttx-sttl-digital) teletext-track-list)(teletext-choice))(when (and with-ttx-sttl
(or dvb-sttl-msg vbi-sttl-msg))(sc-check-launch-sttl))(when (and (> last-sttl-pid -1)(find-if #'(lambda (x)(eq last-sttl-pid (car x))) request-pids))(setf cur-sttl-pid last-sttl-pid))(when (eq cur-sttl-pid -1)(if (and subtitle-choice-list
(/= subt-pid -1)(= selected-subt STTL_DVB_PREF))(setf cur-sttl-pid subt-pid)(if (and teletext-sttl-choice-list
(/= subt-pid-ttx -1)(= selected-subt STTL_TELETEXT_PREF))(setf cur-sttl-pid subt-pid-ttx))))(when audio-track-list
(setf track nil)(when (device-open-p 'audio-mon)(setf track (find-if #'(lambda (x)(eq (get-audio-pid 'audio-mon) (get-track-pid x))) audio-track-list)))(unless track
(setf track (find-if #'(lambda (x)(eq last-audio-pid (get-track-pid x)))
audio-track-list)))(when (= last-audio-pid -1)(setf last-audio-pid (get-track-pid track)))(setf calist-apid (get-track-pid track)))(when (and with-dlna-dms audio-track-list)(send-audio-choice-list (create-audio-choice-list 'audio audio-track-list)))(when vlist
(setf track nil)(when (and (device-open-p 'video-mon) (not video-mon-updated))(setf video-mon-updated t)(setf track (find-if #'(lambda (x)(eq (get-video-pid 'video-mon) (get-track-pid x)))
vlist)))(unless track
(setf track (find-if #'(lambda (x)(eq last-video-pid (get-track-pid x)))
vlist)))(unless track
(setf track (car vlist)))(setf calist-vpid (get-track-pid track))(when (and scramble-p
use-ci-try-and-error
(not tsport-ci-switch-done))(setf rsv-video-pcr (nth 4 track))(setf rsv-video-key key)(setf rsv-video-pid (get-track-pid track))(when is-uk
(set-video-codec 'video (get-track-video-codec track))))(setf last-video-pid (get-track-pid track))(when (or (and (eq request-pcr #x1fff) (> (length vlist) 1)) (and (eq request-pcr #x1ffe)(eq current-network SC_TV_OVER_IP)(> (length vlist) 0)))(setf request-pcr (get-track-pid track)))(when (and with-dlna-dms track)(send-video-choice-list (list track)))(setf cur-calist calist)(if request-pids
(progn
(setf-nthcdr 0 request-pids (cons (nth 0 request-pids) (nthcdr (1+ 0) request-pids)))(setf-nth 0 request-pids (list (get-track-pid track) 'video)))(setf request-pids (cons (list (get-track-pid track) 'video) nil))))(when (eq current-network SC_TV_OVER_IP)(append-over-ip-pid request-pcr)(mapcar #'(lambda (pid)(append-over-ip-pid (car pid)))
request-pids)(when tuner-pids
(mapcar #'(lambda (pid)(append-over-ip-pid pid))
tuner-pids))(send-over-ip-req-pids dvb-over-ip-pid-list)(tuner-set-pids 'tuner :add-pids dvb-over-ip-pid-list))(eval-partial-stream)(when with-dlna-dms
(send-pmt-parsing t))(make-event 'ca-update))))(defun cut-list (lst num)(let ((olst nil) (len))(setf len (length lst))(when (> num len)(setf num len))(do ((pos 0 (+ pos 1)))((>= pos num))(if olst
(setf-cdr (last olst) (cons (nth pos lst) nil))(setf olst (cons (nth pos lst) nil))))
olst))(defun sort-calist (lst vpid apid sttlpid)(let ((plst nil)(slst nil))(mapcar #'(lambda (n)(if (find-if #'(lambda (x)(and (not (= x -1)) (= x (first n))))(list vpid apid sttlpid))(if plst
(setf-cdr (last plst) (cons n nil))(setf plst (cons n nil)))(if slst
(setf-cdr (last slst) (cons n nil))(setf slst (cons n nil)))))
lst)(add-lst-tail plst slst)
plst))(defmacro add-lst-tail (src-lst add-lst)
`(when ,add-lst
(if ,src-lst
(nconc ,src-lst ,add-lst)(setf ,src-lst ,add-lst))))(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-node 'decode-on
#'(lambda ()
decode-p)
#'(lambda ()(eval-events (list 'decode-on 'decode-off)))
#'(lambda ()
nil))(register-node 'dvb-channel
#'(lambda ()(find (tsl-get-data (get-tuning-tsl-key) 'ntype) (list 1 2 3 15)))
#'(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))(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 SC_RES_AVAILABLE 0)(setf need-send-available nil))(unless (eq (get-tuning-svcid) (get-psi-svcid 'psi))(when (psi-invalidate 'psi)(set-psi-valid 'psi nil)(setf new-svcid nil)))(eval-events 'new-reserve))
#'(lambda ()(setf need-send-available t)(cancel-timer 'tuning-timeout)(setf tuning-transition nil)))(defun change-priority (prio)(my-device-priority 'tuner prio)(device-priority 'tsport prio)(when (device-open-p 'tsport-ci1)(my-device-priority 'tsport-ci1 (if (eq last-ci-slot-no 0) prio 1)))(when (device-open-p 'tsport-ci2)(my-device-priority 'tsport-ci2 (if (eq last-ci-slot-no 1) prio 1)))(make-event 'change-priority)(my-device-priority 'psi prio))(defun hdd-digital-program-on (src sym onid l-tsid svcid phys-ch ci-slot prio rec-mode)(monitor-stop)(setf tuning-transition nil)(setf new-record-pcr nil)(setf new-record-video nil)(setf new-record-audio nil)(setf new-record-emi nil)(setf new-record-dtcp nil)(setf new-record-pids nil)(setf tsport-ci-switch-done nil)(setf need-send-available nil)(setf scramble-p nil)(setf prev-content-time 0)(let ((svl-key) (tsl-key) (dev) (dish-param) (port))(setf port (list nil nil nil nil))(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 (eq my-tuner 1)(setf (nth 0 port) "FE_IN2")(setf (nth 0 port) "FE_IN1"))(if (get-signal-source-devices src)(progn
(enter-tuning-transition)(my-select-channel)(make-event 'new-reserve))(device-priority 'psi prio)(if (or (eq my-tuner 1) with-bg-rec-on-1tuner)(my-device-open 'psi 2)(my-device-open 'psi 0))(my-device-open 'ca ci-slot)(when with-dual-ci
(my-device-open 'ca-sub (- 1 ci-slot)))(setf force-tsport nil)(setf wait-tsport-ci1 nil)(setf wait-tsport-ci2 nil)(when (eq ci-slot 0)(setf last-ci-slot-no 0)(setf with-tsport-ci1 t)(setf with-tsport-ci2 nil))(when (eq ci-slot 1)(setf last-ci-slot-no 1)(setf with-tsport-ci1 nil)(setf with-tsport-ci2 t))(when with-dvb-ci
(device-priority 'tsport-ci1 (if (eq ci-slot 0) prio 1))(tsport-config 'tsport-ci1 (list (nth 0 port) (nth 1 port)))(my-device-open 'tsport-ci1 "ci0")(setf (nth 2 port) "CI_IN1")(when with-dual-ci
(device-priority 'tsport-ci2 (if (eq ci-slot 1) prio 1))(tsport-config 'tsport-ci2 (list (nth 0 port) (nth 1 port)))(my-device-open 'tsport-ci2 "ci1")(setf (nth 3 port) "CI_IN2")))(if (device-open-p 'tsport)(my-device-priority 'tsport prio)(device-priority 'tsport prio)(tsport-config 'tsport port)(if (eq my-tuner 1)(my-device-open 'tsport "tsi2")(my-device-open 'tsport "tsi0")))(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)(when dish-band-control-param
(tuner-setup (get-signal-source-tuner src)
:dish-band-control dish-band-control-param))(do ((i 0 (1+ i)))((>= i 4))(when (nth i dish-param-list)(setf dish-param (nth i dish-param-list))(tuner-setup (get-signal-source-tuner src)
:satellite i
:dish-low (nth 0 dish-param)
:dish-high (nth 1 dish-param)
:dish-tone-en (nth 2 dish-param)))))(when (transcode-p)(section-open 'pmt-enc)(device-priority 'psi-enc prio)(my-device-open 'psi-enc 2)(device-priority 'tsport-ex prio)(tsport-config 'tsport-ex (if (> rec-mode 2) "ENCODE" "ENCODE_1"))(my-device-open 'tsport-ex "tsi2")(device-priority 'video-enc prio)(my-device-open 'video-enc (if (> rec-mode 2) 2 1))(device-priority 'audio-enc prio)(my-device-open 'audio-enc (if (> rec-mode 2) 2 1))(audio-stop 'audio-enc)(init-transcode-object 'transcode)(device-priority 'partial-enc prio)(my-device-open 'partial-enc (if (> rec-mode 2) 1 0))(tsport-connect 'tsport-ex 'partial-enc
:mode 'TSPORT_MODE_TTS)(device-priority 'partial-ex prio)(my-device-open 'partial-ex 'parital-enc))(device-priority 'stream-out prio)(if (eq my-tuner 1)(my-device-open 'stream-out 1)(my-device-open 'stream-out 2))(device-priority 'partial prio)(my-device-open 'partial 'stream-out)(device-priority 'cp-out prio)(my-device-open 'cp-out nil)(init-partial-object 'partial)(init-section-object 'pat)(init-section-object 'pmt)(init-section-object 'sdt)(init-section-object 'cat)(init-section-object 'eit-for-sit)(init-section-object 'sdt-for-sit)(init-psi-object 'psi #'hdd-pmt-parser)(init-cp-object 'cp-out)(init-ca-object 'ca)(let* ((resources (list (get-signal-source-tuner src) 'psi 'tsport))(devices (nconc (copy-list resources) (list 'stream-out 'partial 'cp-out 'ca))))(when (transcode-p)(setf-cdr (last resources) (list 'psi-enc 'video-enc))(setf-cdr (last devices) (list 'tsport-ex 'partial-enc 'psi-enc 'video-enc 'audio-enc)))(when with-dvb-ci
(setf-cdr (last devices) (list 'tsport-ci1)))(when with-dual-ci
(setf-cdr (last devices) (list 'tsport-ci2)))(when with-dual-ci
(setf-cdr (last devices) (list 'ca-sub)))(set-signal-source-devices src devices)(resource-node 'dvb-pipe resources))(when (and (eq current-network SC_TV_OVER_IP)
direct-tv-rec)(setf tuner-pids (tuner-get-pids 'tuner
:pids-type "unfixed-pids")))(node-key 'dvb-pipe src)(append-t
'dvb-pipe
(get-signal-source-node src))(set-signal-source-pipe src 'dvb-pipe)(set-tuning-tuner 'tuner)(unless (tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key (get-tuning-tuner)))(let ((cur-tsport-dev (get-connected-tsport-dev)))(unless (eq cur-tsport-dev 'tsport)(tsport-disconnect cur-tsport-dev))(tsport-disconnect 'tsport)))(eval-node (get-signal-source-pipe src)))(unless need-send-available
1)))(defun set-copy-never-timer ()(cancel-timer 'copy-never-timer)(set-timer #'(lambda (arg)(let ((emi))(when (and scramble-p
(or (not new-record-emi)(= 3 new-record-emi)))(send-no-copy t))))
'copy-never-timer
nil
1
10000))(defvar ci-bypass-ctrl nil)(defun ch-blank-on ()(setf ch-blank t))(defun ch-blank-off ()(setf ch-blank 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)(not use-new-tsport)(eq (tsl-get-data ,tsl-key 'ntype) 1))
'stuner
(if (and with-satip
(eq (tsl-get-data ,tsl-key 'ntype) 15))
'siptuner
'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))(progn
(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)))(defun get-tsport-ci-dev ()(if (or
(and (not ci-bypass-ctrl)(not (eq (ca-status 'ca) nil)))(and (eq (ca-status 'ca) 'CA_SESSION_OPEN)
scramble-p))(if (or (and (tuner-info 'tuner 'ci-overspec)(not (is-ciplus-cam 'ca)))
force-tsport)
'tsport
(if with-tsport-ci1
'tsport-ci1
(if with-tsport-ci2
'tsport-ci2
'tsport)))
'tsport))(defun get-connected-tsport-dev ()(if (device-source-p 'tsport (get-tuning-tuner))
'tsport
(if (and (device-open-p 'tsport-ci1)(device-source-p 'tsport 'tsport-ci1)(device-source-p 'tsport-ci1 (get-tuning-tuner)))
'tsport-ci1
(if (and (device-open-p 'tsport-ci2)(device-source-p 'tsport 'tsport-ci2)(device-source-p 'tsport-ci2 (get-tuning-tuner)))
'tsport-ci2
nil))))(register-node 'my-tuner-freq-valid
#'(lambda ()(tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key (get-tuning-tuner))))
#'(lambda ()(set-tuning-tuner 'tuner)(set-tuner-tsl-key (get-tuning-tuner) (get-tuning-tsl-key))(eval-events (list 'tuner-req 'tuner-change)))
#'(lambda ()
nil))(register-node 'my-tuner-connect
#'(lambda ()(tuner-status (get-tuning-tuner)))
#'(lambda ()(unless (tuner-connect (get-tuning-tuner)
:tsl (get-tuner-tsl-key (get-tuning-tuner)))(set-tuner-tsl-key (get-tuning-tuner) (tuner-tsl-key (get-tuning-tuner))))(eval-events (list (list 'tuner-lock (get-tuning-tuner))(list 'tuner-unlock (get-tuning-tuner))(list 'tuner-disconnect (get-tuning-tuner)))))
#'(lambda ()(tuner-disconnect (get-tuning-tuner))))(register-node 'my-tsport-connect
#'(lambda ()(get-connected-tsport-dev))
#'(lambda ()(let ((cur-tsport-dev (get-connected-tsport-dev)))(when (or (not cur-tsport-dev)(eq cur-tsport-dev 'tsport))(when (device-open-p 'tsport-ci1)(tsport-disconnect 'tsport-ci1))(when (device-open-p 'tsport-ci2)(tsport-disconnect 'tsport-ci2))(tsport-connect 'tsport (get-tuning-tuner))))(eval-events (list 'tsport-available 'tsport-change
'tsport-ci1-change 'tsport-ci2-change)))
#'(lambda ()(tsport-disconnect 'tsport)))(register-node 'tsport-ci-connect
#'(lambda ()(eq (get-connected-tsport-dev) (get-tsport-ci-dev)))
#'(lambda ()(let ((cur-tsport-dev (get-connected-tsport-dev))(new-tsport-dev (get-tsport-ci-dev)))(unless (eq cur-tsport-dev new-tsport-dev)(when cur-tsport-dev
(tsport-disconnect cur-tsport-dev)(unless (eq cur-tsport-dev 'tsport)(tsport-disconnect 'tsport))))(when new-tsport-dev
(tsport-connect new-tsport-dev (get-tuning-tuner))(unless (eq new-tsport-dev 'tsport)(tsport-connect 'tsport new-tsport-dev))))(eval-events (list 'tsport-available 'tsport-ci1-available 'tsport-ci2-available
'tsport-ci1-device-available 'tsport-ci2-device-available
'tsport-change 'tsport-ci1-change 'tsport-ci2-change
'ca-module-extract 'ca-session-open 'ca-session-close
'scramble-svc 'ciplus-shunning-updated 'ciplus-cam-status 'tsport-ci-switch
'change-priority)))
#'(lambda ()(let ((cur-tsport-dev (get-connected-tsport-dev)))(unless (eq cur-tsport-dev 'tsport)(tsport-disconnect cur-tsport-dev)(tsport-disconnect 'tsport))(tsport-connect 'tsport (get-tuning-tuner)))))(register-node 'ciplus-check
#'(lambda ()
t)
#'(lambda ()(when (and (or (eq (get-connected-tsport-dev) 'tsport-ci1)(eq (get-connected-tsport-dev) 'tsport-ci2))(is-ciplus-cam 'ca))(send-scramble-system-ciplus 1)))
#'(lambda ()))(register-node 'my-ca-request
#'(lambda ()
t)
#'(lambda ()(when (or (eq (get-connected-tsport-dev) 'tsport-ci1)(eq (get-connected-tsport-dev) 'tsport-ci2))(unless (equal old-calist cur-calist)(setf old-calist cur-calist)(write-bytes msg-pipe SC_RES_CA_REQUEST 0)(ca-request 'ca 'psi (cut-list (sort-calist cur-calist calist-vpid calist-apid cur-sttl-pid)))))(eval-events (list 'ca-session-open 'ca-update 'ciplus-cam-status)))
#'(lambda ()(ca-cancel 'ca)))(register-node 'ciplus-cp
#'(lambda ()
t)
#'(lambda ()(when (or (eq (get-connected-tsport-dev) 'tsport-ci1)(eq (get-connected-tsport-dev) 'tsport-ci2))(when (cp-ciplus-updated 'ca
(tsl-get-data (get-tuning-tsl-key) 'ntype)(tsl-get-data (get-tuning-tsl-key) 'onid)(tsl-get-data (get-tuning-tsl-key) 'tsid)(get-psi-svcid 'psi))(cp-ciplus-reset-uri 'cp-out 'ca
(and (is-ciplus-cam 'ca) scramble-p)(get-psi-svcid 'psi)))(eval-partial-stream))(eval-events (list 'ciplus-cam-status 'tsport-available)))
#'(lambda ()
nil))(defun ciplus-update-shunning-on-state ()(when (eq shunning-status 'CIPLUS_SHUNNING_ON)(setf shunning-on t))(when (eq shunning-status 'CIPLUS_SHUNNING_OFF)(setf shunning-on nil)))(defun ts-to-ci-p ()(or (not (or with-tsport-ci1 with-tsport-ci2))(eq (get-connected-tsport-dev) 'tsport-ci1)(eq (get-connected-tsport-dev) 'tsport-ci2)))(defun is-path-trusted (dev)(if (ts-to-ci-p)(ciplus-is-path-trusted dev)
t))(register-node 'shunning-check
#'(lambda ()(if (eq with-ciplus t)(if (and (eq shunning-on t)
scramble-p)
nil
t)
t))
#'(lambda (key)(if (and (eq with-ciplus t)(ciplus-cam-present 'ca)(not (eq (get-signal-source-svl key) nil)))(progn
(setf shunning-status
(ciplus-query-shunning-status 'ca shunning-status (get-signal-source-svl key)))(ciplus-enable-shunning 'ca 'cp-out shunning-status (owner-p 'tsport))(when (eq shunning-status 'CIPLUS_SHUNNING_ON)(setf shunning-on t))(when (eq shunning-status 'CIPLUS_SHUNNING_OFF)(setf shunning-on nil)))(setf shunning-on nil))(send-encrypted current-network (or (eq shunning-status 'CIPLUS_SHUNNING_ON)(or video-encrypted audio-encrypted)))(eval-events (list 'ciplus-cam-status 'ciplus-svl-updated 'ca-session-open 'tsport-ci-switch)))
#'(lambda ()(when (eq shunning-on t)(send-encrypted current-network nil))(setf shunning-status nil)(setf shunning-on t)))(register-node 'shunning-update
#'(lambda ()
t)
#'(lambda (key)(when (eq sdt-inited t)(cond
((get-section-valid 'sdt)(ciplus-update-sdt-info 'ca (get-signal-source-svl key)
'sdt (is-path-trusted 'ca))(when (is-path-trusted 'ca)(make-event 'ciplus-svl-updated))(setf sdt-evt-received t))((find-timer 'sdt-timeout)
'nothing)(t
(when (and (eq sdt-evt-received nil) (is-path-trusted 'ca))(ciplus-update-sdt-to 'ca (get-signal-source-svl key))(when (is-path-trusted 'ca)(make-event 'ciplus-svl-updated)))(setf sdt-evt-received t))))(setf sdt-inited t)(eval-events (list 'sdt-valid 'sdt-update 'sdt-timeout 'ciplus-cam-status)))
#'(lambda ()(setf sdt-evt-received nil)(setf sdt-inited 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))(defvar rsv-init-ttuner nil)(defvar rsv-init-append nil)(defun use-digital-tuner (src no)(unless rsv-init-ttuner
(setf rsv-init-ttuner t)(set-signal-source-dev src 'digital)(if use-new-tsport
(set-signal-source-no src my-tuner)(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
(write-bytes msg-pipe SC_RES_TUNER_UNLOCK 4
(if my-tuner my-tuner 0))(make-event (list 'tuner-unlock 'tuner)))(TUNER_DISCONNECT
(make-event (list 'tuner-disconnect 'tuner)))(TUNER_LNB_SHORT
(make-event (list 'tuner-short-lnb 'tuner)))(PROPERTY_CHANGE
(monitor-start)))))(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
(setf force-tsport nil)(make-event 'tsport-change)))))(when with-dvb-ci
(register-device 'tsport-ci1
"tsport"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tsport-ci1 nil)(make-event 'tsport-ci1-lost))(AVAILABLE
)(DEVICE_AVAILABLE
(setf old-calist nil)(when force-tsport
(when with-tsport-ci1
(setf force-tsport nil)(set-owner 'tsport-ci1 t)(make-event 'tsport-ci1-device-available)))(when wait-tsport-ci1
(setf wait-tsport-ci1 nil)(ca-select-slot (- 1 last-ci-slot-no))(make-event 'tsport-ci-switch)))(SOURCE_CHANGE
(make-event 'tsport-ci1-change)))))(when with-dual-ci
(register-device 'tsport-ci2
"tsport"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tsport-ci2 nil)(make-event 'tsport-ci2-lost))(AVAILABLE
)(DEVICE_AVAILABLE
(setf old-calist nil)(when force-tsport
(when with-tsport-ci2
(setf force-tsport nil)(set-owner 'tsport-ci2 t)(make-event 'tsport-ci2-device-available)))(when wait-tsport-ci2
(setf wait-tsport-ci2 nil)(ca-select-slot (- 1 last-ci-slot-no))(make-event 'tsport-ci-switch)))(SOURCE_CHANGE
(make-event 'tsport-ci2-change)))))))(tuner-config 'tuner (list "ttuner" "stuner" "siptuner")))(unless rsv-init-append
(setf rsv-init-append t)(append-t
'dvb-available
'my-tuner-freq-valid
'dvb-channel
'my-tuner-connect
'my-tsport-connect
'decode-on
'psi-valid
'parse-pmt
'shunning-check
'tsport-ci-connect
'ciplus-cp
'ciplus-check
'my-ca-request
'my-video-pid-valid
'stream-scramble-check
'my-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
'my-pmt-request
'pmt-monitor)(append-t
'pat-request
'pat-monitor)(append-t
'parse-pmt
'cat-request
'cat-parser)(when with-ciplus
(append-t
'parse-pmt
'sdt-request
'sdt-parser)(append-t
'sdt-request
'shunning-update))(when with-usb-hdd-rec
(append-t
'tsport-ci-connect
'record-file-check
'content-check)(if use-transcode
(progn
(append-t
'content-check
'decode-proc
'encode-proc
'partial-start
'sit-insert)(append-t
'tsport-ci-connect
'video-play-enc))(append-t
'content-check
'partial-start
'sit-insert))(append-t
'partial-start
'stream-open-cond
'stream-open
'stream-valid-monitor
'content-time-monitor)(append-nil
'stream-open-cond
'delay-stream-open)(append-nil
'video-play-monitor
'stream-scramble-fix)(append-t
'stream-scramble-fix
'tsport-ci-switch)(append-nil
'tsport-ci-connect
'tsport-ci-recover)(append-t
'pat-request
'eit-for-sit-request)(append-t
'pat-request
'sdt-for-sit-request))(append-t
'decoder-pipe
'audio-pid-valid
'audio-play)(append-nil
'dvb-channel
'no-dvb-channel)(append-nil
'pat-request
'pat-timeout)(append-nil
'pmt-pid-valid
'no-pmt)(append-nil
'my-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 hdd-record-start (sym network arg prio directrec rec-mode last-audio last-sttl cont-manage video-ch)(c-program-off-inner 'digital)(setf record-mode rec-mode)(setf current-network network)(setf av-tmp-prio prio)(setf direct-tv-rec directrec)(setf last-video-pid nil)(setf last-audio-pid last-audio)(setf last-sttl-pid last-sttl)(setf eit-rec-ctrl-data nil)(setf sdt-rec-ctrl-data nil)(setf request-pids nil)(setf eemi-mode nil)(setf scramble-system-ciplus nil)(setf decode-result-ok nil)(setf wait-stream-open nil)(setf reserved-prio prio)(setf dvb-over-ip-pid-list nil)(setf tmp-over-ip-pid-list nil)(setf tuner-pids nil)(setf video-mon-updated nil)(setf old-calist nil)(setf video-decode-status nil)(if (= cont-manage -1)(setf content-management nil)(setf content-management cont-manage))(when directrec
(init-video-mon video-ch)(init-audio-mon))(when (eq (length arg) 5)(c-program-off-inner 'analog)(hdd-digital-program-on 'digital sym (first arg) (second arg) (third arg) (fourth arg) (fifth arg) prio rec-mode)))(defun hdd-record-stop ()(setf content-management nil)(write-content nil nil))(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 'dvb-pipe nil)(init-node (get-signal-source-pipe src))(my-device-close 'video)(my-device-close 'audio)(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)))(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)(setf last-ci-slot-no 0))(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))(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-open-sesami (on-off)(setf open-sesami (if (eq on-off 0) nil t))(my-select-channel)(make-event 'new-reserve))(defun audio-description-enable (t-or-nil)(setf with-ad t)(setf ad-enable t-or-nil)(make-event 'ad-valid-check))(defun dish-band-control-manual ()(when (with-dvb-sat-p)(setf dish-band-control-param t)(when (device-open-p 'tuner)(tuner-setup 'tuner
:dish-band-control dish-band-control-param))))(defun dish-setup (sat low high tone-en)(let ((dish-param (nth sat dish-param-list)))(unless (and (eq low (nth 0 dish-param))(eq high (nth 1 dish-param))(eq tone-en (nth 2 dish-param)))(setf (nth sat dish-param-list) (list low high tone-en))(when (with-dvb-sat-p)(when (device-open-p 'tuner)(tuner-setup 'tuner
:satellite sat
:dish-low low
:dish-high high
:dish-tone-en tone-en)(make-event (list 'tuner-unlonk 'tuner)))))))(defvar monitor-devices (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)(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 phys-ch)(setf monitor-svl (svl-create-key sym
:onid onid
:tsid tsid
:svcid svcid
:physical_ch phys-ch))(setf monitor-tsl (svl-create-key "TSL"
:physical_ch phys-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)(if (eq my-tuner 1)(my-device-open 'tuner 1)(my-device-open 'tuner 0))(init-tuner-object 'tuner))(when (with-dvb-sat-p)(when dish-band-control-param
(tuner-setup 'tuner
:dish-band-control dish-band-control-param))(do ((i 0 (1+ i)))((>= i 4))(when (nth i dish-param-list)(setf dish-param (nth i dish-param-list))(tuner-setup 'tuner
:satellite i
:dish-low (nth 0 dish-param)
:dish-high (nth 1 dish-param)
:dish-tone-en (nth 2 dish-param)))))(if (device-open-p 'tsport)(my-device-priority 'tsport monitor-prio)(device-priority 'tsport monitor-prio)(if (eq my-tuner 1)(my-device-open 'tsport "tsi2")(my-device-open 'tsport "tsi0")))))(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 SC_RES_EIT_PF_PP_PID 8 pfeit-pp-pid (if f-pmt-svcid f-pmt-svcid -1))))(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 (tsl-get-data (get-tuning-tsl-key) 'ntype) 1)(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))))(register-node 'my-pmt-request
#'(lambda ()(get-section-valid 'pmt))
#'(lambda ()(unless (get-section-valid 'pmt)(section-open 'pmt)(section-disable 'pmt)(setf (nth 0 (get-section-filter 'pmt)) 2)(setf (nth 0 (get-section-mask 'pmt)) 0)(when (eq current-network SC_TV_OVER_IP)(append-over-ip-pid (get-section-pid 'pmt))(tuner-set-pids 'tuner
:add-pids (list (get-section-pid 'pmt))))(section-filter 'pmt
:type "version"
:source 'tsport
:pid (get-section-pid 'pmt)
:length (get-section-length 'pmt)
:filter (get-section-filter 'pmt)
:mask (get-section-mask 'pmt)
:elength (get-section-elength 'pmt)
:efilter (get-section-efilter 'pmt)
:emask (get-section-emask 'pmt))(if (section-enable 'pmt)(cancel-timer 'pmt-retry-timer)(set-timer #'(lambda (arg)(when (section-enable 'pmt)(cancel-timer 'pmt-retry-timer)))
'pmt-retry-timer
nil
nil
500)))(eval-events (list 'pmt-valid 'pmt-update 'pmt-timeout)))
#'(lambda ()(cancel-timer 'pmt-retry-timer)(section-close 'pmt)(set-section-valid 'pmt nil)))(defun parse-cat (data)(let ((header) (table-id) (section-length 0) (desclp-length 0) (ca-system-id nil) (ca-pid nil) (ca-pid-list nil))(setf header (first data))(setf table-id (nth 0 header))(setf section-length (+ (* (logand (nth 1 header) #x0f) #x100) (nth 2 header)))(setf section-length (- section-length 9))(setf desclp (nthcdr 8 header))(do ((x 0 (+ x (+ 2 desc-length))))((>= x section-length))(let (tag)(setf tag (nth 0 desclp))(setf desc-length (nth 1 desclp))(case tag
(#x09
(setf ca-system-id (+ (* (nth 2 desclp) #x100) (nth 3 desclp)))(setf ca-pid (+ (* (logand (nth 4 desclp) #x1F) #x100) (nth 5 desclp)))(when  (eq current-network SC_TV_OVER_IP)(append-over-ip-pid ca-pid)(if ca-pid-list
(setf-cdr (last ca-pid-list) (cons ca-pid nil))(setf ca-pid-list (cons ca-pid nil)))))(otherwise)))(setf desclp (nthcdr (+ desc-length 2) desclp)))(when ca-pid-list
(tuner-set-pids 'tuner :add-pids ca-pid-list))))(register-node 'cat-parser
#'(lambda ()
t)
#'(lambda (key)(when (and (eq current-network SC_TV_OVER_IP)(section-status 'cat))(section-parse 'cat #'parse-cat))(eval-events (list 'cat-valid 'cat-update)))
#'(lambda (key)))(defun reserve-setup (tuner)(setf my-tuner tuner))(new-signal-source 'digital)(new-signal-source 'analog)(use-digital-tuner 'digital tuner-no)(defun init-video-mon (no)(video-config 'video-mon :use "MONITOR" :hint 0)(my-device-open 'video-mon (video-openquery :ch no))(init-video-object 'video-mon))(defun init-audio-mon ()(my-device-open 'audio-mon (device-id 'video-mon))(init-audio-object 'audio-mon))(defun subtitle-choice ()(let ((subt-index 0) (track nil) (subt-reset nil))(if (not with-dvb-sttl)
nil
(when with-ttx-sttl
(setf dvb-sttl-msg t))(setf subtitle-track-num (length subtitle-track-list))(if (<= subtitle-track-num subtitle-choice-num)(if (= subtitle-track-num 0)(progn
(setf subt-pid -1)(setf subt-lang -1))(setf subtitle-choice-list subtitle-track-list)(when with-sort-sttl-list
(sc-sort-sttl-list))(if (not with-ttx-sttl)(progn
(unless use-ttx-sttl-digital
(setf selected-subt STTL_DVB_PREF))(when with-last-sttl
(when (= subt-pid -1)(setf subt-pid last-sttl-pid)))(if (or (= subt-pid -1)(= subt-reset -1))(setf subt-index 0)(setf subt-index (position-if #'(lambda (trk)(= subt-pid (first trk)))
subtitle-choice-list))(unless subt-index
(setf subt-index 0)))(setf track (nth subt-index subtitle-choice-list))(setf subt-pid (first track)))))))))(defun teletext-choice ()(setf teletext-track-num (length teletext-track-list))(when with-ttx-sttl
(setf teletext-sttl-choice-num 0)(setf vbi-sttl-msg 1))(when is-aus
(setf teletext-sttl-choice-num 0)(setf subt-pid-ttx -1))(if (<= teletext-track-num teletext-choice-num)(when (/= teletext-choice-num 0)(setf teletext-choice-list teletext-track-list)(when (or with-ttx-sttl is-aus)(mapcar #'(lambda (trk)(when (or (= (nth 1 (third trk)) 2)(= (nth 1 (third trk)) 5))(if teletext-sttl-choice-list
(setf-cdr (last teletext-sttl-choice-list) (cons trk nil))(setf teletext-sttl-choice-list (cons trk nil)))))
teletext-choice-list)(setf teletext-sttl-choice-num (length teletext-sttl-choice-list)))(when is-aus
(setf selected-subt STTL_TELETEXT_PREF)(setf subt-pid-ttx (first (first teletext-sttl-choice-list)))))))(defvar second-pref-lang-detected STTL_NONE_PREF)(defvar pref-type-detected STTL_NONE_PREF)(defvar pref-lang-index -1)(defun check-only-hard-hearing-sttl (pref-subt-lang pref-subt-2-lang)(let ((ret nil) (only-hard-hearing t))(when (and is-nordic
(or (= current-network SC_TV_DVB)(= current-network SC_TV_CABLE)))(when (= preferred-subtitle-type EEP_SUBT_TYPE_NORMAL)(when (find-if #'(lambda (x)(or (< (nth 1 (third x)) #x20)(> (nth 1 (third x)) #x24)))
subtitle-choice-list)(setf only-hard-hearing nil))(when only-hard-hearing
(when (find-if #'(lambda (x)(/= (nth 1 (third x)) #x05))
teletext-sttl-choice-list)(setf only-hard-hearing nil))(when only-hard-hearing
(setf ret STTL_NONE_PREF)))))
ret))(defun check-pref-lang-found-sttl (pref-subt-lang pref-subt-2-lang)(let ((ret nil) (preferred-lang-found nil))(when (and is-nordic
(or (= current-network SC_TV_CABLE)(and (= current-network SC_TV_DVB) is-finland)))(when (or (check-language-list pref-subt-lang subtitle-choice-list)(check-language-list pref-subt-2-lang subtitle-choiec-list ))(setf preferred-lang-found t))(unless preferred-lang-found
(when (or (check-language-list pref-subt-lang teletext-sttl-choice-list)(check-language-list pref-subt-2-lang teletext-sttl-choice-list))(setf preferred-lang-found t))(unless preferred-lang-found
(setf ret STTL_NONE_PREF))))
ret))(defun check-pref-lang-dvb-sttl (pref-subt-lang pref-subt-2-lang)(let ((ret nil))(when (> subtitle-track-num 0)(setf pref-lang-index (get-subtitle-choice-list-index PREFERRED_TYPE))(when pref-lang-index
(setf pref-type-detected STTL_DVB_PREF)(setf sttl-index pref-lang-index)(when (check-language pref-subt-lang (get-track-subtitle-lang (nth pref-lang-index subtitle-choice-list)))(setf ret STTL_DVB_PREF))(when (and (not ret)(check-language pref-subt-2-lang) (get-track-subtitle-lang (nth pref-lang-index subtitle-choice-list)))(setf second-pref-lang-detected STTL_DVB_PREF))))
ret))(defun check-pref-lang-teletext-sttl (pref-subt-lang pref-subt-2-lang)(let ((ret nil))(when (> teletext-sttl-choice-num 0)(setf pref-lang-index (get-teletext-sttl-choice-list-index PREFERRED_TYPE))(when pref-lang-index
(when (= pref-type-detected STTL_NONE_PREF)(setf pref-type-detected STTL_TELETEXT_PREF)(setf sttl-index pref-lang-index))(when (check-language pref-subt-lang (get-track-teletext-lang (nth pref-lang-index teletext-sttl-choice-list)))(setf sttl-index pref-lang-index)(setf ret STTL_TELETEXT_PREF))(when (and (not ret)(check-language pref-subt-2-lang) (get-track-teletext-lang (nth pref-lang-index teletext-sttl-choice-list)))(when (/= second-pref-lang-detected STTL_DVB_PREF)(setf second-pref-lang-detected STTL_TELETEXT_PREF)(setf sttl-index pref-lang-index)))))
ret))(defun check-second-pref-lang-detected (pref-subt-lang pref-subt-2-lang)(let ((ret nil))(if (= second-pref-lang-detected STTL_DVB_PREF)(setf ret STTL_DVB_PREF)(if (= second-pref-lang-detected STTL_TELETEXT_PREF)(setf ret STTL_TELETEXT_PREF)))
ret))(defun check-inferior-type-lang-dvb-sttl (pref-subt-lang pref-subt-2-lang)(let ((ret nil))(when (> subtitle-track-num 0)(setf pref-lang-index (get-subtitle-choice-list-index INFERIOR_TYPE))(when pref-lang-index
(when (check-language pref-subt-lang (get-track-subtitle-lang (nth pref-lang-index subtitle-choice-list)))(setf sttl-index pref-lang-index)(setf ret STTL_DVB_PREF))(when (and (not ret)(check-language pref-subt-2-lang (get-track-subtitle-lang (nth pref-lang-index subtitle-choice-list))))(setf second-pref-lang-detected STTL_DVB_PREF)(setf sttl-index pref-lang-index))))
ret))(defun check-inferior-type-lang-teletext-sttl (pref-subt-lang pref-subt-2-lang)(let ((ret nil))(when (> teletext-sttl-choice-num 0)(setf pref-lang-index (get-teletext-sttl-choice-list-index INFERIOR_TYPE))(when pref-lang-index
(when (check-language pref-subt-lang (get-track-teletext-lang (nth pref-lang-index teletext-sttl-choice-list)))(setf sttl-index pref-lang-index)(setf ret STTL_TELETEXT_PREF))(when (and (not ret)(check-language pref-subt-2-lang (get-track-teletext-lang (nth pref-lang-index teletext-sttl-choice-list))))(when (/= second-pref-lang-detected STTL_DVB_PREF)(setf second-pref-lang-detected STTL_TELETEXT_PREF)(setf sttl-index pref-lang-index)))))
ret))(defun check-sttl-type (pref-subt-lang pref-subt-2-lang)(let ((ret nil))(if (= second-pref-lang-detected STTL_DVB_PREF)(setf ret STTL_DVB_PREF)(if (= second-pref-lang-detected STTL_TELETEXT_PREF)(setf ret STTL_TELETEXT_PREF)(if (= pref-type-detected STTL_DVB_PREF)(setf ret STTL_DVB_PREF)(if (= pref-type-detected STTL_TELETEXT_PREF)(setf ret STTL_TELETEXT_PREF)))))(unless ret
(setf sttl-index 0)(if (and (= subtitle-track-num 0)(> teletext-sttl-choice-num 0))(setf ret STTL_TELETEXT_PREF)(setf ret STTL_DVB_PREF)))
ret))(defun sc-check-pref-kind-sttl ()(let ((pref-subt-lang (first preferred-subtitle))(pref-subt-2-lang (second preferred-subtitle))(func nil)(func-list (list
'check-only-hard-hearing-sttl
'check-pref-lang-found-sttl
'check-pref-lang-dvb-sttl
'check-pref-lang-teletext-sttl
'check-second-pref-lang-detected
'check-inferior-type-lang-dvb-sttl
'check-inferior-type-lang-teletext-sttl
'check-sttl-type))(ret nil))(setf second-pref-lang-detected STTL_NONE_PREF)(setf pref-type-detected STTL_NONE_PREF)(setf pref-lang-index -1)(if (and (= subtitle-track-num 0)(= teletext-sttl-choice-num 0))(setf ret STTL_NONE_PREF)(do ((f-lst func-list (cdr f-lst)))((or ret (null f-lst)))(setf func (car f-lst))(setf ret (funcall func pref-subt-lang pref-subt-2-lang))))
ret))(defvar sttl-index 0)(defun sc-check-launch-sttl ()(let ((pid-teletext -1) (preferred-sub nil))(setf sttl-index 0)(if (and (= teletext-sttl-choice-num 0) (= subtitle-track-num 0))(setf selected-subt STTL_NONE_PREF)(setf preferred-sub (sc-check-pref-kind-sttl))(cond ((= preferred-sub STTL_TELETEXT_PREF)(setf selected-subt STTL_TELETEXT_PREF)(setf subt-pid-ttx
(first (nth sttl-index teletext-sttl-choice-list))))((and (= preferred-sub STTL_DVB_PREF)(> subtitle-track-num 0))(setf selected-subt STTL_DVB_PREF)(setf subt-pid (first (nth sttl-index subtitle-choice-list))))((and is-nordic
(or (= current-network SC_TV_DVB)(= current-network SC_TV_CABLE)))(setf selected-subt STTL_NONE_PREF))))))(defun check-language (pref-lang-list lang)(find-if #'(lambda (pref-lang)(string= pref-lang lang)) pref-lang-list))(defun check-language-list (pref-lang-list track-list)(find-if #'(lambda (track)(check-language pref-lang-list (first (third track))))
track-list))(defun get-subtitle-choice-list-index (type)(position-if
#'(lambda (track)(let ((subt-type (nth 1 (third track))))(if (= type PREFERRED_TYPE)(when (or (and (= preferred-subtitle-type EEP_SUBT_TYPE_NORMAL)(>= subt-type #x10)(<= subt-type #x1F))(and (= preferred-subtitle-type EEP_SUBT_TYPE_IMPAIRED)(>= subt-type #x20)(<= subt-type #x2F)))
t)(if (= type INFERIOR_TYPE)(when (or (and (= preferred-subtitle-type EEP_SUBT_TYPE_NORMAL)(>= subt-type #x20)(<= subt-type #x2F))(and (= preferred-subtitle-type EEP_SUBT_TYPE_IMPAIRED)(>= subt-type #x10)(<= subt-type #x1F)))
t)
nil))))
subtitle-choice-list))(defun get-teletext-sttl-choice-list-index (type)(position-if
#'(lambda (track)(let ((subt-type (nth 1 (third track))))(if (= type PREFERRED_TYPE)(when (or (and (= preferred-subtitle-type EEP_SUBT_TYPE_NORMAL)(= subt-type #x02))(and (= preferred-subtitle-type EEP_SUBT_TYPE_IMPAIRED)(= subt-type #x05)))
t)(if (= type INFERIOR_TYPE)(when (or (and (= preferred-subtitle-type EEP_SUBT_TYPE_NORMAL)(= subt-type #x05))(and (= preferred-subtitle-type EEP_SUBT_TYPE_IMPAIRED)(= subt-type #x02)))
t)
nil))))
teletext-sttl-choice-list))(defun sc-sort-sttl-list ()(let ((reverse-order nil) (sttl-copy nil) (sort-swap t) (current-lang ""))(when (= preferred-subtitle-type EEP_SUBT_TYPE_IMPAIRED)(setf reverse-order t))(do ((count1 0 (1+ count1))) ((>= count1 subtitle-track-num))(when (not (string= current-lang (get-track-subtitle-lang (nth count1 subtitle-choice-list))))(setf current-lang (get-track-subtitle-lang (nth count1 subtitle-choice-list)))(setf sort-swap t)(do (nil) ((not sort-swap))(setf sort-swap nil)(do ((count2 (1+ count1) (1+ count2))) ((>= count2 subtitle-choice-num))(when (and (string= (get-track-subtitle-lang (nth count2 subtitle-choice-list))
current-lang)(not (string= (get-track-subtitle-lang (nth count2 subtitle-choice-list))(get-track-subtitle-lang (nth (1- count2) subtitle-choice-list)))))(setf sttl-copy (nth count2 subtitle-choice-list))(setf (nth count2 subtitle-choice-list)(nth (- count2 1) subtitle-choice-list))(setf (nth (- count2 1) subtitle-choice-list) sttl-copy)(setf sort-swap t))))))(setf current-lang "")(do ((count1 0 (1+ count1))) ((>= count1 subtitle-track-num))(when (not (string= current-lang (get-track-subtitle-lang (nth count1 subtitle-choice-list))))(setf current-lang (get-track-subtitle-lang (nth count1 subtitle-choice-list)))(setf sort-swap t)(do (nil) ((not sort-swap))(setf sort-swap nil)(do ((count2 (1+ count1) (1+ count2))) ((>= count2 subtitle-choice-num))(when (and (string= (get-track-subtitle-lang (nth count2 subtitle-choice-list))(get-track-subtitle-lang (nth (1- count2) subtitle-choice-list)))(sc-sort-sttl-decide (get-track-subtitle-type (nth (1- count2) subtitle-choice-list))(get-track-subtitle-type (nth count2 subtitle-choice-list))
reverse-order))(setf sttl-copy (nth count2 subtitle-choice-list))(setf (nth count2 subtitle-choice-list)(nth (- count2 1) subtitle-choice-list))(setf (nth (- count2 1) subtitle-choice-list) sttl-copy)(setf sort-swap t))))))))(defun sc-sort-sttl-decide (sub1 sub2 reverse)(let ((s1 nil)(s2 nil))(setf s1 (if (/= (logand sub1 #x20) 0) 2 0))(setf s2 (if (/= (logand sub2 #x20) 0) 2 0))(when (= s1 s2)(setf s1 (if (< sub1 sub2) 0 1))(setf s2 (if (< sub2 sub1) 0 1)))(if reverse
(< s1 s2)(> s1 s2))))(defun send-pmt-parental (rating code)(unless (eq old-pmt-parental-age rating)(write-bytes msg-pipe SC_RES_PARENTAL 8 rating code)(setf old-pmt-parental-age rating)))(defun detect-rating-country-code (code len data)(let ((country-code)(rating))(when (and (> len 0) data)(setf country-code (copy-string "---"))(setf-char country-code 0 (nth 0 data ))(setf-char country-code 1 (nth 1 data ))(setf-char country-code 2 (nth 2 data ))(setf rating (logand (nth 3 data) #x0f))(when (string-equal code country-code)(setf pmt-parental-country-code country-code)(setf pmt-parental-age rating))(detect-rating-country-code code (- len 4) (nthcdr 4 data)))))(defvar stream-scramble-fixed nil)(defvar stream-scramble-fix-timeout 10000)(defun ca-select-slot (slot)(setf old-calist nil)(when (eq slot 0)(unuse-tsport-ci2)(use-tsport-ci1))(when (eq slot 1)(unuse-tsport-ci1)(use-tsport-ci2))(unless (eq last-ci-slot-no slot)(when (device-open-p 'ca)(my-device-close 'ca))(when (device-open-p 'ca-sub)(my-device-close 'ca-sub))(write-bytes msg-pipe SC_RES_USING_CI_SLOT 4 slot))(unless (device-open-p 'ca)(my-device-open 'ca slot)(init-ca-object 'ca))(unless (device-open-p 'ca-sub)(my-device-open 'ca-sub (- 1 slot))(init-ca-object 'ca-sub))(setf last-ci-slot-no slot)(eval-partial-stream))
