(load "/usr/local/slisp/station.lsp")
(defvar special-prio nil)
(setf unknown-stream t)
(defvar msg-pipe nil)
(defvar rui-msg-pipe nil)
(defvar net-msg-pipe nil)
(defvar stream-valid nil)
(defvar st-status nil)
(defvar need-retry nil)
(defvar resume-mark nil)
(defvar req-pause nil)
(defvar pause-play nil)
(defvar stopped t)
(defvar play-valid nil)
(defvar stop-mode nil)
(defvar current-time nil)
(defvar play-mode "normal")
(defvar content-id nil)
(defvar req-content-id nil)
(defvar monitor-content-id nil)
(defvar play-speed 100)
(defvar trik-speed 100)
(defvar skip-seconds nil)
(defvar navi-mode nil)
(defvar trik-mode nil)
(defvar skip-restart nil)
(defvar pmt-svcid nil)
(defvar hdd-mode nil)
(defvar dlna-mode nil)
(defvar net-mode nil)
(defvar content-uri nil)
(defvar req-content-uri nil)
(defvar index-uri nil)
(defvar dlna-protocol nil)
(defvar seek-time nil)
(defvar play-time-buf nil)
(defvar play-status-buf nil)
(defvar play-error-buf nil)
(defvar nouse-dlna-header nil)
(defvar not-dlnadoc nil)
(defvar proxy nil)
(defvar proxy-port nil)
(defvar rate-switch-list nil)
(defvar current-box nil)
(defvar switch-box nil)
(defvar rate-monitor nil)
(defvar event-id nil)
(defvar req-event-id nil)
(defvar dlna-disable-tts nil)
(defvar *status-stop* 0)
(defvar *status-loading* 1)
(defvar *status-playing* 2)
(defvar *status-pause* 3)
(defvar *event-play-finish* 0)
(defvar *event-play-ok* 1)
(defvar *event-play-ng* 2)
(defvar *event-waiting* 3)
(defvar *event-recover* 4)
(defvar *event-switch* 3)
(defvar *event-switched* 4)
(defvar *event-switch-ng* 5)
(defvar *event-downloading* 6)
(defvar PRELOAD_SPAN 10)
(defvar RATE_DOWN_SWITCH_SPAN 5)
(defvar rui-last-event nil)
(defun rui-send-event (event)
(unless (eq rui-last-event event)
(when event
(write-bytes rui-msg-pipe 1000 4 event))
(setf rui-last-event event)))
(defvar net-last-event nil)
(defun net-send-event (event arg1 arg2)
(when net-msg-pipe
(unless (equal net-last-event (list event arg1 arg2))
(when event
(if (and arg1 arg2)
(write-bytes net-msg-pipe event 8 arg1 arg2)
(if arg1
(write-bytes net-msg-pipe event 4 arg1)
(write-bytes net-msg-pipe event 0))))
(setf net-last-event (list event arg1 arg2)))))
(defvar trik-play-info (list nil nil nil nil))
(defmacro set-trik-video-pid (pid)
`(setf (nth 0 trik-play-info) ,pid))
(defmacro get-trik-video-pid ()
(nth 0 trik-play-info))
(defmacro set-trik-video-codec (codec)
`(setf (nth 1 trik-play-info) ,codec))
(defmacro get-trik-video-codec ()
(nth 1 trik-play-info))
(defmacro set-trik-audio-pid (pid)
`(setf (nth 2 trik-play-info) ,pid))
(defmacro get-trik-audio-pid ()
(nth 2 trik-play-info))
(defmacro set-trik-audio-format (format)
`(setf (nth 3 trik-play-info) ,format))
(defmacro get-trik-audio-format ()
(nth 3 trik-play-info))
(defvar notify-trick-cap nil)
(defun send-trick-cap ()
(when (and notify-trick-cap (get-stream-trickcap))
(write-bytes msg-pipe 124 event-id 4 (get-stream-trickcap))
(setf notify-trick-cap nil)))
(defvar divx-hdrl nil)
(defvar rental-limit nil)
(defvar notify-rental-limit nil)
(defvar rental-confirm nil)
(defun send-rental-limit ()
(when (and notify-rental-limit rental-limit)
(timeout-count-stop)
(setf err-msg 125)
(write-bytes msg-pipe err-msg event-id 4 rental-limit)
(setf notify-rental-limit nil)))
(defmacro rental-confirm-p ()
`(or (not rental-limit) rental-confirm))
(defvar pattern " ;-")
(defun search-start (str n)
(do ((x n (+ x 1)))
((not (eq (char str x) (char pattern 0)))
x)))
(defun search-end (str n)
(do ((x n (+ x 1)))
((or (>= x (length str))
(eq (char str x) (char pattern 0))
(eq (char str x) (char pattern 1))
(eq (char str x) (char pattern 2)))
x)))
(defun parse-strn (strn)
(let ((ret) (str) (len) (s 0) (e))
(setf ret (list nil nil nil nil))
(setf str (nth 2 strn))
(if (not str)
ret
(setf len (length str))
(setf s (search-start str s))
(setf e (search-end str s))
(setf (nth 0 ret) (if (>= e len) (subseq str s) (subseq str s e)))
(setf s (search-start str e))
(do ((x s))
((>= x len) ret)
(if (eq (char str x) (char pattern 1))
(progn
(setf s (search-start str (+ x 1)))
(setf e (search-end str s))
(unless (nth 3 ret)
(setf (nth 3 ret) (if (>= e len) (subseq str s) (subseq str s e))))
(setf x (search-start str e)))
(if (eq (char str x) (char pattern 2))
(progn
(setf s (search-start str (+ x 1)))
(setf e (search-end str s))
(if (nth 1 ret)
(unless (nth 2 ret)
(setf (nth 2 ret) (if (>= e len) (subseq str s) (subseq str s e))))
(setf (nth 1 ret) (if (>= e len) (subseq str s) (subseq str s e))))
(setf x (search-start str e)))
(setf e (search-end str s))
(setf x (search-start str e))))))))
(defun make-track-lang (strn)
(let ((lst) (str) (lang) (customized))
(setf lst (parse-strn strn))
(if (or (string= (nth 1 lst) "x")
(string= (nth 1 lst) "i"))
(progn
(setf str (nth 2 lst))
(setf customized 1))
(setf str (nth 1 lst))
(setf customized 0))
(setf lang (copy-string "--------"))
(list (do ((x 0 (+ x 1)))
((> x 8) lang)
(setf-char lang x (if (< x (length str))
(char str x)
0)))
customized)))
(defmacro find-strl (strl fcc)
`(find-if #'(lambda (x)
(string= (nth 0 x) ,fcc))
,strl))
(defmacro subtitle-p (strf)
`(or (string-equal (nth 7 ,strf) "dxsa")
(string-equal (nth 7 ,strf) "dxsb")))
(defun eq-strh-fcctype (strl fcc)
(string= (nth 2 (find-strl strl "strh")) fcc))
(defun get-divx-video-codec (type)
(if (find-if #'(lambda (x)
(string= type x))
(list "div3" "DIV3" "div4" "DIV4" "mp43" "MP43" "msvc" "MSVC"))
'VIDEO_CODEC_DIVX3
(if (find-if #'(lambda (x)
(string= type x))
(list "divx" "DIVX" "xvid" "XVID" "dx50" "DX50"))
'VIDEO_CODEC_MPEG4
nil)))
(defun get-divx-audio-codec (type)
(if (eq type #x0050)
'AUDIO_FORMAT_BC
(if (eq type #x0055)
'AUDIO_FORMAT_MP3
(if (eq type #x2000)
'AUDIO_FORMAT_AC3
nil))))
(defun divx-resolution-check (strf)
(if (eq divx-profile 0)
(and (<= (nth 3 strf) 720) (<= (nth 4 strf) 576)
(>= (nth 3 strf) 64) (>= (nth 4 strf) 32))
t))
(defun parse-divx-hdrl (hdrl)
(let ((avih) (strls) (strh) (strf) (strn) (stream-no) (track) (vlist nil) (alist nil) (slist nil) (invalid-audio) (err nil))
(setf avih (car hdrl))
(setf strls (cdr hdrl))
(setf invalid-audio (stream-info 'stream-in 'invalid-audio))
(mapcar #'(lambda (strl)
(setf strh (find-strl strl "strh"))
(setf strf (find-strl strl "strf"))
(setf strn (find-strl strl "strn"))
(setf stream-no (position strl strls))
(if (eq-strh-fcctype strl "vids")
(if (subtitle-p strf)
(when (or (eq divx-profile 1)
(eq divx-profile 2)
(and (eq divx-profile 0) (string-equal (nth 7 strf) "dxsb")))
(setf track (list stream-no 0 (nth 5 strh) (nth 7 strf)
(make-track-lang strn)))
(if slist
(append-track track slist)
(setf slist (cons track nil))))
(if (not (divx-resolution-check strf))
(setf err 'unsupported-resolution)
(setf track (list stream-no (nth 5 strh) (nth 3 strh)))
(when (get-divx-video-codec (nth 2 track))
(if vlist
(append-track track vlist)
(setf vlist (cons track nil))))))
(if (and (eq-strh-fcctype strl "auds") (not invalid-audio))
(progn
(setf track (list stream-no (nth 5 strh) (nth 2 strf)
(make-track-lang strn) -1))
(when (get-divx-audio-codec (nth 2 track))
(if alist
(append-track track alist)
(setf alist (cons track nil)))))
(if (eq-strh-fcctype strl "txts")
))))
strls)
(unless vlist
(setf err 'unsupported-format))
(when (and (> (length alist) 1) (not (pause-resume-capable-p)))
(setf alist (cons (nth 0 alist) nil)))
(if err
(send-play-ng-msg (stream-errno 'stream-in err))
(when dxst-subtitle
(if (stream-info dev 'dxst-available)
(progn
(setf track (list 100 1 0 "dxst" (make-track-lang nil)))
(if slist
(append-track track slist)
(setf slist (cons track nil))))
(setf dxst-subtitle nil)))
(unless (and req-video (assoc req-video vlist))
(setf req-video (nth 0 (car vlist))))
(unless (and req-audio (assoc req-audio alist))
(setf req-audio (nth 0 (car alist))))
(unless (and req-subtitle (assoc req-subtitle slist))
(setf req-subtitle (nth 0 (car slist))))
(send-video-choice-list (get-stream-type) vlist)
(if req-dualmode
(send-audio-choice-list-with-dualmode (get-stream-type) alist req-audio)
(send-audio-choice-list (get-stream-type) alist))
(send-subtitle-choice-list (get-stream-type) slist))))
(defvar sinfo (list 'STREAM_TTS_MODE nil nil nil nil nil nil nil nil nil))
(defun set-stream-info (dev)
(let ((info nil))
(setf info (stream-info dev
'stream-type
'video-codec
'audio-codec
'video-pid
'audio-pid
'pcr-pid
'video-streamid
'audio-streamid
'e-emi
'trickcap))
(setf sinfo (if info info (list 'STREAM_TTS_MODE nil nil nil nil nil nil nil nil nil)))
(send-trick-cap)
(case (get-stream-type)
(STREAM_PS_MODE
(when (and (get-stream-video-streamid) (get-stream-audio-streamid))
(send-video-choice-list 'STREAM_PS_MODE (list (list (get-stream-video-streamid))))
(unless (eq req-audio (get-stream-audio-streamid))
(when req-audio
(clear-dualmode nil))
(setf req-audio (get-stream-audio-streamid)))
(let ((alist))
(setf alist (list (list (get-stream-audio-streamid) -1)))
(if req-dualmode
(send-audio-choice-list-with-dualmode 'STREAM_PS_MODE alist req-audio)
(send-audio-choice-list 'STREAM_PS_MODE (list (list (get-stream-audio-streamid) -1)))))))
(STREAM_DIVX_MODE
(setf rental-limit (stream-info dev 'rental-limit))
(send-rental-limit)
(when (rental-confirm-p)
(unless divx-hdrl
(setf divx-hdrl (stream-info dev 'divx-header))
(when divx-hdrl
(parse-divx-hdrl divx-hdrl))))
(when divx-hdrl
(unless (and req-video (assoc req-video video-choice-list))
(setf req-video (nth 0 (car video-choice-list))))
(unless (and req-audio (assoc req-audio audio-choice-list))
(setf req-audio (nth 0 (car audio-choice-list))))
(unless (and req-subtitle (assoc req-subtitle subtitle-choice-list))
(setf req-subtitle (nth 0 (car subtitle-choice-list))))))
(otherwise
))))
(defmacro get-stream-type ()
`(nth 0 sinfo))
(defmacro get-stream-video-codec ()
`(nth 1 sinfo))
(defmacro get-stream-audio-codec ()
`(nth 2 sinfo))
(defmacro get-stream-video-pid ()
`(nth 3 sinfo))
(defmacro get-stream-audio-pid ()
`(nth 4 sinfo))
(defmacro get-stream-pcr-pid ()
`(nth 5 sinfo))
(defmacro get-stream-video-streamid ()
`(nth 6 sinfo))
(defmacro get-stream-audio-streamid ()
`(nth 7 sinfo))
(defmacro get-stream-eemi ()
`(nth 8 sinfo))
(defmacro get-stream-trickcap ()
`(nth 9 sinfo))
(defmacro pause-resume-capable-p ()
`(if (get-stream-trickcap) (eq (logand (get-stream-trickcap) #x01) #x01) nil))
(defmacro play-capable-p (speed)
`(if (get-stream-trickcap)
(if (eq ,speed 100)
t
(if (> ,speed 100)
(eq (logand (get-stream-trickcap) #x02) #x02)
(if (< ,speed -100)
(eq (logand (get-stream-trickcap) #x04) #x04)
nil)))
nil))
(defmacro skip-capable-p ()
`(if (get-stream-trickcap) (eq (logand (get-stream-trickcap) #x08) #x08) nil))
(defmacro seek-capable-p ()
`(if (get-stream-trickcap) (eq (logand (get-stream-trickcap) #x08) #x08) nil))
(defmacro get-period (speed)
`(if (and (<= ,speed 130) (>= ,speed -100))
250
(if (or dlna-mode net-mode)
500
100)))
(defun set-play-timer (speed)
(when (and (or monitor-content-id content-uri)
(/= speed 0))
(set-timer #'(lambda (arg)
(send-play-time)
(when (and net-mode play-valid)
(let ((load-time))
(setf load-time (stream-load-time 'stream-in content-uri))
(when (and rate-switch-list rate-monitor (not switch-box) current-time load-time)
(setf load-time (* 1000 load-time))
(if (> (- load-time current-time) PRELOAD_SPAN)
(progn
(setf switch-box (position-if #'(lambda (x)
(string= content-uri x))
rate-switch-list))
(when switch-box
(setf switch-box (1+ switch-box))
(stream-switch 'stream-in
:content-uri (nth switch-box rate-switch-list))))
(if (< (- load-time current-time) RATE_DOWN_SWITCH_SPAN)
(progn
(setf switch-box (position-if #'(lambda (x)
(string= content-uri x))
rate-switch-list))
(when (and switch-box (> switch-box 0))
(setf switch-box (1- switch-box))
(stream-switch 'stream-in
:content-uri (nth switch-box rate-switch-list))))
nil))))))
'play-time-timer
nil
nil
(get-period speed))))
(defvar last-video nil)
(defvar last-audio nil)
(defvar req-video nil)
(defvar req-audio nil)
(defvar req-dualmode nil)
(defvar req-subtitle nil)
(defmacro get-track-pid (track)
`(first ,track))
(defmacro get-track-tag (track)
`(second ,track))
(defmacro get-track-stype (track)
`(first (third ,track)))
(defmacro get-track-video-codec (track)
`(first (third ,track)))
(defmacro set-track-video-pcr (track val)
`(setf (nth 1 (nth 2 ,track)) ,val))
(defmacro get-track-video-pcr (track)
`(second (third ,track)))
(defmacro get-track-audio-format (track)
`(first (third ,track)))
(defmacro get-track-audio-lang (track)
`(second (third ,track)))
(defmacro get-track-audio-type (track)
`(third (third ,track)))
(defun get-track-audio-dualmode (track)
(case (get-stream-type)
(STREAM_TTS_MODE
(nth 3 (nth 2 track)))
(STREAM_PS_MODE
(nth 1 track))
(STREAM_DIVX_MODE
(nth 4 track))))
(defun set-track-audio-dualmode (track val)
(case (get-stream-type)
(STREAM_TTS_MODE
(setf (nth 3 (nth 2 track)) val))
(STREAM_PS_MODE
(setf (nth 1 track) val))
(STREAM_DIVX_MODE
(setf (nth 4 track) val))))
(defmacro set-track-audio-language (track lang)
`(setf (nth 1 (nth 2 ,track)) ,lang))
(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 tag2pid (tag lst)
`(first (find-if #'(lambda (x)
(eq ,tag (second x)))
,lst)))
(defmacro tag2track (tag lst)
`(find-if #'(lambda (x)
(eq ,tag (second x)))
,lst))
(defmacro get-default-video (lst)
`(car ,lst))
(defmacro get-default-audio (lst)
`(car ,lst))
(defun append-track (track lst)
(setf-cdr (last lst) (cons track nil)))
(defun set-parental-level (free level)
)
(defun copy-audio-track (track)
(case (get-stream-type)
(STREAM_TTS_MODE
(list (nth 0 track) (nth 1 track)
(list (nth 0 (nth 2 track))
(copy-string (nth 1 (nth 2 track)))
(nth 2 (nth 2 track))
(nth 3 (nth 2 track))
(nth 4 (nth 2 track)))))
(STREAM_PS_MODE
(copy-list track))
(STREAM_DIVX_MODE
(list (nth 0 track) (nth 1 track) (nth 2 track) (list (copy-string (nth 0 (nth 3 track))) (nth 1 (nth 3 track))) (nth 4 track)))))
(defmacro dual-mono-p ()
`(eq (audio-channel 'audio) 7))
(defun send-audio-choice-list-with-dualmode (type alist aid)
(unless req-dualmode
(setf req-dualmode 0))
(audio-dualmode 'audio req-dualmode)
(let ((new-alist nil) (track))
(mapcar #'(lambda (x)
(if (and (eq aid (nth 0 x)) (eq (get-track-audio-dualmode x) -1))
(progn
(setf track (copy-audio-track x))
(set-track-audio-dualmode track 0)
(if new-alist
(append-track track new-alist)
(setf new-alist (cons track nil)))
(setf track (copy-audio-track x))
(set-track-audio-dualmode track 1)
(append-track track new-alist))
(if new-alist
(append-track x new-alist)
(setf new-alist (cons x nil)))))
alist)
(send-audio-choice-list type new-alist)))
(defun clear-dualmode (send)
(let ((alist nil) (last-delid nil))
(setf req-dualmode nil)
(when send
(mapcar #'(lambda (x)
(if (eq (get-track-audio-dualmode x) -1)
(if alist
(append-track x alist)
(setf alist (cons x nil)))
(unless (eq last-delid (nth 0 x))
(setf last-delid (nth 0 x))
(set-track-audio-dualmode x -1)
(if alist
(append-track x alist)
(setf alist (cons x nil))))))
audio-choice-list)
(send-audio-choice-list (get-stream-type) alist))
(audio-dualmode 'audio 0)))
(defvar err-msg nil)
(defun send-loading-msg ()
(when msg-pipe
(setf err-msg 121)
(write-bytes msg-pipe err-msg event-id 4 0)))
(defun send-timeout-msg ()
(when msg-pipe
(setf err-msg 122)
(write-bytes msg-pipe err-msg event-id 4 0)))
(defun send-play-ng-msg (code)
(when msg-pipe
(timeout-count-stop)
(setf err-msg 123)
(write-bytes msg-pipe err-msg event-id 8 0 code)))
(defun clear-msg ()
(timeout-count-stop)
(when (and msg-pipe err-msg)
(write-bytes msg-pipe 120 event-id 4 1)
(setf err-msg nil)))
(defmacro send-play-ok-msg ()
`(clear-msg))
(defun timeout-count-start (msec)
(unless (or (find-timer 'loading-timer)
(find-timer 'timeout-timer))
(when (and msg-pipe err-msg)
(write-bytes msg-pipe 120 event-id 4 1)
(setf err-msg nil))
(set-timer #'(lambda (arg)
(send-loading-msg)
(set-timer #'(lambda (arg)
(send-timeout-msg))
'timeout-timer
nil
1
30000))
'loading-timer
nil
1
msec)))
(defun timeout-count-stop ()
(cancel-timer 'loading-timer)
(cancel-timer 'timeout-timer))
(register-device 'stream-in
"stream-in"
(get-default-prio)
#'(lambda (sig)
(case sig
(LOST
(set-owner 'stream-in nil))
(AVAILABLE
(set-owner 'stream-in t))
(INFO_CHANGE
(set-stream-info 'stream-in)
(setf trik-mode nil)
(make-event 'trik-mode-off)
(if (or (not (get-trik-video-pid))
(eq trik-speed 100)
(not (eq (get-stream-type) 'STREAM_TTS_MODE)))
(if (eq err-msg 123)
(progn
(setf req-content-uri nil)
(temp-priority)
(setf stop-mode nil)
(make-event 'request-stop))
(set-trik-video-pid nil)
(set-trik-video-codec nil)
(set-trik-audio-pid nil)
(set-trik-audio-format nil)
(when (rental-confirm-p)
(setf play-mode "resume")
(setf seek-time nil)
(setf stream-valid nil))
(make-event 'stream-change))
(when (find-timer 'pat-reset-timer)
(reset-section 'pat)
(make-event 'restart-pat-reset-monitor))
(when (find-timer 'pmt-reset-timer)
(reset-section 'pmt)
(make-event 'restart-pmt-reset-monitor))
(setf trik-mode t)
(make-event 'trik-mode-on)))
(STREAM_PLAYER_TRIK
(setf trik-mode nil)
(make-event 'trik-mode-off)
(when (find-timer 'pat-reset-timer)
(reset-section 'pat)
(make-event 'restart-pat-reset-monitor))
(when (find-timer 'pmt-reset-timer)
(reset-section 'pmt)
(make-event 'restart-pmt-reset-monitor))
(setf trik-mode t)
(make-event 'trik-mode-on))
(STREAM_STOP
(when content-id
(if (and (not navi-mode)
req-content-id
monitor-content-id)
(progn
(setf current-time (stream-play-time 'stream-in))
(if current-time
(write-bytes msg-pipe 9 event-id 8 monitor-content-id current-time)))))
(when dlna-mode
(make-event 'stream-stop)))
(STREAM_FINISH
(when content-id
(if need-retry
(progn
(setf need-retry nil)
(stream-stop 'stream-in)
(stream-skip 'stream-in -4)
(stream-open 'stream-in
:mode "last"))
(if (if (> trik-speed 0)
(stream-index-next 'stream-in)
(stream-index-prev 'stream-in))
(setf next-flag t)
(if navi-mode
(progn
(stream-index-reset 'stream-in)
(setf next-flag t))
(when content-id
(cancel-timer 'play-time-timer)
(write-bytes msg-pipe 10 event-id 4 content-id)
(stream-mark-reset 'stream-in)
(setf req-content-id nil))))
(temp-priority)
(make-event 'stream-finish)))
(when (or dlna-mode net-mode)
(cancel-timer 'play-time-timer)
(write-bytes msg-pipe 10 event-id 4 0)
(send-play-time)
(setf req-content-uri nil)
(temp-priority)
(setf stop-mode nil)
(make-event 'stream-finish)
(rui-send-event *event-play-finish*)
(net-send-event *event-play-finish* nil nil)))
(STREAM_PLAY_NG
(when (or dlna-mode net-mode)
(cancel-timer 'play-time-timer)
(let ((errno))
(setf errno (stream-errno 'stream-in))
(when errno
(setf req-content-uri nil)
(temp-priority)
(setf stop-mode nil)
(make-event 'request-stop)
(send-play-ng-msg errno)
(write-data play-error-buf 'int errno)
(rui-send-event *event-play-ng*)
(net-send-event *event-play-ng* errno nil)))))
(STREAM_SWITCHED
(when (and switch-box rate-switch-list)
(setf current-box switch-box)
(setf switch-box nil)
(setf content-uri (nth current-box rate-switch-list))
(setf req-content-uri content-uri)
(net-send-event *event-switched* current-box nil)))
(STREAM_SWITCHING
(when (and switch-box rate-switch-list)
(net-send-event *event-switch*
switch-box
(stream-http-status 'stream-in (nth switch-box rate-switch-list)))))
(STREAM_SWITCH_NG
(when (and switch-box rate-switch-list)
(let ((errno))
(setf errno (stream-errno 'stream-in (nth switch-box rate-switch-list)))
(when errno
(net-send-event *event-switch-ng* switch-box errno)
(setf switch-box nil)))))
(STREAM_DIVX_SUBTITLE
(stream-subtitle-play 'stream-in (get-subtitle-type req-subtitle) req-subtitle))
(STREAM_HDD_FATAL
(temp-priority)
(setf st-status sig)
(make-event 'hdd-error)
(write-bytes msg-pipe 110 event-id 4 0))
(STREAM_HDD_HANGUP
(temp-priority)
(setf st-status sig)
(make-event 'hdd-error)
(write-bytes msg-pipe 111 event-id 4 0)))))
(register-node 'content-fixed
#'(lambda ()
(or (and hdd-mode content-id (eq content-id req-content-id) (not next-flag))
(and (or dlna-mode net-mode) content-uri (eq content-uri req-content-uri) (not next-flag))))
#'(lambda ()
(setf content-id req-content-id)
(setf event-id req-event-id)
(setf content-uri req-content-uri)
(setf next-flag nil)
(eval-events (list 'request-play 'request-stop 'stream-finish)))
#'(lambda ()
nil))
(register-node 'stream-play
#'(lambda ()
(and stream-valid (rental-confirm-p)))
#'(lambda ()
(when (not stream-valid)
(setf stream-valid (if hdd-mode
(stream-open 'stream-in
:mode play-mode
:stream-dir "/stream"
:data-dir "/data"
:content-id content-id)
(stream-open 'stream-in
:mode play-mode
:seek seek-time
:speed trik-speed
:proxy proxy
:proxy-port proxy-port
:content-uri content-uri
:dlna-protocol dlna-protocol
:dlna-http-retry (if (and rui-msg-pipe (not nouse-dlna-header)) 3 nil)
:nouse-dlna-header nouse-dlna-header
:not-dlnadoc not-dlnadoc
:index-uri index-uri
:divx-subtitle dxst-subtitle
:size content-size
:duration content-duration)))
(if hdd-mode
(if (not stream-valid)
(write-bytes msg-pipe 10 event-id 4 content-id)
(when (< trik-speed 0)
(setf need-retry t)))
(let ((errno))
(setf errno (stream-errno 'stream-in))
(write-data play-error-buf 'int errno)
(net-send-event *event-play-ng* errno nil)
(if errno
(send-play-ng-msg errno)
(timeout-count-start 0))
(when (or stream-valid (not errno) (not (string= play-mode "resume")))
(write-data play-status-buf 'int *status-loading*)))
(when (or seek-time (string= play-mode "normal"))
(stream-subtitle-flush 'stream-in)
(divx-send-flush)
(setf seek-time nil))
(set-stream-info 'stream-in)
(when (and dlna-disable-tts (eq (get-stream-type) 'STREAM_TTS_MODE))
(setf stream-valid nil)
(send-play-ng-msg (stream-errno 'stream-in 'unsupported-format))))
(when (string= play-mode "resume")
(setf play-mode "normal")))
(eval-events (list 'stream-change 'rental-confirm)))
#'(lambda ()
(when stream-valid
(when play-status-buf
(write-data play-status-buf 'int *status-stop*))
(stream-close 'stream-in)
(when resume-mark
(stream-mark 'stream-in))
(setf stream-valid nil))))
(register-node 'play-monitor
#'(lambda ()
t)
#'(lambda ()
(when hdd-mode
(unless (and monitor-content-id (eq monitor-content-id content-id))
(setf monitor-content-id content-id)
(let ((tm))
(setf tm (stream-content-time 'stream-in))
(when (and monitor-content-id tm)
(write-bytes msg-pipe 8 event-id 8 monitor-content-id tm)))))
(when net-mode
(net-send-event *event-downloading*
(* (stream-content-time 'stream-in) 1000)
(stream-http-status 'stream-in content-uri)))
(set-play-timer 100))
#'(lambda ()
(unless (and monitor-content-id (eq monitor-content-id content-id))
(cancel-timer 'content-time-timer)
(cancel-timer 'play-time-timer)
(setf monitor-content-id nil))
(when content-uri
(cancel-timer 'play-time-timer))))
(register-node 'tsport-play
#'(lambda ()
(device-source-p 'tsport 'stream-in))
#'(lambda ()
(tsport-connect 'tsport 'stream-in))
#'(lambda ()
nil))
(register-node 'trik-mode
#'(lambda ()
(and trik-mode (get-video-cp 'video) (get-trik-video-pid)))
#'(lambda ()
(eval-events (list 'trik-mode-on 'trik-mode-off 'video-cp-update)))
#'(lambda ()
(setf trik-mode nil)
(setf last-video nil)
(setf last-audio nil)
(set-trik-video-pid nil)
(set-trik-video-codec nil)
(set-trik-audio-pid nil)
(set-trik-audio-format nil)))
(register-node 'play-speed-set
#'(lambda ()
(and (eq play-speed trik-speed) (not skip-seconds) stopped (or pause-play (not (eq play-speed 0)))))
#'(lambda ()
(when (or skip-seconds (not (eq play-speed trik-speed)) (and req-pause (eq trik-speed 0))
(and content-uri (eq (get-stream-type) 'STREAM_TTS_MODE))
)
(setf stopped (stream-stop 'stream-in stop-mode))
(when skip-seconds
(stream-subtitle-flush 'stream-in)
(divx-send-flush)
(stream-skip 'stream-in skip-seconds)
(unless pause-play
(setf skip-restart t))
(setf skip-seconds nil))
(unless (or (eq play-speed trik-speed)
(eq trik-speed 0)
(eq trik-speed 100))
(stream-subtitle-flush 'stream-in)
(divx-send-flush))
(setf play-speed trik-speed)
(send-play-time)
(unless (eq trik-speed 0)
(setf pause-play nil))
(when dlna-mode
(if (not (eq play-speed 0))
(unless err-msg
(timeout-count-start 5000))
(timeout-count-stop)))
(when (eq play-speed 0)
(when play-status-buf
(write-data play-status-buf 'int *status-pause*))
(cancel-timer 'play-time-timer))
(when hdd-mode
(make-event 'psi-speed-check)))
(eval-events (list 'play-speed-change 'skip-request 'stream-stop)))
#'(lambda ()
(setf stopped (stream-stop 'stream-in stop-mode))
(setf play-speed 100)))
(defvar playing-subtitle nil)
(register-node 'divx-subtitle-check
#'(lambda ()
(and (eq (get-stream-type) 'STREAM_DIVX_MODE)
(eq trik-speed 100)
subtitle-on
playing-subtitle
(eq playing-subtitle req-subtitle)))
#'(lambda ()
(unless (eq playing-subtitle req-subtitle)
(divx-send-change-content)
(setf playing-subtitle req-subtitle))
(unless subtitle-on
(divx-send-flush))
(eval-events (list 'subtitle-change)))
#'(lambda ()
))
(register-node 'divx-subtitle-play
#'(lambda ()
t)
#'(lambda ()
(divx-send-display)
(stream-subtitle-play 'stream-in (get-subtitle-type req-subtitle) req-subtitle))
#'(lambda ()
(stream-subtitle-stop 'stream-in)))
(register-node 'trik-play
#'(lambda ()
t)
#'(lambda ()
(when play-status-buf
(write-data play-status-buf 'int *status-playing*))
(setf need-retry nil)
(when (eq (get-stream-type) 'STREAM_DIVX_MODE)
(stream-select 'stream-in
:video req-video
:audio req-audio))
(stream-play 'stream-in play-speed)
(setf stop-mode t)
(set-play-timer play-speed))
#'(lambda ()
))
(register-node 'decode-monitor
#'(lambda ()
t)
#'(lambda ()
(unless (get-video-result 'video)
(set-video-result 'video (video-status 'video)))
(unless (get-audio-result 'audio)
(set-audio-result 'audio (audio-status 'audio)))
(when (or dlna-mode net-mode)
(setf play-valid (stream-play-status 'stream-in))
(if play-valid
(cancel-timer 'play-valid-timer)
(set-timer #'(lambda (arg)
(make-event 'play-valid-check))
'play-valid-timer
nil
nil
200)))
(when (or
(and (or dlna-mode net-mode) req-pause play-valid)
(and hdd-mode req-pause
(or (and (/= trik-speed 100) (/= trik-speed 0))
(eq (get-video-result 'video) 'DECODE_SUCCESS))))
(send-play-time)
(pause-action))
(when (and dlna-mode (get-video-result 'video)
(or (not (or (get-audio-pid 'audio) (get-audio-streamid 'audio)))
(not (eq trik-speed 100)) (get-audio-result 'audio)))
(if (or (eq (get-video-result 'video) 'DECODE_SUCCESS)
(eq (get-audio-result 'audio) 'DECODE_SUCCESS))
(progn
(when (and req-audio (eq (get-audio-result 'audio) 'DECODE_SUCCESS) (dual-mono-p))
(send-audio-choice-list-with-dualmode (get-stream-type) audio-choice-list req-audio))
(send-play-ok-msg)
(when play-error-buf
(write-data play-error-buf 'int 0))
(rui-send-event (if (eq rui-last-event *event-waiting*) *event-recover* *event-play-ok*)))
(unless err-msg
(timeout-count-start 5000))
(when (or (eq rui-last-event *event-play-ok*)
(eq rui-last-event *event-recover*))
(rui-send-event *event-waiting*))))
(eval-events (list 'video-result-fix 'audio-result-fix 'video-result-update 'audio-result-update 'request-pause 'rui-event-reset 'play-valid-check)))
#'(lambda ()
(setf play-valid nil)
(cancel-timer 'play-valid-timer)
(set-video-result 'video nil)
(set-audio-result 'audio nil)))
(defun eval-copy-protection ()
(when (device-open-p 'cp)
(if (not (eq (get-stream-type) 'STREAM_TTS_MODE))
(make-event 'eval-cp-nonts)
(when (eq (cp-create 'cp
:psi 'psi
:src 'stream-in
:info (get-cp-stream-info 'cp)
:type (get-cp-svc-type 'cp)
:emi (if hdd-mode (get-cp-emi 'cp) nil)
:e-emi (if dlna-mode (if (get-stream-eemi) (get-stream-eemi) 0) nil))
t)
(unless (eq (get-video-cp 'video) (cp-ref 'cp "analog-in-video"))
(set-video-cp 'video (not (get-video-cp 'video)))
(make-event 'video-cp-update))
(unless (eq (get-audio-cp 'audio) (cp-ref 'cp "analog-in-audio"))
(set-audio-cp 'audio (not (get-audio-cp 'audio)))
(make-event 'audio-cp-update))
))))
(defun eval-copy-protection-nonts ()
(when (device-open-p 'cp)
(when (eq (cp-create 'cp
:src 'stream-in
:e-emi (if dlna-mode (if (get-stream-eemi) (get-stream-eemi) 0) nil))
t)
(set-video-cp 'video (cp-ref 'cp "analog-in-video"))
(set-audio-cp 'audio (cp-ref 'cp "analog-in-audio"))
)))
(defvar video-choice-list nil)
(defvar audio-choice-list nil)
(defvar subtitle-choice-list nil)
(defvar last-video-event nil)
(defvar last-audio-event nil)
(defvar last-subtitle-event nil)
(defvar playing-video nil)
(defvar playing-audio nil)
(defun send-video-choice-list (type lst)
(unless (and (equal video-choice-list lst) (eq event-id last-video-event))
(if lst
(let ((pos))
(setf pos (position (assoc req-video lst) lst))
(unless pos
(setf pos 0))
(case type
(STREAM_TTS_MODE
(write-bytes msg-pipe 402 event-id (+ (* (length lst) 16) 8) 1 pos lst))
(STREAM_PS_MODE
(write-bytes msg-pipe 402 event-id (+ (* (length lst) 4) 8) 2 pos lst))
(STREAM_DIVX_MODE
(write-bytes msg-pipe 402 event-id (+ (* (length lst) 12) 8) 3 pos
(mapcar #'(lambda (x)
(let ((y))
(setf y (copy-list x))
(setf (nth 2 y) (uimsbf 32 (nth 2 y)))
y))
lst)))))
(write-bytes msg-pipe 402 event-id 0))
(setf last-video-event event-id)
(setf video-choice-list lst)))
(defun send-audio-choice-list (type lst)
(unless (and (equal audio-choice-list lst) (eq event-id last-audio-event))
(if lst
(let ((pos))
(setf pos (position-if #'(lambda (x)
(and (eq req-audio (nth 0 x))
(or (not req-dualmode)
(eq req-dualmode (get-track-audio-dualmode x)))))
lst))
(unless pos
(setf pos 0))
(case type
(STREAM_TTS_MODE
(write-bytes msg-pipe 403 event-id (+ (* (length lst) 28) 8) 1 pos lst))
(STREAM_PS_MODE
(write-bytes msg-pipe 403 event-id (+ (* (length lst) 8) 8) 2 pos lst))
(STREAM_DIVX_MODE
(write-bytes msg-pipe 403 event-id (+ (* (length lst) 29) 8) 3 pos lst))))
(write-bytes msg-pipe 403 event-id 0))
(setf last-audio-event event-id)
(setf audio-choice-list lst)))
(defun send-subtitle-choice-list (type lst)
(unless (and (equal subtitle-choice-list lst) (eq event-id last-subtitle-event))
(if lst
(let ((pos))
(setf pos (position (assoc req-subtitle lst) lst))
(unless pos
(setf pos 0))
(case type
(STREAM_TTS_MODE
(write-bytes msg-pipe 405 event-id (+ (* (length lst) 24) 8) 1 pos lst))
(STREAM_DIVX_MODE
(write-bytes msg-pipe 405 event-id (+ (* (length lst) 29) 8) 3 pos
(mapcar #'(lambda (x)
(let ((y))
(setf y (copy-list x))
(setf (nth 3 y) (uimsbf 32 (nth 3 y)))
y))
lst)))))
(write-bytes msg-pipe 405 event-id 0))
(setf last-subtitle-event event-id)
(setf subtitle-choice-list lst)))
(defun send-playing-video (info)
(unless (equal playing-video info)
(write-bytes msg-pipe 400 event-id 4 (if info info -1))
(setf playing-video info)))
(defun send-playing-audio (info)
(unless (equal playing-audio info)
(write-bytes msg-pipe 401 event-id 16 (if (and info (nth 0 info))
(list (nth 0 info)
(if (nth 1 info)
(nth 1 info)
-1)
(if (nth 2 info)
(nth 2 info)
-1)
(if (nth 3 info)
(nth 3 info)
-1))
(list -1 -1 -1 "---")))
(setf playing-audio info)))
(defun pmt-parser (pmt)
(set-video-pcr 'video nil)
(set-audio-pcr 'audio nil)
(if (not pmt)
(progn
(cancel-timer 'pmt-delayed-eval-timer)
(setf pmt-svcid nil)
(send-video-choice-list nil nil)
(send-audio-choice-list nil nil)
(send-subtitle-choice-list nil nil)
(send-playing-video nil)
(send-playing-audio nil)
(set-video-pid 'video nil)
(set-audio-pid 'audio nil))
(let ((header) (firstlp) (secondlp) (esheader) (esdesclp) (pcrpid)
(stype) (espid) (tag) (track) (lang) (type) (info-desc)
(vlist nil) (alist nil) (slist nil)
(lang-list nil) (type-list nil))
(setf header (first pmt))
(setf firstlp (second pmt))
(setf secondlp (third pmt))
(setf pmt-svcid (+ (* (nth 3 header) #x100) (nth 4 header)))
(setf pcrpid (+ (* (logand (nth 8 header) #x1F) #x100)
(nth 9 header)))
(mapcar #'(lambda (eslp)
(setf esheader (first eslp))
(setf esdesclp (second eslp))
(setf stype (first esheader))
(setf espid (+ (* (logand (second esheader) #x1F) #x100)
(third esheader)))
(setf tag -1)
(setf lang (copy-string "---"))
(setf type 0)
(setf info-desc nil)
(mapcar #'(lambda (desc)
(when (eq (+ 2 (second desc)) (length desc))
(case (first desc)
(#x52
(setf tag (third desc)))
(#x0a
(setf-char lang 0 (nth 2 desc))
(setf-char lang 1 (nth 3 desc))
(setf-char lang 2 (nth 4 desc))
(setf type (nth 5 desc)))
((#x56 #x59 #x66 #x6a #x7a)
(setf info-desc desc)))))
esdesclp)
(case stype
((#x01 #x02 #x1b)
(setf track (list espid tag (list stype pcrpid)))
(if vlist
(append-track track vlist)
(setf vlist (cons track nil))))
((#x03 #x04 #x0f #x11 #x81)
(setf track (list espid tag (list stype lang type -1 -1)))
(if alist
(append-track track alist)
(setf alist (cons track nil))))
(#x06
(when info-desc
(case (first info-desc)
((#x6a #x7a)
(let ((fmt nil))
(when (eq (first info-desc) #x6a)
(setf fmt #x81))
(when (eq (first info-desc) #x7a)
(setf fmt #x82))
(when fmt
(setf track (list espid tag (list fmt lang type -1 -1)))
(if alist
(append-track track alist)
(setf alist (cons track nil))))))
(#x59
(if (>= (second info-desc) 8)
(do ((x 0 (+ x 8)) (lp (nthcdr 2 info-desc) (setf lp (nthcdr 8 lp)))
(composition-id) (ancillary-id))
((>= x (second info-desc)))
(setf lang (copy-string "---"))
(setf-char lang 0 (nth 0 lp))
(setf-char lang 1 (nth 1 lp))
(setf-char lang 2 (nth 2 lp))
(setf type (nth 3 lp))
(setf composition-id (+ (* (nth 4 lp) #x100) (nth 5 lp)))
(setf ancillary-id (+ (* (nth 6 lp) #x100) (nth 7 lp)))
(setf track (list espid tag (list lang type composition-id ancillary-id)))
(if slist
(append-track track slist)
(setf slist (cons track nil))))
(setf track (list espid tag (list (copy-string "---") 0 0 0)))
(if slist
(append-track track slist)
(setf slist (cons track nil))))))))))
secondlp)
(eval-copy-protection)
(setf last-video (if (and req-video (assoc req-video vlist))
(assoc req-video vlist)
(get-default-video vlist)))
(setf last-audio (if (and req-audio (assoc req-audio alist))
(assoc req-audio alist)
(get-default-audio alist)))
(setf req-video (get-track-pid last-video))
(setf req-audio (get-track-pid last-audio))
(if (and (or dlna-mode net-mode) (eq trik-speed 100) (get-trik-video-pid)
(not (and (eq (get-trik-video-pid) (get-track-pid last-video))
(eq (get-trik-video-codec) (get-track-stype last-video))
(eq (get-trik-audio-pid) (get-track-pid last-audio))
(eq (get-trik-audio-format) (get-track-stype last-audio)))))
(progn
(cancel-timer 'pat-reset-timer)
(cancel-timer 'pmt-reset-timer)
(section-disable 'pat)
(section-disable 'pmt)
(set-timer #'(lambda (arg)
(set-timer #'(lambda (arg)
(make-event 'restart-pat-reset-monitor)
(make-event 'restart-pmt-reset-monitor))
'pmt-block-timer
nil
1
2000)
(unless (and (eq (get-trik-video-pid) (get-track-pid last-video))
(eq (get-trik-video-codec) (get-track-stype last-video)))
(setf stop-mode nil))
(setf trik-mode nil)
(make-event 'trik-mode-off)
(clear-dualmode nil)
(set-video-pcr 'video (get-track-video-pcr last-video))
(set-video-pid 'video (get-track-pid last-video))
(set-trik-video-pid (get-video-pid 'video))
(set-trik-video-codec (get-track-stype last-video))
(audio-attr 'audio (if (eq (get-track-stype last-video) #x1b) 'avc 'mpeg2))
(set-audio-pcr 'audio (get-video-pcr 'video))
(set-audio-pid 'audio (get-track-pid last-audio))
(set-trik-audio-pid (get-audio-pid 'audio))
(set-trik-audio-format (get-track-stype last-audio)))
'pmt-delayed-eval-timer
nil
1
0))
(set-video-pcr 'video (get-track-video-pcr last-video))
(set-video-pid 'video (get-track-pid last-video))
(set-trik-video-pid (get-video-pid 'video))
(set-trik-video-codec (get-track-stype last-video))
(audio-attr 'audio (if (eq (get-track-stype last-video) #x1b) 'avc 'mpeg2))
(set-audio-pcr 'audio (get-video-pcr 'video))
(set-audio-pid 'audio (get-track-pid last-audio))
(set-trik-audio-pid (get-audio-pid 'audio))
(set-trik-audio-format (get-track-stype last-audio))
(send-video-choice-list (get-stream-type) vlist)
(if (and req-audio req-dualmode)
(send-audio-choice-list-with-dualmode (get-stream-type) alist req-audio)
(send-audio-choice-list (get-stream-type) alist))
(send-subtitle-choice-list (get-stream-type) slist)
(setf req-video nil)
(setf req-audio nil)
(send-playing-video (get-video-pid 'video))
(send-playing-audio (list (get-audio-pid 'audio) -1 -1))))))
(defun change-audio (id dualmode)
(when audio-choice-list
(let ((track))
(setf track (assoc id audio-choice-list))
(when track
(if (or (and (get-audio-pid 'audio) (not (eq (get-audio-pid 'audio) id)))
(and (get-audio-streamid 'audio) (not (eq (get-audio-streamid 'audio) id))))
(progn
(temp-priority)
(when (or dlna-mode net-mode)
(setf trik-mode nil)
(make-event 'trik-mode-off))
(setf req-audio id)
(clear-dualmode t)
(case (get-stream-type)
(STREAM_TTS_MODE
(setf req-audio nil)
(set-trik-audio-pid (get-track-pid track))
(set-trik-audio-format (get-track-stype track))
(set-audio-pid 'audio (get-track-pid track)))
(STREAM_DIVX_MODE
(set-audio-format 'audio (get-divx-audio-codec (nth 2 track)))
(set-audio-streamid 'audio (nth 0 track))
(make-event 'audio-update)))
(send-playing-audio (list id -1 -1)))
(unless (eq req-dualmode dualmode)
(setf req-dualmode (audio-dualmode 'audio dualmode))))))))
(defvar divx-fd nil)
(defvar divx-subtitle-setup nil)
(defvar divx-profile 0)
(defvar subtitle-on nil)
(defun divx-send-profile (profile)
(write-bytes divx-fd 0 4 profile))
(defun divx-send-screen-color (color)
(write-bytes divx-fd 2 1)
(write-chars divx-fd color))
(defun divx-send-dxst-config (nline column font-height)
(write-bytes divx-fd 4 12 nline column font-height))
(defun divx-send-display ()
(let ((type))
(setf type (get-subtitle-type req-subtitle))
(write-bytes divx-fd 7 4 (if (and subtitle-on type)
(if (eq type 'xsub)
1
2)
0))))
(defun divx-send-change-content ()
(write-bytes divx-fd 5 0))
(defun divx-send-flush ()
(write-bytes divx-fd 9 0))
(defun set-subtitle-charset (code)
(write-bytes divx-fd 10 4 code))
(defun init-divx-subtitle (fd profile color nline column font-height)
(setf divx-fd fd)
(when (device-open-p 'stream-in)
(stream-subtitle-setup 'stream-in
:socket divx-fd
:xsub-com 8
:dxst-com 11
:column column
:line nline))
(setf divx-profile profile)
(setf divx-subtitle-setup (list column nline))
(divx-send-profile profile)
(divx-send-screen-color color)
(divx-send-dxst-config nline column font-height))
(defun get-subtitle-type (no)
(let ((track))
(setf track (assoc no subtitle-choice-list))
(if (eq (nth 1 track) 0)
'xsub
(if (eq (nth 1 track) 1)
'dxst
nil))))
(defun subtitle-on ()
(setf subtitle-on t)
(make-event 'subtitle-change))
(defun subtitle-off ()
(setf subtitle-on nil)
(make-event 'subtitle-change)
)
(defun change-subtitle (id)
(when subtitle-choice-list
(let ((track))
(setf track (assoc id subtitle-choice-list))
(when (and (eq (get-stream-type) 'STREAM_DIVX_MODE)
track
(not (eq req-subtitle id)))
(setf req-subtitle id)
(make-event 'subtitle-change)))))
(register-node 'speed-100
#'(lambda ()
(or dlna-mode net-mode
(and (or (eq play-speed 100) (eq play-speed 0)) (not skip-restart))))
#'(lambda ()
(setf skip-restart nil)
(eval-events (list 'psi-speed-check)))
#'(lambda ()
nil))
(unregister-node 'video-play)
(register-node 'video-play
#'(lambda ()
t)
#'(lambda ()
(video-play 'video
:psi (if (eq (get-stream-type) 'STREAM_TTS_MODE) 'psi nil)
:codec (get-video-codec 'video)
:pid (get-video-pid 'video)
:pcr (get-video-pcr 'video)
:streamid (get-video-streamid 'video)
:mode (if (and (not content-uri) (eq trik-speed 100)) "sync" "noplay"))
(eval-events (list 'video-update 'video-available)))
#'(lambda ()
(when (and navi-mode hdd-mode)
(video-stop 'video))))
(unregister-node 'audio-play)
(register-node 'audio-play
#'(lambda ()
t)
#'(lambda ()
(audio-play 'audio
:psi (if (eq (get-stream-type) 'STREAM_TTS_MODE) 'psi nil)
:format (get-audio-format 'audio)
:pid (get-audio-pid 'audio)
:pcr (get-audio-pcr 'audio)
:streamid (get-audio-streamid 'audio)
:ext (if (eq (get-stream-type) 'STREAM_MP4_MODE) "raw-payload" nil)
:mode (if (and (not content-uri) (eq trik-speed 100)) "sync" "noplay"))
(setf trik-mode t)
(make-event 'trik-mode-on)
(eval-events (list 'audio-update 'audio-available)))
#'(lambda ()
(when (and navi-mode hdd-mode)
(audio-stop 'audio))))
(register-node 'device-check
#'(lambda ()
(not (and hdd-mode
(or (eq stream-status 'STREAM_HDD_FATAL)
(eq stream-status 'STREAM_HDD_HANGUP)))))
#'(lambda ()
(eval-events (list 'hdd-error)))
#'(lambda ()
nil))
(register-node 'decoder-ready
#'(lambda ()
(or (and (owner-p 'video) (owner-p 'audio))
(and (device-source-p 'video 'tsport) (device-source-p 'audio 'tsport))))
#'(lambda ()
(unless (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 'video-available 'audio-available)))
#'(lambda ()
nil))
(register-node 'ts-stream
#'(lambda ()
(eq (get-stream-type) 'STREAM_TTS_MODE))
#'(lambda ()
(eval-events (list 'stream-change)))
#'(lambda ()
))
(defun reset-section (sym)
(section-disable sym)
(section-enable sym))
(register-node 'pat-reset-monitor
#'(lambda ()
t)
#'(lambda ()
(when content-uri
(set-timer #'reset-section
'pat-reset-timer
'pat
nil
1000))
(eval-events (list 'restart-pat-reset-monitor)))
#'(lambda ()
(cancel-timer 'pat-reset-timer)))
(register-node 'pmt-reset-monitor
#'(lambda ()
t)
#'(lambda ()
(when content-uri
(set-timer #'reset-section
'pmt-reset-timer
'pmt
nil
1000))
(eval-events (list 'restart-pmt-reset-monitor)))
#'(lambda ()
(cancel-timer 'pmt-reset-timer)))
(register-node 'non-ts-check
#'(lambda ()
(and (or (and (get-video-streamid 'video)
(or (get-audio-streamid 'audio) (eq (get-stream-type) 'STREAM_DIVX_MODE)))
(and (get-video-pid 'video) (get-video-pcr 'video)
(get-audio-pid 'audio) (get-audio-pcr 'audio)))
(get-video-cp 'video) (get-audio-cp 'audio)))
#'(lambda ()
(eval-copy-protection-nonts)
(case (get-stream-type)
(STREAM_PS_MODE
(set-video-codec 'video (get-stream-video-codec))
(set-video-streamid 'video (get-stream-video-streamid))
(audio-attr 'audio (get-video-codec 'video))
(set-audio-format 'audio (get-stream-audio-codec))
(set-audio-streamid 'audio (get-stream-audio-streamid))
(set-trik-video-pid (get-stream-video-streamid)))
(STREAM_MP4_MODE
(set-video-codec 'video (get-stream-video-codec))
(set-video-pcr 'video (get-stream-pcr-pid))
(set-video-pid 'video (get-stream-video-pid))
(audio-attr 'audio (get-video-codec 'video))
(set-audio-format 'audio (get-stream-audio-codec))
(set-audio-pcr 'audio (get-stream-pcr-pid))
(set-audio-pid 'audio (get-stream-audio-pid))
(set-trik-video-pid (get-stream-video-pid)))
(STREAM_DIVX_MODE
(let ((track))
(setf track (assoc req-video video-choice-list))
(set-video-codec 'video (get-divx-video-codec (nth 2 track)))
(set-video-streamid 'video (nth 0 track))
(setf track (assoc req-audio audio-choice-list))
(audio-attr 'audio (get-video-codec 'video))
(set-audio-format 'audio (get-divx-audio-codec (nth 2 track)))
(set-audio-streamid 'audio (nth 0 track))
(set-trik-video-pid (get-video-streamid 'video)))))
(eval-events (list 'eval-cp-nonts)))
#'(lambda ()
(set-video-pid 'video nil)
(set-video-codec 'video nil)
(set-video-pcr 'video nil)
(set-video-streamid 'video nil)
(set-audio-pid 'audio nil)
(set-audio-format 'audio nil)
(set-audio-streamid 'audio nil)
(set-audio-pcr 'audio nil)))
(copy-node 'video-play-nonts 'video-play)
(copy-node 'audio-play-nonts 'audio-play)
(register-device 'video2
"video"
(get-default-prio)
#'(lambda (sig)))
(register-device 'audio2
"audio"
(get-default-prio)
#'(lambda (sig)))
(defun connect ()
(my-device-open 'video 0)
(my-device-open 'audio 0)
(when net-msg-pipe
(my-device-open 'video2 1)
(video-stop 'video2)
(my-device-open 'audio2 1)
(audio-stop 'audio2))
(my-device-open 'psi 'video)
(my-device-open 'cp nil)
(my-device-open 'tsport 3)
(my-device-open 'stream-in 'tsport)
(when divx-fd
(stream-subtitle-setup 'stream-in
:socket divx-fd
:xsub-com 8
:dxst-com 11
:column (nth 0 divx-subtitle-setup)
:line (nth 1 divx-subtitle-setup)))
(setf st-status (stream-status 'stream-in))
(init-section-object 'pat)
(init-section-object 'pmt)
(init-psi-object 'psi #'pmt-parser)
(init-video-object 'video)
(init-audio-object 'audio)
(init-cp-object 'cp)
(resource-node 'player-resource (list 'stream-in))
(append-t
'player-resource
'device-check
'decoder-ready
'content-fixed
'stream-play
'tsport-play
'speed-100
'ts-stream
'psi-valid
'parse-pmt
'display-cp-valid)
(append-t
'ts-stream
'pat-request
'pmt-pid-valid
'pmt-request
'pmt-reset-monitor)
(append-t
'pat-request
'pat-reset-monitor)
(append-t
'display-cp-valid
'video-pid-valid
'video-play)
(append-t
'display-cp-valid
'audio-pid-valid
'audio-play)
(append-nil
'ts-stream
'non-ts-check)
(append-t
'non-ts-check
'video-play-nonts)
(append-t
'non-ts-check
'audio-play-nonts)
(unless navi-mode
(stream-trik 'stream-in 'video 'audio)
(append-t
'stream-play
'play-monitor)
(append-t
'content-fixed
'trik-mode
'play-speed-set
'divx-subtitle-check
'divx-subtitle-play)
(append-t
'play-speed-set
'trik-play
'decode-monitor))
(eval-node 'player-resource))
(defun disconnect ()
(setf stop-mode nil)
(cancel-node 'player-resource)
(init-node 'player-resource)
(my-device-close 'stream-in)
(my-device-close 'tsport)
(my-device-close 'psi)
(my-device-close 'cp)
(my-device-close 'audio)
(my-device-close 'video)
(when (device-open-p 'video2)
(my-device-close 'video2))
(when (device-open-p 'audio2)
(my-device-close 'audio2))
(setf st-status nil)
(setf need-retry nil)
(setf resume-mark nil)
(setf pause-play nil)
(setf stopped t)
(setf play-valid nil)
(setf play-mode "normal")
(setf content-id nil)
(setf req-content-id nil)
(setf monitor-content-id nil)
(setf play-speed 100)
(setf trik-speed 100)
(setf skip-seconds nil)
(setf trik-mode nil)
(setf skip-restart nil)
(setf pmt-svcid nil)
(setf content-uri nil)
(setf req-content-uri nil)
(setf monitor-content-uri nil)
(setf index-uri nil)
(setf dlna-protocol nil)
(setf seek-time nil)
(setf nouse-dlna-header nil)
(setf not-dlnadoc nil)
(timeout-count-stop)
(setf rui-last-event nil)
(setf net-last-event nil)
(setf rate-switch-list nil)
(setf current-box nil)
(setf switch-box nil)
(setf rate-monitor nil)
(setf sinfo (list 'STREAM_TTS_MODE nil nil nil nil nil nil nil nil nil)))
(defun set-input-digital ()
)
(unless (boundp 'no-resource-start)
(connect))
(defun temp-priority ()
(when special-prio
(device-priority 'video special-prio)
(device-priority 'audio special-prio)
(set-timer #'(lambda (x)
(device-priority 'video (get-default-prio))
(device-priority 'audio (get-default-prio)))
'temp-priority
nil
1
3000)))
(defun switch-hdd-mode ()
(setf hdd-mode t)
(setf dlna-mode nil)
(setf net-mode nil)
(setf req-content-uri nil))
(defun switch-dlna-mode ()
(setf hdd-mode nil)
(setf dlna-mode t)
(setf net-mode nil)
(setf req-content-id nil))
(defun switch-net-mode ()
(setf hdd-mode nil)
(setf dlna-mode nil)
(setf net-mode t)
(setf req-content-id nil))
(defun hdd-start (content)
(switch-hdd-mode)
(temp-priority)
(setf req-pause nil)
(setf play-mode "normal")
(setf trik-speed 100)
(when (eq req-content-id content)
(stream-index-reset 'stream-in)
(setf content-id nil))
(set-psi-valid 'psi nil)
(setf req-content-id content)
(if content
(let ((tm))
(setf tm (stream-content-time 'stream-in
:mode play-mode
:stream-dir "/stream"
:data-dir "/data"
:content-id content))
(when msg-pipe
(if tm
(write-bytes msg-pipe 8 event-id 8 content tm)
(write-bytes msg-pipe 8 event-id 8 content 0)))))
(make-event 'request-play))
(defun hdd-resume-start (content)
(switch-hdd-mode)
(temp-priority)
(setf req-pause nil)
(setf play-mode "resume")
(setf trik-speed 100)
(when (eq req-content-id content)
(stream-index-reset 'stream-in)
(setf content-id nil))
(set-psi-valid 'psi nil)
(setf req-content-id content)
(make-event 'request-play))
(defun hdd-next (content)
(switch-hdd-mode)
(unless (eq req-content-id content)
(temp-priority)
(if (> trik-speed 0)
(setf play-mode "normal")
(setf play-mode "reverse"))
(set-psi-valid 'psi nil)
(setf req-content-id content)
(make-event 'request-play)))
(defun set-proxy (addr port)
(setf proxy addr)
(setf proxy-port port))
(defun net-play-start (uri-s speed seek)
(let ((uri nil))
(switch-net-mode)
(temp-priority)
(setf req-pause nil)
(if (consp uri-s)
(progn
(setf rate-switch-list (mapcar #'(lambda (x)
(if (or (not x) (string= "(null)" x) (eq (char x 0) 0)) nil x))
uri-s))
(setf uri (car rate-switch-list))
(when (< (length rate-switch-list) 2)
(setf rate-switch-list nil)))
(setf uri (if (or (not uri) (string= "(null)" uri) (eq (char uri 0) 0)) nil uri)))
(if (and content-uri seek (eq seek (* (stream-play-time 'stream-in) 1000)))
(if (eq trik-speed speed)
(make-event 'rui-event-reset)
(play speed))
(if (and content-uri seek)
(setf play-mode "resume")
(setf stop-mode nil)
(setf play-mode "normal"))
(setf trik-speed speed)
(set-psi-valid 'psi nil)
(setf current-box 0)
(setf req-content-uri uri)
(setf seek-time seek)
(setf next-flag t)
(setf rate-monitor t)
(make-event 'request-play)
(send-play-time))))
(defmacro net-start (uri)
`(net-play-start ,uri 100 nil))
(defmacro net-resume-start (uri seek)
`(net-play-start ,uri 100 ,seek))
(defun net-switch (box)
(when (and rate-switch-list (> (length rate-switch-list) box))
(setf switch-box box)
(setf rate-monitor nil)
(when (stream-switch 'stream-in
:content-uri (nth switch-box rate-switch-list)))))
(defun dlna-play-start-inner (uri index protocol speed seek)
(switch-dlna-mode)
(temp-priority)
(rui-send-event nil)
(setf req-pause nil)
(if (and content-uri seek (eq seek (* (stream-play-time 'stream-in) 1000)))
(if (eq trik-speed speed)
(make-event 'rui-event-reset)
(play speed))
(if (and content-uri seek)
(setf play-mode "resume")
(setf stop-mode nil)
(setf play-mode "normal"))
(setf trik-speed speed)
(set-psi-valid 'psi nil)
(setf req-content-uri (if (or (not uri) (string= "(null)" uri) (eq (char uri 0) 0)) nil uri))
(setf index-uri (if (or (not index) (string= "(null)" index) (eq (char index 0) 0)) nil index))
(setf dlna-protocol (if (or (not protocol) (string= "(null)" protocol) (eq (char protocol 0) 0)) nil protocol))
(setf seek-time seek)
(setf next-flag t)
(make-event 'request-play)
(send-play-time)))
(defun dlna-next-inner (uri index protocol)
(switch-dlna-mode)
(temp-priority)
(setf req-pause nil)
(if (> trik-speed 0)
(setf play-mode "normal")
(setf play-mode "reverse"))
(set-psi-valid 'psi nil)
(setf req-content-uri (if (or (not uri) (string= "(null)" uri) (eq (char uri 0) 0)) nil uri))
(setf index-uri (if (or (not index) (string= "(null)" index) (eq (char index 0) 0)) nil index))
(setf dlna-protocol (if (or (not protocol) (string= "(null)" protocol) (eq (char protocol 0) 0)) nil protocol))
(setf seek-time 0)
(setf next-flag t)
(make-event 'request-play)
(send-play-time))
(defvar dxst-subtitle nil)
(defvar content-size nil)
(defvar content-duration nil)
(defun dlna-play-start (uri index protocol speed seek)
(setf notify-trick-cap t)
(setf dxst-subtitle nil)
(setf req-video nil)
(setf req-audio nil)
(setf req-dualmode nil)
(setf req-subtitle nil)
(setf content-size nil)
(setf content-duration nil)
(dlna-play-start-inner uri index protocol 100 nil))
(defun dlna-start (uri index protocol)
(setf notify-trick-cap t)
(setf dxst-subtitle nil)
(setf req-video nil)
(setf req-audio nil)
(setf req-dualmode nil)
(setf req-subtitle nil)
(setf content-size nil)
(setf content-duration nil)
(dlna-play-start-inner uri index protocol 100 nil))
(defun dlna-resume-start (uri index protocol seek)
(setf notify-trick-cap t)
(setf dxst-subtitle nil)
(setf req-video nil)
(setf req-audio nil)
(setf req-dualmode nil)
(setf req-subtitle nil)
(setf content-size nil)
(setf content-duration nil)
(dlna-play-start-inner uri index protocol 100 seek))
(defun dlna-next (uri index protocol)
(setf notify-trick-cap t)
(setf dxst-subtitle nil)
(setf req-video nil)
(setf req-audio nil)
(setf req-dualmode nil)
(setf req-subtitle nil)
(setf content-size nil)
(setf content-duration nil)
(dlna-next-inner uri index protocol))
(defun dlna-divx-start (uri index protocol dxst dlnadoc seek components attr new-event-id)
(unless (eq req-event-id new-event-id)
(stop)
(setf notify-trick-cap t)
(setf req-event-id new-event-id))
(setf dxst-subtitle (if (or (not dxst) (string= "(null)" dxst) (eq (char dxst 0) 0)) nil dxst))
(setf not-dlnadoc (not dlnadoc))
(setf req-video (if (and (nth 0 components) (>= (nth 0 components) 0)) (nth 0 components) nil))
(setf req-audio (if (and (nth 1 components) (>= (nth 1 components) 0)) (nth 1 components) nil))
(setf req-dualmode (if (and (nth 2 components) (>= (nth 2 components) 0)) (nth 2 components) nil))
(setf req-subtitle (if (and (nth 3 components) (>= (nth 3 components) 0)) (nth 3 components) nil))
(setf content-size (nth 0 attr))
(setf content-duration (nth 1 attr))
(dlna-play-start-inner uri index protocol 100 (if (eq seek 0) nil seek)))
(defun dlna-divx-next (uri index protocol dxst dlnadoc new-event-id)
(setf notify-trick-cap t)
(setf req-event-id new-event-id)
(setf dxst-subtitle (if (or (not dxst) (string= "(null)" dxst) (eq (char dxst 0) 0)) nil dxst))
(setf not-dlnadoc (not dlnadoc))
(setf req-video nil)
(setf req-audio nil)
(setf req-dualmode nil)
(setf req-subtitle nil)
(setf content-size nil)
(setf content-duration nil)
(dlna-next-inner uri index protocol))
(defun stop ()
(temp-priority)
(setf req-pause nil)
(setf stop-mode nil)
(if hdd-mode
(progn
(setf req-content-id nil)
(unless navi-mode
(setf resume-mark t))
(make-event 'request-stop)
(stream-index-reset 'stream-in)
(setf resume-mark nil))
(setf req-content-uri nil)
(make-event 'request-stop)
(stream-reset-content 'stream-in)
(send-video-choice-list nil nil)
(send-audio-choice-list nil nil)
(send-subtitle-choice-list nil nil)
(clear-dualmode nil)
(setf divx-hdrl nil)
(setf rental-limit nil)
(setf rental-confirm nil)
(setf notify-rental-limit t)
(stream-subtitle-flush 'stream-in)
(divx-send-flush)
(clear-msg)
(if (pause-resume-capable-p)
(stream-mark 'stream-in)
0)))
(defun stop2 ()
(temp-priority)
(setf trik-speed 0)
(setf stop-mode nil)
(make-event 'play-speed-change)
(if (pause-resume-capable-p)
(stream-mark 'stream-in)
0))
(defun play (speed)
(when (or (not dlna-mode) (play-capable-p speed))
(setf req-pause nil)
(unless (eq trik-speed speed)
(temp-priority)
(make-event 'video-update)
(make-event 'audio-update)
(if (> speed 0)
(setf play-mode "normal")
(setf play-mode "reverse"))
(setf trik-speed speed)
(make-event 'play-speed-change))))
(defun pause ()
(when (or (not dlna-mode) (pause-resume-capable-p))
(setf req-pause t)
(send-play-time)
(make-event 'request-pause)))
(defun send-play-time ()
(setf current-time (stream-play-time 'stream-in))
(when (and (or monitor-content-id content-uri) current-time)
(if play-time-buf
(write-data play-time-buf 'int (* current-time 1000))
(when (and net-mode play-valid)
(net-send-event *event-play-ok* (* current-time 1000) (stream-load-rate 'stream-in content-uri)))
(when msg-pipe
(if (and hdd-mode monitor-content-id)
(write-bytes msg-pipe 9 event-id 8 monitor-content-id current-time)
(write-bytes msg-pipe 9 event-id 8 0 current-time))))))
(defun pause-action ()
(when req-pause
(temp-priority)
(setf trik-speed 0)
(setf pause-play nil)
(when (find-timer 'play-time-timer)
(cancel-timer 'play-time-timer))
(make-event 'play-speed-change)))
(defun skip (seconds)
(when (or (not dlna-mode) (skip-capable-p))
(temp-priority)
(if hdd-mode
(progn
(setf skip-seconds seconds)
(if (eq trik-speed 0)
(progn
(setf req-pause t)
(setf pause-play t))
(setf trik-speed 100))
(setf play-mode "normal")
(make-event 'skip-request))
(if (eq trik-speed 0)
(progn
(setf req-pause t)
(setf pause-play t))
(setf trik-speed 100))
(setf play-mode "resume")
(let ((tm))
(setf tm (stream-play-time 'stream-in))
(when (and tm (>= tm 0))
(setf seek-time (+ tm seconds))
(setf seek-time (* seek-time 1000))
(setf next-flag t)
(make-event 'request-play)
(send-play-time))))))
(defun seek (msec)
(setf req-pause nil)
(if (not content-uri)
(write-data play-time-buf 'int msec)
(when (or (not dlna-mode) (seek-capable-p))
(unless (eq msec (* (stream-play-time 'stream-in) 1000))
(temp-priority)
(setf play-mode "resume")
(setf seek-time msec)
(when (eq trik-speed 0)
(setf req-pause t)
(setf pause-play t))
(setf next-flag t)
(make-event 'request-play)
(send-play-time)))))
(defmacro hdd-stop ()
`(stop))
(defmacro hdd-play (speed)
`(play ,speed))
(defmacro hdd-pause ()
`(pause))
(defmacro hdd-skip (seconds)
`(skip ,seconds))
(defmacro dlna-stop ()
`(stop))
(defmacro dlna-stop2 ()
`(stop2))
(defmacro dlna-play (speed)
`(play ,speed))
(defmacro dlna-pause ()
`(pause))
(defmacro dlna-skip (seconds)
`(skip ,seconds))
(defmacro dlna-start-with-limit (uri index protocol free level)
`(dlna-start ,uri ,index ,protocol))
(defmacro dlna-resume-start-with-limit (uri index protocol seek free level)
`(dlna-resume-start ,uri ,index ,protocol ,seek))
(defun dlna-test-content (uri index protocol)
(if (stream-open 'stream-in
:mode "test"
:content-uri uri
:index-uri index
:dlna-protocol protocol)
1
0))
(defun divx-rental-confirm ()
(when (and rental-limit (> rental-limit 0))
(clear-msg)
(setf rental-confirm t)
(set-stream-info 'stream-in)
(setf play-mode "resume")
(setf seek-time nil)
(setf stream-valid nil)
(make-event 'rental-confirm)))
