(load "/usr/local/slisp/station.lsp")(load "/usr/local/slisp/dlna/dms-market.lsp")


(defvar msg-pipe nil)(defvar msg-form nil)(defun send-event (event size data)(when msg-pipe
(unless msg-form
(setf msg-form (register-message 'msg-form
:fd msg-pipe
:header-size 4
:length-field 4)))(write-bytes msg-form event size data)))

(defmacro transcode-transfer-p ()
`req-transcode)

(defvar dms-play-mode "resume")

(defvar transfer-pcr nil)(defvar transfer-video nil)(defvar transfer-audio nil)(defvar transfer-vtype nil)(defvar transfer-atype nil)

(defvar new-transfer-pcr nil)(defvar new-transfer-video nil)(defvar new-transfer-audio nil)(defvar new-transfer-vtype nil)(defvar new-transfer-atype nil)

(defvar new-transfer-pids nil)(defvar new-encode-pids nil)

(defvar encode-ready nil)(defvar req-encode nil)(defvar overwrite-enc-eemi nil)

(defvar buffer-ch 0)(defvar mpeg2-flag 0)(defvar wtuner 0)(defvar req-tuner-id 0)(defvar req-transcode-mode 0)(defvar req-tune-info nil)(defvar dms-content-flag nil)

(defvar pmemout-sync-wait nil)(defvar partial-stopped t)

(defvar request-pids nil)(defvar request-pcr nil)

(defvar open-sesami nil)(defvar current-svc-info nil)

(defvar svl-key nil)(defvar no-copy-status nil)

(defvar partial-list nil)(defvar video-lost nil)(defvar need-check-stuner-available nil)

(defvar liveview-dec-no nil)

(defmacro set-partial-pids (sym x)
`(setf (nth 1 (assoc ,sym partial-list)) ,x))(defmacro get-partial-pids (sym)
`(nth 1 (assoc ,sym partial-list)))(defmacro set-partial-cp (sym x)
`(when (assoc ,sym partial-list)(setf (nth 2 (assoc ,sym partial-list)) ,x)))(defmacro get-partial-cp (sym)
`(nth 2 (assoc ,sym partial-list)))(defun init-partial-object (sym)(unless (assoc sym partial-list)(setf partial-list (cons (list sym nil nil) partial-list)))(set-partial-pids sym nil)(set-partial-cp sym nil))

(defun list-equal (a b)(if (and a b)(and (eq (car a) (car b)) (list-equal (cdr a) (cdr b)))(if (and (not a) (not b))
t
nil)))

(defvar force-vga nil)(defun hd-format-p (vsym)(let ((vfmt (video-format vsym)))(and vfmt (> (nth 1 vfmt) 576))))

(defun get-encode-compress ()(if (or (and (or (eq req-encode TRANSCODE_720P)(eq req-encode TRANSCODE_720P3500)(eq req-encode TRANSCODE_720P1500))
force-vga)(eq req-encode TRANSCODE_VGA))(if (eq dms-area 'jp)
2000
3000)(if (eq req-encode TRANSCODE_720P)
6000
(if (eq req-encode TRANSCODE_720P3500)
3500
(if (eq req-encode TRANSCODE_720P1500)
1500
(if (eq req-encode TRANSCODE_VGA1500)
1500
(if (eq req-encode TRANSCODE_VGA650)
650
(if (eq req-encode TRANSCODE_QVGA400)
400
(if (eq req-encode TRANSCODE_QVGA150)
150
nil)))))))))(defun get-encode-resolution (tmode)(if (or (and (or (eq req-encode TRANSCODE_720P)(eq req-encode TRANSCODE_720P3500)(eq req-encode TRANSCODE_720P1500))
force-vga)(eq req-encode TRANSCODE_VGA))
"vga"
(if (eq req-encode TRANSCODE_720P)
"720p"
(if (eq req-encode TRANSCODE_720P3500)
"720p"
(if (eq req-encode TRANSCODE_720P1500)
"720p"
(if (eq req-encode TRANSCODE_VGA1500)
"vga"
(if (eq req-encode TRANSCODE_VGA650)
"vga"
(if (eq req-encode TRANSCODE_QVGA400)
"qvga"
(if (eq req-encode TRANSCODE_QVGA150)
"qvga"
nil)))))))))

(defun request-partial (pcr video vtype audio atype emi dtcp pids encode)(setf req-encode encode)(setf new-transfer-pcr pcr)(setf new-transfer-video video)(setf new-transfer-vtype vtype)(setf new-transfer-audio audio)(setf new-transfer-atype atype)(setf new-transfer-pids pids)(unless partial-stopped
(setf pmemout-sync-wait t))(make-event 'transfer-reset-check)(make-event 'encode-restart)(make-event 'encode-req)(make-event 'partial-req)(make-event 'pmemout-req))

(defun cancel-partial ()(setf new-transfer-pids nil)(setf new-encode-pids nil)(make-event 'encode-req)(make-event 'partial-req))

(register-device 'partial
"partial"
(get-default-prio)
#'(lambda (sig)(case sig
(TSPORT_DISCONNECT
(send-event SC_RES_TSPORT_DISCONNECT 0 nil))(SCRAMBLE_CHANGE
(unless partial-stopped
(setf pmemout-sync-wait t))(make-event 'partial-req)(make-event 'pmemout-req))(CREATE_SEQUENCE
(let ((spn (partial-info 'partial 'pmtspn))(eemi (partial-info (if (transcode-transfer-p)
'partial-enc
'partial)
'eemi)))(when spn
(send-event SC_RES_PMTSPN_INFO 8 (list spn eemi)))))(LOST
(set-owner 'partial nil))(AVAILABLE
(set-owner 'partial t)))))

(register-device 'partial-enc
"partial-encode"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(if (eq req-tune-info nil)(progn
(disconnect-player)(send-retry-player-resource-event))(progn
(sender-with-tuner-stop)(send-retry-tuner-resource-event))))(DEVICE_RESET
(setf encode-ready nil)(unless partial-stopped
(setf pmemout-sync-wait t))(make-event 'encode-restart))(VPATH_LOST
(send-event SC_RES_VPATH_LOST 0 nil)))))(register-device 'partial-ex
"partial"
(get-default-prio)
#'(lambda (sig)))

(defmacro no-decode ()
`(not (or (video-pid 'video)(audio-pid 'audio))))

(register-device 'tsport-ex
"tsport"
(get-default-prio)
#'(lambda (sig)))

(register-node 'transfer-reset-check
#'(lambda ()(if (not (transcode-transfer-p))
t
(and new-transfer-video
(eq new-transfer-pcr transfer-pcr)(eq new-transfer-video transfer-video)(eq new-transfer-vtype transfer-vtype))))
#'(lambda ()(setf transfer-pcr new-transfer-pcr)(setf transfer-video new-transfer-video)(setf transfer-vtype new-transfer-vtype)(setf transfer-audio new-transfer-audio)(setf transfer-atype new-transfer-atype)(eval-events (list 'transfer-reset-check)))
#'(lambda ()))

(defvar encode-video nil)(defvar encode-audio nil)(defun set-encode-video-pid (pid)(unless (eq encode-video pid)(setf encode-video pid)(unless partial-stopped
(setf pmemout-sync-wait t))(make-event 'encode-restart)))(defun set-encode-audio-pid (pid)(unless (eq encode-audio pid)(setf encode-audio pid)))

(register-node 'decoder-pipe
#'(lambda ()(or (no-decode)(and (device-source-p 'video 'tsport)(device-source-p 'audio 'tsport))))
#'(lambda ()(unless (or (no-decode)(and (device-source-p 'video 'tsport)(device-source-p 'audio 'tsport)))(video-stop 'video)(audio-stop 'audio))(eval-events (list 'video-source-change 'audio-source-change)))
#'(lambda ()
nil))

(register-node 'video-play-enc
#'(lambda ()
t)
#'(lambda ()(unless (eq (video-pid 'video) (get-video-pid 'video))(when (video-pid 'video)(video-stop 'video))(video-play 'video
:psi psi-play-sym
:pcr (get-video-pcr 'video)
:codec (get-video-codec 'video)
:pid (get-video-pid 'video)))(eval-events (list 'video-update)))
#'(lambda ()(video-stop 'video)))(register-node 'audio-play-enc
#'(lambda ()
t)
#'(lambda ()(audio-play 'audio
:psi psi-play-sym
:pid (get-audio-pid 'audio)
:pcr (get-audio-pcr 'audio)
:format (get-audio-format 'audio)
:mode (get-audio-mode 'audio)
:dmix-mode (get-audio-dmix-mode 'audio))(eval-events (list 'audio-update)))
#'(lambda ()(audio-stop 'audio)))(register-node 'decode-proc
#'(lambda ()(and encode-ready (eq encode-video transfer-video) (eq encode-audio transfer-audio)))
#'(lambda ()(when (and (eq encode-video transfer-video) (eq encode-audio transfer-audio))(if encode-ready
(unless (eq (video-status 'video) 'DECODE_SUCCESS)(send-event SC_RES_AV_DECODE_STAT
4 (list SC_DECODE_NG)))(set-timer #'(lambda ()(send-event SC_RES_AV_DECODE_STAT
4 (list SC_DECODE_NG)))
'decode-timeout
nil
1
3000)(when (and (eq (video-status 'video) 'DECODE_SUCCESS)(eq (audio-status 'audio) 'DECODE_SUCCESS))(when (find-timer 'decode-timeout)(cancel-timer 'decode-timeout))(send-event SC_RES_AV_DECODE_STAT 4 (list SC_DECODE_OK))(setf force-vga (not (hd-format-p 'video)))(setf encode-ready t))))(eval-events (list 'video-result-fix 'video-result-update
'audio-result-fix 'audio-result-update
'encode-restart)))
#'(lambda ()(cancel-timer 'decode-timeout)(setf force-vga nil)(setf encode-ready nil)))

(register-node 'encode-proc
#'(lambda ()(eq (partial-encode-status 'partial-enc) t))
#'(lambda ()(when (device-open-p 'cp)(cp-set 'cp 'partial-enc))(case (partial-encode-start 'partial-enc
:pmt (if dms-content-flag
'ppmt
'pmt)
:video-dev 'video
:audio-dev 'audio
:noindex t
:dtcp-eemi overwrite-enc-eemi
:compress (get-encode-compress)
:resolution (get-encode-resolution))(DEVICE_RESET
(set-timer #'(lambda (arg)(setf encode-ready nil)(unless partial-stopped
(setf pmemout-sync-wait t))(make-event 'encode-restart))
'encode-restart
nil
1
0))(t
(setf new-encode-pids (partial-encode-pids 'partial-enc))))(eval-events (list 'encode-req)))
#'(lambda ()(setf new-encode-pids nil)(partial-encode-stop 'partial-enc)))

(register-node 'partial-start
#'(lambda ()(and (get-partial-pids 'partial)(device-source-p 'partial (if (/= req-encode 0)
'tsport-ex
'tsport))(partial-status 'partial)))
#'(lambda ()(set-partial-pids 'partial (if (/= req-encode 0)
new-encode-pids
new-transfer-pids))(if (get-partial-pids 'partial)(if (/= req-encode 0)(progn
(partial-enable 'partial 'tsport-ex)(partial-start 'partial
:noindex t
:origin 'partial-enc))(when (device-open-p 'cp)(cp-set 'cp 'partial))(partial-enable 'partial 'tsport)(partial-start 'partial
:pat 'pat
:pmt 'pmt
:noindex t
:video-pid transfer-video
:video-stype transfer-vtype
:audio-pid transfer-audio
:audio-stype transfer-atype
:pcr-pid transfer-pcr
:espids (get-partial-pids 'partial)))(partial-stop 'partial))(eval-events (list 'partial-req)))
#'(lambda ()(when pmemout-sync-wait
(listener pmemout-stop 0)(if (or (get-tuning-tsl-key)
req-content-id)(send-event SC_RES_TRANSFER_STOP 0 nil)(send-event SC_RES_TRANSFER_FINISH 0 nil))(listener pmemout-sync 0)(setf pmemout-sync-wait nil))(setf partial-stopped t)(partial-stop 'partial)))

(register-device 'video-mon
"video"
10
#'(lambda (sig)(case sig
((DECODE_SUCCESS DECODE_ERROR DECODE_SCRAMBLE)(when (device-source-p 'video-mon 'tsport)(set-video-result 'video-mon (video-status 'video-mon))(video-property 'video-mon
#'(lambda (pid)(unless (eq (get-video-pid 'video-mon) pid)(set-video-pid 'video-mon pid)(make-event 'psi-mon-update)))))))))

(register-device 'audio-mon
"audio"
10
#'(lambda (sig)(case sig
((DECODE_SUCCESS DECODE_ERROR DECODE_SCRAMBLE)(make-event 'psi-mon-update)))))

(when tuner-power
(register-device 'tuner-pwr
"tuner-power"
(get-default-prio)
#'(lambda (sig)(case sig
(AVAILABLE
(unless (tuner-pwr-status 'tuner-pwr)(tuner-pwr-on 'tuner-pwr)))(TUNER_PWR_CHANGE
(make-event 'tuner-pwr-change))))))

(register-device 'psi-enc
"psi"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'psi-enc nil))(AVAILABLE
(set-owner 'psi-enc t)))))

(register-device 'tsport-in
"tsport"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'tsport-in nil))(AVAILABLE
(set-owner 'tsport-in t)))))

(register-device 'stream-in
"stream-in"
(get-default-prio)
#'(lambda (sig)(case sig
(LOST
(set-owner 'stream-in nil)(disconnect-player)(send-retry-player-resource-event))(AVAILABLE
(set-owner 'stream-in t))(STREAM_PLAY_OK
(send-play-ok-msg))(STREAM_FINISH
(when content-id
(unless partial-stopped
(setf pmemout-sync-wait t))(if (stream-index-next 'stream-in)(setf next-flag t)(setf req-content-id nil)(unless pmemout-sync-wait
(send-event SC_RES_TRANSFER_FINISH 0 nil)))(make-event 'stream-finish)))(STREAM_HDD_FATAL
(setf st-status sig)(make-event 'hdd-error)(send-hdd-fatal))(STREAM_HDD_HANGUP
(setf st-status sig)(make-event 'hdd-error)(send-hdd-hangup)))))

(defvar ppmt-*pid* nil)(defvar ppmt-*svcid* nil)(register-section 'ppat
#'(lambda (data)(let ((ptr) (svcid nil) (pid nil))(setf ptr (nthcdr 8 (nth 0 data)))(do ((x 8 (+ x 4)))((or (> x (length (nth 0 data))) pid))(setf svcid (+ (* (first ptr) #x100) (second ptr)))(unless (eq svcid 0)(setf pid (+ (* (logand (third ptr) #x1F) #x100) (fourth ptr))))(setf ptr (nthcdr 4 ptr)))(setf ppmt-*pid* pid)(setf ppmt-*svcid* svcid)(if (get-section-valid 'ppat)(make-event 'ppat-update)(set-section-valid 'ppat t)(make-event 'ppat-valid)))))(register-section 'ppmt
#'(lambda (data)(if (get-section-valid 'ppmt)(make-event 'ppmt-update)(set-section-valid 'ppmt t)(make-event 'ppmt-valid))))

(register-node 'resource-checker
#'(lambda ()
t)
#'(lambda ()(send-event SC_RES_AVAILABLE 4 (list SC_RESOURCE_AVAILABLE)))
#'(lambda ()(send-event SC_RES_AVAILABLE 4 (list SC_RESOURCE_LOST))))

(defvar resource-checker-flag nil)(register-node 'resource-checker2
#'(lambda ()
t)
#'(lambda ()(send-event SC_RES_AVAILABLE 4 (list SC_RESOURCE_AVAILABLE))(setf resource-checker-flag t))
#'(lambda ()(if resource-checker-flag
(send-event SC_RES_AVAILABLE 4 (list SC_RESOURCE_LOST))(setf resource-checker-flag t))))

(defvar svc-mon-cnt 0)

(register-node 'service-monitor
#'(lambda ()
t)
#'(lambda ()(when (get-psi-valid 'psi)(if (/= svc-mon-cnt 0)(send-event SC_RES_CHANNEL_INFO 0 nil)(let ((tsl (tsl-get-data (tuner-tsl-key 'tuner)
'onid 'tsid 'physical_ch)))(send-event SC_RES_CHANNEL_INFO (* 4 (+ (length tsl) 3))(list (first tsl) (second tsl)(get-psi-svcid 'psi) (third tsl) input-id selected-tuner-no))))(setf svc-mon-cnt (1+ svc-mon-cnt))))
#'(lambda ()))

(register-node 'tuner-power-check
#'(lambda (key)(if tuner-power
(tuner-pwr-status 'tuner-pwr)
t))
#'(lambda (key)(eval-events (list 'tuner-pwr-change)))
#'(lambda (key)
nil))

(defvar decode-p nil)

(register-node 'decode-on
#'(lambda ()
decode-p)
#'(lambda ()(eval-events (list 'decode-on 'decode-off)))
#'(lambda ()
nil))

(defun decode-on ()(setf decode-p t)(make-event 'decode-on))

(defun decode-off ()(setf decode-p nil)(make-event 'decode-off))

(register-node 'pmemout-start
#'(lambda ()
t)
#'(lambda ()(setf partial-stopped nil)(setf pmemout-sync-wait nil)(eval-events (list 'pmemout-req)))
#'(lambda ()
nil))

(register-node 'partial-start-action
#'(lambda ()
t)
#'(lambda ()(let ((eemi (partial-info (if (transcode-transfer-p)
'partial-enc
'partial)
'eemi)))(send-event SC_RES_PARTIAL_START 4 (list eemi))))
#'(lambda ()(send-event SC_RES_PARTIAL_START 4 (list -1))))

(register-node 'tsport-play
#'(lambda ()(device-source-p 'tsport-in 'stream-in))
#'(lambda ()(tsport-connect 'tsport-in 'stream-in))
#'(lambda ()
nil))

(defvar stream-dir "/stream")(defvar data-dir "/data")(defvar nodirect-mode nil)

(defvar req-content-id nil)(defvar req-stream-s-index nil)(defvar req-stream-s-pts nil)(defvar req-stream-s-pos nil)(defvar req-stream-m-index nil)(defvar req-stream-m-pos nil)(defvar stream-s-index nil)(defvar stream-s-pts nil)(defvar stream-s-pos nil)(defvar stream-m-index nil)(defvar stream-m-pos nil)

(defvar stream-valid nil)(defvar next-flag nil)(defvar event-id nil)(defvar req-event-id nil)

(defvar content-id nil)(defvar req-content-id nil)(defvar content-drm nil)

(register-node 'content-fixed
#'(lambda ()(and content-id
(eq content-id req-content-id)(not next-flag) ))
#'(lambda ()(unless (eq content-id req-content-id)(setf content-id req-content-id))(content-fixed-local)(if next-flag
(progn
(setf next-flag nil)(setf stream-s-index nil)(setf stream-s-pos nil))(setf stream-s-index req-stream-s-index)(setf stream-s-pos req-stream-s-pos))(eval-events (list 'request-play 'request-stop 'stream-finish)))
#'(lambda ()
nil))

(register-node 'stream-play
#'(lambda ()
stream-valid)
#'(lambda ()(when (not stream-valid)(setf stream-valid
(stream-open 'stream-in
:mode nodirect-mode
:mode dms-play-mode
:stream-dir stream-dir
:data-dir data-dir
:stream-index stream-s-index
:stream-pos stream-s-pos
:content-id content-id
:drm content-drm))(setf dms-play-mode "normal")(if (and (not stream-valid) content-id)(send-event SC_RES_TRANSFER_FINISH 0 nil)))(eval-events (list 'stream-change)))
#'(lambda ()(stream-close 'stream-in)(when stream-valid
(setf stream-valid nil))))

(register-node 'ppat-request
#'(lambda ()(get-section-valid 'ppat))
#'(lambda ()(unless (get-section-valid 'ppat)(section-open 'ppat)(section-disable 'ppat)(set-section-pid 'ppat 0)(setf (nth 0 (get-section-filter 'ppat)) 0)(setf (nth 0 (get-section-mask 'ppat)) 0)(section-filter 'ppat
:type "version"
:source 'tsport-in
:pid (get-section-pid 'ppat)
:length (get-section-length 'ppat)
:filter (get-section-filter 'ppat)
:mask (get-section-mask 'ppat)
:elength (get-section-elength 'ppat)
:efilter (get-section-efilter 'ppat)
:emask (get-section-emask 'ppat))(section-enable 'ppat))(eval-events (list 'ppat-valid)))
#'(lambda ()(section-close 'ppat)(set-section-valid 'ppat nil)))

(register-node 'ppmt-pid-valid
#'(lambda ()(and ppmt-*pid*
ppmt-*svcid*
(eq ppmt-*pid* (get-section-pid 'ppmt))(eq (/ ppmt-*svcid* #x100)(nth 3 (get-section-filter 'ppmt)))(eq (logand ppmt-*svcid* #xFF)(nth 4 (get-section-filter 'ppmt)))))
#'(lambda ()(when ppmt-*pid*
(set-section-pid 'ppmt ppmt-*pid*))(when ppmt-*svcid*
(setf (nth 3 (get-section-filter 'ppmt)) (/ ppmt-*svcid* #x100))(setf (nth 3 (get-section-mask 'ppmt)) 0)(setf (nth 4 (get-section-filter 'ppmt)) (logand ppmt-*svcid* #xFF))(setf (nth 4 (get-section-mask 'ppmt)) 0))(eval-events (list 'ppat-update)))
#'(lambda ()(setf ppmt-*pid* nil)(setf ppmt-*svcid* nil)))(register-node 'ppmt-request
#'(lambda ()(get-section-valid 'ppmt))
#'(lambda ()(unless (get-section-valid 'ppmt)(section-open 'ppmt)(section-disable 'ppmt)(setf (nth 0 (get-section-filter 'ppmt)) 2)(setf (nth 0 (get-section-mask 'ppmt)) 0)(section-filter 'ppmt
:type "version"
:source 'tsport-in
:pid (get-section-pid 'ppmt)
:length (get-section-length 'ppmt)
:filter (get-section-filter 'ppmt)
:mask (get-section-mask 'ppmt)
:elength (get-section-elength 'ppmt)
:efilter (get-section-efilter 'ppmt)
:emask (get-section-emask 'ppmt))(if (section-enable 'ppmt)(cancel-timer 'ppmt-retry-timer)(set-timer #'(lambda (arg)(when (section-enable 'ppmt)(cancel-timer 'ppmt-retry-timer)))
'ppmt-retry-timer
nil
nil
500)))(eval-events (list 'ppmt-valid)))
#'(lambda ()(cancel-timer 'ppmt-retry-timer)(section-close 'ppmt)(set-section-valid 'ppmt nil)))(register-node 'parse-ppmt
#'(lambda ()(psi-status 'psi))
#'(lambda (key)(psi-validate 'psi 'ppmt)(parse-psi 'psi key)(eval-events (list 'ppmt-update)))
#'(lambda (key)(psi-invalidate 'psi)(funcall (get-pmt-hook 'psi) nil key)))

(register-node 'player-top
#'(lambda ()
t)
#'(lambda ()(stream-stop 'stream-in))
#'(lambda ()))

(register-node 'audio-decode-monitor
#'(lambda ()
liveview-audio-info)
#'(lambda ()(eval-events (list 'psi-mon-update 'setup-audio-info)))
#'(lambda ()
nil))(register-node 'liveview-content-action
#'(lambda ()
t)
#'(lambda ()(unless (device-open-p 'stream-in)(my-device-open 'stream-in 'tsport)(setf stream-status (stream-status 'stream-in)))(make-event 'request-play))
#'(lambda ()
nil))

(defun tuner-rental-start (liveview-flag transcode-mode tune-info)(setf req-transcode-mode transcode-mode)(setf req-tune-info tune-info)(if (= transcode-mode 0)(setf req-transcode nil)(setf req-transcode t))(setf liveview-audio-info nil)(if (eq liveview-flag 1)(create-liveview-info))(if (eq dms-area 'jp)(sender-with-tuner tune-info)(sender-with-tuner-pal tune-info)))

(defmacro get-owner-no (owner)
`(if (equal ,owner "reserved") VIDEO_OWNER_RESERVED VIDEO_OWNER_UNKNOWN))


(defun check-stuner-available (tuner-no)(let (other-no)(if need-check-stuner-available
(progn
(if (eq tuner-no 0)(setf other-no 1)(setf other-no 0))(if (eq (nth other-no stuner-connect-status) 1)
nil
t))
t)))

(defun search-available-tuner (lst)(mapcar #'(lambda (no)(unless (device-open-p 'tuner)(if (eq dms-area 'jp)(my-device-open 'tuner no)(if (check-stuner-available no)(my-device-open 'tuner no)))(if (owner-p 'tuner)(when (eq dms-area 'jp)(my-device-open 'tsport no))(progn
(my-device-close 'tuner)))))
lst))

(defun search-same-tuner (lst tsl-key)(mapcar #'(lambda (no)(when (if (eq dms-area 'pal) (check-stuner-available no) t)(unless (device-open-p 'tuner)(my-device-open 'tuner no)(if (tsl-equal tsl-key (tuner-tsl-key 'tuner))(when (eq dms-area 'jp)(my-device-open 'tsport no))(my-device-close 'tuner)))))
lst))

(defun open-tuner-with (no)(if (eq dms-area 'pal)(if (eq no 2) (setf no 1)))(if (eq dms-area 'jp)(my-device-open 'tuner no)(if (check-stuner-available no)(my-device-open 'tuner no)))(when (eq dms-area 'jp)(my-device-open 'tsport no)))

(defun alloc-tuner-resources (vcodec query-info tuner-list tsl-key)(if (transcode-transfer-p)(progn
(setf video-lost nil)(video-config 'video
:codec vcodec
:use "DMS")(my-device-open 'video
(list (video-openquery :error t)(video-openquery :info query-info)(encode-openquery :error t)))(if (device-open-p 'video)(progn
(my-device-open 'audio (device-id 'video))(if (owner-p 'video)(search-available-tuner tuner-list)(open-tuner-with (device-source 'video)))(my-device-open 'partial-enc 'video)(when (and (owner-p 'video)(not (device-open-p 'tuner)))(my-device-close 'video)(my-device-close 'audio)(my-device-close 'partial-enc)(my-device-open 'video
(list (video-openquery :info query-info)(encode-openquery :error t)))(when (device-open-p 'video)(my-device-open 'audio (device-id 'video))(open-tuner-with (device-source 'video))(my-device-open 'partial-enc 'video)))(when (device-open-p 'partial-enc)(tsport-config 'tsport-ex (if (eq (device-id 'partial-enc) 6) "ENCODE" "ENCODE_1"))(my-device-open 'tsport-ex (if (eq (device-id 'partial-enc) 6) "tsi3" "tsi4"))(tsport-connect 'tsport-ex 'partial-enc
:mode 'TSPORT_MODE_TTS)))(setf video-lost t)))(progn
(search-available-tuner tuner-list)(unless (device-open-p 'tuner)(search-same-tuner tuner-list tsl-key)))))

(defun eval-tuner-resources ()(if (transcode-transfer-p)(if (and (device-open-p 'tuner)(device-open-p 'video)(device-open-p 'partial-enc))
t
(if (device-open-p 'tuner)(let ((owners (video-get-owners 'video)))(send-event SC_RES_LOST_VIDEO 12 (list (get-owner-no (nth 0 owners))(get-owner-no (nth 1 owners))(get-owner-no (nth 2 owners))))
nil)(if video-lost
(let ((owners (video-get-owners 'video)))(send-event SC_RES_LOST_VIDEO 12 (list (get-owner-no (nth 0 owners))(get-owner-no (nth 1 owners))(get-owner-no (nth 2 owners))))
nil)(progn
(send-event SC_RES_LOST_TUNER 0 nil)
nil))))(if (device-open-p 'tuner)
t
(progn
(send-event SC_RES_LOST_TUNER 0 nil)
nil))))

(defun free-tuner-resources ()(when (transcode-transfer-p)(my-device-close 'video)(my-device-close 'audio)(my-device-close 'partial-enc))(my-device-close 'tuner))

(defun send-retry-tuner-resource-event-inner ()(if (eq dms-area 'jp)(alloc-tuner-resources 'VIDEO_CODEC_MPEG2
(svl-key-string (svl-create-key "ALL"
:onid (nth 0 req-tune-info)
:tsid (nth 1 req-tune-info)
:svcid (nth 2 req-tune-info))
'onid 'tsid 'svcid)
'(0 1 2)(svl-create-key "TSL"
:onid (nth 0 req-tune-info)
:tsid (nth 1 req-tune-info)))(alloc-tuner-resources nil
(svl-key-string (svl-create-key (nth 5 req-tune-info)
:onid (nth 0 req-tune-info)
:tsid (nth 1 req-tune-info)
:svcid (nth 2 req-tune-info)
:physical_ch (nth 3 req-tune-info))
'onid 'tsid 'svcid 'physical_ch)(if (eq wtuner 0)
'(0)
'(0 1))(svl-create-key "TSL"
:physical_ch (nth 3 req-tune-info)
:onid (nth 0 req-tune-info)
:tsid (nth 1 req-tune-info))))(when (eval-tuner-resources)(send-event SC_RES_RETRY_ERROR 0 nil))(free-tuner-resources))

(defun send-retry-tuner-resource-event ()(if need-check-stuner-available
(send-event SC_RES_SINGLE_STUNER_RETRY_CHECK 0 nil)(send-retry-tuner-resource-event-inner)))

(defun alloc-player-resources ()(my-device-open 'stream-in 'tsport-in)(when (device-open-p 'stream-in)(if (eq mpeg2-flag 1)(video-config 'video
:codec 'VIDEO_CODEC_MPEG2
:use "DMS")(video-config 'video
:use "DMS"))(my-device-open 'video (list (video-openquery :error t)(encode-openquery :error t)))(when (device-open-p 'video)(my-device-open 'audio (device-id 'video))

(my-device-open 'partial-enc 'video)(when (device-open-p 'partial-enc)(tsport-config 'tsport-ex (if (eq (device-id 'partial-enc) 6) "ENCODE" "ENCODE_1"))(my-device-open 'tsport-ex (if (eq (device-id 'partial-enc) 6) "tsi3" "tsi4"))(tsport-connect 'tsport-ex 'partial-enc
:mode 'TSPORT_MODE_TTS)))))

(defun eval-player-resources ()(if (and (owner-p 'stream-in)(device-open-p 'video)(device-open-p 'partial-enc))
t
(progn
(if (owner-p 'stream-in)(let ((owners (video-get-owners 'video)))(send-event SC_RES_LOST_VIDEO 12 (list (get-owner-no (nth 0 owners))(get-owner-no (nth 1 owners))(get-owner-no (nth 2 owners)))))(send-event SC_RES_LOST_STREAM 0 nil))
nil)))

(defun free-player-resources ()(my-device-close 'video)(my-device-close 'audio)(my-device-close 'partial-enc)(my-device-close 'stream-in))

(defun send-retry-player-resource-event ()(alloc-player-resources)(when (eval-player-resources)(send-event SC_RES_RETRY_ERROR 0 nil))(free-player-resources))

(defun tuner-change-hook (sig)(unless (owner-p 'tuner)(case sig
(PROPERTY_CHANGE
(sender-with-tuner-stop)(send-retry-tuner-resource-event)))))

(defun video-change-hook (sig)(if (eq sig 'DEVICE_BUSY)(if dms-content-flag
(progn
(disconnect-player)(send-retry-player-resource-event))(progn
(sender-with-tuner-stop)(send-retry-tuner-resource-event))))(unless (owner-p 'video)(case sig
(SOURCE_CHANGE
(if dms-content-flag
(progn
(disconnect-player)(send-retry-player-resource-event))(progn
(sender-with-tuner-stop)(send-retry-tuner-resource-event))))((DECODE_SUCCESS DECODE_ERROR DECODE_SCRAMBLE)(unless (eq (video-pid 'video) transfer-video)(if dms-content-flag
(progn
(disconnect-player)(send-retry-player-resource-event))(progn
(sender-with-tuner-stop)(send-retry-tuner-resource-event))))))))

(defun send-video-dec-ch ()(when (device-id 'video)(send-event SC_RES_VIDEO_DEC_CH 4
(+ (device-id 'video) 1))))

(defun sender-with-tuner (tune-info)(my-device-open 'partial (if (eq buffer-ch 0)
"memout0"
(if (eq buffer-ch 1)
"memout1"
"memout2")))(when (boundp 'config-ca)(my-device-open 'ca nil)(init-ca-object 'ca))(my-device-open 'cp nil)(my-device-open 'psi 6)(when (boundp 'config-tuner)(tuner-config 'tuner config-tuner))(when tuner-power
(device-open 'tuner-pwr 0))

(init-partial-object 'partial)(init-cp-object 'cp)(init-section-object 'pat)(init-section-object 'pmt)(init-psi-object 'psi #'pmt-parser)

(alloc-tuner-resources 'VIDEO_CODEC_MPEG2
(svl-key-string (svl-create-key "ALL"
:onid (nth 0 tune-info)
:tsid (nth 1 tune-info)
:svcid (nth 2 tune-info))
'onid 'tsid 'svcid)
'(0 1 2)(svl-create-key "TSL"
:onid (nth 0 tune-info)
:tsid (nth 1 tune-info)))(when (eval-tuner-resources)(init-tuner-object 'tuner)(set-tuner-hook 'tuner #'tuner-change-hook)(when (transcode-transfer-p)(init-video-object 'video)(send-video-dec-ch)(set-video-hook 'video #'video-change-hook)(init-audio-object 'audio)(init-partial-object 'partial-enc))(set-tuning-tsl-key (svl-create-key "TSL"
:onid (nth 0 tune-info)
:tsid (nth 1 tune-info)))(set-tuning-onid (nth 0 tune-info))(set-tuning-tsid (nth 1 tune-info))(set-tuning-svcid (nth 2 tune-info))(set-cur-svc)(svl-query svl-key 'child_lock)(resource-node 'tune-resource (list 'psi))

(append-t
'tune-resource
'resource-checker2
'tuner-power-check
'setup-channel
'tuner-freq-valid
'tuner-connect
'tsport-connect
'decode-on
'psi-valid
'parse-pmt
'parental-check
'transfer-reset-check)

(if (transcode-transfer-p)(progn
(append-t
'transfer-reset-check
'video-play-enc)

(append-t
'transfer-reset-check
'audio-play-enc)

(append-t
'transfer-reset-check
'decode-proc
'encode-proc
'partial-start))(append-t
'transfer-reset-check
'partial-start))

(append-t
'decode-on
'pat-request
'tsid-check
'pmt-pid-valid
'pmt-request)

(append-t
'partial-start
'sit-insert)

(append-t
'partial-start
'pmemout-start
'partial-start-action)

(sender-with-tuner-local-initialize)

(eval-node 'tune-resource)))

(defun sender-with-tuner-pal (tune-info)(my-device-open 'partial (if (eq buffer-ch 0)
"memout0"
(if (eq buffer-ch 1)
"memout1"
"memout2")))(my-device-open 'cp nil)(my-device-open 'psi 6)(if (transcode-transfer-p)(my-device-open 'psi-enc 7))(when (boundp 'config-tuner)(tuner-config 'tuner config-tuner))

(init-partial-object 'partial)(init-cp-object 'cp)(init-section-object 'pat)(init-section-object 'pmt)(init-psi-object 'psi #'pmt-parser)(setf input-id (nth 6 tune-info))

(alloc-tuner-resources nil
(svl-key-string (svl-create-key (nth 5 tune-info)
:onid (nth 0 tune-info)
:tsid (nth 1 tune-info)
:svcid (nth 2 tune-info)
:physical_ch (nth 3 tune-info))
'onid 'tsid 'svcid 'physical_ch)(if (eq wtuner 0)
'(0)
'(0 1))(svl-create-key "TSL"
:physical_ch (nth 3 tune-info)
:onid (nth 0 tune-info)
:tsid (nth 1 tune-info)))


(when (eval-tuner-resources)(setf selected-tuner-no (device-id 'tuner))(when (with-dvb-sat-p)(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)))))(init-tuner-object 'tuner)

(let ((port) (tsport-id) (ci-slot))(setf port (list nil nil nil nil))(if (eq (device-id 'tuner) 1)(setf (nth 0 port) "FE_IN2")(setf (nth 1 port) "FE_IN1"))

(when with-dvb-ci
(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
(tsport-config 'tsport-ci2 (list (nth 0 port) (nth 1 port)))(my-device-open 'tsport-ci2 "ci1")(setf (nth 3 port) "CI_IN2")))

(if (eq (device-id 'tuner) 1)(setf tsport-id 2)(setf tsport-id 0))

(tsport-config 'tsport port)(my-device-open 'tsport tsport-id)

(setf ci-slot (nth 4 tune-info))(when (boundp 'config-ca)(my-device-open 'ca ci-slot)(init-ca-object 'ca)(when with-dual-ci
(my-device-open 'ca-sub (- 1 ci-slot))))(when (eq ci-slot 0)(setf with-tsport-ci1 t)(setf with-tsport-ci2 nil))(when (eq ci-slot 1)(setf with-tsport-ci1 nil)(setf with-tsport-ci2 t))(setf tsport-ci-switch-done nil)(setf last-ci-slot-no ci-slot))

(set-tuner-hook 'tuner #'tuner-change-hook)(when (transcode-transfer-p)(init-video-object 'video)(send-video-dec-ch)(set-video-hook 'video #'video-change-hook)(init-audio-object 'audio)(init-partial-object 'partial-enc))

(set-tuning-tsl-key (svl-create-key "TSL"
:onid (nth 0 tune-info)
:tsid (nth 1 tune-info)))(set-tuning-onid (nth 0 tune-info))(set-tuning-tsid (nth 1 tune-info))(set-tuning-svcid (nth 2 tune-info))(set-cur-svc)(svl-query svl-key 'child_lock)(resource-node 'tune-resource (list 'psi))

(append-t
'tune-resource
'resource-checker2
'setup-channel
'tuner-freq-valid
'tuner-connect
'my-tsport-connect
'decode-on
'psi-valid
'parse-pmt
'tsport-ci-connect
'ciplus-check
'my-ca-request
'service-monitor
'parental-check
'transfer-reset-check)

(if (transcode-transfer-p)(progn
(append-t
'transfer-reset-check
'video-play-enc)

(append-t
'transfer-reset-check
'audio-play-enc)

(append-t
'transfer-reset-check
'decode-proc
'encode-proc
'partial-start))(append-t
'transfer-reset-check
'partial-start))

(append-t
'decode-on
'pat-request
'tsid-check
'pmt-pid-valid
'pmt-request)

(append-t
'partial-start
'sit-insert)

(append-t
'partial-start
'pmemout-start
'partial-start-action)

(when with-dual-ci
(append-nil
'partial-start
'stream-scramble-fix)

(append-t
'stream-scramble-fix
'tsport-ci-switch)

(append-nil
'tsport-ci-connect
'tsport-ci-recover))

(sender-with-tuner-local-initialize)

(eval-node 'tune-resource)))

(defun tuner-rental-stop ()(sender-with-tuner-stop))

(defun sender-with-tuner-stop ()(sender-with-tuner-local-stop)(cancel-node 'tune-resource)(init-node 'tune-resource)

(my-device-close 'partial)(my-device-close 'ca)(my-device-close 'cp)(my-device-close 'psi)(my-device-close 'tsport)(my-device-close 'tuner)(my-device-close 'tuner-pwr)

(my-device-close 'video)(my-device-close 'audio)

(setf content-management nil)(setf request-pids nil)(setf request-pcr nil)

(setf pmt-svcid nil))

(defun set-storage-config (sdir ddir nodirect)(setf stream-dir sdir)(setf data-dir ddir)(setf nodirect-mode nodirect))

(defvar liveview-audio-info nil)(defmacro set-liveview-pid (lst pid)
`(setf (nth 0 ,lst) ,pid))(defmacro get-liveview-pid (lst)
`(first ,lst))(defmacro set-liveview-tag (lst tag)
`(setf (nth 1 ,lst) ,tag))(defmacro get-liveview-tag (lst)
`(second ,lst))(defmacro get-liveview-dualmode (lst)
`(third ,lst))(register-device 'tvp
"tvp"
5
#'(lambda (sig)))(register-device 'tvp-ds-main
"display"
5
#'(lambda (sig)))(register-device 'video-tmp
"video"
5
#'(lambda (sig)))(register-device 'audio-tmp
"audio"
5
#'(lambda (sig)))(defun get-video-decoder-no-tvp ()(let ((dec-no nil))(device-open 'tvp nil)(tvp-devlist 'tvp
nil
(list 'tvp-ds-main))(setf dec-no (device-source 'tvp-ds-main))(device-close 'tvp)(if (< dec-no 3) dec-no nil)))

(defun get-video-decoder-no ()(if liveview-dec-no
(if (>= liveview-dec-no 0)
liveview-dec-no
nil)(get-video-decoder-no-tvp)))

(defun create-liveview-info ()(let ((dec-no (get-video-decoder-no)))(when dec-no
(video-config 'video-tmp
:codec 'VIDEO_CODEC_NONE
:use "DISPLAY_MAIN")(device-open 'video-tmp (video-openquery :ch (+ 1 dec-no)))(when (device-open-p 'video-tmp)(device-open 'audio-tmp (device-id 'video-tmp))(let ((pid (audio-pid 'audio-tmp)))(when pid
(setf liveview-audio-info (list pid -1 (audio-dualmode 'audio-tmp nil)))))(device-close 'audio-tmp)(device-close 'video-tmp)))))

(defun connect-player (liveview-flag stream-ch)

(setf dms-content-flag t)

(if (eq stream-ch 0)(my-device-open 'tsport-in "memin0")(if (eq stream-ch 1)(my-device-open 'tsport-in "memin1")(if (eq stream-ch 2)(my-device-open 'tsport-in "memin2")(if (eq stream-ch 3)(my-device-open 'tsport-in "memin3")))))

(my-device-open 'tsport-in "memin3")

(when liveview-flag
(create-liveview-info))

(my-device-open 'partial (if (eq buffer-ch 0)
"memout0"
(if (eq buffer-ch 1)
"memout1"
"memout2")))(my-device-open 'psi 6)

(init-partial-object 'partial)(init-section-object 'ppat)(init-section-object 'ppmt)(init-psi-object 'psi #'ppmt-parser)

(alloc-player-resources)

(when (eval-player-resources)(init-video-object 'video)(send-video-dec-ch)(set-video-hook 'video #'video-change-hook)(init-audio-object 'audio)(init-partial-object 'partial-enc)(setf stream-status (stream-status 'stream-in))

(resource-node 'player-resource (list 'stream-in))

(append-t
'player-resource
'player-top
'content-fixed
'stream-play
'tsport-play
'ppat-request
'ppmt-pid-valid
'ppmt-request
'parse-ppmt
'transfer-reset-check
'video-play-enc)

(append-t
'transfer-reset-check
'audio-play-enc)

(append-t
'transfer-reset-check
'decode-proc
'encode-proc
'partial-start)

(append-t
'partial-start
'sit-insert)

(append-t
'partial-start
'pmemout-start
'partial-start-action)

(connect-player-local-initialize)

(eval-node 'player-resource)))

(defun disconnect-player ()(cancel-node 'player-resource)(init-node 'player-resource)

(cancel-node 'audio-decode-monitor)(init-node 'audio-decode-monitor)

(disconnect-player-local)

(my-device-close 'tsport-in)(my-device-close 'stream-in)(my-device-close 'partial)(my-device-close 'psi)

(my-device-close 'video)(my-device-close 'audio)(my-device-close 'psi-enc)(my-device-close 'tsport-ex)(my-device-close 'partial-enc))

(defun play-content (content drm s-index s-pos transcode-mode)

(setf req-content-id content)(setf req-stream-s-index s-index)(setf req-stream-s-pos s-pos)(setf req-transcode-mode transcode-mode)(if (= transcode-mode 0)(setf req-transcode nil)(setf req-transcode t))

(setf req-event-id content)

(setf content-drm (get-buffer drm))

(make-event 'request-play))

(defun set-cur-svc ()(let ((lst)(ntype (tsl-get-data (get-tuning-tsl-key) 'ntype))(onid (tsl-get-data (get-tuning-tsl-key) 'onid))(tsid (tsl-get-data (get-tuning-tsl-key) 'tsid))(svcid (get-tuning-svcid))(phych (tsl-get-data (get-tuning-tsl-key) 'physical_ch)))(setf lst (list ntype onid tsid svcid phych))(unless (equal current-svc-info lst)(if (and ntype onid tsid svcid phych (> ntype 0))(progn
(setf svl-key (svl-create-key "SVL"
:onid onid
:tsid tsid
:svcid svcid
:physical_ch phych))(svl-query svl-key 'child_lock)(send-event SC_CREC_CURSVC 20 (list ntype onid tsid svcid phych)))(setf svl-key nil)(send-event SC_CREC_CURSVC 4 (list -1))))(setf current-svc-info lst)))

