(defvar *rh-bufs* nil)
(defvar *rh-ivf* nil)
(defvar *rh-len* 0)
(defvar *rh-plane* 2000)
(defun rh-init () (let* ((raw (%mmap-exec-page 6291456)) (a (logand (+ raw 2097151) (lognot 2097151))) (b (+ a 2097152))) (hvs-map-nc a 2097152) (hvs-map-nc b 2097152) (setq *rh-bufs* (list a b)) (hvs-blit-nc-init) (rh-pattern) *rh-bufs*))
(defun rh-ceil64 (n) (* 64 (ceiling n 64)))
(defun rh-copy-planes (pic buf) (let* ((y (reel.decode::picture-y pic)) (u (reel.decode::picture-u pic)) (v (reel.decode::picture-v pic)) (ysz (rh-ceil64 (length y))) (usz (rh-ceil64 (length u)))) (hvs-ncopy-nc buf (+ (%val->word y) 7) ysz) (hvs-ncopy-nc (+ buf ysz) (+ (%val->word u) 7) usz) (hvs-ncopy-nc (+ buf ysz usz) (+ (%val->word v) 7) usz) (list (+ buf (reel.decode::picture-y-offset pic)) (+ buf ysz (reel.decode::picture-uv-offset pic)) (+ buf ysz usz (reel.decode::picture-uv-offset pic)))))
(defun rh-plane-words (sw sh ys cs ptrs dx dy dw dh) (let* ((ks *hvs-kernel-slot*) (ppf (lambda (s d) (logior (ash 1 30) (ash (floor (* 65536 s) d) 8))))) (list (logior (ash 1 30) (ash 28 24) 8) (logior #xFF000000 (ash dy 12) dx) (logior (ash dh 16) dw) (logior (ash 1 30) (ash sh 16) sw) #xC0C0C0C0 (logior #xC0000000 (first ptrs)) (logior #xC0000000 (second ptrs)) (logior #xC0000000 (third ptrs)) #xC0C0C0C0 #xC0C0C0C0 #xC0C0C0C0 ys cs cs #x00f00000 #xe73304a8 #x00066604 0 (funcall ppf (ash sw -1) dw) (funcall ppf (ash sh -1) dh) #xC0C0C0C0 (funcall ppf sw dw) (funcall ppf sh dh) #xC0C0C0C0 ks ks ks ks #x80000000)))
(defun rh-show-plane (words) (let ((i 0)) (hvs-upload-kernel) (dolist (w words) (hvs-slot-wr32 (+ *rh-plane* i) w) (setq i (+ i 1))) (setf (mem-ref (+ (hvs-base) #x24) :u32) *rh-plane*) i))
(defun rh-pattern () (let* ((buf (first *rh-bufs*)) (sw 512) (sh 288) (cs 256) (ysz (* sw sh)) (usz (* cs (ash sh -1))) (bar 64) (levels (list 16 48 80 112 144 176 208 235)) (row 0)) (loop (when (>= row sh) (return nil)) (let ((x 0) (k 0)) (dolist (lv levels) (let ((w (logior lv (ash lv 8) (ash lv 16) (ash lv 24)))) (hvs-nfill-nc (+ buf (* row sw) x) bar (if (< row (ash sh -3)) (logxor w (if (evenp (+ k (ash row -4))) 0 #x20202020)) w))) (setq x (+ x bar) k (+ k 1)))) (setq row (+ row 1))) (hvs-nfill-nc (+ buf ysz) usz #x80808080) (hvs-nfill-nc (+ buf ysz usz) usz #x80808080) (rh-show-plane (rh-plane-words sw sh sw cs (list buf (+ buf ysz) (+ buf ysz usz)) 0 0 1920 1080)) (list 'pattern sw sh)))
(defun rh-yuv-plane (pic buf dx dy dw dh) (let* ((sw (reel.decode::picture-width pic)) (sh (reel.decode::picture-height pic)) (ys (reel.decode::picture-y-stride pic)) (cs (reel.decode::picture-uv-stride pic)) (ptrs (rh-copy-planes pic buf))) (rh-show-plane (rh-plane-words sw sh ys cs ptrs dx dy dw dh)) (list sw sh ys cs 0)))
(defun rh-present (pic buf) (let ((ptrs (rh-copy-planes pic buf)) (p (+ (hvs-base) #x2000 (* (+ *rh-plane* 5) 4)))) (setf (mem-ref p :u32) (logior #xC0000000 (first ptrs))) (setf (mem-ref (+ p 4) :u32) (logior #xC0000000 (second ptrs))) (setf (mem-ref (+ p 8) :u32) (logior #xC0000000 (third ptrs)))))
(defun rh-le32 (v i) (logior (aref v i) (ash (aref v (+ i 1)) 8) (ash (aref v (+ i 2)) 16) (ash (aref v (+ i 3)) 24)))
(defun rh-u8 (v n) (let ((o (make-array n :element-type (quote (unsigned-byte 8))))) (dotimes (i n) (setf (aref o i) (aref v i))) o))
(defun rh-load (url) (let* ((tb (net-fetch-bytes url)) (n (cdr tb))) (when (> n (%net-resp-cap)) (error "rh-load: ~a is ~a bytes but %net-resp-cap is ~a - bytes past the cap are silently DROPPED (build with MODUS_NET_BUFSZ)" url n (%net-resp-cap))) (setq *rh-ivf* (rh-u8 (car tb) n) *rh-len* n) (list (quote clip-bytes) n)))
(defun rh-first-frame () (let* ((vd (reel:make-decoder)) (sz (rh-le32 *rh-ivf* 32)) (pic (reel:decode-frame vd *rh-ivf* :start 44 :end (+ 44 sz)))) (rh-yuv-plane pic (first *rh-bufs*) 0 60 1920 1080)))
(defun rh-play (vsync) (let ((vd (reel:make-decoder)) (off 32) (n 0) (dec 0) (cp 0) (t-all (mem-ref #x3F003004 :u32))) (loop (when (>= (+ off 12) *rh-len*) (return nil)) (let* ((sz (rh-le32 *rh-ivf* off)) (s (+ off 12)) (e (+ s sz)) (t0 (mem-ref #x3F003004 :u32)) (pic (reel:decode-frame vd *rh-ivf* :start s :end e)) (t1 (mem-ref #x3F003004 :u32))) (let ((buf (if (evenp n) (first *rh-bufs*) (second *rh-bufs*)))) (if (= n 0) (rh-yuv-plane pic buf 0 60 1920 1080) (rh-present pic buf))) (setq cp (+ cp (- (mem-ref #x3F003004 :u32) t1))) (setq dec (+ dec (- t1 t0))) (when vsync (hvs-vsync)) (setq n (+ n 1)) (setq off e))) (let ((tot (- (mem-ref #x3F003004 :u32) t-all))) (list 'frames n 'total-ms (floor tot 1000) 'decode-ms (floor dec 1000) 'copy-ms (floor cp 1000) 'fps (floor (* 1000000 n) (max 1 tot))))))
