(defvar signal-source-list nil)(defvar signal-destination-list nil)(defvar *tsl-sym* "TSL")(defmacro tsl-symbol (sym)
`(setf *tsl-sym* ,sym))(defmacro tuner-tsl-key (sym)
`(tuner-get-tsl-key ,sym *tsl-sym*))(defmacro video-format (sym)
`(video-stream-info ,sym 'format))(defmacro audio-channel (sym)
`(audio-stream-info ,sym 'channel))(defmacro device-lock (sym)
`(device-flag-set ,sym 1))(defmacro device-unlock (sym)
`(device-flag-unset ,sym 1))(defmacro device-lock-p (sym)
`(device-flag-setp ,sym 1))(defvar device-list nil)(defvar resource-list nil)(defvar tuner-list nil)(defvar tsport-list nil)(defvar psi-list nil)(defvar ca-list nil)(defvar cp-list nil)(defvar video-list nil)(defvar audio-list nil)(defvar section-list nil)(defvar my-display 'display)(defvar other-display 'display-sub)(defvar unknown-stream nil)(setf new-svcid nil)(setf pat-*tsid* nil)(setf pat-*pmtlist* nil)(setf pmt-*svcid* nil)(setf pmt-*pid* nil)(defmacro signal-source-p (sym)
`(assoc ,sym signal-source-list))(defmacro set-signal-source-tuner (sym x)
`(setf (nth 1 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-tuner (sym)
`(nth 1 (assoc ,sym signal-source-list)))(defmacro set-signal-source-svl (sym x)
`(setf (nth 2 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-svl (sym)
`(nth 2 (assoc ,sym signal-source-list)))(defmacro set-signal-source-tsl (sym x)
`(setf (nth 3 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-tsl (sym)
`(nth 3 (assoc ,sym signal-source-list)))(defmacro set-signal-source-node (sym x)
`(setf (nth 4 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-node (sym)
`(nth 4 (assoc ,sym signal-source-list)))(defmacro set-signal-source-devices (sym x)
`(setf (nth 5 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-devices (sym)
`(nth 5 (assoc ,sym signal-source-list)))(defmacro set-signal-source-dev (sym x)
`(setf (nth 6 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-dev (sym)
`(nth 6 (assoc ,sym signal-source-list)))(defmacro set-signal-source-no (sym x)
`(setf (nth 7 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-no (sym)
`(nth 7 (assoc ,sym signal-source-list)))(defmacro set-signal-source-pipe (sym x)
`(setf (nth 8 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-pipe (sym)
`(nth 8 (assoc ,sym signal-source-list)))(defmacro set-signal-source-request (sym x)
`(setf (nth 9 (assoc ,sym signal-source-list)) ,x))(defmacro get-signal-source-request (sym)
`(nth 9 (assoc ,sym signal-source-list)))(defun init-signal-source-object (sym)(unless (assoc sym signal-source-list)(setf signal-source-list (cons (list sym nil nil nil nil nil nil nil nil nil) signal-source-list)))(set-signal-source-tuner sym nil)(set-signal-source-svl sym nil)(set-signal-source-tsl sym nil)(set-signal-source-node sym nil)(set-signal-source-devices sym nil)(set-signal-source-dev sym nil)(set-signal-source-no sym nil)(set-signal-source-pipe sym nil)(set-signal-source-request sym nil))(defun free-signal-source-object (sym)(setf signal-source-list (delete-if #'(lambda (x)(eq (car x) sym))
signal-source-list)))(let ((tuning-freq)(tuning-onid)(tuning-tsid)(tuning-svcid)(tuning-tsl-key))(defun init-tuning-param ()(setf tuning-freq nil)(setf tuning-onid nil)(setf tuning-tsid nil)(setf tuning-svcid nil)(setf tuning-tsl-key nil))(defun set-tuning-freq (x)(setf tuning-freq x))(defun get-tuning-freq ()
tuning-freq)(defun set-tuning-onid (x)(setf tuning-onid x))(defun get-tuning-onid ()
tuning-onid)(defun set-tuning-tsid (x)(setf tuning-tsid x))(defun get-tuning-tsid ()
tuning-tsid)(defun set-tuning-svcid (x)(setf tuning-svcid x))(defun get-tuning-svcid ()
tuning-svcid)(defun set-tuning-tsl-key (x)(setf tuning-tsl-key x))(defun get-tuning-tsl-key ()
tuning-tsl-key))(init-tuning-param)(defun my-device-open (dev dst)(unless (assoc dev device-list)(setf device-list (cons (if (eq (device-open dev dst) 'AVAILABLE)(list dev t)(list dev nil))
device-list))))(defun my-device-close (dev)(device-close dev)(setf device-list (delete-if #'(lambda (x)(eq (car x) dev))
device-list)))(defun my-device-add (dev owner)(unless (assoc dev device-list)(setf device-list (cons (list dev owner) device-list))))(defun my-device-del (dev)(setf device-list (delete-if #'(lambda (x)(eq (car x) dev))
device-list)))(defun my-device-priority (dev prio)(let ((status))(setf status (device-priority dev prio))(when status
(if (eq status 'AVAILABLE)(unless (owner-p dev)(set-owner dev t))(when (owner-p dev)(set-owner dev nil))))))(defun set-owner (dev owner)(let ((levent-flg))(setf levent-flg nil)(setf (nth 1 (assoc dev device-list)) owner)(if owner
(progn
(mapcar #'(lambda (x)(when (find dev (nth 1 x))(if (not (find dev (nth 3 x)))(if (find dev (nth 2 x))
nil
(setf (nth 2 x) (cons dev (nth 2 x)))(when (eq (length (nth 1 x)) (length (nth 2 x)))(make-event (nth 0 x))))(setf (nth 3 x) (delete dev (nth 3 x)))(setf (nth 2 x) (cons dev (nth 2 x)))(when (eq (length (nth 1 x)) (length (nth 2 x)))(make-event (nth 0 x))))))
resource-list))(mapcar #'(lambda (x)(when (find dev (nth 1 x))(if (not (find dev (nth 2 x)))(if (find dev (nth 3 x))
nil
(unless (nth 3 x)(setf levent-flg t))(setf (nth 3 x) (cons dev (nth 3 x)))(if levent-flg
(make-event (nth 0 x))))(setf (nth 2 x) (delete dev (nth 2 x)))(unless (nth 3 x)(setf levent-flg t))(setf (nth 3 x) (cons dev (nth 3 x)))(if levent-flg
(make-event (nth 0 x))))))
resource-list))))(defun owner-p (dev)(nth 1 (assoc dev device-list)))(defun available-p (sym)(let ((x))(setf x (assoc sym resource-list))(if x
(if (eq (length (nth 1 x)) (length (nth 2 x)))
t
nil)
nil)))(defun resource-node (sym devs)(let ((lst) (regist nil))(setf lst (assoc sym resource-list))(unless lst
(setf regist t)(setf lst (list sym nil nil nil))(setf resource-list (cons lst resource-list)))(setf (nth 1 lst) devs)(setf (nth 2 lst) nil)(setf (nth 3 lst) nil)(mapcar #'(lambda (x)(when (assoc x device-list)(if (nth 1 (assoc x device-list))(setf (nth 2 lst) (cons x (nth 2 lst)))(setf (nth 3 lst) (cons x (nth 3 lst))))))
devs)(when regist
(register-node sym
#'(lambda ()(available-p (node-symbol)))
#'(lambda ()(eval-events (list (node-symbol))))
#'(lambda ()
nil)))))(defmacro set-tuner-freq (sym x)
`(setf (nth 1 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-freq (sym)
`(nth 1 (assoc ,sym tuner-list)))(defmacro set-tuner-index (sym x)
`(setf (nth 2 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-index (sym)
`(nth 2 (assoc ,sym tuner-list)))(defmacro set-tuner-onid (sym x)
`(setf (nth 3 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-onid (sym)
`(nth 3 (assoc ,sym tuner-list)))(defmacro set-tuner-tsid (sym x)
`(setf (nth 4 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-tsid (sym)
`(nth 4 (assoc ,sym tuner-list)))(defmacro set-tuner-mod (sym x)
`(setf (nth 5 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-mod (sym)
`(nth 5 (assoc ,sym tuner-list)))(defmacro set-tuner-status (sym x)
`(setf (nth 6 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-status (sym)
`(nth 6 (assoc ,sym tuner-list)))(defmacro set-tuner-system (sym x)
`(setf (nth 7 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-system (sym)
`(nth 7 (assoc ,sym tuner-list)))(defmacro set-tuner-tsl-key (sym x)
`(setf (nth 8 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-tsl-key (sym)
`(nth 8 (assoc ,sym tuner-list)))(defmacro set-tuner-hook (sym x)
`(setf (nth 9 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-hook (sym)
`(nth 9 (assoc ,sym tuner-list)))(defmacro set-tuner-offset (sym x)
`(setf (nth 10 (assoc ,sym tuner-list)) ,x))(defmacro get-tuner-offset (sym)
`(nth 10 (assoc ,sym tuner-list)))(defun init-tuner-object (sym)(unless (assoc sym tuner-list)(setf tuner-list (cons (list sym nil nil nil nil nil nil nil nil nil nil) tuner-list)))(set-tuner-tsl-key sym (tuner-tsl-key sym))(set-tuner-freq sym nil)(set-tuner-onid sym nil)(set-tuner-tsid sym nil)(set-tuner-index sym nil)(set-tuner-mod sym nil)(set-tuner-status sym nil)(set-tuner-system sym nil)(set-tuner-hook sym nil)(set-tuner-offset sym nil))(defmacro set-psi-svcid (sym x)
`(setf (nth 1 (assoc ,sym psi-list)) ,x))(defmacro get-psi-svcid (sym)
`(nth 1 (assoc ,sym psi-list)))(defmacro set-psi-pid (sym x)
`(setf (nth 2 (assoc ,sym psi-list)) ,x))(defmacro get-psi-pid (sym)
`(nth 2 (assoc ,sym psi-list)))(defmacro set-psi-valid (sym x)
`(setf (nth 3 (assoc ,sym psi-list)) ,x))(defmacro get-psi-valid (sym)
`(nth 3 (assoc ,sym psi-list)))(defmacro set-psi-error (sym x)
`(setf (nth 4 (assoc ,sym psi-list)) ,x))(defmacro get-psi-error (sym)
`(nth 4 (assoc ,sym psi-list)))(defmacro set-pmt-hook (sym x)
`(setf (nth 5 (assoc ,sym psi-list)) ,x))(defmacro get-pmt-hook (sym)
`(nth 5 (assoc ,sym psi-list)))(defun init-psi-object (sym fun)(unless (assoc sym psi-list)(setf psi-list (cons (list sym nil nil nil nil nil) psi-list)))(set-pmt-hook sym fun)(psi-parser sym #'(lambda (pid data)(if (and pid data)(progn
(set-psi-error sym nil)(set-psi-valid sym t)(set-psi-pid sym pid)(set-psi-svcid sym (+ (* (fourth (first data)) #x100)(fifth (first data)))))(set-psi-error sym (psi-get-error sym))(set-psi-valid sym nil)(set-psi-pid sym nil)(set-psi-svcid sym nil)))))(defmacro set-ca-pids (sym x)
`(setf (nth 1 (assoc ,sym ca-list)) ,x))(defmacro get-ca-pids (sym)
`(nth 1 (assoc ,sym ca-list)))(defun ca-test-pids (sym x)(mapcar #'(lambda (z)(if (assoc z (nth 1 (assoc sym ca-list)))(setf (nth 1 (assoc z (nth 1 (assoc sym ca-list)))) 0)(setf (nth 1 (assoc sym ca-list)) (cons (list z 0) (nth 1 (assoc sym ca-list))))))
x)(make-event 'ca-update)(make-event 'ca-result-fix)(make-event 'ca-result-update))(defun ca-view-pids (sym x)(mapcar #'(lambda (z)(let ((entry))(setf entry (assoc z (nth 1 (assoc sym ca-list))))(if entry
(setf (nth 1 entry) (logior (nth 1 entry) 1))(setf (nth 1 (assoc sym ca-list)) (cons (list z 1) (nth 1 (assoc sym ca-list)))))))
x)(make-event 'ca-update)(make-event 'ca-result-fix)(make-event 'ca-result-update))(defun ca-record-pids (sym x)(mapcar #'(lambda (z)(let ((entry))(setf entry (assoc z (nth 1 (assoc sym ca-list))))(if entry
(setf (nth 1 entry) (logior (nth 1 entry) 2))(setf (nth 1 (assoc sym ca-list)) (cons (list z 1) (nth 1 (assoc sym ca-list)))))))
x)(make-event 'ca-update)(make-event 'ca-result-fix)(make-event 'ca-result-update))(defun ca-request-pids (sym test view record)(mapcar #'(lambda (z)(if (assoc z (nth 1 (assoc sym ca-list)))(setf (nth 1 (assoc z (nth 1 (assoc sym ca-list)))) 0)(setf (nth 1 (assoc sym ca-list)) (cons (list z 0) (nth 1 (assoc sym ca-list))))))
test)(mapcar #'(lambda (z)(let ((entry))(setf entry (assoc z (nth 1 (assoc sym ca-list))))(if entry
(setf (nth 1 entry) (logior (nth 1 entry) 1))(setf (nth 1 (assoc sym ca-list)) (cons (list z 1) (nth 1 (assoc sym ca-list)))))))
view)(mapcar #'(lambda (z)(let ((entry))(setf entry (assoc z (nth 1 (assoc sym ca-list))))(if entry
(setf (nth 1 entry) (logior (nth 1 entry) 2))(setf (nth 1 (assoc sym ca-list)) (cons (list z 1) (nth 1 (assoc sym ca-list)))))))
record)(make-event 'ca-update)(make-event 'ca-result-fix)(make-event 'ca-result-update))(defmacro set-ca-result (sym x)
`(setf (nth 2 (assoc ,sym ca-list)) ,x))(defmacro get-ca-result (sym)
`(nth 2 (assoc ,sym ca-list)))(defun set-parental-condition (sym x)(unless (eq (nth 3 (assoc sym ca-list)) x)(setf (nth 3 (assoc sym ca-list)) x)(make-event 'parental-check)))(defmacro get-parental-condition (sym)
`(nth 3 (assoc ,sym ca-list)))(defmacro set-ca-sysid (sym x)
`(setf (nth 4 (assoc ,sym ca-list)) ,x))(defmacro get-ca-sysid (sym)
`(nth 4 (assoc ,sym ca-list)))(defmacro set-ecm-code (sym x)
`(setf (nth 5 (assoc ,sym ca-list)) ,x))(defmacro get-ecm-code (sym)
`(nth 5 (assoc ,sym ca-list)))(defmacro set-ecm-rec (sym x)
`(setf (nth 6 (assoc ,sym ca-list)) ,x))(defmacro get-ecm-rec (sym)
`(nth 6 (assoc ,sym ca-list)))(defmacro set-bcast-id (sym x)
`(setf (nth 7 (assoc ,sym ca-list)) ,x))(defmacro get-bcast-id (sym)
`(nth 7 (assoc ,sym ca-list)))(defmacro set-ppv-id (sym x)
`(setf (nth 8 (assoc ,sym ca-list)) ,x))(defmacro get-ppv-id (sym)
`(nth 8 (assoc ,sym ca-list)))(defmacro set-ppv-prio (sym x)
`(setf (nth 9 (assoc ,sym ca-list)) ,x))(defmacro get-ppv-prio (sym)
`(nth 9 (assoc ,sym ca-list)))(defmacro set-ppv-fee (sym x)
`(setf (nth 10 (assoc ,sym ca-list)) ,x))(defmacro get-ppv-fee (sym)
`(nth 10 (assoc ,sym ca-list)))(defmacro set-purchase-hook (sym x)
`(setf (nth 11 (assoc ,sym ca-list)) ,x))(defmacro get-purchase-hook (sym)
`(nth 11 (assoc ,sym ca-list)))(defmacro set-sysmngid (sym x)
`(setf (nth 12 (assoc ,sym ca-list)) ,x))(defmacro get-sysmngid (sym)
`(nth 12 (assoc ,sym ca-list)))(defmacro set-ca-session (sym x)
`(setf (nth 13 (assoc ,sym ca-list)) ,x))(defmacro get-ca-session (sym)
`(nth 13 (assoc ,sym ca-list)))(defun init-ca-object (sym hook)(unless (assoc sym ca-list)(setf ca-list (cons (list sym nil nil nil nil nil nil nil nil nil nil nil nil nil) ca-list)))(set-ca-pids sym nil)(set-ca-result sym nil)(set-parental-condition sym t)(set-ca-sysid sym nil)(set-ecm-code sym nil)(set-ecm-rec sym nil)(set-bcast-id sym nil)(set-ppv-id sym nil)(set-ppv-prio sym nil)(set-ppv-fee sym nil)(set-purchase-hook sym hook)(set-sysmngid sym nil)(if (eq (ca-status sym) 'CA_SESSION_CLOSE)(set-ca-session sym nil)(set-ca-session sym t)))(defun request-ca-timer ()(set-timer #'(lambda (arg)(when (and (get-ca-pids 'ca) (not (ca-status 'ca)))(set-ca-result 'ca (ca-force-fixed 'ca))(make-event 'ca-result-fix)))
'ca-timeout-timer
nil
1
1000))(defun cancel-ca-timer ()(cancel-timer 'ca-timeout-timer))(defmacro set-cp-src (sym x)
`(setf (nth 1 (assoc ,sym cp-list)) ,x))(defmacro get-cp-src (sym)
`(nth 1 (assoc ,sym cp-list)))(defmacro set-cp-dst (sym x)
`(setf (nth 2 (assoc ,sym cp-list)) ,x))(defmacro get-cp-dst (sym)
`(nth 2 (assoc ,sym cp-list)))(defmacro set-cp-stream-info (sym x)
`(setf (nth 3 (assoc ,sym cp-list)) ,x))(defmacro get-cp-stream-info (sym)
`(nth 3 (assoc ,sym cp-list)))(defmacro set-cp-svc-type (sym x)
`(setf (nth 4 (assoc ,sym cp-list)) ,x))(defmacro get-cp-svc-type (sym)
`(nth 4 (assoc ,sym cp-list)))(defmacro set-cp-ca (sym x)
`(setf (nth 5 (assoc ,sym cp-list)) ,x))(defmacro get-cp-ca (sym)
`(nth 5 (assoc ,sym cp-list)))(defmacro set-cp-emi (sym x)
`(setf (nth 6 (assoc ,sym cp-list)) ,x))(defmacro get-cp-emi (sym)
`(nth 6 (assoc ,sym cp-list)))(defmacro set-cp-request (sym x)
`(setf (nth 7 (assoc ,sym cp-list)) ,x))(defmacro get-cp-request (sym)
`(nth 7 (assoc ,sym cp-list)))(defmacro set-cp-stb (sym x)
`(setf (nth 8 (assoc ,sym cp-list)) ,x))(defmacro get-cp-stb (sym)
`(nth 8 (assoc ,sym cp-list)))(defmacro set-cp-hook (sym x)
`(setf (nth 9 (assoc ,sym cp-list)) ,x))(defmacro get-cp-hook (sym)
`(nth 9 (assoc ,sym cp-list)))(defmacro set-cp-cog-mode (sym x)
`(setf (nth 10 (assoc ,sym cp-list)) ,x))(defmacro get-cp-cog-mode (sym)
`(nth 10 (assoc ,sym cp-list)))(defun init-cp-object (sym)(unless (assoc sym cp-list)(setf cp-list (cons (list sym nil nil nil nil nil nil nil nil nil nil) cp-list)))(set-cp-src sym nil)(set-cp-dst sym nil)(set-cp-stream-info sym 1)(set-cp-svc-type sym 1)(set-cp-ca sym nil)(set-cp-emi sym nil)(set-cp-request sym nil)(set-cp-stb sym nil)(set-cp-hook sym nil)(set-cp-cog-mode sym nil))(defun set-video-pid (sym x)(if (eq (nth 1 (assoc sym video-list)) x)(make-event 'video-update)(setf (nth 1 (assoc sym video-list)) x)(if (not x)(make-event 'video-pid-invalid))(make-event 'video-update)(make-event 'video-pid-valid)))(defmacro get-video-pid (sym)
`(nth 1 (assoc ,sym video-list)))(defmacro set-video-result (sym x)
`(setf (nth 2 (assoc ,sym video-list)) ,x))(defmacro get-video-result (sym)
`(nth 2 (assoc ,sym video-list)))(defmacro set-video-cp (sym x)
`(setf (nth 3 (assoc ,sym video-list)) ,x))(defmacro get-video-cp (sym)
`(nth 3 (assoc ,sym video-list)))(defmacro set-video-hook (sym x)
`(setf (nth 4 (assoc ,sym video-list)) ,x))(defmacro get-video-hook (sym)
`(nth 4 (assoc ,sym video-list)))(defmacro set-video-pcr (sym x)
`(setf (nth 5 (assoc ,sym video-list)) ,x))(defmacro get-video-pcr (sym)
`(nth 5 (assoc ,sym video-list)))(defmacro set-video-codec (sym x)
`(setf (nth 6 (assoc ,sym video-list)) ,x))(defmacro get-video-codec (sym)
`(nth 6 (assoc ,sym video-list)))(defmacro set-video-streamid (sym x)
`(setf (nth 7 (assoc ,sym video-list)) ,x))(defmacro get-video-streamid (sym)
`(nth 7 (assoc ,sym video-list)))(defmacro set-video-vbipid (sym x)
`(video-set-vbipid ,sym ,x))(defmacro get-video-vbipid (sym)
`(video-get-vbipid ,sym))(defun init-video-object (sym)(unless (assoc sym video-list)(setf video-list (cons (list sym nil nil nil nil nil nil nil) video-list)))(set-video-result sym (video-status sym))(if (get-video-result sym)(video-property sym #'(lambda (pid)(set-video-pid sym pid)))(set-video-pid sym nil))(set-video-cp sym t))(defun set-audio-pid (sym x)(if (eq (nth 1 (assoc sym audio-list)) x)(make-event 'audio-update)(setf (nth 1 (assoc sym audio-list)) x)(if (not x)(make-event 'audio-pid-invalid))(make-event 'audio-update)(make-event 'audio-pid-valid)))(defmacro get-audio-pid (sym)
`(nth 1 (assoc ,sym audio-list)))(defmacro set-audio-result (sym x)
`(setf (nth 2 (assoc ,sym audio-list)) ,x))(defmacro get-audio-result (sym)
`(nth 2 (assoc ,sym audio-list)))(defmacro set-audio-cp (sym x)
`(setf (nth 3 (assoc ,sym audio-list)) ,x))(defmacro get-audio-cp (sym)
`(nth 3 (assoc ,sym audio-list)))(defmacro set-audio-format (sym x)
`(setf (nth 4 (assoc ,sym audio-list)) ,x))(defmacro get-audio-format (sym)
`(nth 4 (assoc ,sym audio-list)))(defmacro set-audio-volume (sym x)
`(setf (nth 5 (assoc ,sym audio-list)) ,x))(defmacro get-audio-volume (sym)
`(nth 5 (assoc ,sym audio-list)))(defmacro set-audio-pcr (sym x)
`(setf (nth 6 (assoc ,sym audio-list)) ,x))(defmacro get-audio-pcr (sym)
`(nth 6 (assoc ,sym audio-list)))(defmacro set-audio-mode (sym x)
`(setf (nth 7 (assoc ,sym audio-list)) ,x))(defmacro get-audio-mode (sym)
`(nth 7 (assoc ,sym audio-list)))(defmacro set-audio-volume-gain (sym x)
`(setf (nth 8 (assoc ,sym audio-list)) ,x))(defmacro get-audio-volume-gain (sym)
`(nth 8 (assoc ,sym audio-list)))(defmacro set-audio-streamid (sym x)
`(setf (nth 9 (assoc ,sym audio-list)) ,x))(defmacro get-audio-streamid (sym)
`(nth 9 (assoc ,sym audio-list)))(defun init-audio-object (sym)(unless (assoc sym audio-list)(setf audio-list (cons (list sym nil nil nil nil nil nil nil nil nil) audio-list)))(set-audio-result sym (audio-status sym))(if (get-audio-result sym)(audio-property sym #'(lambda (pid)(set-audio-pid sym pid)))(set-audio-pid sym nil))(set-audio-cp sym t)(set-audio-format sym nil)(set-audio-volume sym nil)(set-audio-volume-gain sym nil))(defmacro set-section-valid (sym x)
`(setf (nth 1 (assoc ,sym section-list)) ,x))(defmacro get-section-valid (sym)
`(nth 1 (assoc ,sym section-list)))(defmacro set-section-pid (sym x)
`(setf (nth 2 (assoc ,sym section-list)) ,x))(defmacro get-section-pid (sym)
`(nth 2 (assoc ,sym section-list)))(defmacro set-section-length (sym x)
`(setf (nth 3 (assoc ,sym section-list)) ,x))(defmacro get-section-length (sym)
`(nth 3 (assoc ,sym section-list)))(defmacro set-section-elength (sym x)
`(setf (nth 4 (assoc ,sym section-list)) ,x))(defmacro get-section-elength (sym)
`(nth 4 (assoc ,sym section-list)))(defmacro set-section-filter (sym x)
`(setf (nth 5 (assoc ,sym section-list)) ,x))(defmacro get-section-filter (sym)
`(nth 5 (assoc ,sym section-list)))(defmacro set-section-mask (sym x)
`(setf (nth 6 (assoc ,sym section-list)) ,x))(defmacro get-section-mask (sym)
`(nth 6 (assoc ,sym section-list)))(defmacro set-section-efilter (sym x)
`(setf (nth 7 (assoc ,sym section-list)) ,x))(defmacro get-section-efilter (sym)
`(nth 7 (assoc ,sym section-list)))(defmacro set-section-emask (sym x)
`(setf (nth 8 (assoc ,sym section-list)) ,x))(defmacro get-section-emask (sym)
`(nth 8 (assoc ,sym section-list)))(defun init-section-object (sym)(unless (assoc sym section-list)(setf section-list (cons (list sym nil nil nil nil nil nil nil nil) section-list)))(set-section-valid sym nil)(set-section-pid sym nil)(set-section-length sym 6)(set-section-elength sym 0)(set-section-filter sym (list #xFF #xFF #xFF #xFF #xFF #x01))(set-section-mask sym (list #xFF #xFF #xFF #xFF #xFF #xFE))(set-section-efilter sym (list #xFF #xFF #xFF #xFF #xFF #xFF))(set-section-emask sym (list #xFF #xFF #xFF #xFF #xFF #xC1)))(defvar pat-monitor-period 3000)(defvar pmt-monitor-period 3000)(defun set-pat-monitor-period (x)(setf pat-monitor-period x))(defun get-pat-monitor-period ()
pat-monitor-period)(defun set-pmt-monitor-period (x)(setf pmt-monitor-period x))(defun get-pmt-monitor-period ()
pmt-monitor-period)(defun pat-timeout-fun (x)(set-psi-valid 'psi nil)(make-event 'psi-invalid)(set-section-valid 'pat nil)(make-event 'pat-timeout))(defun pat-monitor-fun (x)(section-filter 'pat-mon
:source 'tsport
:pid (get-section-pid 'pat)
:length (get-section-length 'pat)
:filter (get-section-filter 'pat)
:mask (get-section-mask 'pat)
:elength 0)(section-enable 'pat-mon)(set-timer (function pat-timeout-fun)
'pat-timeout
nil
1
(get-pat-monitor-period)))(defun start-pat-monitor ()(cancel-timer 'pat-monitor)(cancel-timer 'pat-timeout)(section-open 'pat-mon)(section-disable 'pat-mon)(set-timer (function pat-monitor-fun)
'pat-monitor
nil
1
(get-pat-monitor-period)))(defun stop-pat-monitor ()(cancel-timer 'pat-monitor)(cancel-timer 'pat-timeout)(section-close 'pat-mon))(defun pmt-timeout-fun (x)(set-psi-valid 'psi nil)(make-event 'psi-invalid)(set-section-valid 'pmt nil)(make-event 'pmt-timeout))(defun pmt-monitor-fun (x)(section-filter 'pmt-mon
:source 'tsport
:pid (get-section-pid 'pmt)
:length (get-section-length 'pmt)
:filter (get-section-filter 'pmt)
:mask (get-section-mask 'pmt)
:elength 0)(section-enable 'pmt-mon)(set-timer (function pmt-timeout-fun)
'pmt-timeout
nil
1
(get-pmt-monitor-period)))(defun start-pmt-monitor ()(cancel-timer 'pmt-monitor)(cancel-timer 'pmt-timeout)(section-open 'pmt-mon)(section-disable 'pmt-mon)(set-timer (function pmt-monitor-fun)
'pmt-monitor
nil
1
(get-pmt-monitor-period)))(defun stop-pmt-monitor ()(cancel-timer 'pmt-monitor)(cancel-timer 'pmt-timeout)(section-close 'pmt-mon))(defun parse-psi (sym key)(psi-parser sym #'(lambda (pid data)(when (and pid data)(set-psi-pid sym pid)(set-psi-svcid sym (+ (* (fourth (first data)) #x100)(fifth (first data))))(unless unknown-stream
(set-tuning-svcid (get-psi-svcid sym)))(funcall (get-pmt-hook sym) data key)(set-psi-valid sym t)))))(defmacro atomic (&rest body)
`(progn
(atomic-start)
,@body
(atomic-end)))(defun setup-node (sym)(set-tuning-tsl-key (get-tuner-tsl-key 'tuner))(set-tuning-svcid (get-psi-svcid 'psi))(eval-node sym))(defun search-svcid-in-pat (svcid)(when pat-*pmtlist*
(setf pmt-*svcid* svcid)(setf pmt-*pid* (nth 1 (assoc pmt-*svcid* pat-*pmtlist*)))))(defun change-svcid (svcid)(set-tuning-svcid svcid)(unless (eq (get-tuning-svcid) (get-psi-svcid 'psi))(set-psi-valid 'psi nil)(set-psi-error 'psi nil)(make-event 'psi-invalid)(search-svcid-in-pat svcid)(make-event 'service-change)))(defun select-channel ()(if (tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key '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-device 'tuner
"tuner"
(get-default-prio)
#'(lambda (sig)(when (get-tuner-hook 'tuner)(funcall (get-tuner-hook 'tuner) sig))(case sig
(LOST
(set-owner 'tuner nil)(make-event 'tuner-lost))(AVAILABLE
(set-owner 'tuner t)(make-event 'tuner-available))(TUNER_LOCK
(make-event 'tuner-lock))(TUNER_UNLOCK
(make-event 'tuner-unlock))(TUNER_SEARCH_LOCK
(make-event 'tuner-search-lock))(TUNER_SEARCH_FAIL
(make-event 'tuner-search-fail))(TUNER_BADSIGNAL
(make-event 'tuner-badsignal))((TUNER_HIGH_LAYER TUNER_LOW_LAYER)(make-event 'tuner-layer-change))(TUNER_CONTROLABLE
(make-event 'tuner-controlable))(TUNER_DISCONNECT
(make-event 'tuner-disconnect))(TUNER_OUTOF_CONTROL
(make-event 'tuner-outof-control)))))(register-device 'tsport
"tsport"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tsport nil))(AVAILABLE
(set-owner 'tsport t)(make-event 'tsport-available))(SOURCE_CHANGE
(make-event 'tsport-change)))))(register-section 'pat
#'(lambda (data)(let ((ptr) (svcid nil) (pid nil))(setf pat-*tsid* nil)(setf pat-*pmtlist* nil)(mapcar #'(lambda (sec)(unless pat-*tsid*
(setf pat-*tsid* (+ (* (nth 3 sec) #x100) (nth 4 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 pat-*pmtlist*
(unless (assoc svcid pat-*pmtlist*)(setf-cdr (last pat-*pmtlist*) (cons (list svcid pid) nil)))(setf pat-*pmtlist* (cons (list svcid pid) nil))))(setf ptr (nthcdr 4 ptr))))
data)(search-svcid-in-pat (if unknown-stream (first (nth 0 pat-*pmtlist*)) (get-tuning-svcid)))(if (get-section-valid 'pat)(progn
(make-event 'pat-tsid-update)(make-event 'pat-pmtlist-update))(set-section-valid 'pat t)(make-event 'pat-valid))(when (and (get-psi-pid 'psi) (not (eq pmt-*pid* (get-psi-pid 'psi))))(set-psi-valid 'psi nil)(set-psi-error 'psi nil)(make-event 'psi-invalid)))))(register-section 'pmt
#'(lambda (data)(if (get-section-valid 'pmt)(make-event 'pmt-update)(set-section-valid 'pmt t)(make-event 'pmt-valid))(when (psi-validate 'psi 'pmt)(set-psi-error 'psi nil)(if (get-psi-valid 'psi)(make-event 'psi-update)(set-psi-valid 'psi t)(make-event 'psi-valid)))))(register-device 'psi
"psi"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'psi nil)(make-event 'psi-lost))(AVAILABLE
(set-owner 'psi t)(when (get-section-valid 'pmt)(when (psi-validate 'psi 'pmt)(set-psi-error 'psi nil)(set-psi-valid 'psi t)(make-event 'psi-valid)))(make-event 'psi-available))(SOURCE_CHANGE
(make-event 'psi-source-change))(PSI_VALID
(set-psi-error 'psi nil)(set-psi-valid 'psi t)(make-event 'psi-valid))(PSI_UPDATE
(set-psi-error 'psi nil)(make-event 'psi-update))(PSI_ERROR
(set-psi-error 'psi (psi-get-error 'psi))(make-event 'psi-error))(PSI_INVALID
(set-psi-valid 'psi nil)(make-event 'psi-invalid)))))(register-device 'ca
"ca"
(get-default-prio)
#'(lambda (sig)(case sig
(CA_SESSION_OPEN
(set-ca-session 'ca t)(make-event 'ca-session-open))(CA_SESSION_CLOSE
(set-ca-session 'ca nil)(make-event 'ca-session-close))((CA_SATISFIED CA_CARD_REMOVE CA_ERROR CA_PPV)(cancel-ca-timer)(set-ca-result 'ca sig)(make-event 'ca-result-fix)(make-event 'ca-result-update))(CA_CARD_INSERT
(when (eq (get-ca-result 'ca) 'CA_CARD_REMOVE)(set-ca-result 'ca nil)(request-ca-timer)(make-event 'ca-result-fix)))(CA_PPV_PURCHASED
(set-ca-sysid 'ca (ca-get-system-id 'ca))(funcall (get-purchase-hook 'ca) (ca-get-purchased-log 'ca)))(CA_COPY_PROTECTION
(eval-copy-protection 'cp)))))(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))((DECODE_SUCCESS DECODE_ERROR DECODE_SCRAMBLE)(if (not (get-video-result 'video))(make-event 'video-result-fix)(set-video-result 'video (video-status 'video))(video-property 'video #'(lambda (pid)(unless (eq (get-video-pid 'video) pid)(set-video-pid 'video pid))))(make-event 'video-result-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))))))(register-device 'cp
"cp"
(get-default-prio)
#'(lambda (sig dev)(when (get-cp-hook dev)(funcall (get-cp-hook dev) sig))))(register-section 'pat-mon
#'(lambda (data)(section-disable 'pat-mon)(cancel-timer 'pat-timeout)(set-timer (function pat-monitor-fun)
'pat-monitor
nil
1
1000)))(register-section 'pmt-mon
#'(lambda (data)(section-disable 'pmt-mon)(cancel-timer 'pmt-timeout)(set-timer (function pmt-monitor-fun)
'pmt-monitor
nil
1
1000)))(register-node 'tuner-freq-valid
#'(lambda ()(tsl-equal (get-tuning-tsl-key) (get-tuner-tsl-key 'tuner)))
#'(lambda ()(set-tuner-tsl-key 'tuner (get-tuning-tsl-key))(eval-events (list 'tuner-req 'tuner-change)))
#'(lambda ()
nil))(register-node 'tuner-connect
#'(lambda ()(tuner-status 'tuner))
#'(lambda ()(unless (tuner-connect 'tuner
:tsl (get-tuner-tsl-key 'tuner))(set-tuner-tsl-key 'tuner (tuner-tsl-key 'tuner)))(eval-events (list 'tuner-lock 'tuner-unlock 'tuner-disconnect)))
#'(lambda ()(tuner-disconnect 'tuner)))(register-node 'tuner-low-layer
#'(lambda ()(eq (tuner-layer 'tuner) 0))
#'(lambda ()(eval-events (list 'tuner-layer-change)))
#'(lambda ()
nil))(register-node 'tsport-connect
#'(lambda ()(device-source-p 'tsport 'tuner))
#'(lambda ()(tsport-connect 'tsport 'tuner)(eval-events (list 'tsport-available 'tsport-change)))
#'(lambda ()
nil))(register-node 'psi-valid
#'(lambda ()(get-psi-valid 'psi))
#'(lambda ()(set-psi-valid 'psi (psi-status 'psi))(eval-events (list 'psi-valid 'psi-invalid)))
#'(lambda ()
nil))(register-node 'parse-pmt
#'(lambda ()(and (get-psi-svcid 'psi) (get-psi-pid 'psi)))
#'(lambda (key)(parse-psi 'psi key)(eval-events (list 'psi-update)))
#'(lambda (key)(when (psi-invalidate 'psi)(set-psi-valid 'psi nil))(when (get-psi-svcid 'psi)(set-psi-svcid 'psi nil)(set-psi-pid 'psi nil)(funcall (get-pmt-hook 'psi) nil key))(eval-events (list 'psi-available))))(register-node 'ca-request
#'(lambda ()
t)
#'(lambda ()(cancel-ca-timer)(ca-request 'ca 'psi (get-ca-pids 'ca))(if (not (ca-status 'ca))(request-ca-timer)(unless (get-ca-result 'ca)(eval-copy-protection 'cp)))(set-ca-result 'ca (ca-status 'ca))(eval-events (list 'ca-update)))
#'(lambda ()(ca-cancel 'ca)))(register-node 'ca-result-fix
#'(lambda ()(get-ca-result 'ca))
#'(lambda ()(case (get-ca-result 'ca)(CA_CARD_REMOVE
(set-ca-sysid 'ca (ca-get-system-id 'ca)))(CA_ERROR
(set-ca-sysid 'ca (ca-get-system-id 'ca))(ca-get-ecm-info 'ca #'(lambda (x y z)(set-ecm-code 'ca x)(set-ecm-rec 'ca y)(set-bcast-id 'ca z))))(CA_PPV
(set-ca-sysid 'ca (ca-get-system-id 'ca))(ca-get-ecm-info 'ca #'(lambda (x y z)(set-ecm-code 'ca x)(set-ecm-rec 'ca y)(set-bcast-id 'ca z)))(ca-get-ppv-info 'ca #'(lambda (x y z)(set-ppv-id 'ca x)(set-ppv-prio 'ca y)(set-ppv-fee 'ca z)))))(eval-events (list 'ca-result-fix)))
#'(lambda ()(set-ca-sysid 'ca nil)(set-ecm-code 'ca nil)(set-ecm-rec 'ca nil)(set-bcast-id 'ca nil)(set-ppv-id 'ca nil)(set-ppv-prio 'ca nil)(set-ppv-fee 'ca nil)(set-ca-result 'ca nil)))(register-node 'display-cp-valid
#'(lambda ()(and (get-video-cp 'video) (get-audio-cp 'audio)))
#'(lambda ()(eval-events (list 'video-cp-update 'audio-cp-update)))
#'(lambda ()
nil))(register-node 'video-pid-valid
#'(lambda ()(get-video-pid 'video))
#'(lambda ()(eval-events (list 'video-pid-invalid 'video-pid-valid)))
#'(lambda ()))(register-node 'video-cp-valid
#'(lambda ()(get-video-cp 'video))
#'(lambda ()(eval-events (list 'video-cp-update)))
#'(lambda ()
nil))(register-node 'video-play
#'(lambda ()(get-video-result 'video))
#'(lambda ()(when (eq (get-video-pid 'video) (audio-property 'audio #'(lambda (pid)
pid)))(audio-stop 'audio))(video-play 'video
:psi 'psi
:pcr (get-video-pcr 'video)
:pid (get-video-pid 'video))(set-video-result 'video (video-status 'video))(eval-events (list 'video-update 'video-result-fix 'video-available)))
#'(lambda ()(video-stop 'video)(set-video-result 'video nil)(eval-events (list 'video-available))))(register-node 'video-pcr
#'(lambda ()
t)
#'(lambda ()(unless (get-audio-pid 'audio)(audio-pcr-set 'audio 'psi)))
#'(lambda ()(audio-pcr-unset 'audio)))(register-node 'audio-pid-valid
#'(lambda ()(get-audio-pid 'audio))
#'(lambda ()(eval-events (list 'audio-pid-invalid 'audio-pid-valid)))
#'(lambda ()))(register-node 'audio-cp-valid
#'(lambda ()(get-audio-cp 'audio))
#'(lambda ()(eval-events (list 'audio-cp-update)))
#'(lambda ()
nil))(register-node 'audio-play
#'(lambda ()(get-audio-result 'audio))
#'(lambda ()(when (audio-play 'audio
:psi 'psi
:pid (get-audio-pid 'audio)
:pcr (get-audio-pcr 'audio)
:format (get-audio-format 'audio)
:mode (get-audio-mode 'audio))(audio-volume 'audio (get-audio-volume 'audio))(audio-volume-gain 'audio (get-audio-volume-gain 'audio)))(set-audio-result 'audio (audio-status 'audio))(eval-events (list 'audio-update 'audio-result-fix 'audio-available)))
#'(lambda ()(audio-stop 'audio)(set-audio-result 'audio nil)(eval-events (list 'audio-available))))(register-node 'audio-pcr
#'(lambda ()
t)
#'(lambda ()(unless (get-video-pid 'video)(audio-pcr-set 'audio 'psi))(eval-events (list 'audio-available)))
#'(lambda ()(audio-pcr-unset 'audio)))(register-node 'set-cgms-mv
#'(lambda ()
t)
#'(lambda ()(cp-set 'cp 'video)(eval-events (list 'cgms-mv-update)))
#'(lambda ()
nil))(register-node 'pat-request
#'(lambda ()(get-section-valid 'pat))
#'(lambda ()(unless (get-section-valid 'pat)(setf pat-*pmtlist* nil)(section-open 'pat)(section-disable 'pat)(set-section-pid 'pat 0)(setf (nth 0 (get-section-filter 'pat)) 0)(setf (nth 0 (get-section-mask 'pat)) 0)(section-filter 'pat
:type "version"
:source 'tsport
:pid (get-section-pid 'pat)
:length (get-section-length 'pat)
:filter (get-section-filter 'pat)
:mask (get-section-mask 'pat)
:elength (get-section-elength 'pat)
:efilter (get-section-efilter 'pat)
:emask (get-section-emask 'pat))(section-enable 'pat))(eval-events (list 'pat-valid 'pat-timeout)))
#'(lambda ()(section-close 'pat)(set-section-valid 'pat nil)))(register-node 'pat-monitor
#'(lambda ()
t)
#'(lambda ()(start-pat-monitor))
#'(lambda ()(stop-pat-monitor)))(register-node 'tsid-check
#'(lambda ()(eq (get-tuning-tsid) pat-*tsid*))
#'(lambda ()(eval-events (list 'pat-tsid-update)))
#'(lambda ()(setf pat-*tsid* nil)))(register-node 'svcid-check
#'(lambda ()
t)
#'(lambda ())
#'(lambda ()))(register-node 'pmt-pid-valid
#'(lambda ()(and pmt-*pid* pmt-*svcid*
(eq pmt-*pid* (get-section-pid 'pmt))(eq (/ pmt-*svcid* #x100) (nth 3 (get-section-filter 'pmt)))(eq (logand pmt-*svcid* #xFF) (nth 4 (get-section-filter 'pmt)))))
#'(lambda ()(when pmt-*pid*
(set-section-pid 'pmt pmt-*pid*))(when pmt-*svcid*
(setf (nth 3 (get-section-filter 'pmt)) (/ pmt-*svcid* #x100))(setf (nth 3 (get-section-mask 'pmt)) 0)(setf (nth 4 (get-section-filter 'pmt)) (logand pmt-*svcid* #xFF))(setf (nth 4 (get-section-mask 'pmt)) 0))(eval-events (list 'service-change 'pat-pmtlist-update)))
#'(lambda ()(setf pmt-*pid* nil)(setf pmt-*svcid* nil)))(register-node '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)(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)))(register-node 'pmt-monitor
#'(lambda ()
t)
#'(lambda ()(start-pmt-monitor))
#'(lambda ()(stop-pmt-monitor)))
